Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_3_19910112
-
utilities/palx.mid
There are no other files named palx.mid in the archive.
.SYMTAB 3511.
TITLE PALX
.NSTGW
IF1,[
VERSIO==.FVERS
;VARIABLE PARAMETERS.
IFNDEF ITS, ITS==0
IFNDEF TENEX, TENEX==0
IFNDEF TWENEX, TWENEX==0
IFNDEF SAIL, SAIL==0
IFE ITS\TENEX\TWENEX\SAIL,[
IFE .OSMIDAS-SIXBIT/ITS/, ITS==1
IFE .OSMIDAS-SIXBIT/TENEX/, TENEX==1
IFE .OSMIDAS-SIXBIT/TWENEX/, TWENEX==1
IFE .OSMIDAS-SIXBIT/SAIL/, SAIL==1
]
IFN TWENEX, TENEX==1 ;TWENEX IMPLIES TENEX
IFNDEF RELCOD,RELCOD==0 ; ASSUME MAKING ABSOLUTE
CORINC==2000 ; CORE INCREMENT
SPL== 4 ; SYMBOLS PER LINE (SYMBOL TABLE LISTING)
SPLTTY==3 ; SYMBOLS PER LINE (TTY)
ARADIX==8. ; ASSEMBLER RADIX
IFE RELCOD, DATLEN==350. ; DATA BLOCK LENGTH
IFN RELCOD, DATLEN==18.
CPW== 6 ; CHARACTERS PER WORD
WPB== 10 ; MACRO BLOCK SIZE
CPL== 120. ; CHARACTERS PER LINE
PDPLEN==300 ; PUSH-DOWN POINTER LENGTH
LSTBSZ==400 ;LISTING BUFFER SIZE.
IFN SAIL, LSTBSZ==203
SRCBSZ==2000 ;SOURCE BUFFER SIZE.
IFN TENEX,SRCBSZ==1777
IFN SAIL,SRCBSZ==200
TTIBSZ==60 ;COMMAND BUFFER SIZE.
SRCPSZ==8 ;LENGTH OF .INSRT PDL.
;;; No one could ever want extend feature -CBF
IFN SAIL, EXTEND==0 ; FOR 18-BIT ADDRESSING
IFE SAIL, EXTEND==0 ; FOR 16-BIT ADDRESSING
IFN EXTEND,[
ADRSIZ==18.
ADRMSK==777777
]
IFE EXTEND,[
ADRSIZ==16.
ADRMSK==177777
]
IFN ITS,FILCHR==3 ;FILE PADDING CHARACTER
IFN SAIL,FILCHR==0
IFNDEF PAGLPT,PAGLPT==60.-5*SAIL ;# LINES/PAGE ON LPT.
IFNDEF PAGXGP,PAGXGP==98. ;# LINES/PAGE ON XGP.
IFNDEF %COMP1,%COMP1==177777 ;INITIALL SETTING OF %COMPAT.
;ACCUMULATOR ASSIGNMENTS
N= 0 ; ACCUMULATION OF SIXBIT SYMBOL, SCRATCH
A= 1 ; SYMBOL VALUE AND FLAGS SET BY SRCH. SCRATCH
B= 2 ; SCRATCH
C= 3 ; SCRATCH
W= 4 ; CODE TO BE GENERATED. LH - TYPE, RH - VALUE
L= 5 ; LOCATION COUNTER
R6= 6 ; SCRATCH
S= 7 ; SYMBOL TABLE SEARCH INDEX
V= 10 ; EXPRESSION OR TERM VALUE, SCRATCH
T1= 11 ; SCRATCH
MP= 12 ; MACRO STORAGE BYTE POINTER
IP= 13 ; LINE BUFFER BYTE POINTER
I= 14 ; CURRENT CHARACTER (ASCII)
AF= 15 ; LH - ASSEMBLER FLAGS, RH - ERROR FLAGS
F= 16 ; EXEC FLAGS
P= 17 ; PUSH-DOWN POINTER
;FLAG REGISTERS (STILL UNDER IF1)
; F - LH
LSTBIT==000001 ;1 - WE'RE MAKING A LISTING.
BINBIT==000002 ;1 - WE'RE MAKING A BINARY.
CSWBIT==000004 ;1 - MAKE CREF-TYPE LISTING.
DSWBIT==000010 ; 1 - /D, JOB DISOWNED.
MSWBIT==000020 ; 1- SUPRESS MACRO LISTING
NSWBIT==000040 ; 1- SUPRESS ERRORS ON TTY
RSWBIT==000100 ; 1- REPRODUCE SOURCE
TTYBIT==000200 ; 1- LISTING IS ON TTY
PSWBIT==000400 ;1 - BINARY ON PTP:
SYMBIT==001000 ;1 - SUPPRESS SYM TAB IN BINARY.
LSWBIT==002000 ;1 - FORCE LISTING.
NULBIT==004000 ;1 - NO OUTPUT FILES GIVEN (NO "_").
BSWBIT==010000 ;1 - SUPPRESS BINARY.
ESWBIT==020000 ;1 - /E, FORCE ERROR FILE OUTPUT.
ERRBIT==040000 ;1 - ERROR FILE OPEN.
ERQBIT==100000 ;1 - ERROR FILE SPEC'D (BUT NOT NEC. OPEN YET)
; F - RH
ARWBIT==000001 ; 1- LEFT ARROW SEEN
INSBIT==000002 ; 1- READING FILENAME DURING .INSRT .
CHRBIT==000004 ; 1- RFILE RE-READS LAST CHAR (USED IN .INSRT)
INFBIT==000010 ; 1- VALID INFORMATION SEEN
FFBIT==000020 ; 1- FORM-FEED SEEN
ENDBIT==000400 ; 1- END OF ALL INPUT FILES
HDRBIT==040000 ; 1- TIME FOR NEW LISTING PAGE
; AF - LH
SUPFLG==000001 ;SUPPRESSED SYMBOL - "===".
INDFLG==000002 ;@ WAS SEEN IN ADDRESS.
SRCFLG==000004 ;HAVE READ WHOLE LINE, BUT NOT LISTED.
LINFLG==000010 ; 1- SUPPRESS LISTING OF LINE
ENDFLG==000020 ; 1- END OF SOURCE ENCOUNTERED
RSWFLG==000040 ; 1- LINE TO BE SUPPRESSED IN REDUCTION
TTYFLG==000100 ; 1- TTY MODE LISTING FORMAT
CONFLG==000200 ; 1- CONCATENATION CHARACTER SEEN
ASZFLG==000400 ; 1 FOR ASCIZ, 0 FOR ASCII PSEUDOOP
ROKFLG==001000 ; 1- REGISTER "OK" FLAG
REGFLG==002000 ; 1- REGISTER FLAG
HKLFLG==004000 ; 1- HALF KILLED SYMBOL BEING DEFINED
TTMFLG==010000 ; 1- .TTYMAC IN PROGRESS
EXTFLG==020000 ; 1- EXTERNAL SYMBOL REFERENCED
NDSFLG==040000 ; 1- DON'T ENTER UNDEFINED SYMS IN DICT.
LCHFLG==100000 ; 1- LOCATION COUNTER HAS CHANGED
LCRFLG==200000 ; 1- LOCATION COUNTER RELOCATABLE
LCRFBP==420100 ;BP TO LCRFLG.
P1F== 400000 ; 1- PASS 1 IN PROGRESS
;IN RH.
ERRU== 000040 ;SOME SYM WAS UNDEFINED.
ERRP1== 000001 ;LIST THIS LINE ON TTY (^D IN ERROR UUO).
;SYMBOL FLAGS, USU. IN A (ALONG WITH VALUE).
INDSYM==000040 ; VALUE OF SYMBOL DEPENDS ON ANOTHER SYMBOL
ENTSYM==000400 ; SYMBOL IS AN ENTRY POINT
EXTSYM==000200 ; SYMBOL IS EXTERNAL
RELSYM==000100 ; SYMBOL HAS RELOCATABLE VALUE
LBLSYM==001000 ;LABEL
MDLSYM==002000 ;MULTIPLY DEFINED LABEL FLAG
REGSYM==004000 ;REGISTER
UNDSYM==010000 ;UNDEFINED SYMBOL FLAG
HKLSYM==020000 ;HALF KILLED SYMBOL
SUPSYM==040000 ;DON'T OUTPUT THIS SYMBOL.
NCRSYM==100000 ;DON'T CREF THIS SYM.
INISYM==200000 ;PDP-11 INSTRUCTION, ERROR IF REDEFINED (BUT OK TO EXPUNGE).
;MISCELLANEOUS PARAMETERS (STILL UNDER IF1)
SETCHA= LDB I,IP ;RESTORE LAST CHAR READ.
CALL= PUSHJ P,
RET= POPJ P,
ERRUUO= 1^9 ;ERROR IN PASS 2 ONLY.
ERRUU1= 2^9 ;ERROR IN EITHER PASS.
.XCREF A,B,CALL,RET
IFN ITS+SAIL,[
;CHANNEL NAMES.
TTO== 0
BIN== 1
LST== 2
ERR== 3
TTI== 4
ERRC== 5
CMDC== 6
SRC== 7
]
; CREF FLAG CHARACTERS
CRFLIN==35
CRFSYM==36
CRFMAC==34
CRFOPC==33
CRR==15
LF==12
TAB==11
SPACE==40
RUBOUT==177
FF==14
INDBIT=="@
DEFINE POINT ?S,ADDR,B=-1
<<<<35.-.RADIX 10.,B>&77>_30.\<<.RADIX 10.,S>&77>_24.> ADDR>TERMIN
DEFINE PHASE A
OFFSET A-.
TERMIN
DEFINE DEPHASE
OFFSET 0
TERMIN
] ;END IF1 ON PAGE 1
IFN ITS,[
SBLK
IF1,[
;MAKE SURE ITS SYSTEM CALLS ARE DEFINED.
IFNDEF .IOT,[
IFE .OSMIDAS-SIXBIT/ITS/,[
.INSRT SYS:ITSDFS
]
IFN .OSMIDAS-SIXBIT/ITS/,[
.INSRT ITSDFS
]
.ITSDF
]
;ASSEMBLE A "NEW SYSTEM CALL" WITH NAME A, ARGS B.
DEFINE SYSCAL A,B
.CALL [SETZ ? SIXBIT/A/ ? B ((SETZ))]
.LOSE %LSCAL
TERMIN
DEFINE SYSCL A,B
.CALL [SETZ ? SIXBIT/A/ ? B ((SETZ))]
TERMIN
;OUTPUT CHAR IN B TO FILE X.
DEFINE UNIOB X
.IOT X,B
TERMIN
;INPUT CHAR FROM FILE X INTO B.
DEFINE UNIIB X
.IOT X,B
TERMIN
;X IS CHANNEL, B HAS BP, C HAS MINUS # BYTES.
;Y IS # BYTES/WD, OR NULL FOR 1.
DEFINE OUTBFR X,Y
IFNB Y, IDIVI C,Y
HRLI B,(C)
.IOT X,B
TERMIN
BUG==.LOSE
] ;IF1
] ;ITS
IFN TENEX,[
;.DECREL
.DECSAV
IF1,[
IFNDEF GTJFN,[
IFE .OSMIDAS-SIXBIT/ITS/,[
.INSRT SYS:TNXDFS
]
IFN .OSMIDAS-SIXBIT/ITS/,[
.INSRT TNXDFS
]
.TNXDF
];IFNDEF GTJFN
DEFINE UNIOB X
SAVE A
MOVE A,X!JFN
BOUT
REST A
TERMIN
DEFINE UNIIB X
SAVE A
MOVE A,X!JFN
BIN
REST A
TERMIN
DEFINE OUTBFR X,Y
MOVE A,X!JFN
SOUT
TERMIN
BUG==JRST 4, ; HALTF IS NORMAL EXIT
.VALUE==JRST 4,
] ;IF1
] ;TENEX
IFN SAIL,[
.DECREL
IF1,[
IFNDEF SPCWAR,[
IFE .OSMIDAS-SIXBIT/ITS/,[
.INSRT SYS:SAIDFS
]
IFN .OSMIDAS-SIXBIT/ITS/,[
.INSRT SAIDFS
]
.DECDF
]
EXPUNG RESCAN,GETLIN,GETCHR,SWITCH
DEFINE UNIOB X
IFSN X,TTO,[
SOSG X!HDR+2
OUT X,
CAIA
JRST 4,.
IDPB B,X!HDR+1
]
IFSE X,TTO,OUTCHR B
TERMIN
DEFINE UNIIB X
IFSN X,TTI,[
SOSG X!HDR+2
IN X,
CAIA
SKIPA B,[^C]
ILDB B,X!HDR+1
]
IFSE X,TTI,[
INCHWL B
CAIN B,^M
INCHWL B
]
TERMIN
BUG==JRST 4,
] ;IF1
] ;SAIL
IF1,[
;NEW MACROS
DEFINE SAVE $1,$2,$3,$4,$5,$6,$7,$8,$9,$10,$11,$12
IRP X,,[$1,$2,$3,$4,$5,$6,$7,$8,$9,$10,$11,$12]
IFSN X,, PUSH P,X
TERMIN
TERMIN
DEFINE REST $1,$2,$3,$4,$5,$6,$7,$8,$9,$10,$11,$12
IRP X,,[$1,$2,$3,$4,$5,$6,$7,$8,$9,$10,$11,$12]
IFSN X,, POP P,X
TERMIN
TERMIN
DEFINE INSIRP A,B
IRPS FOO,,[B]
A,FOO
TERMIN TERMIN
DEFINE ERROR1 ADDR,MSG
IFSN MSG,, ERRUU1 [<010000,,ADDR> ? ASCIZ\MSG\]
IFSE MSG,, ERRUU1 [ASCIZ\ADDR\]
TERMIN
DEFINE ERROR ADDR,MSG
IFSN MSG,, ERRUUO [<010000,,ADDR> ? ASCIZ\MSG\]
IFSE MSG,, ERRUUO [ASCIZ\ADDR\]
TERMIN
;RESTART READING FROM A (IN INBUF).
DEFINE RESCAN A/
MOVEI IP,GCHI
HRRM IP,GETCHA
MOVE IP,A
TERMIN
;NEWLIN FOO ;IN AN OUTPUT ROUTINE, MAKES ^@
;FOO: OUTPUT-1-CHAR ;OUTPUT BOTH CR AND LF.
; POPJ P,
DEFINE NEWLIN X
JUMPN B,X
SAVE B
MOVEI B,^M
CALL X
MOVEI B,^J
PUSH P,[POPBJ]
TERMIN
IFE RELCOD,[DEFINE LOCABS FOO,BAR ;IN ABS ASSEMBLY, ALL VALUES ARE ABS.
TERMIN ]
IFN RELCOD,[
DEFINE LOCABS FOO,BAR
CAIE A,
ERRUU!BAR!1 [ASCIZ\FOO Relocatable\]
CAIE C,
ERRUU!BAR!1 [ASCIZ\FOO External\]
TERMIN
]
] ; END IF1
;IMPURE AREA
.YSTGW
ZZZ==.
LOC 41
JSR UUOH
IFN ITS,TSINT ;ITS INT HANDLER.
LOC ZZZ
LOCTR: L,,0 ;@LOCTR GIVES .+OFFSET .
SYMTBA: 0 ;ADDRESS OF SYMBOL TABLE (= RH OF SYMPNT)
SYMPNT: S,, ;POINTER TO SYMBOL TABLE NAME WORD.
VALPNT: S,,-1 ;POINTER TO SYMBOL TABLE VALUE
IFE SAIL,JOBREL: 0 ;MEMORY BOUND.
CRFINS: JFCL\CALL CRFOUT ;INSN TO CREF SYM IN N, VAL IN A.
CRFIND: JFCL\CALL CRFODF ;CREF FOR DEFINING OCCURRENCE.
ARGRET: 0 ;ADRESS OF RTN FOR ARGC TO CALL,
RET ;JSR ARGRET TO SET COROUTINE START ADDRESS.
ARGTRM: 0 ;TEMP. USED BY ARGC ROUTINES.
BZCOR: ;BEGINNING OF CORE TO BE INITIALIZED TO ZERO
SYMLEN: 0 ;LENGTH OF SYMBOL TABLE
SYMAOB: 0 ;AOBJN PTR -> SYM. TAB.
MACTOP: 0 ;TOP OF MACRO STORAGE
MACPDP: 0 ;MACRO PDL POINTER.
MACBPT: 0 ;POINTS TO BOTTOM OF MACRO PDL FRAME.
MACLVL: 0 ;MACRO NESTING LEVEL
MACXIT: 0 ;ADDR OF ROUTINE TO CALL WHEN FINISH READING STRING.
;CALL THERE+1 FOR .MEXIT TO AVOID DOING MORE PASSES.
;WILL BE MACEND, REPEND, AIRPON OR AIRPCN .
ARGLST: BLOCK 65. ;;HOLD MACRO ARG NAMES DURING DEFINITION READING.
MWPNTR: BLOCK 1 ;MACRO WRITE POINTER
NEXT: BLOCK 1 ;MACRO STG FREE LIST (OF 10-WD BLOCKS)
%RPCNT: 0 ;VALUE OF .RPCNT .
%IRPCN: 0 ;VALUE OF .IRPCNT .
%NARG: 0 ;%NARG PSEUDO SYM, # ARGS TO INNERMOST MACRO CALL.
%SUCCE: 0 ;%SUCCESS PSEUDO SYM, 0 IF LAST COND FAILED, -1 OTHERWISE
SYMBEG: BLOCK 1 ;POINTER TO START OF SYMBOL FOR RESCAN PURPOSES
LINBUF: BLOCK CPL/5+1 ;SOURCE LINE BUFFER
LINIP: 0 ;LAST FILLED PLACE IN LINBUF.
LINEPP: 0 ;P SAVED AT ENTRY TO "LINE"; USED FOR PDL OV RECOVERY.
;0 IF NOT INSIDE THE RTN "LINE".
BYTCNT: BLOCK 1 ;BYTE COUNT
IFE RELCOD,[ ; THIS DATA NEEDED ONLY FOR BIN.
LODADR: BLOCK 1 ;LOAD ADDRESS
CURADR: BLOCK 1 ;CURRENT DATA BLOCK ADDRESS
CHKSUM: BLOCK 1 ;CHECK SUM
DATBBL: 0?0 ; 1,0 (BEG. OF BLOCK) GO HERE.
0?0 ;BLOCK LENGTH HERE
0?0 ;1ST ADDR HERE.
DATBLK: BLOCK DATLEN ;DATA BLOCK
]
IFN RELCOD,[ ; THIS IS RELOCATABLE CODE DATA
LOADRS: 0 ; LOAD ADDRESS OF CURRENT BLOCK
RELPNT: 0 ; BYTE POINTER TO RELOCATION BYTES
BLKHED: 0,,0 ; BLOCK HEADER, TYPE,,SIZE
BLKREL: 0 ; RELOCATION BYTES GO ICI
BLKDAT: BLOCK DATLEN ; DATA WORDS GO ICI
ABSLC: 0 ; ABSOLUTE LC SAVED HERE
RELLC: 0 ; RELOCATABLE LOCATION COUNTER SAVED ICI
INDWRD: 0 ; ALLOCATION WORD FOR INDIRECT TABLES
INDOFF: BLOCK 36. ; INDIRECT VALUE OFFSET TABLE
INDREF: BLOCK 36. ; INDIRECT VALUE SYMBOL TABLE
]
INSCNT: 0 ;# INSTRUCTIONS ASSEMBLED.
INSLEN: 0 ;# WDS IN INSTRUCTIONS (FOR AVG LENGTH)
IRUNTM: 0 ;RUN TIME AT START OF THIS COMMAND.
DATTIM: BLOCK 6 ;DATE & TIME AS ASCIZ STRING.
%YEAR: 0 ;THE CURRENT YEAR AS A NUMBER (LAST TWO DIGITS ONLY)
%MONTH: 0 ;THE CURRENT MONTH AS A NUMBER
%DAY: 0 ;THE CURENT DAY OF MONTH AS A NUMBER
PAGNUM: 0 ;PAGE NUMBER IN SRC.
PAGTOT: 0 ;PAGE NUM. IN LISTING.
PAGEXT: 0 ;PAGE EXTENSION
ERRNUM: 0 ;ERROR COUNT
NONFTL: 0 ;-1 AT FINIS2 IF NO FATAL ERROR
;(SO OK TO RENAME BIN,LST FILES)
CEXT: ;CODE EXTENSION BLOCK
CEXT1: 0 ; BYTES 3&4 OF CODE
CEXT2: 0 ; BYTES 5&6 OF CODE
IFN RELCOD,[
REXTAB: 0 ; RELOCATION OF CODE GOES HERE
REXT: ; NEXT TWO FOR ADDRESS FIELDS
REXT1: 0 ; RELOCATION FOR WORD 2 OF INSTRUCTION (SRC)
REXT2: 0 ; RELOCATION FOR WORD 3 OF INSTRUCTION (DST)
EEXTAB: 0 ; EXTERNAL REFERENCES, THIS FOR .WORD STUFF
EEXT: ; THESE TWO FOR ADDRESS FIELDS
EEXT1: 0 ; SRC
EEXT2: 0 ; DST
]
OFFST: 0 ;0 OF 1, FOR CEXT1 OR CEXT2
LLABN: 0 ;MOST RECENTLY DEFINED LABEL'S NAME,
LLABV: 0 ; VALUE.
LLABS: -1 ; "S" REG.
VALREQ: 0 ;UNDEF. SYM. IS ERROR IF >0.
CTLCF: 0 ;COMMAND TERM. BY ^C, EXIT WHEN DONE.
CTLSF: 0 ;SET => TYPEOUT SUPPRESSED BY ^S.
SRCEOF: 0 ;SET IF INTERNALLY DETECTED EOF.
STRTLC: 0 ;START ADDR PUT HERE BY .END .
LINPOS: 0 ;LSTSIX, ERROCT COUNT CHARS.
HSWCNT: 0 ;NUMBER OF TIMES /H OCCURRED.
LSWCNT: -1 ;# OF /L'S IN CMD STRING, + 1 ON PASS 2, - 1.
;LINES ARE LISTED IFF THIS WORD IS >0.
;SET TO 0 IF LISTING CAUSED EVEN IF NO /L WAS GIVEN.
LSWCN1: -1 ;COUNT IS ACCUMULATED HERE, THEN PUT IN LSWCNT
;CMD STRING IS READ SEVERAL TIMES. THIS AVOIDS
;COUNTING EACH /L EACH TIME.
%ABSAD: 0 ;#0 => GENERATE "@#FOO" FOR "FOO".
%COMPA: 0 ;NONZERO => CHECK FOR INSNS THAT ARE
;INCOMPATIBLE BETWEEN DIFFERENT PDP11'S.
%TTYFL: 0 ;NONZERO CAUSES TTY OUTPUT NOT TO BE DONE
;(IT IS THROWN AWAY). DOES NOT AFFECT OUTPUT
;TO LISTING OR ERROR FILE.
FAICND: 0 ;-1 WHILE INSIDE FAILING CONDITIONAL.
UNCONP: 0 ;PAGNUM, SAVED AT START OF FAILING CONDIT.
UNCONL: 0 ;SLNCNT, " ......"........"
RFILN: 0 ;ACCUMULATE FILENAMES IN THIS BLOCK.
XESAVE: 0 ;FN1 GOES HERE.
EXTSAV: 0 ;2ND NAME GOES HERE.
RFILSN: BLOCK 2 ;SNAME, ACCESS PTR GO HERE.
RFILN1=XESAVE
RFILN2=EXTSAV
RFILP: 0 ;0 IF NULL FILSPEC.
RFILNC: 0
IFN SAIL,[
RFPPNF: 0 ;reading PPN flag
swpblk: 0 ;used by SWAP uuo, DEV
swpnam: 0 ;dmp file NAME
swpext: 0 ;dmp file EXT,,mode bits
swpsa: 0 ;core size,,starting address offset
swpppn: 0 ;dmp file PPN
swpnpp: 0 ;new PPN if creating new job
];sail
TTICSV: 0 ;SAVE TTICNT HERE AFTER READING CMD .
TTICNT: 0
TTIPNT: 0
TTIBUF: BLOCK TTIBSZ
SRCBUF: BLOCK SRCBSZ
0
SRCCNT: 0 ;NUM. INPUT FILES OPENED SO FAR, -1 . (INCLUDES THOSE WHICH HAVE BEEN CLOSED)
SRCNUM: 0 ;# INPUT FILES OPENED BEFORE THE CURRENT ONE.
SRCERR: 0 ;WHAT SRCNUM HELD AT TIME OF LAST ERROR MESSAGE.
SRCDPH: 0 ;DEPTH IN .INSRT FILES, 0 IN OUTER LEVEL.
SRCBPT: 0 ;B.P. (ASCII) TO START OF BUFFER FOR CURRENT SRC FILE.
SRCBND: 0 ;B.P. TO A ^C AFTER END OF LAST SRC BUFFERFULL.
SRCPNT: 0 ;BP FOR ILDBING FROM SRC BUFFER.
SRCTTY: 0 ;-1 => SRC FILE IS TTY.
%FNAM2: 0 ;DECIMAL VAL OF 2ND NAME OF SRC.
LINCNT: 0 ;POS. IN LISTING PAGE.
SLNCNT: 0 ;POS. IN SOURCE PAGE, -1 .
TITBUF: BLOCK 20 ;TITLE, IN ASCIZ.
STITBF: BLOCK 20 ;SUBTITLE, IN ASCIZ.
TSLWRD: 0 ;SUPPRESS LISTING IF NOT 0.
NOCREF: 0 ;SUPPRESS CREF OUTPUT FOR SYMBOL USE.
LSTOPN: 0 ;-1 => LST FILE IS ACTUALLY OPEN (NOT JUST INTENDED TO BE OPENED).
CMDFIL: 0 ;CMD FILE NESTING LEVEL.
CMDPDL: BLOCK 20 ;IN TENEX VERSION, USED TO SAVE CMDCJF FOR PUSHED CMD FILES.
EZCOR:
CCLFLG: 0 ;FLAG ENTERED AT START + 1
IFN SAIL,[
TMPNBP: 0 ;NEXT BYTE POINTER FOR INPUT FROM TMPBUF
TMPBUF: BLOCK TTIBSZ
]
MSNAME: 0 ;INITIAL SNAME.
PAGSIZ: PAGLPT ;# LINES/PAGE IN LISTING (INCL. MARGINS)
TIMDIV: IFN ITS,100000. ;DIVISOR FOR RUNTIME PRINTOUT RTN.
IFN SAIL,1000.
IFN TENEX,0 ;(READ FROM SYSTEM ALONG WITH RUNTIME)
SRCJFN: -TENEX+IFN ITS+SAIL,SRC
SRCMOD: 2 ;BLOCK ASCII INPUT.
IFN SAIL,[
SRCREC: 0 ;RECORD COUNT
SRCWL: 0 ;# WORDS LEFT IN FILE
]
CMDCJF: -TENEX+IFN ITS+SAIL,CMDC
CMDCMO: 0 ;UNIT ASCII INPUT.
IFN SAIL,[
CMDCHD: 0
CMDCPN: 0
CMDCCN: 0
];IFN SAIL
IRPS X,,DEV FN1 FN2 SNM TNM JFN MOD HDR PNT CTR BUF
X==.IRPCN
TERMIN
LSTDEV: 0 ;LST FILE NAMES.
LSTFN1: 0
LSTFN2: 0
LSTSNM: 0
LSTTNM: 'LSTOUT
LSTJFN: -TENEX+IFN ITS+SAIL,LST
LSTMOD: 3 ;BLOCK ASCII OUTPUT.
LSTHDR: 0
LSTPNT: 0 ;BP INTO BUFFER.
LSTCNT: 0 ;# BYTES LEFT EMPTY.
LSTBUF: BLOCK LSTBSZ
ERRDEV: 0 ;ERROR OUTPUT FILE NAMES.
ERRFN1: 0
ERRFN2: 0
ERRSNM: 0
ERRTNM: 'ERROUT
ERRJFN: -TENEX+IFN ITS+SAIL,ERR
ERRMOD: 1 ;UNIT ASCII OUT.
IFN SAIL,[
ERRHDR: 0 ;DEC VERSION BUFFER HEADER.
ERRPNT: 0 ;(IT IS 3 WDS LONG)
ERRCNT: 0
ERRBUF: BLOCK 203
]
BINDEV: 0 ;BINARY OUTPUT FILE NAMES.
BINFN1: 0
BINFN2: 0
BINSNM: 0
BINTNM: 'BINOUT ;TEMP. FN2 TO USE.
BINJFN: -TENEX+IFN ITS+SAIL,BIN
BINMOD: 7 ;BLOCK IMAGE OUT.
BINHDR: 0
BINPNT: 0
BINCNT: 0
IFN SAIL,[
BINBUF: BLOCK 203
BINBSZ==203 ]
IFE RELCOD+SAIL,[
BINBUF==DATBLK
BINBSZ==DATLEN ]
IFN SAIL,[
OPNMD: 10 ;10 FOR OUTPUT, 17 FOR INPUT
OPNDV: 0
OPNHD: 0
ENTNM: 0
ENTEX: 0
0
ENTPPN: 0
]
IFN TENEX,[
TTIJFN: 0 ;JFNS FOR THE VARIOUS FILES
TTOJFN: 0
STRTMP: BLOCK 40 ;SCRATCH FOR STRING CONVERSION
PSIACA: 0 ;AC A DURING PSI
JBLOCK: BLOCK 11 ;LONG FORM GTJFN BLOCK
JBKSTR: BLOCK 100 ;STRING STORAGE FOR 7-BIT JFN ARGS
JBKSTE=.-1
JBKSPT: BLOCK 1 ;POINTER INTO STRING STORAGE
LEVTAB: PIPC1 ;WHERE TO STORE LVL 1 PC.
0
0
CHNTAB: 1,,PSICO ;^O INT. CHNL, LVL 1, CALL PSICO.
REPEAT 35,0
CHNMSK: SETZ
PIPC1: 0
] ;END TENEX STORAGE
NODEFN: 0 ;SYMBOL NOT TO BE DEFINED.
PDL: BLOCK PDPLEN
PAT:
PATCH: BLOCK 100
;ONCE-ONLY INITIALIZATIONN.
PALX11: TDZA A,A ;CLEAR CCL ENTRY FLAG
CCLX11: SETO A, ;SET CCL ENTRY FLAG
MOVEM A,CCLFLG ;STORE FOR LATER CHECKS
MOVE P,[-PDPLEN,,PDL-1]
IFN ITS,[
.FDELE [SIXBIT/ DSK_PALX_BINOUT /]
JFCL
.FDELE [SIXBIT/ DSK_PALX_LSTOUT /]
JFCL ;DELETE ANY WORTHLESS OUTPUT FILES.
.FDELE [SIXBIT/ DSK_PALX_ERROUT /]
JFCL
.OPEN TTI,[SIXBIT/ TTY/]
BUG
.OPEN TTO,[SIXBIT/ !TTY/]
BUG
.SUSET [.SMASK,,[200000]] ;PDL OV ONLY.
.SUSET [.SMSK2,,[1_TTI]]
]
IFN TENEX,[
MOVEI A,100 ;INITIAL TTI AND TTO JFNS
MOVEM A,TTIJFN
MOVEI A,101
MOVEM A,TTOJFN
MOVEI A,400000 ;THIS FORK
CIS ;CLEAR INTERRUPTS IN PROGRES,, ETC.
MOVE B,[LEVTAB,,CHNTAB] ;POINTERS TO INTERRUPT PARAMS
SIR ;SET INTERRUPT VECTOR
EIR ;TURN THEM ON
MOVE B,CHNMSK ;AND MASK FOR CHANNELS ON
AIC
MOVSI A,17 ;ASSIGN CONTROL O TO CHANNEL 0
ATI
IFN TWENEX,[
MOVEI A,0
RSCAN
TDN
SKIPE B,A
RSCAN1: PBIN
CAIE A,40
SOJG B,RSCAN1
]
]
IFN SAIL,SETZM TMPNBP
IFN ITS\TENEX,MOVEI A,JOBFFI
IFN SAIL,MOVE A,JOBFF
HRRM A,SYMPNT ;SYM TAB ALWAYS STARTS RIGHT ABOVE
HRRZM A,SYMTBA ;LAST ASSEMBLED STUFF.
SETZM %TTYFL
MOVE N,[.FNAM1] ;IDENTIFY SELF.
CALL TTOSIX
MOVEI B," ;SPACE
CALL TYO
MOVEI N,.FVERS
CALL TTODEC
;FALLS THROUGH
;FALLS THROUGH.
;COME HERE TO REINITIALIZE, READ A COMMAND AND THEN ASSEMBLE.
RESTRT: ;FIRST CLEAR I/O SYSTEM AND FLUSH EXTRA CORE.
IFN TENEX,[
RESET ;CLEAR SYSTEM STUFF, FILES,...
IRPS X,,[SRCJFN,BINJFN,LSTJFN,ERRJFN]
SETOM X
TERMIN
SETO A, ;CLEAR MAP OF SCRATCH PGS
LDB B,[111100,,SYMTBA]
HRLI B,400000
PMAP
ADDI B,1
TRNN B,400
JRST .-3
]
IFN SAIL,[
RESET
MOVE A,SYMTBA
SUBI A,1
CORE A,
BUG
]
IFN ITS,[
.IOPDL
SKIPE MSNAME ;PUT OUR REMEMBERED DEFAULT INTO SYSTEM VAR IN CASE FOO^S .
.SUSET [.SSNAM,,MSNAME]
SYSCAL TTYSET,[1000,,TTI ? [222020,,202020] ? [232020,,220220]]
LDB A,[121000,,SYMTBA]
.CORE 1(A)
.VALUE
]
MOVE P,[-PDPLEN,,PDL-1]
SETZB F,AF ;CLEAR ALL FLAGS
MOVE N,[XWD BZCOR,BZCOR+1]
SETZB A,BZCOR
BLT N,EZCOR-1
;FALLS THROUGH.
;FALLS THROUGH.
;OBTAIN THE COMMAND (FROM SUPERIOR OR FROM TTY)
CALL TTYCR
IFN ITS,[
;TRY TO GET IT FROM SUPERIOR.
.SUSET [.ROPTIO,,I]
TLNN I,40000 ;IF SUPERIOR MAY HAVE CMD FOR US, READ IT.
JRST RESTR1
.BREAK 12,[5,,TTIBUF] ;IF DDT STRING, READ IT.
SKIPN TTIBUF
JRST RESTR1
SETOM CTLCF ;CAUSE EXIT AFTER EXECUTION,
MOVE IP,[440700,,TTIBUF]
MOVEM IP,TTIPNT ;SET UP POINTER,
ILDB I,IP
CAIE I,^M
AOJA A,.-2 ;COUNT CHARS.
MOVEM A,TTICNT
.BREAK 12,[SETZ [0](5)] ;FLUSH CMD STRING.
JRST RESTR9
]
IFN SAIL,[
SKIPN CCLFLG
JRST RESTR1 ;NOT STARTED AT STARTING ADDRESS + 1
SKIPE TMPNBP
JRST TMPNXT
MOVE A,[1,,[SIXBIT /PAL / ? -TTIBSZ,,TMPBUF-1 ]]
TMPCOR A, ;READ TMPCOR FILE, RETURN LENGTH IN A
JRST TMPCFL ;ATTEMPT TO READ TMPCOR FILE FAILED
TMPFIL: CAILE A,TTIBSZ-1
MOVEI A,TTIBSZ-1
SETZM TMPBUF(A)
MOVE W,[440700,,TMPBUF]
MOVEM W,TMPNBP
TMPNXT: MOVE B,[440700,,TTIBUF]
MOVEM B,TTIPNT
MOVEI A,0
TMPLUP: ILDB C,TMPNBP
IDPB C,B
JUMPE C,TMPDON
CAIN C,12
AOJA A,TMPEOL
AOJA A,TMPLUP
TMPDON: SETOM CTLCF
TMPEOL: MOVEM A,TTICNT
JRST RESTR9
TMPCFL: PJOB A, ;GET JOB NUMBER IN A
IDIVI A,10.
MOVE C,B
IDIVI A,10.
DPB B,[060300,,C]
DPB A,[140300,,C]
ADDI C,202020
HRLZ A,C
HRRI A,'PAL
MOVSI B,'TMP
SETZB C,W
INIT CMDC,17
SIXBIT /DSK/
0
JRST TMPGVP
LOOKUP CMDC,A
JRST TMPGVP
MOVS A,W ;-WORD COUNT
MOVN A,A
CAIL A,TTIBSZ
JRST TMPGVP
INPUT CMDC,[-TTIBSZ,,TMPBUF-1 ? 0]
RELEASE CMDC,
JRST TMPFIL
TMPGVP: RELEASE CMDC,
SETOM CTLCF
JRST RESTR1
];END OF IFN SAIL CONDITIONAL
RESTR1: CALL TTILIN ;READ COMMAND FROM TTY.
RESTR9:
IFN ITS,.SUSET [.RSNAM,,MSNAME]
IFN SAIL,[
MOVEI A,0
DSKPPN A,
MOVEM A,MSNAME
]
SKIPN N,TTICNT ;SAVE NUM CHARS FOR PASS 2.
JRST FINIS5 ;NULL COMMAND, EXIT OR RESTART.
MOVE N,TTICNT
MOVEM N,TTICSV
CALL GETDAT ;PUT ASCII DATE & TIME INTO DATTIM.
;SEE WHETHER COMMAND CONTAINS UNQUOTED "_".
;ALSO, COUNT THE /L'S AND /H'S IN THE CMD STRING,
;AND SET THE BITS FOR ALL OTHER SWITCHES EXCEPT /T.
SETOM LSWCN1
SAVE TTICNT
SAVE TTIPNT
TSTAR0: CALL RFILE ;READ ALL FILENAMES.
TRZN F,ENDBIT ;UNTIL END OF CMD STRING.
JRST TSTAR0
TLZ AF,TTYFLG ;CANCEL /T SWITCH.
TRZN F,ARWBIT ;IF SAW NO ARROW,
TLO F,NULBIT ;SAY SO.
REST TTIPNT
REST TTICNT
MOVE A,LSWCN1 ;SAVE # OF /L'S WHERE REMAINING PASSES
MOVEM A,LSWCNT ;THRU CMD STRING WON'T CHANGE IT.
;FALLS THROUGH
;FALLS THROUGH.
;COMPUTE SIZES OF AND SET UP POINTERS TO VARIOUS TABLES.
MOVEI A,2_10. ;GET HASH TABLE SIZE.
LSH A,@HSWCNT
SUBI A,1
MOVEM A,SYMLEN ;STORE IT.
MOVNM A,SYMAOB ;STORE AOBJN PTR.
HRLZS SYMAOB
MOVE B,SYMTBA ;SYMTAB START + # ENTRIES =
ADDI B,1(A) ;ADDR OF TABLE OF 2ND WDS (VALUES)
HRRM B,VALPNT
ADDI B,(A) ;ADDR OF WD AFTER ITS END.
MOVEM B,MACTOP ;MACRO STORAGE STARTS THERE.
ADDI B,100
;NOW ALLOCATE CORE FOR THEM.
IFN ITS,[
LSH B,-10.
.CORE 1(B)
.VALUE
.SUSET [.RMEMT,,JOBREL]
]
IFN TENEX,[
MOVEM B,JOBREL
]
IFN SAIL,[
CORE B,
BUG
]
HRRZ A,SYMTBA
HRLS A ;CLEAR THE CORE WE JUST GOT.
ADDI A,1
MOVE B,JOBREL
SETZM -1(A)
BLT A,-1(B)
;PUT INITIAL SYMBOLS INTO HASH TABLE.
MOVE B,[-INILEN,,INITAB]
INIT0: MOVE N,(B) ;GET, HASH NAME.
CALL SRCH
JFCL
AOBJN B,.+1
MOVE A,(B) ;GET, STORE VALUE.
MOVEM A,@VALPNT
MOVEM N,@SYMPNT
AOBJN B,INIT0
;FALLS THROUGH.
;FALLS THROUGH.
;READ THE FILE NAMES AND OPEN THE FILES.
MOVE B,MSNAME ;DEFAULT SNAME.
MOVEM B,RFILSN
CALL GETBIN ;INITIALIZE THE BINARY FILE
CALL GETLST ;INITIALIZE THE LISTING FILE
CALL GETERR ; ERROR FILE.
TLO AF,P1F ;MUST SAY PASS 1 BEFORE CALL INIPAS.
CALL INIPAS
CALL GETSRC ;INITIALIZE THE SOURCE FILE
MOVEI S,BINDEV
TLNE F,BINBIT ;IF SHOULD OPEN BINARY, DO IT NOW.
CALL OINIT
MOVEI S,LSTDEV
TLNE F,LSTBIT
TLNE F,TTYBIT
JRST INIT1
CALL OINIT ;IF SUPPOSED TO, OPEN LST FILE,
SETOM LSTOPN ;AND SAY IT'S OK TO OUTPUT TO IT NOW.
INIT1: MOVEI S,ERRDEV
TLNE F,ERQBIT ;OPEN ERR FILE IF WANTED.
CALL OINIT ;(DON'T SET ERRBIT TILL ERR FILE OPENED
TLNE F,ERQBIT ;SO ERRORS OPENING SRC, BIN, LST DON'T GET IOCERR
TLO F,ERRBIT ;TRYING TO PUT ERR MSG IN ERR FILE)
IFN ITS,[
TLNE F,DSWBIT ;IF SAID TO DISOWN SELF, DO IT.
CALL INITD
]
CALL ASSEMB ;CALL THE ASSEMBLER
;FALLS THROUGH
;FALLS THROUGH.
;PRINT VARIOUS MESSAGES ON TTY ABOUT THE ASSEMBLY.
CALL ERRFCR ;TURN ON TTY OUTPUT, SKIP A LINE
SKIPN A,ERRNUM ;TEST ERRORS, LOAD A
JRST NOERRS
CALL ERRDEC ;PRINT NUM. ERRS.
MOVEI A,[ASCIZ/ Errors Detected/]
CALL ERRSTR
CALL ERR2CR
NOERRS: MOVE A,INSLEN ;GET AVERAGE INSN LENGTH.
JUMPE A,FINIS1 ;(NO MESSAGE IF NO INSNS)
IMULI A,10.
IDIV A,INSCNT
IDIVI A,10. ;WANT THE 1ST FRACTIONAL DIGIT.
SAVE B
CALL ERRDEC ;TYPE INTEGER PART.
MOVEI B,".
CALL ERROUT
REST A
CALL ERRDEC ;TYPE FRACTIONAL DIGIT.
MOVEI A,[ASCIZ/ Words Average Instruction Length/]
CALL ERRSTR
CALL ERR2CR
FINIS1:
IFN ITS,[
.SUSET [.RRUNT,,A] ;CURRENT RUNTIME.
SUB A,IRUNTM ;DEDUCT STARTING TIME
IDIVI A,10000. ;CONVERT TO SECONDS.
IMULI A,4069.
]
IFN TENEX,[
MOVEI A,400000 ;RUN TIME OF THIS FORK
RUNTM
SUB A,IRUNTM ;MINUS WHEN STARTED ASSY
]
IFN SAIL,[
MOVEI A,0
RUNTIM A,
SUB A,IRUNTM
]
IDIV A,TIMDIV ;A_# SECONDS, B_FRACTION.
LSH B,1
CAML B,TIMDIV ;>1/2 SECOND => ROUND UP.
ADDI A,1
CALL ERRDEC ;PRINT NUM. SECONDS.
MOVEI A,[ASCIZ / Seconds Runtime/]
CALL ERRSTR
CALL ERRCR
;FALLS THROUGH.
;FALLS THROUGH.
;CLOSE AND MAYBE RENNAME THE FILES.
SETOM NONFTL ;ASSEMBLY FINISHED, OK TO RENAME BIN, LST.
;COME HERE IF ENCOUNTER FATAL ERROR. (EG TOO MANY SYMS)
FINIS2: MOVEI S,ERRDEV ;RENAME ERR FILE (IF ANY) IN ANY CASE.
CALL OCLOS1
MOVEI S,SRCJFN-JFN
CALL ICLOSE ;CLOSE SRC FILE.
CALL BINCLS ;CLOSE BINARY, WRITE LAST BUFFER.
TLNN F,TTYBIT
TLNN F,LSTBIT ;IF HAVE LST FILE,
JRST FINIS5
CALL LSTCLS ;FINISH LAST BLOCK OF LISTING
FINIS5:
IFN ITS,.LOGOUT ;...IF DISOWNED.
SKIPN CTLCF ;EXIT IF SHOULD,
JRST RESTRT ;ELSE NEW CMD STRING.
IFN ITS, .BREAK 16,160000
IFN SAIL, EXIT
IFN TENEX, RESET ? HALTF
IFN ITS,[
;DISOWN SELF, DON'T DO TTY I-O.
INITD: .OPEN TTI,[SIXBIT/ NUL/]
.VALUE ;PREVENT "TTY" IO FROM HANGING.
.OPEN TTO,[SIXBIT/ !NUL/]
.VALUE
.VALUE [ASCIZ/:PROCEED :DISOWN /] ;GIVE BACK TTY.
RET
]
;ROUTINES TO READ AND DEFAULT THE NAMES FOR THE OUTPUT FILES,
;AND TO DECIDE WHICH OF THEM ARE WANTED.
;THESE ROUTINES DO NOT ACTUALLY OPEN THE FILES.
;THEY DO SOMETIMES INITIALIZE BUFFERS, ETC.
;INITIALIZE A BINARY FILE, DEFAULTING DEV TO DSK, FN2 TO BIN.
;IF /P IS GIVEN, ALWAYS WRITE TO PTP IN 8-BIT MODE.
;ELSE IF NULL FILSPEC, NO BIN.
GETBIN: CALL RFIL0
TLNN F,PSWBIT+NULBIT+SYMBIT ;/P OR /S OR NO "_"
SKIPE RFILP ;OR NONNULL BIN SPEC
TLNE F,BSWBIT ;AND IF /B NOT GIVEN,
RET
MOVE B,[RFILN,,BINDEV] ;MAKE BIN FILE.
BLT B,BINSNM ;COPY NAMES.
SKIPN B,BINFN2
IFN RELCOD, MOVSI B,'REL
IFE RELCOD,MOVSI B,'BIN
MOVEM B,BINFN2 ;DEFAULT THE FN2, AND THE DEV.
MOVSI B,'DSK
TLNE F,PSWBIT
MOVSI B,'PTP
SKIPN BINDEV
MOVEM B,BINDEV
TLNE F,PSWBIT ;/P IMPLIES NO SYMS.
TLO F,SYMBIT
TLO F,BINBIT ;SAY WE'RE MAKING A BIN FILE.
SETZM BINCNT ;SAY NOTHING YET PUT IN BINBUF
RET
;INITIALIZE A LISTING FILE
;IF ARWBIT OR ENDBIT, DOESN'T ACTUALLY READ ANYTHING.
;IF ON TTY, SETS TTYBIT.
GETLST: CALL RFILL ;READ FILE NAME, SET FOR INPUT.
SKIPGE LSWCNT ;IF AT LEAST 1 /L APPEARED,
TLNE F,RSWBIT+CSWBIT ;OR /R OR /C,
JRST .+3
SKIPN RFILP ;OR NONNULL LST SPEC => WRITE LST.
RET
SKIPGE LSWCNT ;IF NO /L'S IN CMD, SAY THERE WAS 1.
SETZM LSWCNT ;(LIST ON PASS 2 ONLY)
MOVS B,RFILN ;FULL WORD DEVICE NAME
CAIE B,'TTY
JRST GETLS1
TLO F,TTYBIT+LSTBIT
JRST ERRTTY ;TEST FOR RUNNING DISOWNED.
GETLS1: MOVE B,[RFILN,,LSTDEV]
BLT B,LSTSNM ;COPY NAMES FROM SPEC.
MOVSI B,'DSK
SKIPN LSTDEV
MOVEM B,LSTDEV
IFN ITS, MOVE B,[SIXBIT/LIST/]
IFN TENEX+SAIL, MOVSI B,'LST
TLNE F,CSWBIT ;DEFAULT FN2 TO LIST,
IFN ITS, MOVE B,[SIXBIT/CREF/] ;OR CREF IF /C.
IFN TENEX+SAIL, MOVSI B,'CRF
SKIPN LSTFN2
MOVEM B,LSTFN2
TLO F,LSTBIT ;ELSE INDICATE HAVE LISTING.
SETZM LSTCNT ;SAY NOTHING YET PUT IN LSTBUF
RET
;DECIDE WHETHER AN ERROR OUTPUT FILE IS WANTED,
;AND READ AND DEFAULT IT'S NAMES IF IT IS.
GETERR: CALL RFILL ;READ IN NAMES.
TLNE F,DSWBIT+NSWBIT+ESWBIT ;IF WON'T HAVE ERRORS ON TTY,
JRST .+3 ;OR /E WAS GIVEN,
SKIPN RFILP ;OR HAD ERR SPEC,
RET
MOVE B,[RFILN,,ERRDEV]
BLT B,ERRSNM ;COPY NAMES FOR LATER RENAME.
MOVSI B,'DSK
SKIPN ERRDEV
MOVEM B,ERRDEV
MOVE B,[SIXBIT/ERRORS/]
SKIPN ERRFN2
MOVEM B,ERRFN2
TLO F,ERQBIT ;SAY WE'RE MAKING AN ERROR FILE.
RET
;INITIALIZE A SOURCE FILE
;READS THE FILENAMES FROM THE COMMAND BUFFER,
;DEFAULTING DEVICE, SNAME AND FN1 TO THOSE PREVIOUSLY USED,
;DEFAULTING FN2 TO '>' .
;OPENS THE FILE AND SAVES REAL FN1 AND FN2 FOR PRINTING ON LISTING.
GETSRC: SAVE N,A
CALL RFILE ;READ FILE NAME.
;ENTER HERE FOR .INSRT AFTER PUSHING SRC INFO ON MACPDL.
GETINS: SAVE S
IFN ITS, MOVSI B,(SIXBIT/>/)
;IFN TENEX, MOVSI B,'P11
IFN TENEX, MOVE B,[SIXBIT/PALX/]
IFN SAIL, MOVSI B,'PAL
SKIPN RFILN2 ;DEFAULT 2ND NAME.
MOVEM B,RFILN2
SETZM SRCEOF ;HAVEN'T SEEN .EOT IN THIS FILE.
SETZM SRCTTY ;ASSUME THIS FILE ISN'T THE TTY.
MOVS B,RFILN ;DON'T REOPEN TTY! (WOULD .RESET)
CAIN B,(SIXBIT/TTY/)
JRST GETSR1
MOVEI S,SRCJFN-JFN
CALL IINIT ;OPEN SRC FILE.
JRST GETSX1 ;FAILED.
GETSR1: SKIPE SRCDPH ;IF THIS IS PART OF .INSRT, LIST THE LINE WITH THE PSEUDO.
CALL ENDLF
SKIPN RFILN1 ;IF DEV HAS NO NAMES,
MOVEM N,RFILN1 ;STORE SPECIFIED NAME.
MOVE N,RFILN1
SKIPN LSTFN1 ;DEFAULT LST, BIN, ERR FN1'S TO SRC'S.
MOVEM N,LSTFN1
SKIPN BINFN1
MOVEM N,BINFN1
SKIPN ERRFN1
MOVEM N,ERRFN1
AOS B,SRCCNT ;SRCNUM IDENTIFIES THIS SRC FILE.
MOVEM B,SRCNUM
MOVE B,SRCBPT ;SAVE PTR TO START OF BUFFER.
MOVEM B,SRCPNT
MOVEM B,SRCBND ;SAY BUFFER EMPTY.
MOVEI B,^C
IDPB B,SRCBND
SETOB B,PAGEXT ;NOW STARTING PAGE 1.
MOVNM B,PAGNUM
SETZM SLNCNT ;LINE 1.
TRO F,HDRBIT ;START PAGE IN LISTING
IFN ITS+SAIL,[
MOVE B,[440600,,RFILN2]
SETZ 0, ;ACCUM. %FNAM2 IN 0.
FNAM2A: ILDB A,B
CAIL A,'0 ;IGNORE NON-DIGITS.
CAILE A,'9
JRST FNAM2B
IMULI 0,10. ;READ IN DIGITS AS DECIMAL NUM.
ADDI 0,-'0(A)
FNAM2B: TLNE B,770000 ;READ TILL END OF WD.
JRST FNAM2A
MOVEM 0,%FNAM2 ;SET VALUE OF %FNAM2.
]
IFN TENEX,[ ;USE FILE VERSION # AS %FNAM2.
SAVE C
SETZM %FNAM2 ; ASSUME IS ZERO (INCASE NOT DSK)
MOVS B,RFILN ; GET DEVICE NAME
CAIE B,'DSK ; DSK?
JRST FNAM2C ; NO - SKIP GTFDB
MOVE A,SRCJFN
MOVE B,[1,,7] ;READ THE VERSION #.
MOVEI C,%FNAM2 ;INTO %FNAM2.
GTFDB
HLRZS %FNAM2 ;VERSION RETURNED IN LH.
FNAM2C: REST C
]
REST S,A,0
MOVS B,RFILN
CAIE B,'TTY ;IF SRC IS TTY,
RET
SETOM SRCTTY ;SPECIAL STUFF FOR INPUT.
ERRTTY: TLNN F,DSWBIT ;IF WILL BE DISOWNED, CAN'T USE TTY.
RET
CALL ERRFCR
MOVEI A,[ASCIZ/Using TTY while disowned?/]
JRST CMDERR
;.INSRT PSEUDO - PUSH INTO FILE WHOSE NAME FOLLOWS THE PSEUDO.
AINSRT:
IFN SAIL,[
SKIPE SRCTTY
JRST AINSR3 ;.INSRT IN TTY INPUT IS OK
MOVE B,RFILN
CAME B,[SIXBIT /DSK/]
ERROR1 ENDL,.INSRT in non-disk source
]
AINSR3: MOVE A,SRCDPH ;DON'T ALLOW PUSH TOO DEEP.
CAIL A,SRCPSZ
ERROR1 ENDL,.INSRT PDL overflow
SAVE F,RFILN,RFILN1,RFILN2,RFILSN
MOVSI B,'DSK ;DON'T CLOBBER CMD-STRING NAME DEFAULTS,
MOVEM B,RFILN ;DEFAULT THIS FILE'S DEV TO DSK.
TRO F,INSBIT+CHRBIT ;TELL RFILE TO READ FROM ASSEMBLY INPUT.
CALL RFILE ;READ NAME OF FILE TO INSERT.
SETCHAR
TRZA F,INSBIT ;MOVE TO END OF LINE .INSRT'S ON.
AINSR1: CALL @GETCHA
CAIE I,^J
JRST AINSR1
AINSR2: HRRZ B,MACPDP ;PUSH OUTER FILE'S NAMES ONTO MACPDL.
IFN TENEX,[PUSH B,SRCJFN
SETOM SRCJFN]
IFN SAIL,[
PUSH B,SRCREC
PUSH B,SRCWL
]
REST 1(B),2(B),3(B),4(B),F
MOVEI B,4(B)
IRPS X,,SLNCNT PAGEXT PAGNUM SRCTTY SRCBPT SRCPNT SRCBND SRCNUM MP
PUSH B,X
TERMIN
HRRM B,MACPDP ;SAVE ALL INFO ON CURRENT SRC FILE
SETZ MP, ;PUSH OUT OF ANY MACRO CALL.
AOS B,SRCDPH ;ONE .INSRT LEVEL DEEPER NOW.
IFN ITS+TENEX, ADDI B,200(B)
IFN ITS,[.IOPUS SRC,
SYSCAL CORBLK,[(SETZ 1000) ? 1000,,-1 ? 1000,,(B) ? 1000,,400001]
SYSCAL CORBLK,[(SETZ 1000) ? 1000,,-1 ? 1000,,1(B) ? 1000,,-1 ? 1000,,0]
;THOSE CALLS GET FRESH PAGE # 200+2N, SHARE PAGE 0 AS PAGE 200+2N+1.
]
IFN ITS+TENEX,[
LSH B,10. ;ADDR OF START OF FRESH PAGE.
HRRM B,SRCBPT ;THAT PAGE IS BUFFER FOR THIS SRC FILE.
]
IFN SAIL,[
MOVE B,[440700,,SRCBUF]
MOVEM B,SRCBPT
]
CALL GCHSE0 ;GET CHARS FROM SRC FILE (NOT FROM MACROS, ETC)
SAVE N,A
JRST GETINS ;NOW GO OPEN INSERTED FILE.
GETSX1: SKIPN SRCDPH ;INPUT OPEN FAILED:
JRST OPENL ;NOT IN .INSRT => FATAL.
MOVSI B,'TTY ;IN .INSRT, CHANGE DEV. TO TTY:
MOVEM B,RFILN
SAVE F
TLZ F,NSWBIT ;TYPE OUT THIS ERR MSG EVEN IF DON'T TYPE MOST ERRORS.
ERROR1 [.INSRT OPEN failed, TTY: inserted instead:]
REST F
JRST GETSR1
;OPEN AN INPUT FILE. S POINTS TO ITS FILE BLOCK.
;ONLY THE JFN AND MOD WORDS OF THE FILE BLOCK MUST EXIST.
;THE FILENAMES ARE ASSUMED TO BE IN RFILN, RFILN1, RFILN2, RFILSN.
IINIT:
IFN ITS,[
SYSCL OPEN,[JFN(S) ? 4000,,MOD(S) ? RFILN ? RFILN1 ? RFILN2 ? RFILSN]
RET
HRLZ B,JFN(S)
HRRI B,RFILN
MOVE N,RFILN1 ;SAVE IN CASE NON-DIR-DEV.
.RCHST B, ;GET REAL FN1, FN2.
HRLZS RFILN
JRST POPJ1
]
IFN TENEX,[
SAVE A,B
CALL ICLOSE
MOVEI A,RFILN1
CALL JBKINI
MOVEI A,JBLOCK+2
SKIPE C,RFILN
CALL JBKSIX
MOVSI A,100000 ;OLD FILE, INPUT
MOVEM A,JBLOCK
MOVEI A,JBLOCK
MOVEI B,0
GTJFN
JRST POPBAJ ;CANT GET JFN OF SOURCE
MOVEM A,JFN(S)
MOVE B,[070000,,200000] ;READ, ASCII
OPENF
JRST POPBAJ
REST B,A
JRST POPJ1
]
IFN SAIL,[
MOVE A,RFILN
MOVEM A,OPNDV
SETZM OPNHD
MOVEI A,10
HRRZ B,JFN(S)
CAIN B,SRC
MOVEI A,17
CAIN B,CMDC
MOVEI A,0
MOVEM A,OPNMD
MOVEI A,HDR(S)
MOVEM A,OPNHD
MOVS A,JFN(S)
LSH A,5
IOR A,[OPEN OPNMD]
XCT A
RET
MOVE A,RFILN1
MOVEM A,ENTNM
MOVE A,RFILN2
HLLZM A,ENTEX
MOVE A,RFILSN
MOVEM A,ENTPPN
MOVS A,JFN(S)
LSH A,5
IOR A,[LOOKUP ENTNM]
XCT A
RET
MOVS A,ENTPPN
MOVNM A,SRCWL ;# WORDS LEFT IN FILE
SETZM SRCREC ;ZERO RECORD COUNT
JRST POPJ1
]
;OPEN AN OUTPUT FILE. S POINTS TO THE FILE BLOCK.
;THE FILE BLOCK SHOULD LOOK LIKE THAT OF THE LST, BIN FILES.
IFN TENEX,[
OINIT: MOVEI A,[SIXBIT /^PAL11ERR /]
CALL JBKINI
MOVEI A,JBLOCK+2
SKIPE C,DEV(S)
CALL JBKSIX
MOVEI A,JBLOCK+4
SKIPE C,TNM(S)
CALL JBKSIX
MOVSI A,400000
MOVEM A,JBLOCK
MOVEI A,JBLOCK
MOVEI B,0
GTJFN
JRST OPENLB
MOVEM A,JFN(S)
LDB B,[020100,,MOD(S)]
MOVE B,OPENTB(B) ; GET CORRECT OPEN BITS
OPENF
JRST OPENLB
RET
OPENTB: 070000,,100000
IFN RELCOD, 440000,,100000
IFE RELCOD, 100000,,100000
]
IFN ITS,[
OINIT: SYSCL OPEN,[JFN(S) ? DEV(S) ? [SIXBIT/_PALX_/]
TNM(S) ? SNM(S) ? 4000,,MOD(S)]
JRST OPENLB
RET
]
IFN SAIL,[
OINIT: MOVE A,MOD(S) ;GET 0 FOR ASCII OR 10 FOR BINARY.
TRNN A,4
TDZA A,A
MOVEI A,10
MOVEM A,OPNMD ;BUFFERED OUTPUT
MOVE A,DEV(S)
MOVEM A,OPNDV
MOVSI A,HDR(S)
HLLZM A,OPNHD
MOVS A,JFN(S)
LSH A,5
IOR A,[OPEN OPNMD]
XCT A
JRST OPENLB
MOVE A,FN1(S)
MOVEM A,ENTNM
MOVE A,FN2(S)
HLLZM A,ENTEX
SETZM ENTEX+1
MOVE A,SNM(S)
MOVEM A,ENTPPN
MOVS A,JFN(S)
LSH A,5
IOR A,[ENTER ENTNM]
XCT A
JRST OPENLB
MOVEI A,BUF(S)
EXCH A,JOBFF
MOVS B,JFN(S)
LSH B,5
IOR B,[OUTBUF 1]
XCT B
MOVEM A,JOBFF
RET
]
;TTILIN,TTILN - READ IN A COMMAND, PROCESSING RUBOUTS, PROMPTING WITH "*"
IFE TWENEX,[
TTILIN: SETZM %TTYFL
MOVEI B,"*
SETZM CTLSF
CALL TYO
TTILN: SETZM %TTYFL
SETZM CTLSF
SETZM TTICNT ;NO CHARS READ YET.
MOVE B,[440700,,TTIBUF]
SKIPE SRCTTY
HRR B,SRCBPT
TLNE AF,TTMFLG ;FOR .TTYMAC, READ INTO LINBUF.
HRRI B,LINBUF
TTIRU1: MOVEM B,TTIPNT
TTILUP: UNIIB TTI
CAIE B,^J
CAIN B,^_
MOVEI B,^M
CAIN B,^M
JRST TTICR ;^M MEANS ALL READ.
IFN TENEX,CAIE B,^A
CAIN B,177
JRST TTIRUB
CAIE B,33 ;ALTMODE, AND SAIL'S EOF CHR,
CAIN B,612
JRST TTICTC
CAIE B,^Z
CAIN B,^C
JRST TTICTC ;^C - END LINE, CAUSE EXIT.
IFN TENEX,CAIE B,^Q
CAIN B,^U
JRST TTIRU2 ;^U - CANCEL COMMAND.
CAIN B,^X
MOVEI B,"_ ;TV BACKARROW (UNDERSCORE AT SAIL) WINS TOO
IDPB B,TTIPNT ;NORMAL CHAR.
AOS TTICNT
JRST TTILUP
TTICTC: CALL TTYCR
TLNE AF,TTMFLG
RET
SETOM SRCEOF ;IF TTY IS SRC, EOF.
SKIPN SRCTTY
SETOM CTLCF ;IF THIS IS CMD STR, EXIT AFTERWARDS.
TTICR:
IFN TWENEX,UNIIB TTI ;READ AND THROW AWAY ^J FOLLOWING ^M
TLNN AF,TTMFLG
SKIPE SRCTTY
RET
MOVE B,[440700,,TTIBUF]
MOVEM B,TTIPNT ;SET UP FOR REMOVAL OF CHARS.
RET
TTIRUB: SOSGE TTICNT ;IF NO CHAR TO RUB, RETRY.
JRST TTIRU2
LDB B,TTIPNT
CALL TYO ;PRINT DELETED CHARACTER
MOVSI B,070000
ADD B,TTIPNT
JUMPGE B,TTIRU1 ;J IF STILL IN SAME WD.
SUB B,[430000,,1] ;ELSE BACK UP 1.
JRST TTIRU1
TTIRU2: SOS (P) ;RUBOUT WITH EMPTY BUFFER.
JRST TTYCR ;RETURN TO CALL TO TTILIN OR TTILN.
]
IFN TWENEX,[
TTILIN: SETZM %TTYFL
SETZM CTLSF
MOVEI B,"*
CALL TYO
SAVE C
HRROI C,[ASCIZ "*"]
JRST TTILN1
TTILN: SAVE C
MOVEI C,0
SETZM %TTYFL
SETZM CTLSF
TTILN1: SAVE A
MOVE A,[440700,,TTIBUF]
SKIPE SRCTTY
HRR A,SRCBPT
TLNE AF,TTMFLG ;FOR .TTYMAC, READ INTO LINBUF.
HRRI A,LINBUF
HRRZM A,TTICNT
MOVE B,[RD%BRK\RD%BEL\RD%CRF\TTIBSZ]
RDTTY
HALTF
LDB C,A
SUB A,TTICNT ;CONVERT TO COUNT NOT INCLUDING TERMINATOR
MULI A,5 ; ...
SUBI B,-4(A) ; ...
HRRZM B,TTICNT
TLNE AF,TTMFLG
JRST TTILN2
MOVE B,[440700,,TTIBUF]
SKIPN SRCTTY
MOVEM B,TTIPNT ;SET UP FOR REMOVAL OF CHARS.
CAIE C,^Z
JRST TTILN2
SETOM SRCEOF ;IF TTY IS SRC, EOF.
SKIPN SRCTTY
SETOM CTLCF ;IF THIS IS CMD STR, EXIT AFTERWARDS.
TTILN2: REST A
REST C
RET
]
;READ IN THE LST OR ERR FILE NAMES.
RFILL: SETZM RFILP ;LST: 0 IF ARW OR NUL, 1 ELSE.
CAIA
RFIL0: SETOM RFILP ;BIN: 0 IF SPEC EXISTS & IS EMPTY.
SETZM RFILN ;CAUSE DEFAULTING OF DEV, FN1, FN2 INDIVIDUALLY.
SETZM RFILN1
SETZM RFILN2
TLNN F,NULBIT ;EXIT IF NO MORE OUTPUT SPECS.
TRNE F,ARWBIT
RET
SETZM RFILP
RFILE: SAVE V ;B.P. INTO NAME GOES IN T0.
SETZM RFILN2 ;FORCE DEFAULTING OF FN2.
RFNAM0: MOVEI B,RFXCTB ;COUNT HOW MANY NAMES SO FAR.
MOVEM B,RFILNC
RFNAME: SETZ 0, ;GET NEXT NAME; RESET NAME, B.P.
MOVE V,[440600,,0]
RFLOOP: CALL TTICHR ;READ A CHAR.
IFE SAIL,TRNN F,INSBIT ;COMMA ORDINARY CHAR. IN .INSRT .
CAIE B,",
CAIN B,^M
JRST RFSPAC ;", , ^M TERMINATE SPEC.
IFN SAIL,[
CAIE B,"[
CAIN B,"]
JRST RFSPAC
TRNN F,INSBIT ;! IN INSERT FILE NAME . . .
TRNE F,ARWBIT ; OR "SOURCE" FILE NAME . . .
JRST RFLOP1 ; DOESN'T CAUSE A SWAP!!
CAIN B,"!
JRST RFSPAC
RFLOP1:
]
TRNN F,INSBIT ;_ ALSO ORDINARY IN .INSRT .
CAIE B,"_
CAIN B,<" >
JRST RFSPAC ;THESE ALSO.
CAIN B,":
JRST RFCOL ;COLON SETS DEV.
CAIN B,";
JRST RFSEM ;SEMI SETS SNAME.
IFN TENEX+SAIL,[
CAIN B,".
JRST RFSPAC
]
TRNE F,INSBIT ;NO COMMAND FILES OR SWITCHES IN .INSRT'S.
JRST RFLOO1
CAIN B,"@
JRST RFATSN ;@ -- USE CMD FILE.
CAIN B,"/
JRST RFSPAC ;SLASH ENDS NAME.
RFLOO1: CAIN B,^R ;^R - RESET FILENAME COUNTER.
JRST RFSPAC
CAIN B,^Q ;^Q - QUOTE NEXT CHAR.
CALL TTICHR
MOVEI B,-40(B) ;NORMAL - CONV. TO SIXBIT.
TLNE V,770000 ;PUT IN NAME IF ROOM LEFT.
IDPB B,V
JRST RFLOOP
RFXCTB: MOVEM 0,RFILN+1 ;TABLE EXECUTED BELOW
MOVEM 0,RFILN2
MOVEM 0,RFILN
MOVEM 0,RFILSN
SKIPA
IFN SAIL,[
HRRM 0,RFILSN
HRLM 0,RFILSN
RFPPTB=.
]
RFCOL: SKIPE 0
MOVEM 0,RFILN
SETOM RFILP ;INDICATE NOT NULL.
JRST RFNAME
RFSEM: SKIPE 0
MOVEM 0,RFILSN ;SIMILAR BUT SET SNAME INSTEAD.
SETOM RFILP
JRST RFNAME
RFSPAC:
IFN SAIL,[
SKIPL V,RFPPNF
JRST RFSPAZ ;NOT PROCESSING PPN NOW
JUMPE 0,RFSPZ3
RFSPZ1: TRNE 0,77
JRST RFSPZ2
LSH 0,-6
JRST RFSPZ1
RFSPZ2: TLNN 0,77
JRST RFSPZ4
LSH 0,-6
JRST RFSPZ2
RFSPZ4: XCT RFPPTB(V)
SOS RFPPNF
RFSPZ3: CAIE B,",
JRST [SETZM RFPPNF ? JRST RFSPA0]
MOVNI B,2
MOVEM B,RFPPNF
JRST RFNAME
]
IFE SAIL,RFSPAC:
RFSPAZ: JUMPE 0,RFSPA0 ;IF NAME WAS READ,
XCT @RFILNC ;STORE IT,
AOS RFILNC ;COUNT NAMES SO FAR.
SETOM RFILP ;SAY NON-NULL SPEC.
RFSPA0: CAIN B,^R ;^R - RESET FILENAME COUNTER.
JRST RFNAM0
IFN TENEX, CAIE B,".
CAIN B,40
JRST RFNAME ;SPACE -- GET ANOTHER NAME.
IFN SAIL,[
CAIN B,".
JRST [HLLOS RFILN2 ? JRST RFNAME] ;INDICATE NULL FN2
CAIN B,"[
JRST [SETOM RFPPNF ? JRST RFNAME]
CAIN B,"]
JRST RFNAME
CAIN B,"!
JRST RFSWAP
]
CAIE B,"/
JRST RFSPA1 ;SLASH -- READ A SWITCH
CALL TTICHR
SETZ V,
DEFINE SWITCH A,D
CAIN B,"A
HRROI V,D
TERMIN ;MACRO TO HANDLE NORMAL SWITCH.
SWITCH B,BSWBIT ;/B - SUPPRESS BINARY.
SWITCH C,CSWBIT ;/C - CREF LISTING.
IFN ITS,SWITCH D,DSWBIT+NSWBIT ;/D - DISOWN SELF.
SWITCH E,ESWBIT ;/E - FORCE ERROR FILE OUTPUT.
CAIN B,"H ;/H - DOUBLE SYMTAB SIZE.
JRST [AOS HSWCNT ? JRST RFNAME]
CAIN B,"L ;/L - ONCE => LIST, TWICE => BOTH PASSES.
JRST [AOS LSWCN1 ? JRST RFNAME]
SWITCH M,MSWBIT ;/M - NO MACRO LISTING.
SWITCH N,NSWBIT ;/N - NO ERROR MSGS ON TTY.
IFE RELCOD, SWITCH P,PSWBIT ;/P - BINARY ON PTP:.
SWITCH R,RSWBIT ;/R - REPRODUCE SOURCE IN LISTING.
IFE RELCOD, SWITCH S,SYMBIT ;/S - NO SYMS IN BINARY.
CAIN B,"V ;/V - SET # LINES/PAGE IN LISTING.
JRST RFVSW
CAIE B,"T ;/T - COMPLEMENT TTY-TYPE LISTING.
JUMPE V,ERRSW ;IF INVALID SWITCH.
TLO F,(V)
TRNN V,-1 ;HANDLE /T SPECIALLY.
TLC AF,TTYFLG
JRST RFNAME ;SWITCH DONE, READ ANOTHER NAME.
RFSPA1: CAIN B,^X ;TV BACKARROW OR UNDERSCORE OR WHATEVER
MOVEI B,"_
CAIE B,"_
JRST RFSP1A
TRO F,ARWBIT ;_ -- SAY SAW AN _.
SETOM RFILP ;IF THIS SPEC WAS THE LAST OUTPUT SPEC, ASSUME NON-NULL.
RFSP1A: CAIN B,^M
TRO F,ENDBIT
POPVJ: REST V
RET
IFN SAIL,[
RFSWAP: MOVSI V,(SIXBIT /DSK/)
SKIPN RFILSN
MOVSI V,(SIXBIT /SYS/)
SKIPN B,RFILN ;FILL IN SWPBLK WITH SOME REASONABLE DEFAULTS
MOVE B,V
MOVEM B,SWPBLK
MOVE B,RFILN1
MOVEM B,SWPNAM
SKIPN B,RFILN2
MOVSI B,(SIXBIT /DMP/)
HLLZM B,SWPEXT ;MODE BITS IN RIGHT HALF
SKIPE B,CCLFLG ;START IN RPG MODE ONLY IF PALX STARTED THAT WAY
MOVEI B,1 ;YEP
MOVEM B,SWPSA
SKIPN B,RFILSN
MOVE B,MSNAME
MOVEM B,SWPPPN
SETZM SWPNPP
MOVEI B,SWPBLK
SWAP B,
JRST 4,. ;BUT DID HE EVER RETURN?
;NO, HE'LL NEVER RETURN.
;AND HIS FATE IS STILL UNLEARNED!
;HE MAY RIDE FOREVER 'NEATH THE STREETS OF BOSTON.
;HE'S THE MAN WHO NEVER RETURNED!
];SAIL
;/V SWITCH - FOLLOW BY NUMBER, "L" OR "X", SETS #LINES/PAGE.
RFVSW: CALL RFDECN ;READ DECIMAL # FROM TTY.
CAIN B,"L ;L MEANS USE SIZE OF LPT.
MOVEI V,PAGLPT
CAIN B,"X ;X MEANS USE SIZE OF XGP.
MOVEI V,PAGXGP
MOVEM V,PAGSIZ
JRST RFNAME
;READ DECIMAL NUMBER FROM COMMAND INPUT STREAM.
RFDECN: SETZ V, ;AND RETURN IT IN V.
RFDEC1: CALL TTICHR
CAIL B,"0
CAILE B,"9
RET ;RETURN ON NNON-DIGIT.
IMULI V,10.
ADDI V,-"0(B)
JRST RFDEC1
;COME AFTER READING AN "@"; READ IN CMD FILE NAME, OPEN IT.
RFATSN: SAVE RFILP,RFILNC,N,S,RFILSN
MOVSI B,-3
RFATS0: SAVE RFILN(B) ;SAVE, ZERO FILEAMES.
SETZM RFILN(B)
AOBJN B,RFATS0
CALL RFILE ;READ CMD FILE NAMES.
MOVEI B,(SIXBIT/CMD/)
SKIPN RFILN2
MOVSM B,RFILN2 ;DEFAULT THE FN2.
MOVSI B,'DSK
SKIPN RFILN
MOVEM B,RFILN ;DEFAULT THE DEV.
SKIPE B,CMDFIL ;IF ALREADY INSIDE CMD FILE,
IFN TENEX,[CALL [MOVE N,CMDCJF
MOVEM N,CMDPDL(B) ;REMEMBER JFN OF OUTER CMD FILE.
RET]]
IFN ITS,.IOPUS CMDC, ;SAVE IT.
IFN SAIL,[
CALL [ IOPUSH CMDC,0 ;SPECIFY ZERO IOPUSH ID
JRST [ CALL ERRFCR
MOVEI A,[ASCIZ/Too many levels of indirect command file indirection/]
JRST CMDERR ]
RET ]
];IFN SAIL
AOS CMDFIL
MOVEI S,CMDCJF-JFN
CALL IINIT ;INIT. INPUT FILE ON(OR PUT) CHNL IN CMDJFN
CALL OPENL
REST RFILN2,RFILN1,RFILN,RFILSN,S,N,RFILNC,RFILP
MOVEI B," ;SPACE BEFORE CMD FILE.
TRZ F,ENDBIT ;IN CASE CR AFTER CMD FILE SPEC.
JRST RFSPAC
;GET NEXT CMD STRING CHAR.
TTICHR: TRZE F,CHRBIT ;CHRBIT => RE-READ LAST SOURCE CHAR.
JRST [LDB B,IP ? JRST TTILC]
TRNE F,INSBIT ;IF READING FILENAME FOR .INSRT,
JRST [CALL @GETCHA ;READ FROM ASSEMBLY INPUT,
MOVEI B,(I)
JRST TTILC]
SKIPE CMDFIL ;IF NO CMD FILE, GET FROM COMMAND BUF
JRST TTICH1
SOSGE TTICNT ;IF NO CHARS LEFT,
SKIPA B,[^M] ;SAY EOL.
ILDB B,TTIPNT ;ELSE GET NEXT CHAR FROM BUFFER.
TTILC: CAIL B,140 ;CONVERT LOWER CASE TO UPPER.
SUBI B,40
RET
TTICH1: UNIIB CMDC, ;READ FROM CMD FILE INTO B.
JUMPE B,TTICH1
CAIE B,^J ;TREAT ^M, ^J IN FILES AS SPACES.
CAIN B,^M
MOVEI B,<" >
CAIN B,^L
JRST TTICH2 ;^L ENDS CMD FILE.
CAIE B,^C
JUMPGE B,TTILC
TTICH2: SAVE A,B,S ;EOF IN CMD FILE, POP OUT OF IT.
MOVEI S,CMDCJF-JFN
CALL ICLOSE ;CLOSE INPUT ON CHNL IN CMDCJFN
SOSE B,CMDFIL
IFN ITS,.IOPOP CMDC, ;ANOTHER CMD FILE OUTSIDE, POP IT.
IFN SAIL,[
CALL [ IOPOP CMDC,0
BUG ;WAS NOTHING PUSHED
RET ]
];IFN SAIL
IFN TENEX,[CALL [MOVE B,CMDPDL(B)
MOVEM B,CMDCJFN ;RESTORE CMD JFN TO THAT OF OUTER FILE.
RET]]
REST S,B,A
MOVEI B," ;PUT SPACE AFTER CMD FILE.
RET
;I/O ROUTINES
LSTSP: MOVEI B,"
JRST LSTOUT
LSTCR: TDZA B,B
LSTTAB: MOVEI B,11
LSTOUT: TRZE F,HDRBIT ;START NEW PAGE IF WAS REQUESTED.
CALL HEADER
LSTSRC: NEWLIN LSTDMP ;TURN ^@ INTO ^M^J.
LSTDMP: TLNE F,TTYBIT ;IF LISTING ON TTY,
JRST LSTDM0 ;WRITE ON IT INSTEAD.
SKIPN LSTOPN
RET ;DON'T OUTPUT TO LST FILE IF IT ISN'T REALLY OPEN.
SOSG LSTCNT ;DECREMENT ITEM COUNT
CALL LIST1 ;EMPTY ENTIRE BUFFER
IDPB B,LSTPNT ;STORE THE CHARACTER
LSTDM1: CAIE B,^J ;IF LF,
RET
SOSG LINCNT ;COUNT 1 LINE IN PAGE.
TRO F,HDRBIT
RET
LSTDM0: CALL TYO
JRST LSTDM1
LIST1:
IFN SAIL,[
OUT LST,
RET
BUG
]
.ELSE [
SAVE A,B,C,W
MOVE B,[440700,,LSTBUF]
MOVEM B,LSTPNT
SKIPGE C,LSTCNT
JRST LIST1A ;NOTHING WAS EVER PUT IN LSTBUF.
SUBI C,5*LSTBSZ ;-<# CHARS TO OUTPUT>
OUTBFR LST,5
LIST1A: MOVEI A,5*LSTBSZ
MOVEM A,LSTCNT
REST W
JRST POPCBA
]
LSTCLS:
IFN ITS\TENEX,[
SOS LSTCNT ;LIST1 ASSUMES LSTCNT SOS'S ONCE TOO MANNY.
IFN ITS,[
MOVE A,LSTCNT
IDIVI A,5
MOVEI C,FILCHR
LSTCL1: SOJL B,LSTCL2
SOS LSTCNT
IDPB C,LSTPNT
JRST LSTCL1
LSTCL2: ]
SKIPL LSTCNT ;IF ANYTHING WAS EVER OUTPUT,
CALL LIST1 ;WE HAVE A PARTIAL BUFFER TO WRITE OUT.
]
SETZM LSTOPN
MOVEI S,LSTDEV
JRST OCLOSE ;CLOSE FILE (MAYBE RENAME)
;START NEW PAGE IN LISTING.
HEADER: SAVE F,0,A,B
TLO F,NSWBIT ;DON'T OUTPUT TO TTY
TLZ F,ERRBIT ; OR ERROR FILE.
MOVEI B,14 ;OUTPUT A FORM FEED
CALL LSTDMP
MOVE B,PAGSIZ ;RESET LINE COUNTER REGISTER
SUBI B,3
MOVEM B,LINCNT
TLNE F,RSWBIT ;NO HEADERS IF OUTPUTTING SOURCE.
JRST HEADE2
CALL LSTTAB
MOVE N,[440700,,TITBUF]
CALL LSTSTR ;LIST THE TITLE.
CAME N,[350700,,TITBUF]
CALL LSTTAB ;AND TAB IF TITLE NONNULL.
MOVE N,[SIXBIT/PALX/]
CALL LSTSIX
CALL LSTSP
MOVEI N,.FVERS
CALL LSTNUM
CALL LSTTAB
MOVE N,[440700,,DATTIM]
CALL LSTSTR
PPAGE==[440700,,[ASCIZ/ Page /]]
MOVE N,PPAGE
CALL LSTSTR ;PRINT ' PAGE '
AOS A,PAGTOT ;PRINT LISTING PAGE'S NUMBER.
CALL ERRDEC
CALL LSTCR
CALL LSTTAB
CALL LSTFIL ;PRINT SRC FILE'S NAME
MOVE N,PPAGE
CALL LSTSTR ;PRINT ' PAGE '
MOVE A,PAGNUM ;AND SRC PAGE'S NUMBER.
CALL ERRDEC
AOSN A,PAGEXT
JRST HEADE1
MOVEI B,". ;HANDLE CONTINUATION PAGES' NUMBERS.
CALL LSTDMP
CALL ERRDEC
HEADE1: CALL LSTSP
CALL LSTTAB
MOVE 0,[440700,,STITBF]
CALL LSTSTR ;LIST SUBTITLE.
CALL ERR2CR
HEADE2: REST B,A,0,F
RET
;OUTPUT ASCIZ STRING <- BP IN N TO LST.
LSTSTR: ILDB B,N
JUMPE B,CPOPJ
CALL LSTDMP
JRST LSTSTR
TTYOUT: NEWLIN TYO ;TURN ^@ INTO ^M^J.
TYO:
TTYDMP: SKIPE %TTYFL
RET
UNIOB TTO
RET
TTYCR: SAVE B
MOVEI B,^M
CALL TYO
MOVEI B,^J
CALL TYO
JRST POPBJ
;OUTPUT SIXBIT WD IN N TO TTY.
TTOSIX: SAVE B
TTOSI1: SETZ A,
ROTC N,6
JUMPE A,POPBJ
MOVEI B,40(A)
CALL TYO
JRST TTOSI1
;OUTPUT DECIMAL NUMBER IN N TO TTY.
TTODEC: PUSH P,A
PUSH P,B
MOVE A,N
PUSHJ P,TTODC1
POP P,B
POP P,A
POPJ P,
TTODC1: IDIVI A,10.
HRLM B,(P)
SKIPE A
PUSHJ P,TTODC1
HLRZ B,(P)
ADDI B,"0
JRST TYO
;GET CHAR FROM SOURCE FILE.
GCHS: ILDB I,SRCPNT
CAIGE I,^M ;IF ORD. CHAR,
JRST GCHS0
GCHR1: IDPB I,IP ;SAVE FOR RESCAN, LISTING.
MOVEM IP,LINIP
CAMN IP,[010700,,LINBUF+CPL/5]
CALL GCHSEL ;IF FULL, LIST NEXT TIME.
RET
GCHS0: JUMPE I,GCHS ;IGNORE NULL CHARS
CAIN I,^J
JRST GCHSLF
CAIN I,^L ;HANDLE SPECIAL CHARS.
JRST GCHSFF
CAIE I,^C ;ONLY ^C, ^J, ^L REALLY SPECIAL.
JRST GCHR1
MOVE I,SRCPNT ;^C - AT END OF BUFFER?
CAMN I,SRCBND
JRST GCHBUF ;YES, READ NEXT BUFFER.
JRST GCHEOF ;NO, THIS IS EOF.
GCHSFF: AOS PAGNUM ;FF - INCREM SOURCE PAGE.
SETOM PAGEXT
SETZM SLNCNT ;1ST LINE THEREOF.
GCHMFF: TRO F,HDRBIT ;NEW LISTING PAGE.
JRST @GETCHA ;SKIP FF, GET ANOTHER CHAR.
;LF - INCREM SOURCE LINE NUM, SAY HAVE WHOLE LINE.
GCHSLF: AOS SLNCNT
GCHMLF: CALL GCHSEL
JRST GCHR1 ;STORE CHAR AS USUAL.
;READ NEXT SOURCE BUFFER.
GCHBUF: SKIPE SRCEOF ;IF INTERNAL EOF,
JRST GCHEOF ;GET NEXT FILE.
SKIPE SRCTTY
JRST GCHTTY ;IF FROM TTY, HANDLE RUBOUTS.
IFN ITS,[
HRRZ I,SRCBPT ;ADDR OF START OF BUFFER.
HRLI I,-SRCBSZ ;AOBJN -> BUFFER.
.IOT SRC,I ;READ IN BUFFERFULL.
HLRZ I,I
MOVEI I,SRCBSZ(I) ;NUM. WDS READ.
JUMPE I,GCHEOF ;NONE READ MEANS EOF.
ADD I,SRCBPT
MOVEM I,SRCBND ;POINT AFTER LAST WD READ.
]
IFN TENEX,[
SAVE A,B,C
MOVE A,SRCJFN
HRRO B,SRCBPT
MOVNI C,5*SRCBSZ
SIN
MOVEM B,SRCBND
MOVEI I,SRCBSZ*5(C)
REST C,B,A
JUMPE I,GCHEOF
]
IFN SAIL,[
SKIPN SRCWL
JRST GCHEOF
SAVE I+1
HRRO I,SRCBPT
ADD I,[-SRCBSZ,,-1]
MOVEI I+1,0
IN SRC,I
JRST GCHBU1
STATO SRC,20000 ;EOF?
JRST [ OUTSTR [ASCIZ /Input lossage in source input
/]
JRST 4,.]
MOVN I,SRCWL
CAIA
GCHBU1: MOVNI I,SRCBSZ
ADDM I,SRCWL
REST I+1
AOS SRCREC
MOVNS I ;# WORDS READ
ADD I,SRCBPT
MOVEM I,SRCBND
]
GCHBF1: MOVEI I,^C
IDPB I,SRCBND ;PUT ^C AFTER BUFFER.
GCHBF2: MOVE I,SRCBPT
MOVEM I,SRCPNT
JRST GCHS ;GO READ 1ST OF CHARS READ.
;READ SOURCE LINE FROM TTY.
GCHTTY: SAVE TTIPNT,TTICNT ;TTILIN WILL CLOBBER THESE.
CALL TTILN
MOVEI I,^M
IDPB I,TTIPNT
MOVEI I,^J
IDPB I,TTIPNT ;TERMINATE LINE PROPERLY.
MOVE I,TTIPNT
MOVEM I,SRCBND ;REMEMBER END OF BUFFER.
REST TTICNT,TTIPNT
JRST GCHBF1 ;SET UP SRCPNT, READ 1ST CHAR.
GCHEOF:
SKIPN SRCDPH ;IF EOF IN .INSRT FILE,
JRST GCHEO1
IFN ITS,[
LDB I,[121000,,SRCBPT] ;FLUSH THE FILE'S BUFFER.
SYSCAL CORBLK,[1000,, ? 1000,,-1 ? I]
.IOPOP SRC,
]
IFN TENEX,[
SAVE A,B,C,S
SETO A, ;INDICATE DELETE PAGE,
LDB B,[111100,,SRCBPT] ;GET PAGE #,
HRLI B,4^5 ;SAY IN SELF.
SETZ C,
PMAP ;DELETE THE 2 PAGES USED FOR A BUFFER.
AOS B
PMAP
MOVEI S,SRCJFN-JFN
CALL ICLOSE ;RELEASE THE JFN OF FILE JUST ENDED.
REST S,C,B,A
]
HRRO I,MACPDP ;GET SRCPDL PTR, -1 IN LH SO NO PDLOV
IRPS X,,[MP SRCNUM SRCBND SRCPNT SRCBPT SRCTTY PAGNUM PAGEXT SLNCNT
RFILN RFILN1 RFILN2 RFILSN]
POP I,X
TERMIN
IFN SAIL,[
SAVE A,B
POP I,SRCWL
POP I,SRCREC
SKIPE SRCTTY
JRST GCHETT ;BACK TO TTY
OPEN SRC,[ 17
SIXBIT /DSK/
0]
JRST 4,.
MOVE A,RFILN1
MOVEM A,ENTNM
MOVE A,RFILN2
CAMN A,[-1]
MOVEI A,0
MOVEM A,ENTEX
SETZM ENTEX+1
MOVE A,RFILSN
MOVEM A,ENTPPN
LOOKUP SRC,ENTNM
JRST 4,.
USETI SRC,@SRCREC
MOVSI A,-SRCBSZ
HRRI A,SRCBUF-1
MOVEI B,0
IN SRC,A
JRST GCHEOX
STATO SRC,20000 ;EOF?
JRST [ OUTSTR [ASCIZ /Input lossage in source input
/]
JRST 4,.]
GCHEOX: REST B,A
]
IFN TENEX,POP I,SRCJFN
HRRM I,MACPDP
TRO F,HDRBIT ;NEW PAGE IN LISTING.
SOS SRCDPH ;EXITED 1 .INSRT FILE.
SETZM SRCEOF
CALL GCHSET ;MIGHT BE POPPING INTO MACRO.
JRST @GETCHA ;TRY AGAIN TO READ CHAR.
GCHEO1: TRNE F,ENDBIT ;CRR SEEN BY COMMAND SCANNER?
JRST GCHSND ;NO, NO END STMT.
CALL GETSRC ;GET THE NEXT SOURCE FILE
JRST GCHBUF
;COME HERE ON EOF OF LAST SRC FILE.
GCHSND: ERROR1 No END Statement
TLO AF,ENDFLG ;MAKE THIS LAST LINE OF PASS.
MOVEI I,^J
JRST GCHSLF ;MAKE THIS LAST CHAR OF LINE.
IFN SAIL,[
GCHETT: MOVE A,SRCBPT
MOVEM A,SRCPNT
MOVEM A,SRCBND
MOVEI A,^C
IDPB A,SRCBND
JRST GCHEOX
]
;GET CHAR FROM MACRO.
GCHM: ILDB I,MP
GCHM1: CAIL I,^K
JRST GCHR1 ;<15, ORD. CHAR, JUST STORE & GO.
JUMPE I,GCHMNL ;^@ - GO TO NEXT BLOCK.
CAIN I,^J
JRST GCHMLF ;^J - HAVE WHOLE LINE.
CAIE I,^C
JRST GCHR1 ;ALL BUT ^C NORMAL CHARS.
CALL READMB ;^C - SPECIAL CODE FOLLOWS.
TRZE I,100 ;IF >= 100,
JRST GETDS ; MEANS SUBSTITUTE A MACRO ARG.
CALL @GCHMT-1(I) ;ELSE MEANS POP THIS STRING.
JRST @GETCHA ;AFTER TERMINATING, GET NEXT CHAR.
GCHMT: PHASE 1
QUEMAC::@MACXIT ;^C^A - END READING STRING (REPEAT, IRP OR MACRO)
QUEARG::DSEND ;^C^B - END MACRO ARG.
DEPHASE
GCHMNL: HRR MP,(MP) ;^@ - TRACE LINK TO NEXT BLOCK.
LDB I,MP
JRST GCHM1
;GET CHAR WHILE RESCANNING.
GCHI: CAMN IP,LINIP
JRST GCHI0
ILDB I,IP
RET
GCHI0: CALL GCHSET ;DONE REREADING, CHOSE NEW SOURCE,
SETCHAR
CAIE I,^J ;RESET GCHL IF NEC.
CAMN IP,[010700,,LINBUF+CPL/5]
CALL GCHSEL
JRST GETCHR ;GET CHAR FROM IT.
GCHSET: MOVEI I,GCHM ;IF MP>0 USE GCHM
JUMPN MP,GCHSE1
GCHSE0: MOVEI I,GCHS ;ELSE READ FROM SRC.
GCHSE1: HRRM I,GETCHA
RET
;START NEW LINE, READ 1ST CHAR.
GETLIN: MOVE IP,LINPNT
MOVEM IP,LINIP ;RE-START BUFFER.
;READ 1 CHAR INTO I. IMPURE!!
GETCHR:
GETCHA: JRST GCHS ;OR GCHM, GCHI, GCHL .
GCHL: SAVE A,B
CALL ENDLA ;DECIDE WHETHER TO LIST.
TRNE AF,ERRP1 ;IF WERE ERRORS,
MOVEI A,ERROUT ; PRINT ON TTY.
CALL LOTAB ;IN TTY FMT LISTING, 2 TABS.
CALL (A)
TLNN AF,TTYFLG
CALL (A) ;NORMAL FMT, 2 MORE.
TLNN AF,TTYFLG
CALL (A)
MOVE I,LINPNT
GCHL1: CAMN I,LINIP ;UNTIL THE END OF THE LINE,
JRST GCHL2
ILDB B,I ;FETCH AND LIST THE CHARS IN LINBUF.
CALL (A)
JRST GCHL1
GCHL2: CAIN B,^J ;IF DIDN'T END W/ CRLF,
JRST GETCH3
MOVEI B,^M ;OUTPUT CRLF ANYWAY.
CALL (A)
MOVEI B,^J
CALL (A)
GETCH3: REST B,A
CALL GCHSET ;RESTORE SOURCE.
JRST GETLIN ;RESTART BUFFER, FETCH.
;SET TO LIST LINE WHERN FETCH NEXT CHAR.
GCHSEL: TLO AF,SRCFLG
MOVEI IP,GCHL
HRRM IP,GETCHA
MOVE IP,LINIP
RET
;ROUTINE TO OUTPUT RELOCATABLE BINARY
IFE RELCOD,[
; THIS NOT NEEDED IF MAKING RELOCATABLE
BINOUT: ;BINARY OUTPUT
ANDI B,377 ;MASK TO 8 BITS
SYMOUT: TLNE F,PSWBIT
JRST BINPPB
SOSG BINCNT
CALL BINDMP
IDPB B,BINPNT
RET
BINPPB: UNIOB BIN
RET
BINDMP:
IFN SAIL,[
OUT BIN,
RET
BUG
]
.ELSE [
SAVE A,B,C
MOVE B,[444400,,BINBUF]
MOVEM B,BINPNT
SKIPGE C,BINCNT
JRST BINDM1 ;NOTHING WAS EVER PUT IN BINBUF.
SUBI C,BINBSZ ;-<# WDS TO OUTPUT>
OUTBFR BIN
BINDM1: MOVEI A,BINBSZ
MOVEM A,BINCNT ;BUFFER NOW EMPTY.
]
] ;END IFE RELCOD
POPCBA: REST C
POPBAJ: REST B
POPAJ: REST A
RET
;CLOSE BINARY FILE.
BINCLS: TLZN F,BINBIT ;NO MORE BIN OPEN.
RET
IFE RELCOD,[
SKIPN B,BINCNT ;(NOTHING EVER PUT IN BIN BUFFER =>
;DON'T TRY TO WRITE IT OUT.
JRST BINCL1 ;PREVENTS IOCERR IF NO BIN FILE)
SETZ B, ;PUT A ZERO AT THE END.
CALL BINOUT ;SO LOADERS WILL SEE EOF.
]
IFE RELCOD+SAIL,[
MOVEI S,BINDEV
TLNE F,PSWBIT ;DON'T .IOT IF UNIT MODE.
JRST BINCL1
SOS BINCNT ;(SYMOUT DOES THIS SO I WILL)
CALL BINDMP ;OUTPUT PARTIAL BUFFER.
]
BINCL1: MOVEI S,BINDEV
SETZ N,
JRST OCLOSE ;CLOSE, MAYBE RENAME.
IFN ITS,[
OCLOSE: SKIPE NONFTL ;DON'T RENAME BIN, LST AFTER FATAL ERROR.
OCLOS1: SYSCL RENMWO,[JFN(S) ? FN1(S) ? FN2(S)]
JFCL
ICLOSE: SYSCAL CLOSE,[JFN(S)]
RET
]
IFN SAIL,[
ICLOSE:
OCLOSE:
OCLOS1: MOVS A,JFN(S)
LSH A,5
TLO A,(CLOSE)
XCT A
TLC A,(CLOSE#RELEAS)
XCT A
RET
]
IFN TENEX,[
OCLOSE: SKIPE NONFTL
OCLOS1: CALL ORENM
ICLOSE: SKIPGE A,JFN(S)
RET
GTSTS
JUMPGE B,CLOSR1
CLOSF
JFCL
JRST CLOSR2
CLOSR1: RLJFN
JFCL
CLOSR2: SETOM JFN(S)
RET
ORENM: SKIPGE A,JFN(S)
RET
DVCHR
TLNN B,100000
RET
MOVE A,JFN(S)
HRLI A,400000
CLOSF
JFCL
MOVEI A,FN1(S)
CALL JBKINI
MOVEI A,JBLOCK+2
SKIPE C,DEV(S)
CALL JBKSIX
MOVSI A,600000
MOVEM A,JBLOCK
MOVEI A,JBLOCK
MOVEI B,0
GTJFN
JRST RNMXXX
MOVE B,A
MOVE A,JFN(S)
RNAMF
JRST RNMXXX
MOVEM B,JFN(S)
RET
RNMXXX: HRROI A,[ASCIZ /
? File RNAMF error
/]
PSOUT
RET
JBKINI: PUSH P,A
MOVEI A,JBKSTR
MOVEM A,JBKSPT
SETZM JBLOCK
MOVE A,[JBLOCK,,JBLOCK+1]
BLT A,JBLOCK+10
MOVE A,[377777,,377777]
MOVEM A,JBLOCK+1
MOVEI A,JBLOCK+4 ;NAME
CALL JBKINS
MOVEI A,JBLOCK+5 ;EXT
CALL JBKINS
MOVEI A,JBLOCK+3 ;USER
CALL JBKINS
JRST POPAJ
JBKINS: AOS C,-1(P)
SKIPN C,-1(C)
RET
JBKSIX: MOVE B,JBKSPT ;CALLED HERE, A/ DSP ADDR, B/ SIXBIT
HRLI B,440700
MOVEM B,0(A)
MOVE A,B
AOS JBKSPT
AOS JBKSPT
MOVEI B,0
LSHC B,6
ADDI B,40
IDPB B,A
JUMPN C,.-4
MOVEI B,0
IDPB B,A
RET
]
ERRTMS: CALL ERRFCR
MOVEI A,[ASCIZ/Too many symbols/]
JRST CMDERR
ERRSW: SAVE B ;SAVE BAD SWITCH.
CALL ERRFCR ;TURN ON TYPEOUT AND CRLF.
MOVEI B,"/
CALL ERROUT
REST B
CALL ERROUT ;PRINT THE SWITCH.
MOVEI A,[ASCIZ / is a bad switch/]
CMDERR: CALL ERRSTR
CALL ERRCR
CMDER0: SETZM CTLCF ;ERROR - GIVE USER ANOTHER CHANCE.
IFN ITS, .RESET TTI,
IFN TENEX,[ MOVE A,TTIJFN
CFIBF
]
IFN SAIL, CLRBFI
JRST FINIS2
;COME HERE AFTER FAILING OUTPUT OPEN.
OPENLB: HRLI B,(S)
HRRI B,RFILN
BLT B,RFILSN
OPENL: CALL ERRFCR
CALL LSTFIL ;PRINT NAME OF LOSING FILE.
MOVEI B,^I
CALL ERROUT
TRO F,ENDBIT ;PREVENT ERRTF MESSAGE.
IFN ITS,[
.OPEN ERRC,OPENLF
.VALUE
OPENL0: .IOT ERRC,B
CAIN B,^L
JRST CMDER0
CALL ERROUT
JRST OPENL0
OPENLF: SIXBIT/ ERR/
1?0
]
IFN TENEX,[
HRLOI B,400000
MOVEI A,101
MOVEI C,0
ERSTR
JFCL
JFCL
JRST CMDER0
]
IFN SAIL,[
MOVEI A,[ASCIZ /Cannot LOOKUP or ENTER/]
CALL ERRSTR
JRST CMDER0
]
;ERROR UUO.
UERROR: TLNE AF,P1F ;DO NOTHING ON PASS 1.
JRST UUOXIT
;ERROR1 UUO.
UERR1: CALL ERRFIL ;PRINT FILENAMES IF NEC.
AOS ERRNUM ;TALLY ERROR.
SAVE N ;HAS SYM. BEING USED, MAYBE.
MOVE N,LLABN
SKIPN LLABN ;IF DEFINED A LABEL,
JRST UERR2
CALL LSTSIX ;PRINT . REL. TO IT.
MOVN A,LLABV
ADD A,L
ANDI A,ADRMSK
JUMPE A,UERR3 ;JUST LABEL IF DISP=0.
MOVEI B,"+
CALL ERROUT ;AS LABEL+DISP.
AOS LINPOS
CALL ERROCT
UERR3: MOVE N,LINPOS ;MOVE TO POS. 16.
CAIGE N,10
UERR2: CALL ERRTAB ;NO LABEL, JUST PRINT 2 TABS.
CALL ERRTAB
REST N
MOVEI A,(L)
CALL ERROCT ;PRINT LOC. CTR.
CALL ERRTAB
CALL ERRPGL ;PRINT PAGE AND LINE NUMBER.
CALL ERRTAB
HRRZ A,40
CALL ERRSTR ;PRINT ERROR MESSAGE.
CALL ERRCR
JRST UUOXIT
ERRPGL: MOVE A,PAGNUM ;PRINT PAGE AND LINE NUMBER.
CALL ERRDEC
MOVEI B,"-
CALL ERROUT
MOVE A,SLNCNT
AOJA A,ERRDEC
ERRFCR: SETZM CTLSF ;TURN ON TYPEOUT AND CRLF.
TLZA F,NSWBIT
ERR2CR: CALL ERRCR ;ERROR-OUTPUT 2 CRLFS.
ERRCR: TDZA B,B ;ONLY 1 CRLF.
ERRSP: MOVEI B," ;A SPACE.
;OUTPUT CHAR IN B AS PART OF ERROR MSG (TO LST, MAYBE TO TTY).
ERROUT: NEWLIN ERROU1
ERROU1: TLNE F,ERRBIT ;OUTPUT TO ERR FILE IF ANY.
CALL ERROU2
TLNN F,NSWBIT+TTYBIT ;IF LST IS TTY OR ERROR MSGS SUPPR,
CALL TYO ; DON'T OUTPUT TO TTY.
TLNN F,LSTBIT ;OUTPUT TO LST IF HAVE ONE.
RET
JRST LSTOUT
ERROU2: UNIOB ERR
RET
;DECIMAL PRINT.
ERRDEC: SKIPA B,[10.] ;SET RADIX 10.
ERROCT: MOVEI B,10 ;OR 8.
MOVEM B,ERRRDX' ;SAVE IT.
ERROC1: IDIV A,ERRRDX
HRLM B,(P) ;SAVE NEXT DIGIT.
SKIPE A
CALL ERROC1
HLRZ B,(P) ;GET DIGITS IN REVERSE ORDER.
ADDI B,"0
AOS LINPOS
JRST ERROUT
;PRINT A TAB.
ERRTAB: MOVEI B,^I
JRST ERROUT
;PRINT ERROR MESSAGE.
ERRSTR: HRLI A,440700
ERRMS1: ILDB B,A
CAIG B,^H ;CTL CHARS ARE SPECIAL.
JRST ERRMS2
CALL ERROUT
JRST ERRMS1
ERRMS2: XCT ERRMST(B)
JRST ERRMS1
;TABLE OF ACTIONS ON CHARS 0 THRU 8.
ERRMST: RET ;END OF ASCIZ.
CALL LSTSIX ;PRINT SYMBOL'S NAME.
JRST ERRMSB ;^B - SET RETURN ADDR.
JFCL
TRO AF,ERRP1 ;^D - FORCE LISTING OF LINE.
CALL LSTNUM ;^E - DECIMAL NUMBER IN N
ERRMSB: HRRZ B,(A) ;SET RET ADDR FROM RH OF WD IN STRING.
HRRM B,-4(P)
TLZ A,77^4 ;SKIP CHARS LEFT IN WD.
JRST ERRMS1
;TYPE NAME OF CURRENT INPUT FILE ON TTY.
ERRFIL: SAVE F,0
TLZ F,LSTBIT ;SO LSTFIL WON'T WRITE TO LST.
MOVE N,SRCNUM ;GET # OF FILE OF LAST ERROR.
CAMN N,SRCERR ;IF PREV. ERROR WAS IN OTHER FILE,
JRST ERRFI1
MOVEM N,SRCERR ;SAY LAST ERROR WAS IN THIS FILE.
MOVE 0,[SIXBIT/FILE/]
CALL LSTSIX ;PRINT "FILE" AND FILE'S NAME.
CALL ERRTAB
CALL LSTFIL
CALL ERRCR
ERRFI1: REST 0,F ;ELSE DO NOTHING.
RET
LSTNUM: SAVE A,B
MOVE A,N
CALL ERRDEC
REST B,A
RET
;PRINT NAME OF CURRENT FILE ON LST, TTY, ERR.
LSTFIL: MOVE N,RFILN
CAMN N,[SIXBIT/DSK/]
JRST LSTFI1
CALL LSTSIX ;PRINT DEV IF NOT DSK.
MOVEI B,":
CALL ERROUT
JRST LSTFI2
LSTFI1: IFN ITS+TENEX,[
MOVE N,RFILSN ;IS DSK - PRINT SNAME
CALL LSTSIX
MOVEI B,";
CALL ERROUT
]
LSTFI2: MOVE N,RFILN1
CALL LSTSIX ;PRINT 1ST NAME.
CALL ERRSP
MOVE N,RFILN2
IFN ITS+TENEX, JRST LSTSIX ;, 2ND NAME.
IFN SAIL,[
CAME N,[-1]
PUSHJ P,LSTSIX
MOVE B,RFILN
CAME B,[SIXBIT /DSK/]
RET
MOVEI B,"[ ;]
CALL ERROUT
SAVE A
MOVEI A,N
HLLZ N,RFILSN
LSTFI3: TLNE N,770000
JRST LSTFI4
LSH N,6
JRST LSTFI3
LSTFI4: CALL LSTSIX
JUMPN A,LSTFI5
MOVEI B,",
CALL ERROUT
HRLZ N,RFILSN
AOJA A,LSTFI3
LSTFI5: REST A ;[
MOVEI B,"]
JRST ERROUT
]
;OUTPUT WD IN N AS SIXBIT TO LST, TTO, ERR.
LSTSIX: SETZM LINPOS
TLNN N,770000
JRST LSTLTG ;LOCAL TAG
LSTSI0: SAVE R6
MOVSI R6,440600
LSTSI1: ILDB B,R6
JUMPE B,POPR6J
ADDI B,"
CALL ERROUT
AOS LINPOS ;COUNT CHARS PRINTED.
TLNE R6,770000
JRST LSTSI1
POPR6J: REST R6
RET
LSTLTG: SAVE N,S ;OUTPUT LOCAL TAG
HRRZ S,N ;-> BASE SYMBOL
MOVE N,@SYMPNT
CALL LSTSI0
REST S,N
MOVEI B,"/ ;SLASH SEPARATES THE TWO SYMBOLS
AOS LINPOS
CALL ERROUT
SAVE A
HLRZ A,N ;NNN$
CALL ERRDEC
REST A
MOVEI B,"$
AOS LINPOS
JRST ERROUT
;GETDAT DATE AND TIME ROUTINE
IFN SAIL,[
GETDAT: MOVE C,[440700,,DATTIM]
DATE N,
IDIVI N,31.
ADDI A,1 ;DAY
MOVEM A,%DAY
SAVE A
IDIVI N,12.
ADDI A,1 ;MONTH
MOVEM A,%MONTH
ADDI N,64. ;YEAR
MOVEM N,%YEAR
MOVEI B,"/
CALL GETDA1 ;CONVERT A
REST A
CALL GETDA2
MOVE A,N
CALL GETDA2
MOVEI B,40
IDPB B,C
TIMER N,
IDIVI N,60. ;NUMBER OF SECOND SINCE MIDNIGHT
IDIVI N,60.
SAVE A ;SECS
IDIVI N,60.
EXCH N,A
CALL GETDA2
MOVEI B,":
MOVE A,N
CALL GETDA2
REST A
CALL GETDA2
MOVEI A,0
RUNTIM A,
MOVEM A,IRUNTM
RET
GETDA2: IDPB B,C
GETDA1: SAVE B
IDIVI A,10.
ADDI A,"0
IDPB A,C
ADDI B,"0
IDPB B,C
REST B
RET
]
IFN TENEX,[
GETDAT: GTAD
MOVE B,A ;INTERNAL TENEX FMT TIME AND DATE.
HRROI A,DATTIM ;INTO ASCII IN DATTIM.
SETZ C,
ODTIM
MOVEI A,400000
RUNTM ;GET RUNTIME THIS FORK.
MOVEM A,IRUNTM
MOVEM B,TIMDIV
SETO 2, ; -1 means use current date and time
SETZ 4, ; 0 means default options
ODCNV
HLRZ A,B ; Year
SUBI A,1900.
MOVEM A,%YEAR
HRRZM B,%MONTH
AOS %MONTH ; January = 1
HLRZM C,%DAY
AOS %DAY
RET
]
IFN ITS,[
GETDAT: MOVE C,[440700,,DATTIM]
.RDATE N, ;DATE AS SIXBIT/YYMMDD/
CALL GETYMD ;SET UP %YEAR, %MONTH AND %DAY
ROT N,14 ;NOW SIXBIT/MMDDYY/
MOVEI B,"/ ;CHAR. TO SEPARATE NUMBERS WITH.
CALL GETDA1 ;OUTPUT INTO DATTIM.
MOVEI B,40
IDPB B,C ;2 SPACES.
IDPB B,C
.RTIME N, ;SIXBIT/HHMMSS/
MOVEI B,": ;CHAR. FOR SEPARATOR.
CALL GETDA1
.SUSET [.RRUNT,,IRUNTM]
RET
GETDA1: MOVEI I,6 ;# CHARS TO GET OUT OF N.
GETDA2: SETZ A,
ROTC N,6 ;NEXT CHAR. TO A.
ADDI A,40
IDPB A,C
SOJE I,CPOPJ ;AFTER 6TH, DONE.
TRNE I,1
JRST GETDA2
IDPB B,C ;AFTER 2ND AND 4TH, SEPARATOR.
JRST GETDA2
GETYMD: SAVE N,C ;SAVE THE ORIGINAL SIXBIT OF /YYMMDD/
MOVEI I,6 ;NUMBER OF CHARS TO GET
MOVEI C,[%YEAR ? %MONTH ? %DAY] ;WHERE TO PUT THINGS AS WE GET THEM
GETDA3: SETZI B, ;ZERO THE NUMBER
GETDA4: SETZI A,
ROTC N,6 ;NEXT CHAR INTO A
IMULI B,10.
SUBI A,'0 ;SUBTRACT SIXBIT OF 0, GIVES REAL NUMBER
ADD B,A ;NEW NUMBER
SOS I ;DECREMENT COUNTER
TRNE I,1 ;TEST IT
JRST GETDA4 ;GO GET NEXT CHAR IF ODD
MOVEM B,@(C) ;STORE THE NUMBER AWAY
AOS C ;INCREMENT WHERE TO PUT THINGS
JUMPG I,GETDA3 ;IF MORE TO DO, DO THEM
REST C,N ;RESTORE THE SAVED REGS
RET ;GET OUT
]
ASSEMB: ;ASSEMBLER PROPER
IFN RELCOD,[
MOVE A,[ASCII ".MAIN"]
MOVEM A,TITBUF ; SET DEFAULT TITLE TO ".MAIN"
SETOM INDWRD ; RELEASE ALL INDIRECT SLOTS
]
TLNE F,TTYBIT ;TELETYPE?
TLC AF,TTYFLG ; YES, TOGGLE BIT FOR LISTING
SETOM LLABS
CALL LINE ;GO DO PASS ONE.
SETOM LLABS
TLZ AF,P1F ;RESET TO PASS 2
AOS VALREQ ;NORMALLY NEED VALUES.
SETZM TSLWRD
SETZM STITBF
MOVEI B,1 ;DEFAULT START ADDR IS 1.
MOVEM B,STRTLC
TRZ F,ENDBIT+FFBIT+ARWBIT
MOVE B,[440700,,TTIBUF]
MOVEM B,TTIPNT ;RESTART CMD STRING SCAN.
MOVE B,TTICSV
MOVEM B,TTICNT
MOVE B,MSNAME ;SET DEFAULT SNAME TO USER'S.
MOVEM B,RFILSN ;FOR THE 1ST INPUT FILE.
SAVE F
SETP2A: TDNE F,[NULBIT,,ARWBIT]
JRST SETP2B ;READ PAST OUTPUT SPECS.
CALL RFILE
JRST SETP2A
SETP2B: REST F
AOS LSWCNT ;LIST LINES NOW EVEN IF ONLY ONE /L.
CALL INIPAS
CALL GETSRC ;READ IN SRC FILE'S NAME, OPEN & INIT.
CALL BLKINI ;INITIALIZE BINARY OUTPUT BLOCK
IFN RELCOD,[
CALL ENTOUT ; DUMP ENTRY POINT BLOCK
CALL NAMOUT ; DUMP NAME BLOCK
CALL CODINI ; INITILIZE FOR CODE DUMPING
]
CALL LINE ;CALL THE ASSEMBLER (PASS TWO)
IFN RELCOD,[
CALL STORLC ; SAVE THE LOCATION COUNTER
]
CALL COMPRS
TLNE F,BINBIT
CALL DUMP2 ;OUTPUT END BLOCK, SYMTAB TO BIN.
TLNE F,LSTBIT ;LISTING?
CALL SYMTB ; YES, OUTPUT THE SYMBOL TABLE
RET
INIPAS: MOVEI B,%COMP1 ;INIT. %COMPAT.
MOVEM B,%COMPAT
MOVEI B,GCHS ;INIT. GETCHA TO GET FROM SRC.
HRRM B,GETCHA
HLLZS LOCTR ;CLEAR OFFSET.
MOVE B,[004400,,MACPDL-1]
MOVEM B,MACPDP ;INIT. MACRO PDL.
SETZM MACBPT
SETZB L,LLABN ;CLEAR LOCATION COUNTER
IFN RELCOD, TLO AF,LCRFLG ; MAKE LOCATION COUNTER RELOCATABLE
SETZB W,MP
MOVSI B,'DSK
MOVEM B,RFILN ;DEFAULT DEV. FOR 1ST SRC FILE.
SETZM SRCDPH ;NOT IN .INSRT FILE.
SETOM SRCCNT ;NOW READING 0TH SRC FILE.
SETZM SRCERR ;PRETEND HAD HAD ERROR IN THAT FILE.
MOVE B,[440700,,SRCBUF]
MOVEM B,SRCBPT ;B.P. TO OUTER LEVEL SRC BUFFER.
TLZ AF,SRCFLG+LINFLG+RSWFLG
MOVEI B,(CALL)
TLNE F,CSWBIT ;CREF IF /C AND PASS 2.
TLNE AF,P1F
MOVEI B,(JFCL)
HRLM B,CRFINS
HRLM B,CRFIND
RET
;THE MAIN STATEMENT-READING LOOP OF THE ASSEMBLER.
LINE: MOVEM P,LINEPP ;REMEMBER P TO RESTORE IT ON ERRORS THAT RESTART HERE.
LINE1: CALL GETLIN ;SET UP LISTING BUFFER ETC FOR NEXT LINE.
CALL STMNT ;READ AND PROCESS IT.
TLZN AF,ENDFLG ;TEST FOR END STATEMENT
JRST LINE1 ;GET THE NEXT LINE
SETZM LINEPP ;WE'RE NO LONGER INSIDE "LINE" FOR PDL OV'S SAKE.
TRNN F,ENDBIT ;IF FILSPECS REMAIN...
ERROR1 Extra input files
RET ;END OF PASS
LINPNT: 440700,,LINBUF ;POINTER TO START OF LINE
TYPPNT: 220500,,1 ;OP TYPE POINTER
ENDLR: TLNE F,RSWBIT ;SUPPRESS IF /R
TLO AF,RSWFLG ;SET LOCAL FLAG
ENDL: ;END OF LINE PROCESSOR
CAIA
ENDL0: CALL GETCHR ;MOVE TILL EOL.
CAIE I,^J
JRST ENDL0
ENDLF: ;ENDL FIN
HLRZ B,W ;GET TYPE
XCT ENDLT2(B) ;EVEN LOCATION TEST
ERROR1 Word at odd address
CALL ENDLA ;DECIDE WHETHER TO LIST.
TRNE AF,ERRP1 ;IF WAS ^D IN ERROR,
MOVEI A,ERROUT ; LIST ON TTY.
CAIN A,CPOPJ ;IF WOULDN'T LIST ANYWAY, SKIP WORK.
JRST ENDL11
TLNN F,RSWBIT ;/R => DON'T LIST OCTAL.
CALL PRNTA ;LIST THE OCTAL
SETZ B,
TLNN AF,SRCFLG ;IF HAVE FULL SRC LINE,
JRST ENDL10
TLNN F,RSWBIT
CALL LOTAB ; LIST IT.
SKIPA C,LINPNT ;GET SET TO PRINT LINE
ENDL9: CALL 0(A) ;LIST A CHARACTER
ILDB B,C ;GET ANOTHER CHARACTER
CAIE B,^J
JRST ENDL9
ENDL10: CALL 0(A) ;END,LIST CR/LF
TLNN F,RSWBIT
CALL PRNTB ;LIST EXTENSION LINE, IF ANY
ENDL11: HLRZ B,W ;GET TYPE
IFN RELCOD, PUSH P,B ; SAVE THE STMT TYPE
XCT ENDLT3(B) ;UPDATE LOCATION COUNTER
CALL DUMP ;OUTPUT WDS IF NEC.
IFN RELCOD,[
POP P,B ; RECOVER STMT TYPE
TLNE F,BINBIT ; MAKING BINARY --
TLNE AF,P1F ; -- OR PASS 2?
JRST ENDL12 ; NO - DON'T DUMP EXTERNAL REFS
TLZN AF,EXTFLG ; ANY EXTERNAL REFERENCES?
JRST ENDL12 ; NO - THEN DON'T BOTHER TO LOOK
XCT ENDLT4(B) ; FIXUP NEEDED? (TO ENDL12 IF NOT)
CALL CODUMP ; YES - DUMP CODE BLOCK
CALL BLKINI ; RE-INIT BLOCK
SETZ C, ; ZERO EXTERNAL POINTER
GLBREF: SKIPN EEXTAB(C) ; A GLOBAL REF MADE FOR THIS WORD?
JRST GLBNXT ; NO CHECK REST
MOVE N,EEXTAB(C) ; YES - GET SYMBOL
PUSH P,C ; SAVE REFERENCE LOCATION
CALL GRD50 ; CONVERT TO RADIX 50
POP P,C ; RESTORE LOCATION OF REFERENCE
TLO B,600000 ; SAY IS GLOBAL REFERENCE
AOS A,BYTCNT ; PUT IT INTO --
MOVEM B,BLKDAT-1(A) ; -- THE OUTPUT BLOCK
IBP RELPNT ; ZERO RELOCATION FOR NAME
TLNN AF,LCRFLG ; GET RELOCATION --
TDZA B,B ; -- OF LOCATION --
MOVEI B,1 ; -- OF REFERENCE
IDPB B,RELPNT ; AND PUT IN RELOCATION WORD
MOVEI B,0(R6) ; GET LOCATION OF REFERENCE
TLO B,400000 ; SAY@IS ADDITIVE REQUEST
AOS A,BYTCNT ; PUT INTO --
MOVEM B,BLKDAT-1(A) ; -- THE SYMBOL BLOCK
GLBNXT: ADDI R6,2 ; INCREMENT REFERENCE LOCATION
CAIGE R6,0(L) ; LAST ONE DONE?
AOJA C,GLBREF ; NO - DO THEM ALL
CALL DMPSYM ; YES - DUMP THE SYMBOL BLOCK
CALL CODINI ; RE-INIT FOR CODE DUMPING
ENDL12:
]
ANDI L,ADRMSK
IFE RELCOD,[
SETZB W,CEXT1 ;ZERO ARGUMENT
SETZM CEXT2 ; AND EXTENSIONS
]
IFN RELCOD,[
SETZB W,CEXT ; CLEAR ARGUEMENTS FOR CODE ..
MOVE 1,[CEXT,,CEXT+1]
BLT 1,EEXT2
]
TRZ AF,-1
TLNE AF,SRCFLG ;IF LISTED LINE, FLUSH CALL TO GCHL.
CALL [MOVE IP,LINPNT ;RESET LINE BUFFER PTR
MOVEM IP,LINIP ;TO BEG. OF BUFFER.
JRST GCHSET] ;GETCHR SHOULDN'T TRY TO LIST LINE.
TLZ AF,LINFLG+RSWFLG+SRCFLG
RET
ENDLT2: PHASE 0
CAIA
CL1: CAIA ; ASSIGNMENT
CL2: CAIA ; .=
CL3: TRNE L,1 ; XXXXXX
CL4: CAIA ; XXX
CL5: CAIA ; .END
CL6: TRNE L,1 ; XXXXXX XXXXXX
CL7: TRNE L,1 ; XXXXXX XXXXXX XXXXXX
DEPHASE
ENDLT3:
PHASE 0
CAIA
CL1: CAIA ; ASSIGNMENT
CL2: SKIPA L,W ; .=
CL3: MOVSI R6,-2 ; XXXXXX
CL4: MOVSI R6,-1 ; XXX
CL5: CAIA ; .END
CL6: MOVSI R6,-4 ; XXXXXX XXXXXX
CL7: MOVSI R6,-6 ; XXXXXX XXXXXX XXXXXX
DEPHASE
IFN RELCOD,[
ENDLT4:
PHASE 0
JRST ENDL12
CL1: JRST ENDL12 ; ASSIGNMENT
CL2: JRST ENDL12 ; .=
CL3: MOVEI R6,-2(L) ; XXXXXX
CL4: JRST ENDL12 ; XXX
CL5: JRST ENDL12 ; .END
CL6: MOVEI R6,-4(L) ; XXXXXX XXXXXX
CL7: MOVEI R6,-6(L) ; XXXXXX XXXXXX XXXXXX
DEPHASE
]
;DECIDE WHETHER TO LIST.
ENDLA: MOVEI A,CPOPJ ;ASSUME DON'T LIST.
SKIPN TSLWRD ;MUST NOT BE .XLISTED,
TLNN F,LSTBIT ;MUST HAVE LISTING.
RET
TLNE F,MSWBIT ;IF /M, MUSTN'T BE IN MACRO.
JUMPN MP,CPOPJ
SKIPLE LSWCNT ;NO /L, OR ONLY 1 /L AND PASS 1, => NO LIST.
TLNE AF,LINFLG+RSWFLG ;MUST BE NON-SUPPRESSED.
RET
MOVEI A,LSTOUT ;OK, LIST.
SKIPN NOCREF
TLNN F,CSWBIT ;IF /C,
RET
MOVEI B,CRFLIN ;INDICATE REAL LINE COMING UP.
JRST LSTOUT
STMNT: ;STATEMENT PROCESSOR
SETZM OFFST ;CLEAR ADDRESS OFFSET
CALL GETSYM ;TRY FOR SYMBOL
JRST STMNT2 ; NO
CAIN I,": ;LABEL?
JRST LABEL ; YES
CAIN I,"= ;ASSIGNMENT?
JRST ASGMT ; YES
CALL SRCH
JRST STMNT3 ;TREAT AS EXPRESSION
XCT CRFINS
MOVEI W,(A)
LDB B,TYPPNT ;FOUND, GET TYPE
JRST @STMNJT(B) ;GO TO ROUTINE.
STMNJT: PHASE 0
STMNT3
NPOP:: STMNT3 ;VALUE-RETURNING PSEUDOS.
PSOP:: JRST 0(A) ;PSEUDO-OP, GO TO ROUTINE
CNOP:: JRST CONDIT ;CONDITIONAL
IRPS X,,BG OP SC UN BC TR RT FL ML FS
X!OP:: P!X!OP
TERMIN
SPOP:: SPOPTB(A) ;MARK, SOB.
MAOP:: JRST CALLM ;MACROS.
INOP:: STMNT3 ;%FNAM2 .
INVOP:: [ CALL 0(A) ? JRST STMNT] ;INVISIBLE PSEUDO-OP.
DEPHASE
SPOPTB: BUG ;NO SPECIAL INSN HAS CODE 0.
JRST PMARK
JRST PSOB
STMNT2: CAIE I,". ;LOC TYPE STATEMENT?
JRST STMNT4 ; NO
CALL GETNB ;POSSIBLY, GET NEXT NON-BLANK
CAIE I,"=
JRST STMNT3 ; NO
CALL GETCHR ;YES, BYPASS CHAR
CAIN I,"=
CALL GETCHR ;ALLOW .==
AOS VALREQ ;UNDEFS SYMS ARE ERRORS.
CALL EXPRF ;EVALUATE THE EXPRESSION
ERROR1 No value after ".="
SOS VALREQ
IFN RELCOD,[
CALL STORLC ; SAVE LOCATION COUNTER
SKIPG A ; NEW ONE RELOCATABLE?
TLZA AF,LCRFLG ; NO - MAKE IT ABSOLUTE
TLO AF,LCRFLG ; YES - SAY RELOCATABLE
TLO AF,LCHFLG ; SAY LOCATION COUNTER CHANGED
SKIPE C
ERROR1 Cannot set location counter to external value
]
SUB V,LOCTR ;UN-OFFSET.
LDB W,[POINT ADRSIZ,V,35] ;GET VALUE
HRLI W,CL2 ;SET CLASS
IFN RELCOD,[
SKIPG A ; RELOCATABLE?
AOS REXTAB ; YES - SAY SO FOR LISTING
]
JRST ENDL ;LIST AND EXIT
POPOP::
STMNT3: RESCAN SYMBEG
SETCHAR ;RESET CHARACTER
STMNT4: CALL EXPRF ;GET AN EXPRESSION
SKIPA ; NO SOAP
JRST WORDF ; YES, EXIT THROUGH "WORD"
CAIN I,", ;IS THERE A COMMA?
JRST WORDD ;YES, PROCESS A WORD OF ZERO.
JRST ENDL ;NO-EXIT NULL
IFN RELCOD,[
;
; ROUTINE TO SAVE AWAY THE LOCATION COUNTER IN THE
; PROPER SLOT, DEPENDING UPON WETHER OR NOT IT IS RELOCATABLE.
; THE VALUE IS ONLY SAVED IF IT IS LARGER THAN THE LAST ONE.
STORLC: TLZE AF,LCRFLG ; RELOCATABLE
JRST STOREL ; YES - SAVE THAT WAY
CAMLE L,ABSLC ; NO - LARGER THAN LAST?
MOVEM L,ABSLC ; YES - SAVE IT
RET ; EXIT
STOREL: CAMLE L,RELLC ; LARGER THAN LAST?
MOVEM L,RELLC ; YES - SAVE IT
RET ; EXIT
]
LABEL: CALL GETCHR ;PASS BY THE COLON.
CAIN I,":
TLOA AF,HKLFLG ;ANOTHER COLON => .5KILL, PASS BY.
TLZA AF,HKLFLG
CALL GETCHR
CALL SRCH ;SEARCH USER TABLE
JFCL
MOVEI B,@LOCTR ;GET POINT + OFFSET.
TLNE A,UNDSYM ;OK TO DEFINE IF UNDEF.
JRST LABEL4
TLZE A,INISYM
JRST [ ERROR1 PDP-11 instruction redefined
JRST LABEL4]
TLNN AF,P1F
JRST LABEL3 ;PASS 2, DIFFERENT ERROR MSGS.
LDB W,TYPPNT
JUMPN W,[ERROR1 Is reserved
JRST LABEL4]
CAIN B,(A) ;ELSE ERROR IF NEW VALUE #OLD.
TLNE A,REGSYM+MDLSYM ;OR ALREADY HAD ONE.
JRST LABEL9
JRST LABEL4
;PASS 1 MULT DEF SYMS.
LABEL9: ERROR1 Label being redefined
TLO A,MDLSYM ;SAY THIS SYM IS MUL DEF.
;HERE ACTUALLY REDEFINE THE SYMBOL.
LABEL4: HRRI A,(B) ;GET LOC + OFFSET.
TLZ A,#NCRSYM#ENTSYM#MDLSYM ;DON'T CLEAR NO-CREF BIT.
TLO A,LBLSYM ;SET LABEL FLAG.
TLZE AF,HKLFLG ;IS THIS SYMBOL HALF KILLED?
TLO A,HKLSYM ;YES, SAY SO IN IT'S VALUE
IFN RELCOD,[
TLNE AF,LCRFLG ; LOCATION COUNTER RELOCATABLE?
TLOA A,RELSYM ; YES - MAKE LABEL RELOCATABLE
TLZ A,RELSYM ; NO - MAKE LABEL ABSOLUTE
]
MOVEM N,LLABN ;REMEMBER LAST LABEL DEFINED.
HRRZM A,LLABV
TLNE N,770000
HRRZM S,LLABS
CALL INSRT ;DEFINE IT.
JRST STMNT ;EXIT.
;COME HERE FOR LABEL IN PASS 2 .
LABEL3: TLNN A,LBLSYM
ERROR LABEL4, Not a label on pass 1
TLNE A,MDLSYM
ERROR LABEL4, Multiply defined label
CAIE B,0(A)
ERROR Out of phase
JRST LABEL4
ASGMT: ;ASSIGNMENT PROCESSOR
PUSH P,N ;STACK SYMBOL
CALL GETCHR ;BYPASS "=
CAIN I,"= ;== IS HALF KILLED
TLOA AF,HKLFLG
TLZA AF,HKLFLG
CALL GETCHR ;BYPASS SECOND =
CAIN I,"= ;IF THERE'S A THIRD "=",
TLOA AF,SUPFLG ;THEN SYMBOL IS FULLY KILLED.
TLZA AF,SUPFLG
CALL GETCHR
CALL EXPR ; EVAL EXPRESSION.
ERROR1 Null value in assignment to
IFE RELCOD,[ ;NON-RELOCATABLE ASSIGNMENT.
ASGMT0: LDB W,[POINT ADRSIZ,V,35] ;GET EXPRESSION VALUE.
HRLI W,CL1 ;SET CLASS.
POP P,N ;GET SYMBOL
CALL SRCH ;SEARCH USER TABLE.
JFCL
LDB B,TYPPNT ;IF OLD VALUE A MACRO,
CAIN B,MAOP
CALL REMMAC ;GIVE BACK STORAGE.
CAIN B,INOP
JRST ASGMT5 ;SETTING INDIR. OPS SPECIAL.
TLZE A,INISYM
JRST [ ERROR1 PDP-11 instruction being redefined
JRST ASGMT1]
TLNN A,LBLSYM ; LABEL?
JRST ASGMT1 ; NO
MOVEI B,(W)
TLNN AF,REGFLG ;ERROR IF NEW VALUE NOT = OLD.
CAIE B,(A)
TLO A,MDLSYM
ASGMT1: TLNN A,MDLSYM ;MUL DEF?
JRST ASGMT2 ; NO
ERROR1 Label being redefined
ASGMT2: TLZ A,#NCRSYM#LBLSYM
TLNE AF,REGFLG ;REGISTER EXPRESSION?
TLOA A,REGSYM ;YES--FLAG AND TEST MAGNITUDE.
TLZA A,REGSYM ;NO--RESET AND SKIP TEST.
CAIG V,7 ;YES--OUT OF RANGE?
JRST ASGMT3 ;NO.
ERRUU1 REGMES
SETZ V, ;CLEAR VALUE
ASGMT3: TRNE AF,ERRU ;ANY UNDEFINED ERRORS?
TLOA A,UNDSYM ;YES, SET FLAG SAYING SYM IS UNDEFINED.
TLZ A,UNDSYM ;ELSE MARK IT AS DEFINED.
HRR A,V ;GET VALUE
TLZE AF,HKLFLG ;.5KILL IF NEC.
TLO A,HKLSYM
TLZE AF,SUPFLG ;FULLY KILL IF NEC.
TLO A,SUPSYM
XCT CRFIND ;INDIC. BEING DEFINED.
CALL INSRT ;DEFINE SYMBOL AND EXIT.
JRST ENDL
ASGMT5: DPB W,[2000+A,,] ;SET IND. OP'S WORD.
XCT CRFIND
JRST ENDL
]
IFN RELCOD,[
;FALLS THROUGH.
; THIS ASSIGNMENT PROCESSOR IS FOR THE RELOCATABLE VERSION
; OF THE ASSEMBLER. IT MUST KNOW ABOUT RELOCATABLE VALUES
; AND EXTERNAL REFERENCES. IF A SYMBOL IS SET EQUAL TO
; AN EXPRESSION CONTAINING AN EXTERNAL REFERENCE, IT BUILDS
; AN ENTRY IN THE INDIRECT VALUE TABLE CONSISTING OF THE NAME
; OF THE EXTERNAL SYMBOL, AND THE OFFSET FROM ITS VALUE.
ASGMT0: LDB W,[POINT 16,V,35] ; GET VALUE OF EXPRESSION
HRLI W,CL1 ; SET CLASS
POP P,N ; THE SYMBOL
PUSH P,A ; SAVE THE RELOCATION COUNT OF EXP.
CALL SRCH ; LOOKUP SYMBOL
JRST ASGMT2 ; NOT THERE - EASY TO FIX!
TLNN A,INDSYM ; OLD VALUE DEPENDENT?
JRST ASGMT6 ; NO
HRRZI B,0(A) ; YES - GET INDIRECT VALUE TABLE INDEX
CALL RELIND ; RETURN THE TABLE SLOT
ASGMT6: LDB B,TYPPNT ; GET SYMBOL TYPE
CAIN B,MAOP ; A MACRO?
CALL REMMAC ; YES - RELEASE STORAGE
CAIN B,INOP ; AN INDIRECT OP?
JRST ASGMT5 ; YES - THEY IS DIFFERENT
TLNE A,EXTSYM ; EXTERNAL?
ERROR1 External symbol being redefined
TLNE A,ENTSYM ; ENTRY POINT?
TLNE A,UNDSYM ; YES - DEFINED YET?
JRST .+3 ; NO - FINE
CAIE V,0(A) ; YES - TO SAME VALUE?
ERROR1 Entry point being redefined
TLNN A,LBLSYM ; A LABEL?
JRST ASGMT1 ; NO - OK TO REDEFINE
MOVEI B,0(W) ; YES - GET NEW VALUE
TLNN AF,REGFLG ; NEW VALUE A REGISTER OR --
CAIE B,0(A) ; -- NEW VALUE NOT EQUAL OLD?
TLO A,MDLSYM ; YES - THEN IS MULTIPLY DEFINED
ASGMT1: TLZ A,RELSYM ; CLEAR RELOCATION
TLNN A,MDLSYM ; MULTIPLY DEFINED?
JRST ASGMT2 ; NO - FINE!
ERROR1 Label being redefined
TLZ A,UNDSYM ; MAKE IT DEFINED
ASGMT4: TLZE AF,HKLFLG ; HALF KILLED?
TLO A,HKLSYM ; YES - HALF KILL IT
TLZE AF,SUPFLG ;FULLY KILL IF NEC.
TLO A,SUPSYM
POP P,B ; GET RELOCATION OF EXPRESSION
CAIN B,1 ; RELOCATABLE VALUE?
TLOA A,RELSYM ; YES - SET RELOCATION BIT
CAIA ; NO - DON'T SET FOR LISTING
AOS REXTAB ; SET RELOCATION FOR LISTING
XCT CRFIND ; CREF IT
CALL INSRT ; PUT IN SYMBOL TABLE
JRST ENDL ; LIST AND EXIT
ASGMT2: TLZ A,-1-NCRSYM-ENTSYM ; CLEAR BITS
JUMPN C,ASGMT7 ; INDIRECT VALUE GUYS IS SPECIAL
TLNE AF,REGFLG ; A REGISTER?
TLOA A,REGSYM ; YES - SAY SO, TEST VALUE
TLZA A,REGSYM ; NO - SAY SO, DON'T TEST VALUE
CAIG V,7 ; TEST VALUE - 0-7?
JRST ASGMT3 ; YES - THAT'S FINE!
ERRUU1 REGMES ; NO - NOT SO GOOD
SETZ V, ; CLEAR VALUE
ASGMT3: TRNE AF,ERRU ; ANY UNDEFINED GUYS?
TLO A,UNDSYM ; YES - SAY THIS ONE IS
HRRI A,0(V) ; GET VALUE
JRST ASGMT4 ; GO INSERT SYMBOL
ASGMT5: DPB W,[2000+A,,0] ; SET IND. OPS WORD
XCT CRFIND ; CREF IT
JRST ENDL ; LIST AND EXIT
ASGMT7: PUSHJ P,GETIND ; GET AN INDIRRECT VALUE SLOT
MOVEM C,INDREF(B) ; STORE SYMBOL NAME
TRNE V,100000 ; SIGN EXTEND --
TRO V,700000 ; -- THE OFFSET
MOVEM V,INDOFF(B) ; SAVE IT IN TABLE
HRRI A,0(B) ; SET SYMS VALUE TO INDEX
TLO A,INDSYM ; SAY VALUE DEPENDENT
MOVEM C,EEXTAB ; SET EXTERNALNESS FOR LISTING
JRST ASGMT4 ; INSERT SYMBOL
;
; ROUTINE TO ASSIGN OR DEASSIGN SLOTS IN THE INDIRECT
; VALUE TABLE. ENTER AT GETIND TO GET TABLE INDEX IN B.
; ENTER AT RELIND WITH TABLE INDEX IN B TO RELEASE IT.
;
GETIND: PUSH P,A ; SAVE A
MOVE A,INDWRD ; GET ALLOCATION INFO
JFFO A,GOTIND ; FIND FREE SLOT
ERROR1 POPAJ,Indirect value table overflow
RELIND: PUSH P,A ; RELEASE, SAVE A
GOTIND: MOVE A,BITS(B) ; GET MASK FOR SLOT'S BIT
XORM A,INDWRD ; COMPLEMENT SLOT'S USAGE
POP P,A ; RESTORE A
RET ; RETURN
.X==400000,,000000
BITS: REPEAT 36.,[.X
.X==.X_-1
]
]
PBGOP: ;PROCESS BASIC GROUP OPS
CALL AEXP ;GET FIRST ARGUMENT
DPB V,[060600,,W] ;STORE SRC MODE AND REG IN INSN.
SKIPE CEXT1 ;SKIP IF REGISTER TYPE
AOS OFFST ;FLAG SECOND FIELD
CALL PSOB3 ;SKIP A COMMA.
CALL AEXP ;READ DESTINATION
IOR W,V ;MERGE IT INTO INSN.
SKIPE %COMPA ;IF WE'RE CHECKING FOR INTER-MODEL INCOMPATIBLE INSNS
TRNE W,7000 ;CHECK FOR "OPR AC,-(AC)", ETC.
JRST OPXIT
TRCE V,60 ;LOOK FOR INCREMENT OR DECREMENT IN DESTINATION.
TRCN V,60
JRST OPXIT
LSH V,6 ;SEE IF SRC REGISTER AND DEST REGISTER ARE THE SAME.
XOR V,W
TRNN V,700
ERRUU1 PBGOPE
JRST OPXIT
PBGOPE: ASCIZ/Inter-model incompatible PDP-11 instruction/
PUNOP: CALL AEXP ;1-OPERAND INSNS (TST, ETC.).
CAIN W,100 ;CHECK FOR "JMP".
SKIPN %COMPA
TDOA W,V ;MERGE DEST INTO INSN.
JRST PUNOP1 ;"JMP", AND CHECKING MODEL COMPATIBILITY.
PRTOP2: IOR W,V ;MERGE INTO BASIC CODE
OPXIT: AOS INSCNT ;1 MORE INSTRUCTION.
AOS INSLEN ;UPDATE TOTAL LENGTH OF INSTRUCTIONS.
HRLI W,CL3 ;ASSUME 1 WORD
SKIPN CEXT1 ;TRUE?
JRST ENDL ; YES, LIST AND EXIT
AOS INSLEN
HRLI W,CL6 ;NO, ASSUME TWO
SKIPN CEXT2 ;TRUE?
JRST ENDL
AOS INSLEN
HRLI W,CL7 ;NO, SET FOR THREE
JRST ENDL ;LIST AND EXIT
PFSOP: MOVEI A,3 ;FLOATING AC-TO-MEM, AC IS 0 TO 3.
CALL REGEX1 ;READ IN THE AC, CHECK IN BOUNDS.
DPB V,[060200,,W] ;STORE AC IN INSN.
CALL PSOB3 ;PASS THE COMMA
CALL AEXP ;READ THE DESTINATION.
JRST PRTOP2
PSCOP: MOVEI A,7 ;XOR OR JSR: AN AC TO MEM INSN, WHOSE AC IS FOM 0 TO 7,
CALL REGEX1 ;SO READ THE AC.
DPB V,[060300,,W] ;AND STORE IT IN THE INSN.
CALL PSOB3 ;SKIP OVER THE COMMA,
CALL AEXP ;AND READ THE DESTINATION.
PUNOP1: IOR W,V ;MERGE DEST INTO INSN - HERE FOR JSR AND JMP AND XOR.
ANDI V,70 ;CHECK FOR "JMP (AC)+", ETC.
SKIPE %COMPAT
CAIE V,20
JRST OPXIT
TRNN W,70000 ;DON'T BARF FOR "XOR" - ONLY "JMP" AND "JSR".
ERRUU1 PBGOPE ;INSN THAT EXECUTES DIFFERENTLY ON DIFFERENT MODEL PDP-11'S.
JRST OPXIT
PMARK: MOVEI W,6400 ;REPLACE SPECIAL-INSN-CODE BY VALUE OF INSN.
CALL EXPRF ;READ ARG,
SETZ V,
TRZE V,777700 ;IT MUST FIT IN 6 BITS.
ERROR MARK instruction argument too large
LOCABS MARK INSN ARG,O,;DON'T WANT RELOCATABLE OR EXTERNAL.
JRST PRTOP2
PFLOP: SKIPA A,[3] ;FLOATING MEM-TO-AC INSNS.
PMLOP: MOVEI A,7 ;NON-FLOATING MEM-TO-AC INSNS.
SAVE A
CALL AEXP ;READ SRC ADDR.
IORI W,(V) ;MRERGE NTO INSN.
CALL PSOB3 ;PASS COMMA.
REST A
CALL REGEX1 ;READ AC ARG, CHECK SMALL ENOUGH.
LSH V,6 ;SHIFT AC # INTO PLACE,
JRST PRTOP2 ;MERGE IN AND DONE.
PRTOP: ;PROCESS RETURN JUMP
PRTOP1: CALL REGEXP ;GET A REGISTER EXPRESSION
JRST PRTOP2
PSOB: MOVEI W,77000 ;VALUE OF INSN, FOR PRTOP2.
CALL REGEXP ;READ # OF AC TO DECREMENT.
LSH V,6
IORI W,(V) ;PUT INTO INSN.
CALL PSOB3 ;PASS COMMA, ERROR IF NONE.
CALL EXPRF ;READ ADDRESS TO BRANCH TO,
JRST PBCOP2 ;(ERROR IF NO ADDRESS)
IFN RELCOD,[
JUMPN C,PBCOP2 ; CAN'T BE EXTERNAL
LDB C,[LCRFBP,,AF] ;COMPARE RELOCATION AGAINST
CAME A,C ;THAT OF POINT.
JRST PBCOP2 ;OFFSET OF SOB CAN'T BE RELOCATABLE
]
SUBI V,@LOCTR ;GET OFFSET FROM CURRENT ADDR.,
SUBI V,2
MOVNS V ;BEFORE ".", NEGATE.
ROT V,-1
ANDCMI V,700000
TDNN V,[-100] ;ERROR IF WON'T FIT IN 6 BIT FIELD.
JRST PRTOP2
JRST PBCOP2
PSOB3: CAIE I,",
ERROR1 CPOPJ,Missing comma
JRST GETCHR ;SKIP THE COMMA
PTROP: ;PROCESS TRAP/EMT OPS
CALL EXPRF ;GET EXPRESSION
SETZ V, ;NULL RETURN. ASSUME ZERO.
TRZE V,777400 ;VALUE TOO BIG?
ERROR TRAP/EMT Code too large
LOCABS TRAP/EMT CODE,O,;ERROR UNLESS LOCAL & ABSOLUTE.
JRST PRTOP2
PBCOP: ;PROCESS BRANCH ON CONDITION
CALL EXPRF ;EVALUATE EXPRESSION
JRST PBCOP2 ; NULL, ERROR
IFN RELCOD,[
JUMPN C,PBCOP2 ; CAN'T BE EXTERNAL
TLNE AF,LCRFLG ; L. C. RELOCATABLE?
JRST .+3 ; YES - THEN TARGET MUST BE
JUMPN A,PBCOP2 ; NO - TARGET MUST BE ABSOLUTE
CAIA
JUMPE A,PBCOP2
]
SUBI V,@LOCTR ;SUBTRACT . .
MOVEI V,-2(V)
ROT V,-1 ;/2, ODD BIT TO SIGN
ANDCMI V,700000
TRNE V,000200 ;NEGATIVE?
TRC V,077400 ; YES, TOGGLE HIGH BITS
TRNN V,077400 ;ANY OVERFLOW?
JUMPGE V,PRTOP2 ; NO, BRANCH IF EVEN
PBCOP2: MOVEI V,377 ; YES, INVALID BRANCH, SO ASSEMBLE A BRANCH TO ".".
ERROR Branch out of range
JRST PRTOP2
;EXPRESSION HANDLERS
AEXP: ;"A EXPRESSION EVALUATOR
AEXP01: SETZ V,
CALL SETNB ;GET A NON-BLANK
CAIN I,"#
JRST AEXP02
CAIN I,"(
JRST AEXP06
CAIN I,"-
JRST AEXP07
CAIN I,"@
TLOA AF,INDFLG ;IF INDIR., SAY SO.
JRST AEXP10 ;NO UNARIES, PROCESS BASIC EXPRESSION
CALL GETCHR ;SKIP TH "@"
JRST AEXP01 ;GO READ ADDR.
AEXP02: ; #
CALL GETCHR ;BYPASS UNARY OP
CALL EXPRF ;EVALUATE EXPRESSION
ERROR1 Null expression in instruction
AEXP21: MOVE B,OFFST ;GET OFFST
HRROM V,CEXT(B) ;STORE ADDRESS
IFN RELCOD,[
MOVEM A,REXT(B) ; SET RELOCATION
MOVEM C,EEXT(B) ; SET EXTERNAL NESS
]
MOVEI V,27 ;(PC)+ MODE.
JRST AEXPXT
AEXP05: CAILE V,7 ;ANY OVERFLOW?
ERRUU1 REGMES ;OVERFLOW.
AEXPXT: TLZE AF,INDFLG ;IF WAS @,
TRO V,10 ;MAKE INDIRECT.
RET
AEXP06: ; (
CALL AEXP20 ;EVALUATE PARENTHESES
SETZ A, ;ZERO IN CASE OF INDEX
CAIE I,"+ ;FINAL "+ SEEN?
JRST AEXP13 ; NO, GO SEE IF (R) OR @(R)?
CALL GETNB
TRO V,20
JRST AEXPXT
AEXP13: TLCN AF,INDFLG
JRST AEXP05 ;NO-REGISTER MODE
MOVE A,OFFST ;YES, SAME AS @0(REG)
HLROM A,CEXT(A) ;STORE THE 0 .
ADDI V,70
RET
AEXP07: ; -(
MOVEM IP,SYMBEG ;SAVE POINTER IN CASE OF FAILURE
CALL GETNB ;GET THE NEXT NON-BLANK
CAIE I,"( ;PARENTHESIS?
JRST AEXP09 ; NO, TREAT AS EXPRESSION
CALL AEXP20 ;YES, EVALUATE
TRO V,40 ;SET BITS
JRST AEXPXT
AEXP09: ; -( FAILURE
RESCAN SYMBEG ;GET POINTER TO "-
SETCHAR ;RESTORE CHARACTER
AEXP10: ; NO UNARIES
CALL EXPR ;EVALUATE EXPRESSION
ERROR1 Null immediate operand
CAIN I,"( ;ANOTHER EXPRESSION?
JRST AEXP11 ; YES, BRANCH
TLNE AF,REGFLG ;REGISTER EXPRESSION?
JRST AEXP05 ; YES, TREAT AS %
SKIPE %ABSAD ; USER WANT ABSOLUTE ADDRESSING?
TLOE AF,INDFLG ; YES - CAN WE DO IT?
CAIA ; NO - GIVE HIM PC RELATIVE THEN
JRST AEXP21 ; YES - THEN GIVE IT TO HIM
IFE RELCOD,[
SUBI V,@LOCTR ;DECREMENT BY CLC
HRROI A,-4(V) ;ASSUME FIRST ADDRESS FIELD
SKIPE B,OFFST ;TRUE?
HRROI A,-6(V) ; NO, TREAT AS SECOND FIELD
MOVEM A,CEXT(B) ;SET VALUE
MOVEI V,67
JRST AEXPXT
]
IFN RELCOD,[
TLNE AF,LCRFLG ; NO - LOCATION COUNTER RELOCATABLE?
JRST AEXP30 ; YES - THIS REQUIRES EXTRA THOUGHT
AEXP31: SUBI V,@LOCTR ; EASY, COMPUTE OFFSET
HRROI R6,-4(V) ; ASSUME FIRST AOERAND
SKIPE B,OFFST ; GOOD GUESS?
HRROI R6,-6(V) ; NOPE - WAS SECOND
AEXP33: MOVEM R6,CEXT(B) ; SET VALUE
MOVEM A,REXT(B) ; SET RELOCATION
MOVEM C,EEXT(B) ; SET EXTERNALNESS
MOVEI V,67 ; (PC)
JRST AEXPXT ; EXIT
AEXP30: JUMPE A,AEXP32 ; IF TAG ABSOLUTE, CAN'T BE RELITIVE
SETZ A, ; IF TAG RELOCATABLE, RELOCATION IS ZERO
JRST AEXP31 ; FINNISH IT OFF
AEXP32: SETO A, ; SAY NEGATIVE RELOCATION (DUMP WILL FIX)
HRROI R6,-2(V) ; PC WILL BE INCREMENTED AT THIS POINT
MOVE B,OFFST ; OFFSET FROM START OF INSTRUCTION
JRST AEXP33 ; FINNISH THIS OFF
]
AEXP11: ; E1(E2)
TLNE AF,REGFLG ;REGISTER EXPRESSION?
ERRUU1 REGMES
MOVE B,OFFST
HRROM V,CEXT(B) ;SAVE DISPLACEMENT.
IFN RELCOD,[
MOVEM A,REXT(B) ; SET RELOCATION
MOVEM C,EEXT(B) ; SET EXTERNAL REFERENCE
]
CALL AEXP20 ;GET REGISTER NUM.
IORI V,60 ;SET INDEXED MODE.
JRST AEXPXT
AEXP20: ;()
CALL GETCHR ;BYPASS PAREN
CALL REGEXP ;EVALUATE REGISTER EXPRESSION
CAIE I,") ;PROPER DELIMITER
ERROR1 SETNB,Missing )
JRST GETNB ;BYPASS THE ")".
;READ IN A REGISTER NUMBER.
REGEXP: MOVEI A,7 ;NORMALLY 7 IS LARGEST LEGAL REG. #.
REGEX1: HRLM A,(P) ;CALL HERE IF SOME OTHER LARGEST LEGAL.
CALL EXPR ;EVALUATE EXPRESSION
ERRUUO REGMES ;ERROR IF NULL.
LOCABS REGISTER,O
HLRZ A,(P)
CAIG V,(A) ;ARE WE WITHIN BOUNDS?
RET
ERRUUO REGMES ;NO, ERROR.
SETZ V, ;SET VALUE TO ZERO
RET
REGMES: ASCIZ/Bad register number/
EXPR: ;EXPRESSION PROCESSOR, REGISTER ALLOWED
TLOA AF,ROKFLG ;ALLOW REGISTER TYPE SYMBOLS
EXPRF: ;EXPRESSION FIN, NO REGISTERS ALLOWED
TLZ AF,ROKFLG ;PRECLUDE REGISTER
CALL EXPRZ
RET
AOS (P)
CAIE I,">
RET
ERROR1 Unmatched >
JRST GETNB
EXPRZ: SETZB A,C ; NO RELOCATION, NO EXT. REF.
CALL EXPRRC ;REALLY READ EXPR.
CAIA
AOS (P) ;WE SKIP IF EXPRRC DID.
IFN RELCOD,[
JUMPE A,EXPRF2 ; ABSOLUTE IS OK
CAIE A,1 ; RELOCATION ONE?
ERROR1 Relocation error
CAIA
EXPRF2: JUMPE C,EXPRF3 ; LOCAL IS OK TOO
TLNE AF,REGFLG ; A REGISTER?
ERROR1 Register in bad context
EXPRF3:
]
RET
IFE RELCOD,[
; THIS EXPRRC ROUTINE FOR ABSOLUTE VERSION OF ASSEMBLER
EXPRRC: TLZ AF,REGFLG ;RESET ACTUAL FLAG
CALL EXPRT ;GET THE FIRST TERM
RET ; NULL, EXIT
EXPRF1: LDB B,C4PNTR ;MAP CHARACTER USING COLUMN 4
EXPRF2: XCT EXPRJT(B) ;EXECUTE TABLE
PUSH P,N ;STACK INSTRUCTION
CALL GETCHR
PUSH P,V ;STACK CURRENT VALUE
PUSH P,R6 ; SAVE OP TYPE
CALL EXPRT ;GET THE NEXT EXPRESSION TERM
ERROR1 No term after operator
POP P,R6 ; RESTORE OP TYPE
POP P,N ;GET PREVIOUS VALUE
IFE EXTEND,[
TRNE N,100000 ;EXTEND SIGN IF NEGATIVE
TDO N,[-1,,700000]
TRNE V,100000
TDO V,[-1,,700000]
]
POP P,R6
XCT R6 ;EXECUTE INSTRUCTION
LDB V,[POINT ADRSIZ,0,35] ;RETURN TRIMMED RESULT IN V
JRST EXPRF1 ;RECYCLE
]
IFN RELCOD,[
; THIS EXPRRC ROUTINE FOR RELOCATABLE VERSION OF ASSEMBLER
EXPRRC: TLZ AF,REGFLG ; NOT A REGISTER YET
CALL EXPRT ; READ FIRST TERM
RET ; NULL - THEN EXIT NULL TOO
EXPRF1: LDB R6,C4PNTR ; GET OP TYPE
XCT EXPRJT(R6) ; TEST VALIDITY
PUSH P,N ; SAVE THE INSN FOR THIS OPERATOR.
CALL GETCHR ; BY PASS IT
PUSH P,C ; SAVE EXTERNAL REFERENCE
PUSH P,A ; SAVE RELOCATION COUNT
PUSH P,V ; SAVE VALUE
PUSH P,R6 ; SAVE OP(EXPRT CLOBBERS IF CALLS SRCH)
CALL EXPRT ; EVALUATE NEXT TERM
ERROR1 No term after operator
POP P,R6 ; RESTORE OP
POP P,N ; RESTORE OLD VALUE
TRNE N,100000 ; SIGN EXTEND --
TDO N,[-1,,700000] ; -- OLD VALUE
TRNE V,100000 ; SIGN EXTEND --
TDO V,[-1,,700000] ; -- VALUE OF NEW TERM
XCT EXPTB3(R6) ; COMPUTE RELOCATION, EXTRN'NESS
SUB P,[2,,2] ; REMOVE EXTERNAL, RELOCATION FROM STACK
POP P,R6 ;GET BACK THE INSN TO COMBINE
SAVE A ; SAVE A (IDIV IN R6 WILL ZORCH IT)
XCT R6 ;VALUES OF OPERANDS.
REST A ; RESTORE RELOCATION
LDB V,[POINT 16,N,35] ; TRIM VALUE TO V
JRST EXPRF1 ; DO NEXT TERM, IF ANY
EXPTB3: PHASE 0
0
EXND:: 0
EXTM:: 0
EXPL:: CALL ADDREL
EXML:: CALL MULREL
EXMI:: CALL SUBREL
EXDV:: CALL DIVREL
EXOR:: CALL BTHABS
EXAN:: CALL BTHABS
EXXR:: CALL BTHABS
EXLA:: CALL BTHABS
DEPHASE
]
EXPRJT: PHASE 0 ;EXPRESSION JUMP TABLE
ERROR1 CPOPJ1,Bad character in expression
EXND:: JRST CPOPJ1
EXTM:: JRST CNSTRM ;CONSECUTIVE TERMS, MAYBE
EXPL:: MOVSI N,(ADDI N,0(V)) ; +
EXML:: MOVSI N,(IMULI N,(V)) ; *
EXMI:: MOVSI N,(SUBI N,0(V)) ; -
EXDV:: MOVE N,[IDIV N,V] ; /
EXOR:: MOVSI N,(IORI N,0(V)) ; !
EXAN:: MOVSI N,(ANDI N,0(V)) ; &
EXXR:: MOVSI N,(XORI N,(V)) ; #
EXLA:: MOVSI N,(LSH N,(V)) ; _
DEPHASE
CNSTRM: SAVE A,C
CALL EXPRT
JRST CNSTR1 ;WASN'T REALLY A TERM
ERROR1 Consecutive terms
CNSTR0: CALL EXPRT
JRST CNSTR1
JRST CNSTR0
CNSTR1: REST C,A
JRST EXPRF1 ;RESUME LOOKING FOR OPERATORS
IFN RELCOD,[
;
; ROUTINES TO COMPUTE THE RELOCATABLITY AND EXTERNALNESS
; OF AN EXPRESSION.
; ROUTINE TO ASSURE BOTH ARGUEMENTS ARE ABSOLUTE AND LOCAL
BTHABS: SKIPN A ; SECOND MUST BE ABS
SKIPE -1(P) ; SO MUST FIRST
ERROR1 Relocatable quantity in illegal context
BTHLCL: SKIPN C ; SECOND MUST BE LOCAL
SKIPE -2(P) ; SO MUST FIRST
ERROR1 External reference in illegal context
RET ; RETURN
ADDREL: ADD A,-1(P) ; NEW RELOCATION IS SUM OF OTHER TWO
SKIPN -2(P) ; FIRST TERM EXTERNAL?
RET ; YES - THEN EXTRN'ESS OF 2ND IS IT
SKIPE C ; NO - IS SECOND EXTERNAL?
ERROR1 Cannot add external references
MOVE C,-2(P) ; RETURN EXTERNALNESS OF FIRST
RET ; RETURN
SUBREL: EXCH A,-1(P) ; SWAP RELOCATION COUNTS
SUB A,-1(P) ; RELOCATION IS DIFFERENCE
EXCH C,-2(P) ; EXCHANGE EXTERNALS
SKIPE -2(P) ; SUBTRACTING AN EXTERNAL?
ERROR1 Cannot subtract an external reference
RET ; NO - FINE!
MULREL: JUMPE A,MULRE2 ; SECOND ABS IS FINE!
SKIPE -1(P) ; SECOND REL, IS FIRST?
ERROR1 BTHLCL,Product of two relocatable quantities
IMULI A,0(N) ; NO - RELOCATION IS 2ND*1ST OPERAND
JRST BTHLCL ; AND BOTH MUST BE LOCAL
MULRE2: MOVE A,-1(P) ; GET RELOCATION OF FIRST
IMULI A,0(V) ; RELOCATION IS THAT TIMES 2ND OPERAND
JRST BTHLCL ; AGAIN, BOTH MUST BE LOCAL
DIVREL: SKIPE A ; DIVISOR MUST BE ABSOLUTE
ERROR1 Division by a relocatable quantity
MOVE A,-1(P) ; RELOCATION OF DIVIDEND
SAVE B ; SAVE B (IDIV WILL CLOBBER IT)
IDIV A,V ; RELOCATION IS THAT OVER DIVISOR
REST B ; RESTORE B
JRST BTHLCL ; ASSURE BOTH ARE LOCAL
]
EXPRT: SETZB A,C ; NO RELOCATION, EXT. REF.
TDZA V,V
TERM0: CALL GETCHR
LDB B,CPNTRM
JRST @TERMT1(B)
TERMT1: PHASE 0
CPOPJ ;CHARS. THAT FORCE NULL TERMS.
TERMSP::TERM0 ;SPACES, + => SKIP CHAR.
TERMDG::TERM1 ;DIGIT => READ NUMBER.
TERMSY::TERMS ;ALPHABETIC => READ SYMBOL.
TERMOB::TERME ;< => READ EXPR.
TERMMI::TERMM ;- => READ & NEGATE TERM.
TERMQ1::TERMQ ;' => READ 1 ASCII CHAR.
TERMQ2::TERMDQ ;" => READ 2 ASCII CHARS.
DEPHASE
TERME: CALL GETCHR ;SKIP THE "<"
PUSH P,AF ;SAVE REGFLG, ROKFLG.
TLO AF,ROKFLG ;REG'NESS OK (WILL FORGET IT ANYWAY).
CALL EXPRRC
SETZ V, ;IF EXPR NULL.
TLZ AF,REGFLG+ROKFLG ;RESTORE THESE FLAGS.
POP P,B
AND B,[REGFLG+ROKFLG,,]
IOR AF,B
CAIE I,">
ERROR1 Unmatched <
CAIN I,">
CALL GETCHR ;SKIP THE >.
JRST NUMXIT
TERM1: CALL GETSYM ;MIGHT BE LOCAL TAG
CAIA
JRST TERMS0 ;YUP
SETZ T1, ;IS NUMBER
TERM2: IMULI V,10 ;ACCUMULATE OCTAL.
ADDI V,-"0(I)
IMULI T1,10. ;ACCUMULATE DECIMAL.
ADDI T1,-"0(I)
CALL GETCHR ;GET NEXT CHARACTER
CAIL I,"0 ;IS IT IN RANGE?
CAILE I,"9
JRST NUMXA ;NO, TEST FOR END OF NUM.
JRST TERM2 ;DO IT AGAIN.
NUMXA: CAIE I,". ;IS CHAR A ".?
JRST NUMXIT ;NO, OCTAL.
CALL GETCHR ;YES, GET PAST CHAR.
MOVE V,T1 ;GET DECIMAL NUMBER.
IFE EXTEND,[
NUMXIT: TDZE V,[-200000] ;MASK TO 16 BITS, ANY OVERFLOW?
ERROR1 Numeric overflow
]
IFN EXTEND,[
NUMXIT: TDZ V,[-1,,0] ;MASK TO 18 BITS.
]
AOS 0(P) ;SET FOR SKIP-EXIT
JRST SETNB ;RETURN NON-BLANK
ROKTST: ;REGISTER "OK" TEST
TLNN AF,ROKFLG ;REGISTER ALLOWED?
ERROR Register in bad context
TLO AF,REGFLG ;SET FLAG
IFN RELCOD, JRST TERMS2 ; CHECK RELOCATIBILITY
RET
TERMPE: MOVEI V,@LOCTR ;TERM IS "." -- GET CURRENT LOCATION COUNTER
IFN RELCOD,[
SETZ C, ; NOT EXTERNAL
TLNN AF,LCRFLG ; LOCATION COUNTER RELOCATABLE?
TDZA A,A ; NO - SAY IS ABSOLUTE
MOVEI A,1 ; YES - SAY IS RELOCATABLE
]
ANDI V,ADRMSK
CALL GETCHR ;MOVE PAST CHARACTER
JRST NUMXIT ;EXIT NUMERIC
TERMDQ: CALL GETCHR ;STARTS WITH " -- GET THE NEXT CHARACTER
MOVE V,I ;MOVE TO EXPRESSION AC
CALL GETCHR ;GET THE NEXT CHAR
LSH I,8 ;MOVE OVER ONE
CAIA ;SKIP AND FALL THROUGH
TERMQ: ;"'
CALL GETCHR ;GET THE NEXT CHARACTER
TRO V,(I) ;MERGE/PLACE CHARACTER IN 10
CALL GETCHR
JRST NUMXIT ;EXIT NUMERIC
TERMM: CALL GETCHR ;PASS BY THE "-".
CALL EXPRT
JFCL
MOVN V,V ;READ, NEGATE TERM.
ANDI V,ADRMSK
IFN RELCOD,[
MOVNS A ; NEGATE RELOCATION COUNT
]
JRST CPOPJ1
IFE RELCOD,[
; THIS TERMS ROUTINE FOR ABSOLUTE ASSEMBLER
TERMS: CALL GETSYM
JRST TERMPE ;IF NOT SYMBOL, MUST BE ".".
TERMS0: AOS (P)
CALL SRCH
JRST EXPRT2 ;NO STE, SAY IS UNDEF MAYBE?
XCT CRFINS
TLNE A,UNDSYM ;IF UNDEF, MAYBE IS ERROR.
JRST EXPRT3
LDB B,TYPPNT ;YES, GET TYPE
LDB V,[POINT ADRSIZ,A,35] ;OK, GET VALUE
XCT EXPRTT(B) ;DISPATCH ON TABLE
RET
JRST ROKTST ;IF XCT SKIPS, IS REG SYM.
EXPRT2: CALL INSRT ;NOT IN SYMBOL TABLE, FLAG AS UNDEFINED
XCT CRFINS
EXPRT3: SKIPE VALREQ
ERROR1 Undefined
TRO AF,ERRU
RET
]
ASEE: CALL GETSYM ;SKIP SYMBOL AFTER .SEE
RET
CALL SRCH
CAIA
XCT CRFINS ;AND CREF IT
RET ;TRY FOR TERM AGAIN
IFN RELCOD,[
; TERMS ROUTINE FOR THE RELOCATABLE VERSION
TERMS: CALL GETSYM ; GET THE SYMBOL
JRST TERMPE ; NOT A SYMBOL, WAS "."
AOS 0(P) ; WILL SKIP RETURN
SETZ C, ; CLEAR C (GETSYM CLOBBERS IT!)
CALL SRCH ; LOOK UP SYMBOL
JRST TRMUDS ; NOT THERE - UNDEFINED
XCT CRFINS ; CREF THE SYMBOL REFERENCE
TLNE A,UNDSYM ; UNDEFINED?
JRST TRMUD2 ; YES - COULD BE TROUBLE
TLNE A,EXTSYM ; EXTERNAL?
JRST TRMEXT ; YES - RETURN EXTERNAL REF.
TLNE A,INDSYM ; DEPENDENT VALUE?
JRST TRMIND ; YES - RETURN THAT
LDB B,TYPPNT ; GET TYPE
LDB V,[POINT 16,A,35]; GET VALUE
XCT EXPRTT(B) ; IS IT A REGISTER?
CAIA ; NO - SET RELOCATION
JRST ROKTST ; YES - CHECK CONTEXT
TERMS2: TLNN A,RELSYM ; RELOCATABLE?
TDZA A,A ; NO - SET ZERO RELOCATION COUNT
MOVEI A,1 ; YES - RELOCATION COUNT IS 1
RET ; RETURN IT
TRMUDS: MOVSI A,UNDSYM ; SAY IT IS UNDEFINED
TLNN AF,NDSFLG ; ARE WE INSERTING UNDEFINED SYMBOLS?
CALL INSRT ; YES - INSERT IN TABLE
XCT CRFINS
TRMUD2: TRO AF,ERRU ; SAY WE GOTS A UNDEFINED FELLA
SKIPN VALREQ ; WANT VALUES?
JRST TERMS2 ; SET RELOCATABILITY AND EXIT
ERROR1 Undefined - treated as if external
TRMEXT: MOVE C,N ; SAY EXTERNAL REQ.
TLO AF,EXTFLG ; SAY EXTERNAL SEEN
JRST TERMS2 ; SET RELOCATILIBITY AND EXIT
TRMIND: HRRE V,INDOFF(A) ; GET OFFSET
MOVE C,INDREF(A) ; GET DEPENDENT SYMBOL
TLO AF,EXTFLG ; SAY EXTERNAL SEEN
JRST TERMS2 ; SET RELOCATABILITY AND EXIT
]
EXPRTT: PHASE 0
TLNN A,REGSYM ;NORMAL SYMBOL.
CALL (A) ;VALUE-RETURNING PSEUDO.
REPEAT 2,ERROR1 Pseudo-op in bad context
REPEAT MAOP-CNOP-1,JFCL ;MACHINE INSNS.
ERROR1 Macro name in bad context
INOP:: HRRZ V,(A) ;PSEUDO-SYMBOL.
INVOP:: JRST EXPRT4 ;INVISIBLE PSEUDO.
DEPHASE
EXPRT4: CALL 0(A)
SOS (P) ;WAS AOS'ED
JRST EXPRT
;SYMBOL/CHARACTER HANDLERS
GETSYM: ;GET A SYMBOL
MOVSI C,440600 ;SET POINTER
TDZA N,N ;CLEAR AC AND SKIP
GETSY1: CALL GETCHR ;GET NEXT CHARACTER
MOVEM IP,SYMBEG ;SAVE START IN CASE OF FAIL
LDB B,ANPNTR ;MAP CHARACTER TYPE
XCT GETSY3(B) ;EXECUTE TABLE
GETSY2: SUBI I,40 ;VALID, CONVERT TO SIXBIT
GETSY6: CAME C,[0600,,] ;ARE WE FULL?
IDPB I,C ; NO, STORE CHARACTER
GETSY5: CALL GETCHR ;GET THE NEXT INPUT CHARACTER
LDB B,ANPNTR ;MAPE CHARACTER TYPE
GETSY8: XCT GETSY4(B) ;EXECUTE TABLE
CAME N,[SIXBIT /./];FINISHED, WAS IT A DOT?
JRST CPOPJ1 ; NO, VALID. EXIT +1
GETSY7: RESCAN SYMBEG ; YES, RESET CHARACTER POINTER
SETCHAR ; AND CHARACTER
SETZ N, ;CLEAR AC
CPOPJ: RET
GETSY3: ;FIRST CHARACTER TABLE
PHASE 0
RET ;NOTHING CHARACTER, EXIT NULL
.TAB:: JRST GETSY1 ;SPACE OR TAB, BYPASS
.ALP:: JFCL ;ALPHA, FALL THROUGH
.NUM:: JRST GETLTG ;NUMERIC, SEE IF LOCAL TAG
.DOT:: JFCL ;DOT, FALL THROUGH, TEST LATER
.TRM:: RET ;TERMINATOR, EXIT NULL
.LOW:: SUBI I,40 ;LOWER CASE, TO UPPER.
DEPHASE
GETSY4: ;SUCCEEDING CHARACTERS
PHASE 0
JFCL
CALL GETNB ;SPACE OR TAB, BYPASS AND FALL THROUGH
JRST GETSY2 ;ALPHA, RECYCLE
JRST GETSY2 ;NUMERIC, DITTO
JRST GETSY2 ;DOT, DITTO
JFCL ;TERMINATOR, FALL THROUGH
.LOW:: JRST GETSY6
DEPHASE
POPJ1:
CPOPJ1: AOS (P)
RET
SETNB: SETCHAR ;SET CHARACTER IN I
CAIA
GETNB: CALL GETCHR
CAIE I,SPACE ;IF SPACE
CAIN I,TAB ; OR TAB;
JRST GETNB ; BYPASS
RET ;OTHERWISE EXIT
;POSSIBLE LOCAL TAG, OR SYMBOL BEGINNING WITH A DIGIT
GETLTG: SAVE A
MOVEI A,-"0(I) ;ACCUMULATE NUMERIC PART IN A, SYMBOL IN N
GETLT1: SUBI I,40
TLNE C,770000
IDPB I,C
CALL GETCHR
CAIN I,"$
JRST GETLT2 ;LOOKS LIKE A LOCAL TAG
LDB B,ANPNTR ;GET CHARACTER TYPE
XCT GETLT3(B)
IMULI A,10. ;A DIGIT, KEEP LOOKING
ADDI A,-"0(I)
JRST GETLT1
GETLT8: REST A ;TURNED OUT TO BE A SYMBOL THAT BEGAN WITH A DIGIT
JRST GETSY8
GETLT7: REST A ;TURNED OUT TO BE A NUMBER, RESCAN
JRST GETSY7
GETLT3: PHASE 0
JRST GETLT7 ;NULL CHARACTER, FROB WAS A NUMBER
.TAB:: JRST GETLT7 ;SPACE OR TAB, FROB WAS A NUMBER
.ALP:: JRST GETLT8 ;ALPHABETIC, REJOIN NORMAL SYMBOL LOOP
.NUM:: JFCL ;DIGIT, CAN'T TELL YET
.DOT:: JRST GETLT7 ;DOT, FOR NOW ASSUME DECIMAL NUMBER
.TRM:: JRST GETLT7 ;TERMINATOR, FROB WAS A NUMBER
.LOW:: JRST GETLT8 ;LOWER CASE ALPHABETIC, REJOIN NORMAL SYMBOL LOOP
DEPHASE
GETLT2: MOVE N,A ;LOCAL TAG WITH THIS NUMBER
REST A
SKIPE FAICND
JRST GETLT4
CAILE N,0
CAIL N,10000
ERROR1 GETSY7,$ Illegal local tag
SKIPGE LLABS
ERROR1 $ Local tag before first label
GETLT4: HRLZS N ;GENERATE UNIQUE SYMBOL NAME
HRR N,LLABS ;4.4-4.9=0, 3.1-4.3=NNN, 1.1-2.9=S OF PRECEDING REAL TAG
CALL GETNB ;READ NEXT DELIMITER
JRST POPJ1 ;RETURN AS IF NORMAL SYMBOL
;PSEUDO-OPS
AEND: ;"END" PSEUDO-OP
TLO AF,ENDFLG ;FLAG "END SEEN"
CALL EXPRF ;EVALUATE THE ADDRESS
IFE RELCOD, MOVEI V,1 ; NULL, FORCE ODD VECTOR
IFN RELCOD, SETO A, ; NULL - INDICATE NO STARTING ADDRESS
MOVEM V,STRTLC ;SAVE START ADDR.
IFN RELCOD,[
HRLM A,STRTLC ; SET RELOCATION OF STARTING ADDRESS
SKIPE C
ERROR1 Starting address cannot be external
]
MOVEI W,(V) ;SET VALUE FOR ENDL.
HRLI W,CL5 ;FLAG AS .END
IFN RELCOD,[
JUMPLE A,ENDL ; LIST AND EXIT IF ABSOLUTE
AOS REXTAB ; OTHERWISE SET RELOCATION FOR LISTING
]
JRST ENDL ;LIST AND EXIT
AIFF:: AIFT:: AIFTF::
OPCERR: ERROR1 At top level
JRST ENDL ;FLAG ERROR, LIST, AND EXIT
AEVEN: MOVEI W,1(L) ;.EVEN - MOVE UP TO NEXT EVEN ADDR.
TRZ W,1
JRST LOCSL
AODD: MOVEI W,(L) ;GET CURRENT LOC. CTR,
TRO W,1 ;MOVE UP TO ODD ADDR,
LOCSL:
IFN RELCOD,[
TLO AF,LCHFLG ; SAY LOCATION COUNTER CHANGED
TLNE AF,LCRFLG ; LOCATION COUNTER RELOCATABLE?
AOS REXTAB ; YES - SET RELOCATION FOR LISTING
]
ANDI W,ADRMSK
HRLI W,CL2 ;LISTING-CLASS IS LOC CTR SETTING,
JRST ENDL
; .OFFSET -- SET OFFSET.
AOFFSE: CALL EXPRF ;READ IN VALUE,
SETZ V, ;OR 0 IF NONE,
HRRM V,LOCTR ;STORE AS OFFSET,
MOVEI W,(V) ;SET UP VALUE OF LINE.
HRLI W,CL1
LOCABS OFFSET,1
JRST ENDL
;COPY REST OF LINE TO TTY AND TITBUF (ASCIZ).
ATITLE: MOVE A,[440700,,TITBUF]
CALL SETNB
ATITL1: CAIN I,^M
SETZ I,
IDPB I,A
JUMPE I,ATITL2
MOVE B,I
CALL TTYDMP
CALL GETCHR
JRST ATITL1
ATITL2: CALL TTYCR
JRST ENDL
;.STITL - COPY REST OF LINE TO STITBF (ASCIZ).
ASBTTL: ;DEC'S NAME FOR SUBTITLE
ASTITL: MOVE A,[440700,,STITBF]
CALL SETNB ;GET FIRST NON-BLANK(WELL...)
ASTIT1: CAIN I,^M
SETZ I,
IDPB I,A
JUMPE I,ENDL
CALL GETCHR
JRST ASTIT1
;.LIST - DECREMENT LISTING SUPPRESS COUNT UNLESS IT'S 0.
ALIST: SOSL TSLWRD
TLOA AF,LINFLG
SETZM TSLWRD
JRST ENDL
;INCREM. LISTING SUPPR COUNT.
ANLIST:
AXLIST: AOS TSLWRD
JRST ENDL
;.ABS - SET %ABSADR SO ABSOLUTE ADDRESSING WILL BE THE DEFAULT.
AABS: SETOM %ABSADR
JRST ENDL
;COMMENT PSEUDOOP - BYPASSES TVEDIT DIRECTORIES.
ACOMNT: CALL SETNB
SAVE I ;REMEMBER THE DELIMITER.
ACOMN1: CALL GETCHR
CAME I,(P)
JRST ACOMN1 ;KEEP GOING TILL DELIMITER.
SUB P,[1,,1]
CALL GETCHR ;PASS THE DELIMITER.
JRST ENDL
RAD50: CALL SETNB ;GET FIRST NON-BLANK
PUSH P,I ;SAVE DELIMITER
MOVSI W,CL3 ;FLAG WORD TO BE OUTPUT
RAD501: CALL GRAD50 ;GET ONE RAD50 CHARACTER
MOVSI W,CL3 ;NOW COMMITED TO OUTPUT SOMETHING
IMULI B,3100 ;PUT IT IN IT'S PLACE
ADD W,B
CALL GRAD50
IMULI B,50 ;THIS ONE TOO
ADD W,B
CALL GRAD50
ADD W,B
CALL ENDLF ;OUTPUT A WORD
JRST RAD501 ;AND TRY FOR MORE
GRAD50: CALL GETCHR
CAMN I,-1(P) ;IS IT THE DELIMITER?
JRST RAD50T ;YES
LDB B,SQPNTR ;GET SQUOZE FOR CHAR.
JUMPN B,CPOPJ ;A SQUOZE CHAR, OK.
CAIN I,40 ;SPACE ALSO OK (FOR 0)
RET
RAD50E: ERROR .RAD50: Bad character
JRST .+2
RAD50T: CALL GETCHR
SKIPE W ;DO WE HAVE SOMETHING TO OUTPUT?
CALL ENDLF ;YES, DO SO
SUB P,[2,,2] ;UNSCREW THE STACK.
JRST ENDL
;.ASCII /STRING/
AASCIZ: TLOA AF,ASZFLG ;FLAG TO PUT ON NULL
AASCII: TLZ AF,ASZFLG ;NO TERMINATING NULL
AASCI0: CALL SETNB ;GET FIRST NON-BLANK
CAIN I,";
JRST AASCI4
CAIE I,^M
CAIN I,^J
JRST AASCI4
CAIN I,"< ;"<" INDICATES A .BYTE VALUE
JRST AASCI6 ;...
PUSH P,I ;STACK TERMINATOR
AASCI1: CALL GETCHR ;GET NEXT CHARACTER
CAMN I,0(P) ;TERMINATOR?
JRST AASCI2 ; YES
MOVEI W,0(I) ;PLACE IN AC4
HRLI W,CL4 ;SET CLASS
CALL ENDLF ;PRINT AND DUMP IT
JRST AASCI1 ;RECYCLE
AASCI2: CALL GETCHR ;SKIP TERMINATOR
POP P,N ;FLUSH TERMINATOR FROM STACK
JRST AASCI0
AASCI4: MOVSI W,CL4 ;ZERO DATUM (RH)
TLNE AF,ASZFLG
CALL ENDLF ;OUTPUT IT IF ASCIZ
SETZ W,
JRST ENDL ;EXIT
AASCI6: CALL GETCHR ;SKIP <
CALL EXPRZ ;GET EXPRESSION, REGISTER NOT ALLOWED
ERROR Expression expected
LOCABS .BYTE ARG,O
TDCN V,[177400] ;OVERFLOW?
JRST .+3 ; NO.
;HIGH BITS ARE NOW COMPLEMENTED.
TDZE V,[-400] ;MASK TO 8 BITS.
;ANY OVERFLOW
ERROR Byte too large
LDB W,[POINT 8,V,35] ;SET CODE
HRLI W,CL4 ;SET CLASS
CAIE I,"> ;ANY MORE
ERROR > Expected
CALL ENDLF ;YES, DUMP THIS ITEM
CALL GETCHR ;BYPASS >
JRST AASCI0 ;GET ANOTHER ITEM
;.BYTE BYTE1,BYTE2,BYTE3
ABYTE: CALL EXPRF ;EVALUATE EXPRESSION
SETZ V, ;NULL, ASSUME 0
LOCABS .BYTE ARG,O
TDCN V,[177400] ;OVERFLOW?
JRST .+3 ; NO.
;HIGH BITS ARE NOW COMPLEMENTED.
TDZE V,[-400] ;MASK TO 8 BITS.
;ANY OVERFLOW
ERROR Byte too large
LDB W,[POINT 8,V,35] ;SET CODE
HRLI W,CL4 ;SET CLASS
CAIE I,", ;ANY MORE
JRST ENDL ; NO, EXIT
CALL ENDLF ;YES, DUMP THIS ITEM
CALL GETCHR ;BYPASS COMMA
JRST ABYTE ;GET ANOTHER ITEM
AWORD: CALL EXPRF ;.WORD -- EVALUATE EXPRESSION
WORDD: SETZ V, ; NULL, ASSUME 0
WORDF: MOVE W,V ;GET VALUE
IFN RELCOD,[
MOVEM A,REXTAB ; SET RELOCATION AND --
MOVEM C,EEXTAB ; -- EXTERNALNESS OF WORD
]
HRLI W,CL3 ;SET CLASS
CAIE I,", ;END OF STRING?
JRST ENDL ; YES, LIST AND EXIT
CALL ENDLF ;NO, LIST THIS WORD
CALL GETCHR ;BYPASS COMMA
JRST AWORD ;RE-CYCLE
ABLKW: CALL EXPRF ;.BLKW, READ # WDS SPACE TO LEAVE.
MOVEI V,1 ;ASSUME 1 IF NO ARG.
LSH V,1 ;# BYTES SPACE.
MOVEI W,(L)
ADDI W,1 ;BUT 1ST MOVE UP TO EVEN ADDR.
TRZ W,1
JRST ABLKB1
ABLKB: CALL EXPRF ;.BLKB, READ # BYTES SPACE.
MOVEI V,1
MOVEI W,(L)
ABLKB1: LOCABS .BLKW/.BLKB ARG,1
ADDI W,(V) ;W _ NEW LOC. CTR.
JRST LOCSL
;FLEXPR FLTNUM
DEFINE FLOAT X
FSC X,233 ;OR YOUR FAVORITE FLOAT INSTR.
TERMIN
FLTNU1: SETZ V,
MOVE B,[1.0]
FLTNU4: CAIL I,"0
CAILE I,"9
RET
FMPR B,[10.0] ;B HAS HIGHEST POWER OF 10 THAT WE HAVE SEEN
FMPR V,[10.0]
MOVEI T1,-"0(I)
FLOAT T1
FADR V,T1
CALL GETCHR ;GET NEXT CHARACTER
JRST FLTNU4
FLTNUM: PUSH P,I ;SAVE FIRST CHAR SO WE CAN CHECK NUM IS NEG
CAIN I,"-
CALL GETCHR
CALL FLTNU1 ;TRY TO PARSE THE INTEGER BEFORE THE DECIMAL PT.
FLTNU2: CAIE I,". ;IS CHAR A ".?
JRST FLTNU3
CALL GETCHR ;YES, GET PAST .
PUSH P,V ;SAVE FIRST NUMBER
CALL FLTNU1
FDVR V,B
POP P,T1
FADR V,T1
FLTNU3: CAIE I,"E ;SCALING FIELD?
CAIN I,"@
SKIPA
JRST FLTNU5
CALL GETCHR
MOVE B,[10.0]
CAIE I,"-
JRST FLTNU9
MOVE B,[0.1]
CALL GETCHR
FLTNU9: SETZ R6, ;GET A DECIMAL INTEGER INTO R6
FLTNU6: CAIL I,"0
CAILE I,"9
JRST FLTNU8
IMULI R6,12
ADDI R6,-"0(I)
CALL GETCHR
JRST FLTNU6
FLTNU8: TRNE R6,1
FMPR V,B
FMPR B,B
LSH R6,-1
JUMPN R6,FLTNU8
FLTNU5: POP P,C
CAIN C,"-
MOVN V,V
SETZ T1,
RET ;NEVER SKIPS
FLEXPR: CALL FLTNUM
SETZ C, ;FLAG INDICATION NO ERROR SO FAR
AOSA (P) ;ALWAYS SKIPS
FLEXP1: CALL GETCHR
CAIE I,"; ;LOOK FOR COMMENT
CAIN I,15 ;OR END OF LINE
RET
CAIN I,",
RET ;OR SEPARATOR
JUMPN C,FLEXP1 ;IF WE'VE SEEN ONE ERROR QUIT COMPLAINING
CAIE I,40
CAIN I,11 ;ERROR IF ANYTHING EXCEPT SPACE OR TAB
JRST FLEXP1
ERROR1 Bad character in scan of floating point number
AOJA C,FLEXP1
;AFLT2 AFLT4 ;.FLT2 .FLT4
AFLT2: CALL FLEXPR ;.FLT2 -- EVALUATE FLOATING PT. EXPRESSION
SETZ V, ; NULL, ASSUME 0
TLZE V,400000
MOVN V,V ;MAKE A SIGN MAGNITUDE NUMBER
DPB V,[POINT 26,V,34] ;Shift the fraction left 1 bit.
LSH V,-2
HLRM V,W ;FIRST WORD OF NUMBER
LSH V,-2
HRRM V,CEXT1
HRLI W,CL6
IFN RELCOD,[
MOVEM A,REXTAB ; SET RELOCATION AND --
MOVEM C,EEXTAB ; -- EXTERNALNESS OF WORD
]
CAIE I,", ;END OF STRING?
JRST ENDL ; YES, LIST AND EXIT
CALL ENDLF ;NO, LIST THIS WORD
AFLTB: CALL GETCHR ;BYPASS COMMA
CAIE I,40 ;LOOK FOR NON BLANK CHAR
JRST AFLT2 ;RE-CYCLE
JRST AFLTB
AFLT4: CALL FLEXPR
SETZ V,T1
TLZE V,400000
DMOVN V,V
DPB V,[POINT 3,T1,8] ;Put the low 30 bits of the fraction together
PUSH P,T1
DPB V,[POINT 26,V,34]
LSH V,-2
HLRM V,W
LSH V,-2
HRRM V,CEXT1
IFN RELCOD,[
MOVEM A,REXTAB ; SET RELOCATION AND --
MOVEM C,EEXTAB ; -- EXTERNALNESS OF WORD
]
HRLI W,CL6
CALL ENDLF
POP P,T1
LSH T1,2
HRRM T1,CEXT1
LSH T1,2
HLRM T1,W
HRLI W,CL6
CAIE I,",
JRST ENDL
CALL ENDLF
CALL GETCHR
JRST AFLT4
AREM: ;DEC'S NAME FOR SAME THING
AMSG: SOS ERRNUM ;DON'T COUNT AN ERROR.
AERROR: CAIA
CALL GETCHR ;FETCH TILL EOL.
CAIE I,^M
JRST .-2
SETZ I,
DPB I,IP ;MAKE LINBUF ASCIZ.
ERRUU1 LINBUF ;ISSUE ERROR MSG.
TLO AF,LINFLG
JRST ENDL
;PRINT OUT MESSAGE BETWEEN DELIMITERS
APRINT: CALL SETNB
PUSH P,I
APRIN1: CALL GETCHR
CAMN I,(P)
JRST APRIN2
MOVE B,I
CALL TTYDMP
TLNE F,ERRBIT ;IF ERR FILE OPEN, OUTPUT TO IT.
CALL ERROU2
JRST APRIN1
APRIN2: POP P,I
JRST ENDL
;.EOT - FORCE EOF (SKIP REST OF FILE)
AEOT: CALL ENDLR ;FINISH LINE FROM CURRENT FILE.
MOVE A,SRCPNT ;PUT ^C IN BUFFER.
MOVEI B,^C
IDPB B,A
RET
;.EJECT - NEW PAGE IN LISTING.
APAGE:
AEJECT: TRO F,HDRBIT ;FORCE NEW PAGE.
TLO AF,LINFLG ;DON'T LIST THIS LINE.
JRST ENDL
;.XCREF - SET DON'T-CREF BITS OF SPECIFIED SYMBOLS.
AXCREF: CALL GETSYM
ERROR1 ENDL,What symbol? - .XCREF
CALL SRCH ;FIND STE.
MOVSI A,UNDSYM
TLO A,NCRSYM
CALL INSRT
CAIE I,", ;IF FOLLOWED BY COMMA, GET ANOTHER SYMBOL.
JRST ENDL
CALL GETCHR ;PASS COMMA
JRST AXCREF ; GET MORE
;.Expunge -- flush symbols following
aexpunge:
call getsym
error1 endl,Nothing to expunge
call srch
jfcl
movsi a,undsym
call insrt
caie i,",
jrst endl
call getchr
jrst aexpunge
;.AUXIL - TELLS @ THAT THIS IS AN AUXILIARY FILE OF SYMBOL DEFINITIONS.
AAUXIL: RET
IFN RELCOD,[
;
; PSEUDO-OPS FOR RELOCATABLE STUFF
; .ENTRY PSEUDO-OP
AENTRY: CALL GETSYM ; READ SYMBOL NAME
ERROR1 ENDL,Expected a symbol name
CALL SRCH ; LOOK UP THE SYMBOL
JRST UNDENT ; NOT THERE, COULD BE TROUBLE
TLNE A,UNDSYM ; DEFINED?
JRST UNDENT ; NO, COULD BE TROUBLE
SETENT: TLO A,ENTSYM ; YES - SAY IS ENTRY POINT
CALL INSRT ; PUT IN SYM TAB
XCT CRFINS ; CREF THE REFERENCE
CAIE I,", ; MORE SYMBOLS?
JRST ENDL ; NO - EXIT
CALL GETCHR ; YES - PASS COMMA
JRST AENTRY ; AND GET THEM
;
; HERE IF SYMBOL UNDEFINED, ERROR ON PASS 2
;
UNDENT: TLNN AF,P1F ; PASS ONE?
ERROR Undefined
JRST SETENT ; YES - NOT AN ERROR THEN
; .EXTRN PSEUDO-OP
AEXTRN: CALL GETSYM ; GET SYMBOL NAME
ERROR1 ENDL,Expected a symbol name
CALL SRCH ; LOOK UP SYMBOL
JRST EXTSET ; NOT THERE - THIS IS EASY!
TLNE A,EXTSYM ; ALREADY EXTERNAL?
JRST EXTST2 ; YES - THIS IS SIMPLE TOO!
TLNN A,UNDSYM ; UNDEFINED?
JRST EXTERR ; NO - THAT IS REAL TROUBLE
EXTSET: MOVSI A,EXTSYM ; SAY IS EXTERNAL
CALL INSRT ; PUT IN SYMTAB
EXTST2: XCT CRFIND ; CREF A DEFINING OCCURENCE
EXTNXT: CAIE I,", ; MORE SYMBOLS?
JRST ENDL ; NO - EXIT
CALL GETCHR ; YES - PASS COMMA
JRST AEXTRN ; GET MORE SYMBOLS
;
; HERE IF SYMBOL IS ALREADY DEFINED, ERROR
;
EXTERR: ERROR1 Already defined locally
JRST EXTNXT ; GET NEXT ONE
]
IFE RELCOD,[
AENTRY: AEXTRN: ERROR1 ENDL, In absolute assembly
]
;HANDLE REPEATS
REPEA0: ;"REPEAT" PSEUDO-OP
AOS VALREQ ;INSIST SYMS DEFINED.
CALL EXPRF ;EVALUATE EXPRESSION
ERROR1 .REPT: Null argument
SOS VALREQ
LOCABS .REPT ARG,1
MOVEI W,(V)
HRLI W,CL1 ;LIST VALUE
TRNN V,100000
CAIN V,0 ;IF LESS THAN OR EQUAL TO ZERO,
JRST UNSCON ; JUST LIST
PUSH P,V ;STACK EXPRESSION
CALL ENDLR ;LIST LINE
CALL GETBLK ;INIT. WRITING OF BODY AS STRING.
PUSH P,MWPNTR ;SAVE STARTING BLOCK ADDRESS
SETZ S, ;ZERO LEVEL COUNT
REPEA1: CALL GETLIN
CALL GETSYM ;TEST THE FIRST SYMBOL
JRST REPEA2 ; NON-SYMBOLIC
CAMN N,.REPTX
AOJA S,REPEA2 ; INCREMENT AND BRANCH
CAMN N,.ENDRX
SOJL S,REPEA3 ; DECREMENT AND BRANCH IF END
REPEA2: RESCAN LINPNT ;POINT TO START OF LINE
REPEA4: CALL GETCHR ;GET THE NEXT CHARACTER
CALL WCIMT ;WRITE INTO STRING
CAIE I,^J ;KEEP GOING TILL EOL.
JRST REPEA4
CALL ENDLR ;LIST THE LINE
TLNN AF,ENDFLG ;SKIP IF EOF SEEN
JRST REPEA1 ;TRY THE NEXT LINE
ERROR1 .ENDR Missing
REPEA3: CALL ENDLR ;TERMINATION, LIST LINE
MOVEI I,QUEMAC ;END, SET TO CLOSE
CALL WTIMT ;WRITE FLAG AND "REPEAT END"
REST A,V ;STRING'S ADDR, # TIMES TO REPEAT.
IDPB MP,MACPDP ;PUSH ON MACRO PDL, OUTER MACRO-READ-POINTER,
MOVEI B,REPEND ;WHEN FINISH READING BODY EACH TIME,
EXCH B,MACXIT ;REPEND IS PLACE TO CALL.
IDPB B,MACPDP ;SAVE OUTER STRING'S EXIT ROUTINE ADDR.
MOVE B,%RPCNT ;(SAVE OUTER .REPT'S .RPCNT OVER THIS ONE)
IDPB B,MACPDP
IDPB A,MACPDP ;BP -> START OF REPEAT-BODY-BLOCK.
IDPB V,MACPDP ;# REPETITIONS YET TO BE DONE.
SETOM %RPCNT ;PASS # 0 COMING UP.
MOVEI T1,GCHM ;NOW READING FROM MACRO-STRING.
HRRM T1,GETCHA
;FALLS THROUGH.
;COME HERE TO START NEXT PASS THRU .REPT OR POP OUT OF IT.
;MAY BE CALLED FROM GCHM SO DON'T CLOBBER ACS.
REPEND: CAIA ;CALL HERE AFTER PASS THRU REPEAT.
SETZM @MACPDP ;CALL HERE FROM .MEXIT, PRETEND 0 PASSES TO GO.
HRRO I,MACPDP
SOSL (I) ;1 LESS PASS STILL UNDONE,
JRST REPEN1 ;STIIL AT LEAST 1.
SAVE A
SUBI I,1 ;NONE LEFT, DISCARD THE -1 ON MACPDL TOP.
POP I,A
CALL REMMAC ;FREE THE BLOCKS CONTAINING .REPT'S BODY.
POP I,%RPCNT ;UNBIND .RPCNT.
POP I,MACXIT ;UNBIND END-OF-STRING EXIT RTN.
POP I,MP ;UNBIND INPUT STREAM.
HRRM I,MACPDP ;MAKE PDL PTR -> BELOW WHAT WE POPPED.
REST A
JUMPE MP,GCHSE0 ;MAYBE POPPED INTO A FILE,
RET ;MAYBE INTO MACRO OR REPT, ETC.
REPEN1: AOS %RPCNT ;STARTING NEXT PASS,
MOVE MP,-1(I) ;RESTART READING FROM BEGINNING,
RET
;COME HERE FOR .REPT WITH COUNT OF 0.
UNSCON: CALL ENDLR ;LIST THE LINE
UNSCO1: CALL GETLIN
CALL GETSYM ;CHECK THE FIRST SYMBOL
JRST UNSCO2 ; NON-SYMBOLIC, LIST
CAMN N,.ENDRX ;"ENDR"?
JRST ENDLR ; YES, LIST AND EXIT
CAME N,.REPTX ;NESTED?
JRST UNSCO2 ; NO
CALL UNSCO2 ;YES, RECURSE
JRST UNSCO1 ;BACK TO NORMAL
UNSCO2: SETZ I,
TLNE AF,ENDFLG ;EOF SEEN?
JRST ENDL ; YES, EXIT
CALL ENDLR ;NO, LIST THE LINE
JRST UNSCO1 ;TRY AGAIN
;.IF PSEUDO-OP:
; .IF <COND-NAME> <ARGS (OPTIONAL, DEPENDS ON CONDITION)>
; <BODY>
; .ENDC
AIF: CALL CNT ;PROCESS CONDITION, SKIP IF TRUE.
JRST UNCOND ;FAILED, SKIP BODY.
JRST STCOND ;PROCESS THE BODY.
;.IIF <CONDIT> <ARGS>, <STMT>
AIIF: SETZM %SUCCESS ;ZERO'D UNLESS COND IS TRUE
CALL CNT ;PROCESS CONDITION AND ARGS AND COMMA.
JRST ENDLR ;FALSE, JUST LIST LINE.
MOVEM P,%SUCCESS ;SET %SUCCESS NON-ZERO
JRST STMNT ;HANDLE REST OF LINE.
;.LIF <CONDITION>
; <SINGLE-LINE-OF-BODY>
ALIF: CALL CNT ;READ IN AND TEST CONDITION,
JRST ALIF1
MOVEM P,%SUCCESS ;COND TRUE, ASSEMBLE NEXT LINE
JRST ENDLR
ALIF1: CALL ENDLR ;SKIP NEXT LINE IF CONDITION FAILS.
SETZM %SUCCESS
JRST ENDLR
; .ALSO
; <BODY>
; .ENDC
AALSO: SKIPN %SUCCESS
JRST UNCOND ;LAST WAS FALSE, THIS FAILS ALSO
JRST STCOND ;TRUE, PROCESS BODY
; .ELSE
; <BODY>
; .ENDC
AELSE: SKIPE %SUCCESS ;TEST WHETHER LAST COND WAS FALSE
JRST UNCOND ;TRUE, SKIP BODY.
JRST STCOND ;FALSE, PROCESS THE BODY
;.IELSE <STMT>
AIELSE: SKIPE %SUCCESS ;REVERSE SENSE OF %SUCCESS
JRST [SETZM %SUCCESS
JRST ENDLR]
MOVEM P,%SUCCESS ;LAST FAILED SO PROCESS <STMT>
JRST STMNT
;.IALSO <STMT>
AIALSO: SKIPN %SUCCESS
JRST ENDLR
JRST STMNT ;PROCESS IT
;.LELSE
; <SINGLE-LINE-OF-BODY>
ALELSE: SKIPE %SUCCESS ;"COMPLEMENT" %SUCCESS
JRST [SETZM %SUCCESS
CALL ENDLR
JRST ENDLR]
MOVEM P,%SUCCESS ;ONLY SET LOW 16 BITS
JRST ENDLR
;.LALSO
; <SINGLE-LINE-OF-BODY>
ALALSO: SKIPN %SUCCESS
CALL ENDLR ;COND WAS TRUE, SKIP A LINE
JRST ENDLR
;HANDLE OLD-STYLE CONDITIONALS BY TRANSLATING TO NEW STYLE.
CONDIT: MOVE N,CONDTB(A) ;GET NEW CONDITION NAME
CALL CNT0 ;TEST IN USUAL WAY.
JRST UNCOND ;NOT SATISFIED
STCOND: MOVEM P,%SUCCESS ;INDICATE TRUE CONDITIONAL
STCON3: PUSH P,[SIXBIT/.IFF/]
PUSH P,[SIXBIT/.IFT/]
STCON0: CALL ENDLR ;SATISFIED CONDITIONAL
STCON1: TLNE AF,ENDFLG ;EOF => EXIT CONDITIONAL. DON'T CALL
JRST POP2J ;ENDLR SINCE OUR CALLER WILL. (WOULD GET 2 "NO END" MSGS)
CALL GETLIN
CALL GETSYM ;LOOK AT 1ST SYMBOL ON LINE.
JRST STCON2 ;NO SYMBOL FOUND.
CAMN N,.ENDCX ;IF .ENDC SEEN
JRST CONDX1 ;THEN END OF CONDITIONAL
STCON2: TLNE AF,ENDFLG ;EOF => EXIT CONDITIONAL. DON'T CALL
JRST POP2J ;ENDLR SINCE OUR CALLER WILL. (WOULD GET 2 "NO END" MSGS)
CAME N,(P) ;IF NEXT PART WANTS CONDIT THE WAY IT WAS
CAMN N,[SIXBIT/.IFTF/]
JRST STCON0 ;OR DOESN'T CARE, GO ON ASSEMBLING.
CAMN N,-1(P) ;IF NEXT PART WANTED COND. THE OTHER WAY,
JRST UNCON0 ;START SKIPPING OVER IT.
RESCAN SYMBEG ;BACK UP
SETCHAR ;IN ORDER TO
CALL STMNT ;EXECUTE LINE
JRST STCON1
;COME HERE FOR FALSE CONDITIONAL.
UNCOND: SETZM %SUCCESS ;INDICATE THIS COND FAILED
PUSH P,[SIXBIT/.IFT/]
PUSH P,[SIXBIT/.IFF/]
UNCON0: SETOM FAICND
PUSH P,[0] ;THIS WD IS LEVEL CNTR.
MOVE A,SLNCNT
MOVEM A,UNCONL ;REMEMBER PAGE & LINE NUM OF
MOVE A,PAGNUM ;START OF CONDITIONAL.
MOVEM A,UNCONP
UNCON4: CALL ENDLR ;UNSATISFIED CONDITIONAL
UNCON1: CALL GETLIN
CALL GETSYM ;GET SOMETHING
JRST UNCON2 ;NO SYMBOL
CAMN N,.ENDCX
JRST [SOSL (P) ;DOWN ONE CONDITIONAL LEVEL.
JRST UNCON2 ;STILL NOT AT BOTTOM.
JRST CONDXT] ;TERMINATED THIS CONDITIONAL.
CAME N,[SIXBIT/.IF/]
CAMN N,[SIXBIT/.ELSE/]
JRST UNCON5 ;ENTERING AN INNER CONDITIONAL.
CAMN N,[SIXBIT /.ALSO/]
JRST UNCON5
SKIPE (P) ;IF NOT WITHIN INNER CONDITIONALS,
JRST UNCON3
CAME N,[SIXBIT/.IFTF/]
CAMN N,-1(P) ;IF WANT COND. THE WAY IT WAS,
JRST [POP P,A ? SETZM FAICND ? JRST STCON0] ;START ASEMBLING STUFF.
UNCON3: CALL SRCH
JRST UNCON2
HLRZ N,A
CAIN N,CNOP ;IS IT A CONDITIONAL?
UNCON5: AOS (P) ;YES, INCREM. DEPTH IN CONDITIONALS.
UNCON2: MOVEI I,0
TLNN AF,ENDFLG
JRST UNCON4 ;UNLESS HIT END, LIST LINE & DO NEXT.
CALL ERRCR
MOVEI A,[ASCIZ/Within unsuccessful conditional at /]
CALL ERRSTR
MOVE A,UNCONP
CALL ERRDEC
MOVEI B,"-
CALL ERROUT
AOS A,UNCONL
CALL ERRDEC
CALL ERRCR
POP3J: SUB P,[1,,1]
POP2J: SUB P,[2,,2]
RET
CONDXT: SUB P,[1,,1] ;POP THE LEVEL COUNT.
CONDX1: SETZM FAICND
MOVE A,(P)
SUB P,[2,,2] ;POP .IFT AND .IFF .
CAMN A,[SIXBIT /.IFT/]
JRST CONDX2
SETZM %SUCCESS ;.ENDC OF A FALSE COND ZEROES %SUCCESS
JRST ENDLR
CONDX2: MOVEM P,%SUCCESS ;TRUE COND SETS %SUCCESS TO -1
JRST ENDLR
CONDTB: PHASE 0
$IF1:: SIXBIT/P1/ ? $IF2:: SIXBIT/P2/
IRPS X,,DF NDF B NB G GE L LE NZ Z
$IF!X:: SIXBIT/X/
TERMIN DEPHASE
;PARALLEL TABLES: CNTTB0 HAS CONDITION NAMES (SIXBIT) IN NUMERICAL ORDER,
;CNTTB1 HAS CORRESPONDING ACTIONS.
CNTTB0:
IRP X,,[B=B,DF=DF,DIF=DIF,E N,EQ N,G LE,GE L,GT LE
IDN#DIF,L GE,LE G,LT GE,NB#B,NDF#DF,NE E,NG G,NL L
NZ E,P1=P1,P2#P1,Z N]
IRPS Y,Z,X
IFE .IRPCN,[SIXBIT/Y/ ;COND. NAME IN FIRST TABLE.
IF2 [ CNTTM1==V ;DEFAULT IS >0, FOR ARITH COND.
IFSE Z,=,CNTTM1==SETZ ;= => TRUE, CALL RTN.
IFSE Z,#,CNTTM1==TRN ;# => REVERSED, CALL RTN.
]]
IFN .IRPCN,[IF2 [ .=.+CNTTB1-CNTTB0-1 ;MOVE TO 2ND TABLE.
CNTTM1+IFL CNTTM1,[CNT!Y]+IFGE CNTTM1,SKIP!Y
.=.+CNTTB0-CNTTB1 ;MOVE BACK TO 1ST TABLE.
]]
TERMIN TERMIN
IF1 [CNTTBL==0
REPEAT 10.,IFE CNTTBL,IFGE 1_.RPCNT-.+CNTTB0, CNTTBL==.RPCNT
] ;(NOW CNTTBL HAS LOG BASE 2 OF TABLE SIZE, ROUNDED UP.)
CNTTB1==CNTTB0+1_CNTTBL ;MAKE TABLE SIZE NEXT POWER OF 2.
REPEAT CNTTB1-., 377777,,-1 ;FILL OUT 1ST TABLE WITH LARGEST POSITIVE NUM.
CNTTB1: BLOCK CNTTB1-CNTTB0 ;MAKE 2ND TABLE SAME SIZE AS FIRST.
;COME HERE TO READ IN THE CONDITION OF A NEW CONDITIONAL,
;SKIP-RETURN IFF CONDITION IS TRUE.
;LEAVE INPUT STREAM BEFORE BODY OF CONDITIONAL.
CNT: CALL GETSYM ;READ IN CONDITION-TYPE.
ERROR1 CPOPJ,Condition missing
CNT0: SETZ A, ;A IS PTR INTO TABLES FOR BINARY-SEARCHING.
REPEAT CNTTBL,[ ;CNTTB0(A) WILL HOLD AONDITION NAME; CNTTB1(A), ACTION.
CAML N,CNTTB0+1_<CNTTBL-.RPCNT-1>(A)
ADDI A,1_<CNTTBL-.RPCNT-1>
]
CAME N,CNTTB0(A) ;IS THE COND-NAME ACTUALLY IN TABLE?
ERROR1 CPOPJ,Bad condition name
SKIPGE V,CNTTB1(A) ;IF ACTION POSITIVE, IT IS SKIP-INSTRUCTION,
JRST CNTSPC ;ELSE IT IS ADDR OF RTN, GO CALL IT.
SAVE V
AOS VALREQ
CALL EXPRF ;ACTION IS INSN => ARITHMETIC COND, READ NUMBER.
ERROR1 No argument in conditional
SOS VALREQ
LDB W,[POINT ADRSIZ,V,35];PREPARE TO LIST VALUE OF ARG ALONG WITH CONDITIONAL.
HRLI W,CL1
LSH V,24 ;MOVE VALUE'S SIGN INTO BIT 4.9 FOR TEST.
REST A ;RESTORE THE TEST INSN (A SKIP!X)
XCT A
AOS (P)
JRST CNTCMA
;COME HERE FOR SPECIAL CONDITIONALS.
CNTSPC: TLNN V,200000 ;BIT 4.8 OFF => TRUE CONDITION.
JRST [CALL (V) ? RET ? JRST POPJ1]
CALL (V) ;BIT 4.8 => REVERSE THE TEST.
AOS (P)
RET
;RTN FOR .IF DIF & .IF IDN, READS 2 MACRO-ARGS, SKIPS IF DIFFERENT
CNTDIF: CALL ARGINI ;INIT. THE FIRST ARG.
ERROR1 POPAJ,No argument in conditional
;(RETURN NON-SKIPPING FROM CNT)
CALL GETBLK ;PREPARE TO COPY 1ST ARG INTO MACRO-STORAGE.
SAVE MWPNTR,MWPNTR
;WILL ILDB -1(P) TO RE-READ ARG, USE (P) TO FREE IT AFTER.
CNTDI1: CALL ARGC ;GET NEXT CHAR TO WRITE IN STRING.
JRST CNTDI0 ;NO MORE CHARS.
CALL WCIMT
JRST CNTDI1
CNTDI0: MOVEI I,^C
CALL WCIMT ;TERMINATE STRING WITH ^C.
CALL ARGINI ;START READING 2ND ARG.
JRST CNTDI3 ;NO ARG SAME AS NULL ARG.
CNTDI2: CALL ARGC
JRST CNTDI3 ;AT END OF 2ND, SEE IF END OF 1ST.
ILDB A,-1(P) ;GET CHAR OF 1ST,
CAIN A,(I)
JRST CNTDI2 ;THE SAME SO FAR.
CNTDI4: CALL ARGC ;THEY'RE DIFFERENT, SKIP REST OF 2ND ARG.
JRST CNTDI5
JRST CNTDI4
CNTDI3: ILDB A,-1(P)
CAIE A,^C ;SKIP-RETURN IF 1ST ARG LONGER THAN 2ND, NOT EQUAL.
CNTDI5: AOS -2(P)
REST A ;GET THE OTHER SAVED COPY OF MWPNTR,
CALL REMMAC ;FREE 1ST ARG'S STRING STG.
JRST POPAJ
;RTN FOR .IF B & .IF NB, READ 1 ARG & SKIP IF BLANK.
CNTB: CALL ARGINI
JRST POPJ1 ;NO ARG COUNTS AS BLANK.
CALL ARGC
JRST POPJ1 ;ARG NULL => BLANK.
CNTB0: CALL ARGC ;CAN'T BE BLANK, SKIP THE ARG
RET ;RETURN FAILURE.
JRST CNTB0
;RTN FOR .IF 1 & .IF 2, SKIP IF PASS 1.
CNTP1: TLNE AF,P1F
AOS (P)
JRST CNTCMA
;RTN FOR .IF DF & .IF NDF, SKIP IF ALL SYMS IN ARG ARE DEF.
CNTDF: SAVE VALREQ
SETZM VALREQ ;DON'T WANT ERROR MSG ON UNDEF SYM!
TLO AF,NDSFLG ; AND DON'T WANT THEM PUT IN DICT.
CALL EXPRF ;READ THE ARG,
JFCL
REST VALREQ
TLZ AF,NDSFLG ; PUT UNDEFINEDS IN DICT. AGAIN
TRZN AF,ERRU ;SKIP UNLESS SAW UNDEF SYM.
AOS (P)
CNTCMA: CAIE I,",
RET
JRST @GETCHA
;.IRP DUMMY,<ARG1,ARG2,ARG3>
AIRP: MOVEI S,IRPORD ;INDICATE ORDINARY .IRP .
JRST AIRP0
;.IRPC DUMMY,STRING
AIRPC: MOVEI S,IRPCHR
AIRP0: CALL GETBLK ;GET START OF .IRP ARGS BLOCK.
CALL GETSYM ;READ DUMMY SYMBOL NAME.
ERROR1 [[SETO N, ? JRST .+1]]Invalid IRP
CALL PSOB3 ;PASS COMMA, ERROR IF NONE.
SAVE MWPNTR
MOVEM N,ARGLST ;PRETEND THAT DUMMY IS 1ST MACRO ARG.
SETZM ARGLST+1 ;AND ONLY 1 ARG. (WILL READ IN BODY AS MACRO-DEF.)
AOS MWPNTR ;1ST WD -> BEFORE START OF ARGLIST OR STRING.
AOS MWPNTR ;ARG BLOCK+1 - BP. -> AFTER LAST ARGN.
JRST @.(S)
PHASE 1
IRPORD::AIRP1
IRPCHR::[SETZ I, ;MAKE A 1-CHAR-LONG MACRO ACTUAL,
CALL WCIMT ;EACH PASS THRU .IRPC WILL PUT THE NEXT
CALL WTARGT ;CHAR OF THE STRING INTO THIS ACTUAL.
MOVE I,[250000,,1]
ADDM I,MWPNTR ;BYPASS REST OF THIS WORD (3RD WD IN BLOCK).
JRST AIRP1]
DEPHASE
AIRP1: MOVE I,MWPNTR ;PUT BP TO START OF ARGS
MOVEM I,@(P) ;INTO BLOCK'S 1ST WORD.
CAIN S,IRPORD ;.IRP, PUT TERMINATOR BEFORE 1ST ARG.
CALL WTARGT
CALL ARGINI ;INIT. READING OF STRING OR ARGLIST.
JRST AIRP4 ;THERE IS NO ARGLIST.
AIRP2: CALL ARGC ;GET NEXT ARG CHARS_ACTER,
JRST AIRP3 ;NO MORE CHARS.
CALL WCIMT ;WRITE IT IN .IRP ARGS BLPCK.
CAIN I,", ;IN .IRP, REPLACE A COMMA
CAIE S,IRPORD
JRST AIRP2
HRRZ I,ARGRET ;IF THE ARG TO "IRP" IS BRACKETED,
CAIN I,ARGLT1 ;THEN BRACKETS INSIDE THE ARG INHIBIT COMMAS,
SKIPN ARGTRM ;SO THAT ".IRP X,<FOO,<BAR,BLE>>" HAS 2 ARGS
CAIA ;WHICH ARE "FOO" AND "<BAR,BLE>".
JRST AIRP2
MOVEI I,^C ;WITH A TERMINATOR QUEARG.
DPB I,MWPNTR
MOVEI I,QUEARG
CALL WCIMT
JRST AIRP2
AIRP3: CAIN S,IRPORD ;.IRP, FOLLOW ARGS BY TERMINATOR.
CALL WTARGT
AIRP4: MOVE A,MWPNTR
MOVE B,(P)
MOVEM A,1(B) ;STORE PTR TO END IN 2ND WD OF BLOCK.
CALL ENDLR ;LIST THE LINE THE .IRP IS ON.
SAVE S
CALL [CALL GETBLK ;START IRP-BODY BLOCK.
SAVE MWPNTR, [1] ;SAVE THEM SINCE DEF00 DOES.
SETZ S, ;.MACR - .ENDM LEVEL COUNT.
MOVEI A,3 ;3 WDS SPECIAL AT START OF BLOCK.
ADDM A,MWPNTR
JRST DEF03] ;GO READ IN BODY OF IRP.
SAVE A
CALL ENDLR
REST A,S,B
MOVEM B,2(A) ;-> IRP BODY BLOCK RET. IN A.
MOVE C,MACBPT ;ALL IS READ IN, NOW PUSH MACRO PDL.
IDPB C,MACPDP ;SAVE OLD MACBPT.
MOVE C,%IRPCN ;SAVE OUTER .IRPCN .
IDPB C,MACPDP
MOVE C,AIRPXT-1(S) ;GET ADDR OF APPROPRIATE END-OF-STRING RTN.
EXCH C,MACXIT ;CALL IT WHEN FINISH EACH PASS.
IDPB C,MACPDP ;SAVE OUTER STRING'S EOS RTN.
IDPB MP,MACPDP ;SAVE OUTER MACRO PTR.
IDPB A,MACPDP ;SAVE PTR -> "MACRO DEF"
IDPB A,MACPDP ;MAKE SPACE FOR THIS INVOCATION'S SAVED READ PTR.
MOVE C,MACPDP ;(WHICH WILL BE STORED BY AIRPND)
MOVEM C,MACBPT ;MACBPT POINTS TO THAT WORD.
ADDI B,2
HRLI B,440700 ;COME UP WITH THE "MACRO ARG" B.P.
IDPB B,MACPDP
MOVEI B,1
IDPB B,MACPDP ;STORE "# MACRO ARGS"
MOVE MP,(C)
SETOM %IRPCN
CALL GCHSET
JRST @MACXIT ;PRETEND -1'TH PASS THRU IRP JUST ENDED.
AIRPXT: PHASE 1
IRPORD::AIRPON ;END-OF-PASS RTN FOR .IRP,
IRPCHR::AIRPCN ; FOR .IRPC .
DEPHASE
;COME HERE AFTER END OF PASS THRU .IRP .
AIRPON: CAIA ;CALL HERE AFTER PASS,
JRST AIRPX ;CALL HERE FROM .MEXIT
CALL AIRPND ;SET READ PTR TO START OF IRP BODY.
SAVE A,B
MOVE A,MACBPT
AIRPO1: ILDB B,1(A) ;MOVE THRU LAST PASS'S IRP ACTUAL
PUSHJ P,AIRPO9 ;MOVE TO NEXT BLOCK IF NEC.
CAIE B,^C ;UNTIL GET TO TERMINATOR.
JRST AIRPO1
ILDB B,1(A) ;MOVE OVER TERMINATOR, NOW -> NEXT IRP ACTUAL.
PUSHJ P,AIRPO9
MOVE B,1(A)
CAME B,1(I) ;BUT MAYBE WE POINT TO LAST TERMINATOR?
JRST POPBAJ ;NO, THERE'S ANOTHER IRP ACTUAL, DO NEXT PASS.
REST B ;YES, POP THE IRP STUFF OF MACPDL.
AIRPC1: MOVE A,I
CALL REMMAC ;FREE UP THE IRP ARGS BLOCK.
MOVE I,MACBPT
MOVE A,-1(I)
CALL REMMAC ;FREE THE IRP BODY BLOCK.
MOVE MP,-2(I) ;RESTORE THE SAVED MACRO READ PTR AND MACXIT AND MACBPT.
MOVE A,-3(I)
MOVEM A,MACXIT
MOVE A,-4(I)
MOVEM A,%IRPCN
MOVE A,-5(I)
MOVEM A,MACBPT
MOVNI A,8
ADDM A,MACPDP ;FLUSH THE WDS FROM THE STACK.
CALL GCHSET
JRST POPAJ
AIRPO9: JUMPN B,CPOPJ ;DO NOTHING UNLESS AT END OF MACRO-BLOCK.
MOVE B,@1(A) ;ELSE GET ADDR OF NEXT BLOCK,
HRRM B,1(A) ;MAKE BP. -> IT.
LDB B,1(A) ;GET NEXT CHAR FROM THAT BLOCK.
RET
AIRPX: CALL AIRPND ;.MEXIT IN IRP; SET UP POINTERS,
SAVE A
JRST AIRPC1 ;GO POP OFF MACPDL.
;COME HERE AFTER END OF PASS THRU .IRPC .
AIRPCN: CAIA ;CALL HERE AT END OF PASS.
JRST AIRPX ;CALL HERE FROM .MEXIT .
CALL AIRPND ;SET READ PTR TO START OF IRP BODY.
SAVE A
MOVE A,(I) ;GET BP INTO STRING TO IRPC ON.
CAMN A,1(I) ;IF -> LAST CHAR, THERE ARE NO MORE,
JRST AIRPC1 ;GO POP OUT OF THE IRP.
ILDB A,(I) ;ELSE GET THE NEXT CHAR.
JUMPE A,[ MOVE A,@(I) ;GONE PAST END OF BLOCK =>
HRLI A,350700 ;FOLLOW POINTER IN LAST WORD
MOVEM A,(I) ;TO FIND NEXT BLOCK.
LDB A,A ;AND FETCH ITS 1ST CHARACTER.
JRST .+1]
DPB A,[350700,,2(I)] ;PUT IT IN THE PHONY MACRO ACTUAL.
JRST POPAJ
;COMMON RTN FOR END OF PASS THRU ANY IRP.
;SET THE MACRO READ PTR (IN MP AND `MACBPT) -> START OF IRP BODY.
;LEAVE I -> IRP ARGS BLOCK.
AIRPND: AOS %IRPCN
MOVE I,MACBPT
MOVE MP,-1(I) ;-> IRP BODY BLOCK.
HRLI MP,440700
ADDI MP,3 ;BP -> START OF TEXT OF IRP BODY.
MOVEM MP,@MACBPT
MOVE I,-1(MP) ;-> IRP ARGS BLOCK.
RET
;MACRO ARG READING COROUTINES.
;CALL HERE TO INIT. READING OF MACRO ARG (FROM ASSEMBLY INPUT PATH)
ARGINI: SETCHAR
LDB B,C1PNTR
CAIN B,MACR ;1ST CHAR IS CR OR ;, NO ARG.
RET
AOS (P) ;ELSE THERE IS AN ARG.
CAIN I,"\ ;\ - ARG IS EVALUATED & CONVERTED TO BASE 8.
JRST ARGBS
CAIN I,"< ;< - ARG IS BRACKETED WITH < & >.
JRST ARGLT
CAIE I,"^ ;ARG IS ORDINARY UNLESS STARTS WITH ^ .
JRST ARG1
CALL @GETCHA ;ARG USES DELIMITERS, READ THE DELIMITER.
MOVEM I,ARGTRM ;SAVE IT.
JSR ARGRET ;RETURN, ARGC CALLS AT .+1 .
CALL @GETCHA
CAME I,ARGTRM ;WAS THIS CHAR THE DELIMITER?
JRST POPJ1 ;NO, IT'S PART OF THE ARG.
ARGEN1: CALL @GETCHA
ARGEND: LDB B,C1PNTR ;MOVE PAST THE ARGUMENT.
XCT .+1(B)
PHASE 0
ERROR1 ARGEN1,Bad macro-type argument
MASP:: JRST ARGEN1 ;PASS SPACES. ^- PASS MOST CHARS BUT ERROR.
MACM:: JRST @GETCHA ;COMMA, STOP ON NEXT CHAR.
MACR:: RET ;CR OR ;, STOP ON IT SO NEXT ARGINI WILL SEE IT.
DEPHASE
ARGBS: CALL @GETCHA ;ARG IS \<EXPR> -- READ 1ST CHAR OF EXPR.
SAVE S
CALL EXPRF
ERROR1 No expression after backslash
REST S
MOVEM V,ARGTRM ;SAVE VALUE OF ARG IN RH,
MOVE V,[220300,,ARGTRM]
ARGBS0: HLLM V,ARGTRM ;PUT LH OF BP INTO RH, IN LH.
ILDB A,V
JUMPN A,ARGBS1 ;THEN MOVE BP PAST LEADING ZEROS.
TLNE V,77^4 ;BUT DON'T MOVE PAST LAST DIGIT.
JRST ARGBS0 ;CAN PASS IT, UPDATE LH(ARGTRM)
ARGBS1: JSR ARGRET
;COME HERE FROM ARGC
HLLZ I,ARGTRM ;LH OF ARGTRM SAYS WHICH FIELD IN WORD,
HRRI I,ARGTRM ;THE WORD IS ARGTRM (THE RH, WHICH HAS VALUE OF ARG)
TLNN I,77^4 ;USED ALL 6 OCTAL DIGITS?
JRST [SETCHAR ? JRST ARGEND] ;YES, PASS END OF ARG.
IBP ARGTRM
ILDB I,I ;GET THE NEXT OCTAL DIGIT.
ADDI I,"0
JRST POPJ1
ARGLT: SETZM ARGTRM ;ARG IS BRACKETED, ARGTRM COUNTS ANGLE-BRACKET LEVEL.
JSR ARGRET
ARGLT1: CALL @GETCHA
CAIN I,"<
AOS ARGTRM ;< - GO UP ONE LEVEL.
CAIN I,">
SOSL ARGTRM ;> - DOWN 1 LEVEL, MAYBE END ARG.
JRST POPJ1 ;ORDINARY CHAR IS IN ARG.
JRST ARGEN1 ;FOUND THE MATCHING >.
;HANDLE AN ORDINARY ARG.
ARG1: JSR ARGRET ;THE 1ST CHAR OF ARG WAS READ ALREADY.
SETCHAR
ARG2: LDB B,C1PNTR
XCT ARG1TB(B) ;SPACES, COMMA, CR AND ; SPECIAL.
MOVEM IP,SYMBEG ;IT WAS A SPACE, CHECK FORWARD
CALL GETNB ;IF 1ST NONSPACE IS ;,
CAIN I,";
RET ;IGNORE THE SPACE, STOP ON THE ;.
RESCAN SYMBEG ;SPACES NOT BEFORE ;'S ARE ORDINARY CHARS.
SETCHAR
ARG3: AOS (P)
JSR ARGRET ;EVERY CHAR. AFTER THE 1ST HAS TO BE READ.
CALL @GETCHA
JRST ARG2 ;BUT TREAT THEM THE SAME WAY.
ARG1TB: PHASE 0
JRST ARG3 ;ORDINARY CHAR, RETURN IT.
MASP:: JFCL ;SPACE, FALL THRU INTO SPECIAL RTN.
MACM:: JRST @GETCHA ;COMMA, PASS IT & END OF ARG.
MACR:: RET ;CR OR ;, END OF ARG BUT STOP ON IT.
DEPHASE
;CALL HERE TO READ NEXT CHARACTER OF MACRO-ARG.
;SKIPS => CHAR IS IN I .
;ELSE ARG HAS ENDED, CALL ARGINI TO START NEXT ARG.
ARGC: JRST @ARGRET
;.TTYMAC ENTRY TO MACRO HANDLER
ATTYMA: TLO AF,TTMFLG ;WE ARE NOW DOING A .TTYMAC
MOVNI N,2 ;LOOK LIKE DEFINING STRANGE MACRO
CALL GETBLK
CALL DEF00 ;READ IN THE DEFINITION.
SAVE A ;REMEMBER ITS ADDRESS.
CALL ENDLR ;LIST LINE WITH .ENDM .
SAVE TTIPNT,TTICNT
CALL TTILN ;READ ARGS FROM TTY.
MOVEI B,^M ;PUT CRLF AFTER LINE READ.
IDPB B,TTIPNT
MOVEI B,^J
IDPB B,TTIPNT
MOVE B,TTIPNT ;REMEMBER LAST FILLED SLOT IN LINBUF.
MOVEM B,LINIP
REST TTICNT,TTIPNT
RESCAN <[350700,,LINBUF]>
TLZ AF,TTMFLG
REST A ;ENDLR DESTROTED A.
SETCHAR
JRST CALLM ;NOW EXPAND MACRO WITH ARGS FROM TTY.
;.MACR PSEUDOOP.
AMACRO:
AMACR: CALL DEFIN0 ;READ IN THE DEFINITION,
JRST ENDLR ;LIST THE LAST LINE & EXIT.
DEFIN0: CALL GETBLK ;OK, GET A BLOCK FROM STORAGE
CALL GETSYM ;GET MACRO'S NAME
ERROR1 DEFERR,Define what name?
DEF00: CALL SRCH ;SEE IF ALREADY DEFINED
SETZ A, ; NOT IN TABLE
TLNE A,LBLSYM
ERROR1 DEFERR, Label made macro
LDB B,TYPPNT ;GET OP TYPE
CAIE B,MAOP ;MACRO?
TLZA A,-1-NCRSYM ;NO, PRETEND NOT FOUND.
CALL DECMAC ; YES, DECREMENT REFERENCE
HRRZ A,MWPNTR ;GET POINTER TO START OF BLOCK
HRLI A,MAOP ;FLAG MACRO
XCT CRFIND ;INDIC. BEING DEFINED.
CALL INSRT ;INSERT IN SYMBOL TABLE
PUSH P,MWPNTR ;STACK POINTER TO START OF BLOCK
MOVEI A,2
ADDM A,MWPNTR ;MOVE PAST REFERENCE LEVEL AND ARG COUNT
TDZA S,S ;INIT ARG COUNT
DEF01: CALL GETCHR ;MOVE PAST COMMA
CALL GETSYM ;GET AN ARG
JRST DEF02 ; NOT THERE
MOVEM N,ARGLST(S) ;STORE IN LIST
ADDI S,1 ;BUMP POINTER
CAIN I,", ;ANY MORE?
JRST DEF01 ; YES
DEF02: PUSH P,S ;STACK ARG COUNT
SETZM ARGLST(S) ;MARK END
CALL ENDLR ;LIST THE LINE
SETZ S, ;INIT LEVEL COUNT
DEF03: CALL GETLIN
CALL GETSYM ;TEST THE FIRST SYMBOL
JRST DEF04
CAME N,[SIXBIT/.IRP/]
CAMN N,[SIXBIT/.IRPC/]
AOJA S,DEF04
CAME N,.TTYMX
CAMN N,.MACRX ;MACRO DEF - INCREM LEVEL COUNT.
AOJA S,DEF04
CAME N,.REPTX
CAMN N,.MACRY
AOJA S,DEF04
CAME N,.ENDRX
CAMN N,.ENDMX ;END OF DEF - DECREM COUNT.
SOJL S,DEF13 ;END IF MINUS
DEF04: RESCAN LINPNT ;SET TO START OF LINE
DEF05: CALL GETCHR ;GET THE NEXT CHARACTER
DEF06: CAIE I,"' ;CONCATENATION CHARACTER?
JRST DEF06C ; NO, BRANCH AROUND
DEF06A: CALL GETCHR ;YES, GET THE NEXT CHARACTER
CAIE I,"' ;MULTIPLE?
JRST DEF06B ; NO
CALL WCIMT ;YES, SAVE ONLY ONE
JRST DEF06A ;TEST FOR MORE
DEF06B: TLO AF,CONFLG ;FLAG THE CONCATENATION CHARACTER
DEF06C: LDB B,ANPNTR ;MAP
XCT DEFT1(B) ;EXECUTE TABLE
CALL WCIMT ;WRITE IN TREE
JRST DEF05 ;TRY FOR ANOTHER
DEF15: SUBI I,40 ;LOWER CASE LETTER STARTS A SYMBOL.
DEF07: SETZ N, ;POSSIBLE ARGUMENT
MOVSI C,440600
MOVEM IP,SYMBEG ;SAVE START JUST IN CASE
DEF08: SUBI I,40 ;CONVERT TO SIXBIT
DEF14: CAME C,[POINT 6,N,35] ;ROOM TO STORE?
IDPB I,C ; YES, DO SO
CALL GETCHR ;GET THE NEXT CHARACTER
LDB B,ANPNTR ;MAP
XCT DEFT2(B) ;EXECUTE TABLE
SETZ B, ;INIT SEARCH INDEX
DEF09: SKIPN ARGLST(B) ;TEST FOR END
JRST DEF10 ; YES
CAME N,ARGLST(B) ;NO, HAVE WE A MATCH?
AOJA B,DEF09 ; NO,TRY THE NEXT SLOT
TLZ AF,CONFLG ;REMOVE POSSIBLE CONCATENATION CHARACTER
MOVEI I,101(B) ;SET DUMMY SYMBOL POINTER
CALL WTIMT ;WRITE IN TREE
SETCHAR ;SED CHARACTER
CAIN I,"' ;CONCATENATION CHARACTER?
JRST DEF05 ; YES, BYPASS IT
JRST DEF06 ; NO, PROCESS IT
DEF10: RESCAN SYMBEG ;MISSED, RESET POINTER
SETCHAR ;RESET CHARACTER
DEF11: LDB B,ANPNTR ;MAP
XCT DEFT3(B) ;EXECUTE TABLE
CALL WCIMT ;OK, WRITE IN TREE
CALL GETCHR ;GET NEXT CHAR
JRST DEF11 ;TEST IT
DEF12: CALL WCIMT ;WRITE IT OUT
CAIE I,^J ;IF FINISHED LINE,
JRST DEF05
CALL ENDLR ;LIST IT
TLNN AF,ENDFLG ;SKIP IF EOF SEEN
JRST DEF03 ;GET THE NEXT LINE
DEF13: MOVEI I,QUEMAC ;FINISHED, SET "END OF MACRO DEFINITION"
CALL WTIMT ;WRITE IT, WITH QUE, IN TREE
POP P,B ;RETRIEVE COUNT
POP P,A ; AND POINTER TO START OF BLOCK
SETZM 0(A) ;ZERO LEVEL COUNT
HRRZM B,1(A) ;STORE ARG COUNT IN SECOND RUNG
SETCHAR ;RESTORE LAST CHARACTER
RET
DEFERR: MOVNI N,1 ;SKIP DEFN. BY DEFINING ______.
JRST DEF00
DEFT1: PHASE 0
JRST DEF12
.TAB:: JFCL
.ALP:: JRST DEF07
.NUM:: JRST DEF07
.DOT:: JRST DEF07
.TRM:: JRST DEF12
.LOW:: JRST DEF15
DEPHASE
DEFT2:
PHASE 0
JFCL
.TAB:: JFCL
.ALP:: JRST DEF08
.NUM:: JRST DEF08
.DOT:: JRST DEF08
.TRM:: JFCL
.LOW:: JRST DEF14
DEPHASE
DEFT3: PHASE 0
JRST DEF06
.TAB:: JRST DEF06
.ALP:: JFCL
.NUM:: JFCL
.DOT:: JFCL
.TRM:: JRST DEF06
.LOW:: JFCL
DEPHASE
;MACRO PDL FRAME FORMAT:
;WD 1 PREVIOUS MACBPT, OR 0 IN LOWEST FRAME.
;WD 2 PREVIOUS %NARG.
;WD 3 PREVIOUS MACXIT.
;WD 4 PREVIOUS READ POINTER (MP)
;WD 5 PTR TO 1ST BLOCK OF MACRO.
;WD 6 READ PTR IN MACRO SAVED AROUND DUMMY SYMBOL. MACBPT PTS HERE.
;WD 7 B.P. TO START OF 1ST ARG, ETC. FOR ALL ARGS.
;LAST NUMBER OF ARGS. MACPDP POINTS HERE.
CALLM: AOS (A) ;INCR. REF. COUNT IN MACRO.
MOVN S,1(A) ;MAX. NUM. ARGS.
HRLZS S ;GET "AOBJN PTR" TO ARGUMENT.
SAVE A ;REMEMBER MACRO BODY ADDR.
JUMPE S,MAC50 ;TEST FOR NO ARGS
CALL SETNB ;RESTORE LAST CHARACTER
CALL GETBLK ;BLOCK TO STORE ARGS IN.
MAC20: CALL ARGINI ;START READING MACRO-TYPE ARG FROM INPUT STREAM.
JRST MAC50 ;NO MORE ARGS, FINISH UP.
SAVE MWPNTR
MAC21: CALL ARGC ;GET NEXT CHAR OF ARG,
JRST MAC40 ;(NO MORE CHARS IN ARG)
CALL WCIMT ;WRITE CHAR IN MACRO-CALL-BLOCK.
JRST MAC21
MAC40: CALL WTARGT ;TERMINATE ARG.
AOBJN S,MAC20 ;BRANCH IF MORE ARGS WANTED.
MAC50: CALL ENDLR ;FINISH READING LINE FROM OLD SOURCE.
MOVE B,MACBPT ;NOW PUSH THE NEW FRAME ON MACRO PDL:
IDPB B,MACPDP ;OLD MACBPT.
MOVE B,%NARG
IDPB B,MACPDP ;OLD %NARG
MOVEI B,MACEND
EXCH B,MACXIT
IDPB B,MACPDP ;OLD MACXIT
IDPB MP,MACPDP ;OLD MACRO READ PTR.
AOS MACPDP ;WILL FILL IN PTR TO MACRO BODY LATER.
AOS A,MACPDP ;NEEDN'T STORE WD 6 ( IT HAS MEANING
MOVEM A,MACBPT ;ONLY WHILE READING DUMMIES)
MOVEI B,(P)
SUBI B,-1(S) ;ADDR OF 1ST ARG B.P. ON THE STACK.
AOS MACPDP ;PLACE FOR 1ST ARG B.P. TO GO.
MOVSS B
HRR B,MACPDP ;BLT PTR
ANDI S,-1 ;# OF ARGS ACTUALLY READ = # WDS PUSHED.
ADDM S,MACPDP ;ADDR OF LAST WD OF FRAME
BLT B,@MACPDP ;(BLT'S 1 WD MORE THAN NECESSARY)
HRRZM S,@MACPDP ;SAVE # ARGS IN LAST WD.
MOVEM S,%NARG ;SO "FOO==%NARG" WILL WORK
HRLI S,(S) ;# ARGS,,# ARGS
SUB P,S ;POP ARG B.P.'S OFF STACK.
REST MP ;ADDR OF MACRO BODY.
MOVEM MP,-1(A) ;SAVE IN WD 5 OF FRAME. (A STILL HAS MACBPT)
HRLI MP,440700 ;GET B.P. TO ILDB TEXT OF MACRO.
ADDI MP,2
AOS MACLVL
JRST GCHSET
;COME HERE AFTER READING ENTIRE MACRO. CALLED FROM GCHM SO DON'T CLOBBER ACS.
MACEND: JFCL ;.MEXIT WILL CALL HERE+1
MOVE I,@MACPDP ;GET NUM. ARGS.
SOS A,MACBPT ;-> WD 3, -> MACRO.
MOVEM A,MACPDP
MOVE A,2(A) ;GET PTR -> 1ST ARG (IF ANY ARGS)
CAIE I,0 ;IF WERE ARGS, FLUSH CALL-BLOCK.
CALL REMMAC ;FLUSH BLOCK HOLDING THEM.
MOVE A,MACPDP
SUBI A,5
MOVEM A,MACPDP ;FLUSH REMAINING WDS.
IRPS X,,MACBPT %NARG MACXIT
MOVE B,1+.IRPCN(A)
MOVEM B,X
TERMIN
MOVE MP,4(A)
MOVE A,5(A)
CALL DECMAC ;SOS MACRO REF-COUNT, MAYBE FREE.
SOS MACLVL ;DECREMENT MACRO LEVEL COUNT
JUMPE MP,GCHSE0 ;IF POPPED TO FILE, RESET GETCHA .
RET
;.MEXIT - POP OUT OF INNERMOST REPEAT, IRP OR MACRO.
AMEXIT: JUMPE MP,[ERROR1 ENDLR,.MEXIT in file
]
CALL ENDLR ;LIST THE LINE WITH THE .MEXIT ON IT.
MOVE A,MACXIT ;GET ADDR OF RTN TO END 1 PASS THRU INNERMOST STRING,
JRST 1(A) ;CALL 1 INSN AFTER TO END ALL PASSES THRU IT.
;.NCHR SYM,ARG SAME AS SYM==.LENGT ARG
ANCHR: JSP A,ANCHR1
;.LENGT - TAKES ARG LIKE MACRO, RETURNS # CHARS IN IT.
ALENGT: SETZ V,
CALL ARGINI ;INIT. READING OF ARG.
RET ;NO ARG, RETURN 0.
ALENG1: CALL ARGC ;READ NEXT CHAR.
RET ;NO MORE, RETURN # COUNTED.
AOJA V,ALENG1
;.NTYPE SYM,ARG SAME AS SYM==.ADRMD ARG
ANTYPE: JSP A,ANCHR1
;.ADRMD ARG, RETURNS ADDRESSING MODE OF ARG
;(EG RETURNS 64 FOR INDEX OF R4)
AADRMD: SAVE CEXT,OFFST ;DON'T CLOBBER INSN ARG BEING READ.
CALL AEXP
AADRI2: TLZ AF,REGFLG
TRZ AF,ERRU ;EVEN IF ARG INCLUDES UNDEFINED SYMS, VALUE IS NOT UNDEF
REST OFFST,CEXT
JRST CNTCMA ;RETURN WHAT AEXP RETURNED.
;.ADRIX ARG, RETURNS THE INDEX-WORD OF ARG. .ADRIX 1(2), RETURNS 1.
AADRIX: SAVE CEXT,OFFST
CALL AEXP
MOVE V,OFFST
HRRZ V,CEXT(V)
JRST AADRI2
ANARG: CALL GETSYM
JFCL
SAVE N
MOVE V,%NARG
TLO AF,HKLFLG
JRST ASGMT0
ANCHR1: SAVE A ;REMEMBER ADDR OF RTN TO GET VALUE,
CALL GETSYM ;READ NAME OF SYM TO ASSIGN.
JFCL
CALL PSOB3 ;PASS COMMA, ERROR IF NONE.
EXCH N,(P) ;PUT NAME ON STACK FOR ASGMT0.
CALL @N ;CALL RTN TO READ OTHER ARGS, RETURN VALUE IN V.
TLO AF,HKLFLG
JRST ASGMT0 ;ASSIGN SYM, HALF-KILLED.
;MACRO STORAGE HANDLERS
WTARGT: MOVEI I,QUEARG ;TERMINATE ARG.
WTIMT: ;WRITE TWO CHARACTERS IN MACRO TREE
PUSH P,I ;STACK CURRENT CHARACTER
MOVEI I,^C ;SET FLAG CHARACTER
CALL WCIMT ;WRITE IT
POP P,I ;RESTORE CHARCTER AND FALL THROUGH
WCIMT: ;WRITE CHARACTER IN MACRO TREE
TLZE AF,CONFLG ;CONCATENATION CHARACTER PENDING?
JRST WCIMT2 ; YES, WRITE IT OUT
IBP MWPNTR ;POINT TO ACTUAL WORD
SKIPN @MWPNTR ;END OF BLOCK?
JRST WCIMT1 ; YES, GET ANOTHER
DPB I,MWPNTR ;NO, STORE BYTE
RET
WCIMT1: PUSH P,MWPNTR ;NEAD A NEW BLOCK, SAVE CURRENT POINTER
CALL GETBLK ;GET IT
HRRZ T1,MWPNTR ;GET START OF NEW BLOCK
EXCH T1,0(P) ;EXCHANGE WITH POINTER TO LAST
POP P,0(T1) ;STORE VECTOR
JRST WCIMT ;TRY AGAIN
WCIMT2: PUSH P,I ;STACK CURRENT CHARACTER
MOVEI I,"'
CALL WCIMT ;WRITE CONCATENATION CHARACTER
POP P,I ;RESTORE CHARACTER
JRST WCIMT ;CONTINUE
GETBLK: ;GET A BLOCK FOR MACRO STORAGE
SKIPE T1,NEXT ;ANY REMNANTS OF GARBAGE COLLECTION?
JRST GETBL1 ; YES, RE-USE
PUSH P,S ; NO, SAVE REGISTER
MOVEI S,WPB
ADDB S,MACTOP ;UPDATE FREE LOCATION POINTER
CAML S,JOBREL ;ANY ROOM?
CALL GETCOR ; NO, GET MORE CORE
MOVEI T1,-<WPB-1>(S) ;POINT TO START OF BLOCK
POP P,S ;RESTORE
SETZM WPB-1(T1) ;CLEAR VECTOR
GETBL1: HRLI T1,440700 ;FORM BYTE POINTER
MOVEM T1,MWPNTR ;SET NEW BYTE POINTER
HRLI T1,-<WPB-1> ;GET SET TO INITIALIZE BLOCK
SETOM 0(T1) ;CLEAR ENDRY
AOBJN T1,.-1 ;SET ALL EXCEPT LAST TO -1
PUSH P,0(T1) ;GET TOP
POP P,NEXT ;SET FOR NEXT BLOCK
SETZM 0(T1) ;CLEAR LAST WORD
RET
READMB: ;READ MACRO BYTE
ILDB I,MP ;GET CHARACTER
JUMPN I,CPOPJ ;EXIT IF NON-NULL
MOVE MP,0(MP) ;END OF BLOCK, GET LINK
HRLI MP,440700 ;SET ASCII BYTE POINTER
JRST READMB ;TRY AGAIN
GETDS: ;GET DUMMY SYMBOL
ANDI I,37
CAMLE I,@MACPDP ;GOT THAT MANY ARGS?
JRST GCHM ;NO, ARG IS NULL.
ADD I,MACBPT ;ELSE INDEX INTO FRAME,
MOVEM MP,@MACBPT ;SAVE PTR IN MACRO ITSELF IN WD 4.
MOVE MP,(I) ;READ FROM DS.
JRST GCHM ;GET 1ST CHAR OF ARG.
DSEND: ;DUMMY SYMBOL END
MOVE MP,@MACBPT ;RESTORE READ PTR FROM WD 4.
RET
DECMAC: ;DECREMENT MACRO STORAGE
SOSL 0(A) ;TEST FOR END
RET ; NO, EXIT
REMMAC: ;REMOVE MACRO STORAGE
PUSH P,A ;SAVE POINTER
HRLS A ;SAVE CURRENT POINTER
HRR A,WPB-1(A) ;GET NEXT LINK
TRNE A,-1 ;TEST FOR END (NULL)
JRST .-3 ; NO
HLRZS A ;YES, GET RETURN POINTER
HRL A,NEXT ;GET CURRENT START OF CHAIN
HLRM A,WPB-1(A) ;STORE AT TOP
POP P,A ;RESTORE BORROWED REGISTER
HRRZM A,NEXT ;SET NEW START
RET
;LISTING ROYTINES
PRNTA: ;PRINT BASIC LINE OCTAL
HLRZ R6,W ;GET CLASS TYPE
TLNE AF,TTYFLG ;TELETYPE (DOUBLE LINE)?
JRST PRNTA1 ; YES, BRANCH
CALL LOTAB ;LIST A TAB
HLRZ C,PRNTAT(R6) ;TEST FOR LEFT HALF
CALL 0(C) ;PROCESS
CALL LOTAB ;OUTPUT TAB
HRRZ C,PRNTAT(R6) ;GET RIGHT HALF
CALL 0(C) ;PROCESS
CALL LOTAB
HLRZ C,PRNTBT(R6) ;GET NEXT ITEM
SKIPE C ;SKIP IF NULL
CALL 0(C)
CALL LOTAB
HRRZ C,PRNTBT(R6)
SKIPE C ;SKIP IF NULL
CALL 0(C) ;PROCESS
RET
PRNTA1: ;TELETYPE LINE 1
CALL LOSP
CALL LOSP
HLRZ C,PRNTAT(R6)
CALL PRNTA2
CALL LOSP
HRRZ C,PRNTAT(R6)
PRNTA2: CAIE C,CPOPJ
JRST 0(C)
MOVEI C,6
CALL LOSP ;OUTPUT 6 SPACES
SOJG C,.-1
RET
PRNTAT:
PHASE 0
XWD CPOPJ, CPOPJ
XWD CPOPJ, LOBAS ; ASSIGNMENT
XWD CPOPJ, LOBAS ; .=
XWD LOLOC, LOBAS ; XXXXXX
XWD LOLOC, LOLOB ; XXX
XWD CPOPJ, LOBAS ; .END
XWD LOLOC, LOBAS ; XXXXXX XXXXXX
XWD LOLOC, LOBAS ; XXXXXX XXXXXX XXXXXX
DEPHASE
PRNTB: ;PRINT EXTENSION LINE OCTAL
HLRZ R6,W ;GET CLASS
TLNE AF,TTYFLG ;IF NON-TELETYPE
SKIPN PRNTBT(R6) ; OR NON-MULTIPLE WORD
RET ; EXIT
MOVEI C,5 ;SET FOR 5 SPACES
CALL LOSP ;LIST THEM
SOJG C,.-1
HLRZ C,PRNTBT(R6) ;GET OP
CALL 0(C) ;LIST FIRST WORD
HRRZ C,PRNTBT(R6) ;GET RIGHT HALF
JUMPE C,PRNTB1 ;BRANCH IF NULL
CALL LOSP ;LIST ANOTHER SPACE
CALL 0(C) ;PROCESS CODE
PRNTB1: MOVEI B,0
JRST 0(A) ;LIST CR AND EXIT
PRNTBT:
PHASE 0
0
0 ; ASSIGNMENT
0 ; .=
0 ; XXXXXX
0 ; XXX
0 ; .END
XWD LOHOW, 0 ; XXXXXX XXXXXX
XWD LOHOW, LOLOW ; XXXXXX XXXXXX XXXXXX
DEPHASE
LOTAB: MOVEI B,TAB
JRST 0(A)
LOSP: MOVEI B,SPACE
JRST 0(A)
LOLOC: LDB V,[POINT ADRSIZ,L,35]
IFN RELCOD,[
PUSH P,[0] ; PUSH EXTERNALNESS
PUSH P,[0] ; PUSH RELOCATION
TLNE AF,LCRFLG ; LOCATION COUNTER RELOCATABLE?
AOS 0(P) ; YES - ADJUST STACK ENTRY
]
JRST PRNTWD ;PRINT LOCATION
LOBAS: LDB V,[POINT ADRSIZ,W,35]
IFN RELCOD,[
PUSH P,EEXTAB ; PUSH EXTERNALNESS
PUSH P,REXTAB ; DITTO RELOCATION
]
JRST PRNTWD ;PRINT BASIC
LOHOW: LDB V,[POINT ADRSIZ,CEXT1,35]
IFN RELCOD,[
PUSH P,EEXT1
PUSH P,REXT1
]
JRST PRNTWD ;PRINT HIGH ORDER WORD
LOHOB: LDB V,[POINT 8,CEXT1,35]
JRST PRNTBY ;PRINT HIGH ORDER BYTE
LOLOW: LDB V,[POINT ADRSIZ,CEXT2,35]
IFN RELCOD,[
PUSH P,EEXT2
PUSH P,REXT2
]
JRST PRNTWD ;PRINT LOW ORDER WORD
LOLOB: LDB V,[POINT 8,W,35]
JRST PRNTBY ;PRINT LOW ORDER BYTE
PRNTBY: ;PRINT BYTE
MOVEI B,SPACE
CALL 0(A) ;LIST THREE SPACES
CALL 0(A)
CALL 0(A)
IFN RELCOD,[
PUSH P,[0]
PUSH P,[0] ; BYTES IS ABSOLUTE AND LOCAL!
]
SKIPA C,[POINT 3,V,26]
PRNTWD: MOVE C,[POINT 3,V,17]
ILDB B,C
ADDI B,"0 ;CONVERT TO ASCII
CALL 0(A) ;LIST
TLNE C,770000
JRST PRNTWD+1
IFN RELCOD,[
POP P,V ; GET RELOCATION
POP P,C ; GET EXTERNAL REF.
JUMPN V,PRNREL ; JUMP IF RELOCATABLE
JUMPE C,CPOPJ ; EXIT IF NEITHER
MOVEI B,"* ; WAS EXTERNAL - TYPE --
JRST 0(A) ; -- STAR AND EXIT
PRNREL: MOVEI B,"' ; ASSUME ONLY RELOCATABLE
JUMPE C,0(A) ; TRUE IF NO EXTERNAL REF.
MOVEI B,"! ; ELSE IS BOTH
JRST 0(A)
]
RET
IFE RELCOD,[
; THIS CODE ONLY ASSEMBLED IF NOT MAKING RELOCATABLE VERSION
;OUTPUT END BLOCK, SYMBOLS.
DUMP2: CALL BLKDMP ;DUMP CURRENT BUFFER
MOVE C,[140300,,[1060]] ;OUTPUT END BLOCK:
DUMP4: ILDB B,C ;GET NEXT CONSTANT BYTE,
ADDM B,CHKSUM
CALL BINOUT ;OUTPUT IT,
TLNE C,770000 ;DO ALL 4.
JRST DUMP4
LDB B,[001000,,STRTLC]
ADDM B,CHKSUM ;NEXT, 2 BYTES OF START ADDR.
CALL BINOUT
LDB B,[101000,,STRTLC]
ADDM B,CHKSUM
CALL BINOUT
MOVN B,CHKSUM ;GET CHECKSUM.
CALL BINOUT ; PUNCH IT.
TLNE F,SYMBIT
RET
MOVEI B,2 ;"2" IS CODE FOR "SYM-TAB BLOCK" IN 11SIM LOADER FORMAT.
CALL SYMOUT
MOVN S,SYMLEN ;GET AOBJN PTR -> SYMTAB
HRLZ S,S
JUMPE S,CPOPJ
DUMP3: SKIPN B,@SYMPNT ;GET NAME.
RET ;0 => AT END.
IFE TENEX,[
CALL SYMOUT
MOVE B,@VALPNT
ANDCMI B,600000 ;DON'T LET HIGH BITS CONFUSE 11SIM.
CALL SYMOUT ;WRITE VALUE, TOO.
]
IFN TENEX,[
CALL RADOUT
HLRZ B,@VALPNT
CALL WRDOUT
HRRZ B,@VALPNT
CALL WRDOUT
]
AOBJN S,DUMP3
IFN TENEX,[
MOVEI B,0
CALL WRDOUT
CALL WRDOUT
CALL WRDOUT
CALL WRDOUT
]
RET
IFN TENEX,[
WRDOUT: PUSH P,B
CALL BINOUT
POP P,B
LSH B,-8
CALL BINOUT
RET
RADOUT: MOVEI A,0
LSHC A,6
MOVE C,RADTAB(A)
REPEAT 2,[
IMULI C,50
MOVEI A,0
LSHC A,6
ADD C,RADTAB(A)
]
PUSH P,B
MOVE B,C
CALL BINOUT
MOVE B,C
LSH B,-8
CALL BINOUT
POP P,B
MOVEI A,0
LSHC A,6
MOVE C,RADTAB(A)
REPEAT 2,[
IMULI C,50
MOVEI A,0
LSHC A,6
ADD C,RADTAB(A)
]
MOVE B,C
CALL BINOUT
MOVE B,C
LSH B,-8
CALL BINOUT
RET
RADTAB: 0 ;
0 ; !
0 ; "
0 ; #
33 ; $
35 ; %
0 ; &
0 ; '
0 ; (
0 ; )
0 ; *
0 ; +
0 ; ,
0 ; -
34 ; .
0 ; /
36 ; 0
37 ; 1
40 ; 2
41 ; 3
42 ; 4
43 ; 5
44 ; 6
45 ; 7
46 ; 8
47 ; 9
0 ; :
0 ; ;
0 ; <
0 ; =
0 ; >
0 ; ?
0 ; @
1. ; A
2. ; B
3. ; C
4. ; D
5. ; E
6. ; F
7. ; G
8. ; H
9. ; I
10. ; J
11. ; K
12. ; L
13. ; M
14. ; N
15. ; O
16. ; P
17. ; Q
18. ; R
19. ; S
20. ; T
21. ; U
22. ; V
23. ; W
24. ; X
25. ; Y
26. ; Z
0 ; [
0 ; \
0 ; ]
0 ; ^
0 ; _
]
;OUTPUT OCTAL IF NEC, INCREM L .
DUMP: HLRO B,R6 ;-NUM BYTES.
TLNE F,BINBIT
TLNE AF,P1F
JRST DUMP9 ;IF NOT MAKING BIN, JUST INCR. L.
MOVE A,BYTCNT
CAIGE A,DATLEN(B) ;IF NOT ENOUGH ROOM
CAME L,CURADR ;OR PROFRAM BREAK,
CALL BLKDMP ;START NEW BLOCK.
SUB L,B ;INCREM L .
MOVEM L,CURADR
DUMP8: LDB B,DUMPT(R6) ;GET, OUTPUT BYTE.
AOS A,BYTCNT ;COUNT BYTES IN BLOCK.
MOVEM B,DATBLK-1(A)
AOBJN R6,DUMP8
RET
DUMP9: SUBI L,(B)
RET
DUMPT: POINT 8,W,35
POINT 8,W,27
POINT 8,CEXT1,35
POINT 8,CEXT1,27
POINT 8,CEXT2,35
POINT 8,CEXT2,27
;OUTPUT THE BLOCK WHICH HAS GROWN IN DATBLK.
BLKDMP: SKIPN BYTCNT ;IF NO BLOCK, JUST RE-INIT.
JRST BLKINI
BLKD0: SAVE A,B,C
MOVEI A,1
MOVEM A,DATBBL ;SET UP 1ST WD.
MOVEI A,6
ADDM A,BYTCNT ;GET TOTAL BLOCK LENGTH.
MOVSI A,-4 ;GET LENGTH, ADDR AS BYTES:
BLKD1: LDB B,BLKDMT(A)
MOVEM B,DATBBL+2(A)
AOBJN A,BLKD1
MOVNS BYTCNT
HRLZ A,BYTCNT ;-<LENGTH>,,0
SETZ B, ;GET -<SUM OF WDS>
BLKD2: SUB B,DATBBL(A)
AOBJN A,BLKD2
DPB B,[001000+A,,DATBBL] ;STORE AS CHECKSUM.
SOS C,BYTCNT ;-<# WORDS INCL CHECKSUM>
MOVE B,[444400,,DATBBL]
IFN ITS,[
TLNN F,PSWBIT ;IF P SWITCH,
JRST BLKD5
]
IFN ITS\SAIL,[ ;OUTPUT WD AT A TIME
;FOR SAIL, AND ITS PAPER TAPE.
MOVE A,B
BLKD3: ILDB B,A
UNIOB BIN
AOJL C,BLKD3
JRST BLKD4
]
BLKD5: ;OUTPUT WHOLE BLOCK AT ONCE
IFN ITS\TENEX,[ ;FOR TENEX, AND ITS NON-PAPER-TAPE.
OUTBFR BIN
]
BLKD4: REST C,B,A
BLKINI: ;CODE BLOCK INITIALIZATION
MOVEM L,LODADR ;SET STARTING ADDRESS
MOVEM L,CURADR ;SAVE CURRENT ADDRESS
SETZM BYTCNT ;CLEAR BYTE COUNT
SETZM CHKSUM ; AND CHECK-SUM
RET
BLKDMT: ;BLOCK DUMP TABLE
POINT 8,BYTCNT,35
POINT 8,BYTCNT,27
POINT 8,LODADR,35
IFE EXTEND,[
POINT 8,LODADR,27
]
IFN EXTEND,[
POINT 10,LODADR,27
]
]
IFN RELCOD,[
; THESE ROUTINES ARE FOR THE OUTPUT OF RELOCATABLE CODE
;
; ROUTINE TO OUTPUT CODE.
;
DUMP: HLRO B,R6 ; - BYTES TO DUMP
TLNE F,BINBIT ; NOT MAKING BINARY FILE --
TLNE AF,P1F ; -- OR PASS ONE?
JRST DUMPNC ; YES - DON'T DUMP ANY CODE
HRRZ A,BYTCNT ; GET NUMBER OF BYTES IN BUFFER
CAIG A,DATLEN(B) ; NO ROOM FOR THE NEW ONES --
TLZE AF,LCHFLG ; -- OR PROGRAM BREAK?
CALL CODUMP ; YES - DUMP CURRENT BLOCK
SUB L,B ; UPDATE THE LOCATION COUNTER
TRNE B,1 ; DUMPING FULL WORDS?
JRST DMPBYT ; NO - JUST DUMPING SINGLE BYTE
DUMPWD: AOS A,BYTCNT ; YES - COUNT ONE BYTE
HRRZ B,@WORDT(R6) ; GET THE BYTE (ACTUALLY A WORD)
HRL B,CODET(R6) ; GET ITS BYTE CODE
MOVEM B,BLKDAT-1(A) ; PUT INTO BLOCK
MOVE B,@RELTAB(R6) ; GET RELOCATION
JUMPGE B,DUMPW2 ; STORE IF NO FIXUP
MOVSI B,200000 ; FIXUP - TELL SAVBIN TO --
IORM B,BLKDAT-1(A) ; -- SUBTRACT LOCATION OF THIS WORD
DUMPW2: IDPB B,RELPNT ; SET RELOCATION
AOBJN R6,DUMPWD ; DO ALL THE WORDS
RET ; RETURN
;
; HERE TO DUMP A SINGLE BYTE (NOT RELOCATABLE)
;
DMPBYT: AOS A,BYTCNT ; COUNT THIS BYTE
SETZ B, ; DEPOSIT A ZERO --
IDPB B,RELPNT ; -- RELOCATION BYTE
MOVEI B,0(W) ; GET THE BYTE
HRLI B,1 ; THE BYTE CODE FOR ONE BYTE
MOVEM B,BLKDAT-1(A) ; PUT IT INTO THE BLOCK
RET ; RETURN
;
; HERE IF NOT MAKING BINARY, JUST UPDATE LOCATION COUNTER.
;
DUMPNC: SUB L,B ; UPDATE THE LOCATION COUNTER
RET ; RETURN
;
; TABLE INDEXED BY BYTE NUMBER GIVING ADDRESS OF NEXT BYTE
;
WORDT: W ; FIRST BYTE COMES FROM W
NULWRD ; NEXT ONE IS NULL (TWO IN W)
CEXT1 ; THIRD FROM CEXT1 (TWO BYTES)
NULWRD ; NEXT IS NULL
CEXT2 ; THEN TWO BYTES FROM CEXT2
NULWRD ; THEN A NULL BYTE
;
; TABLE INDEXED BY BYTE NUMBER YEILDING BYTE CODES
;
CODET: 2 ; FIRST WORD HAS TWO BYTES
-1 ; NEXT WORD HAS NO BYTES
2 ; THEN TWO BYTES AGAIN
-1 ; THEN NO BYTES ONCE MORE
2 ; TWO BYTES FROM CEXT2
-1 ; THEN NONE
NULWRD: 0 ; A NULL BYTE
;
; TABLE INDEXED BY BYTE NUMBER GIVING ADDRESS OF RELOCATION
;
RELTAB: REXTAB ; FIRST FROM REXTAB
NULWRD ; SECOND ABSOLUTE
REXT1 ; 3RD FROM TABLE
NULWRD
REXT2 ; 4TH FROM TABLE
NULWRD
; HERE TO DUMP BLOCK TYPE 1 (CODE). FIRST DATA
; WORD IS THE LOAD ADDRESS (WHICH IS RELOCATABLE), THE
; REST ARE CODE. ENTER AT CODINI TO INITILIZE FIRST.
;
CODUMP: MOVEI A,1 ; PUT THE BLOCK --
HRLM A,BLKHED ; -- TYPE INTO HEADER
MOVE A,LOADRS ; PUT THE LOAD ADDRESS INTO --
MOVEM A,BLKDAT ; -- THE FIRST DATA WORD
CALL BLKDMP ; DUMP THE BLOCK
CODINI: AOS BYTCNT ; COUNT A BYTE FOR THE LOAD ADDRESS
TLNN AF,LCRFLG ; LOCATION COUNTER RELOCATABLE?
TDZA A,A ; NO ZERO RELOCATION
MOVEI A,1 ; YES - RELOCATION IS ONE
IDPB A,RELPNT ; OUTPUT RELOCATION BYTE
HRRZM L,LOADRS ; SET LOAD ADDRESS
RET ; RETURN
;
; HERE TO DUMP THE ENTRY POINT BLOCK.
;
ENTOUT: TLNN F,BINBIT ; MAKING BINARY?
RET ; NO - THEN DON'T BOTHER WITH THIS
MOVN S,SYMLEN ; GET - SIZE OF SYMBOL TABLE
HRLZ S,S ; CONVERT TO AOBJN POINTER
ENTOU2: MOVE N,@SYMPNT ; GET A SYMBOL
JUMPE N,ENTOU3 ; SKIP IF NULL
MOVE B,@VALPNT ; YES - GET ITS VALUE
TLNE B,ENTSYM ; IS IT AN ENTRY POINT?
CALL ENTO ; YES - PUT INTO BLOCK
ENTOU3: AOBJN S,ENTOU2 ; PROCESS ALL SYMBOLS
ENTDUN: JRST ENTDMP ; DUMP LAST BLOCK AND EXIT
;
; ROUTINE TO PUT ONE SYMBOL INTO ENTRY BLOCK.
;
ENTO: HRRZ A,BYTCNT ; GET NUMBER ALREADY THERE
CAIL A,DATLEN ; ROOM FOR THIS ONE?
CALL ENTDMP ; NO - DUMP CURRENT BLOCK
CALL GRD50 ; GET RADIX 50 FOR SYMBOL
AOS A,BYTCNT ; COUNT THIS ONE
MOVEM B,BLKDAT-1(A) ; PUT INTO BLOCK
RET ; RETURN
;
; ROUTINE TO DUMP THE ENTRY BLOCK (TYPE 4)
;
ENTDMP: MOVEI A,4 ; SET THE BLOCK --
HRLM A,BLKHED ; -- TYPE IN HEADER
JRST BLKDMP ; DUMP BLOCK AND RETURN
; HERE TO DUMP THE NAME BLOCK
;
NAMOUT: TLNN F,BINBIT ; MAKING BINARY?
RET ; NO - THEN FORGET ABOUT THIS
SETZ N, ; CLEAR SYMBOL DESTINATION
MOVSI C,-6 ; AOBJN POINTER FOR 6 CHARACTERS
MOVE A,[440700,,TITBUF]; POINTER TO TITLE
NAMGCH: ILDB I,A ; GET A CHARACTER FROM THE TITLE
LDB B,ANPNTR ; GET ITS TYPE
XCT NAMET(B) ; IS IT PART OF THE NAME?
JRST NAMDMP ; NO - MUST BE THE END OF IT THEN
CAIN B,.LOW ; YES - IS IT LOWER CASE?
SUBI I,40 ; YES - MAKE IT UPPER
LSH N,6 ; INSERT NEW CHARACTER --
ADDI N,-40(I) ; -- INTO SIXBIT SYMBOL
AOBJN C,NAMGCH ; DO THE WHOLE NAME
;
; HERE WHEN NAME FOUND - DUMP A TYPE 6 (NAME) BLOCK
;
NAMDMP: CALL GRD501 ; GET RADIX 50 (ALREADY RIGHT JUST.)
MOVEM B,BLKDAT ; PUT IT INTO BLOCK
MOVEI A,6 ; PUT TYPE INTO --
HRLM A,BLKHED ; -- BLOCK HEAD
AOS BYTCNT ; COUNT THE WORD
JRST BLKDMP ; DUMP BLOCK AND RETURN
;
; DECISION TABLE FOR SCANNING NAME
;
NAMET: JFCL ; NULL -- IGNORE
JFCL ; SPACE, TAB -- END OF NAME
CAIA ; LETTER -- PART OF NAME
CAIA ; NUMBER -- DITTO
CAIA ; DOT -- DITTO AGAIN
JFCL ; TERMINATOR -- END OF NAME
CAIA ; LOWER CASE -- INCLUDE IN NAME
; ROUTINE TO DUMP THE START BLOCK, SYMBOL
; BLOCKS, AND THE END BLOCK.
;
DUMP2: CALL CODUMP ; DUMP LAST BLOCK OF CODE
CALL BLKINI ; RE-INIT BLOCK
SKIPGE STRTLC ; HAVE A STARTING ADDRESS?
JRST DUMP22 ; NO - THEN NO START BLOCK
MOVEI A,7 ; PUT TYPE OF --
HRLM A,BLKHED ; -- START BLOCK INTO HEADER
HRRZ A,STRTLC ; PUT STARTING ADDRESS --
MOVEM A,BLKDAT ; -- INTO BLOCK
HLRZ A,STRTLC ; GET RELOCATION OF START ADDRESS
IDPB A,RELPNT ; SET RELOCATION OF STARTING ADDRESS
AOS BYTCNT ; ONE DATA WORD
CALL BLKDMP ; DUMP THE BLOCK
;
; NOW DUMP THE SYMBOLS
;
DUMP22: MOVN S,SYMLEN ; GET NUMBER ODAF SYMBOLS
HRLZ S,S ; CONVERT TO AOBJN POINTER
DUMPSM: MOVE N,@SYMPNT ; GET A SYMBOL
JUMPE N,DMPSM3 ; ZERO ->SKIP IT
CALL GRD50 ; GET RADIX 50 VALUE OF SYMBOL
MOVE C,@VALPNT ; GET VALUE OF SYMBOL
TLNE C,UNDSYM+EXTSYM ; UNDEFINED OR EXTERNAL?
JRST DMPSME ; YES - THEY ARE SPECIAL
TLO B,100000 ; NO - ASSUME INTERNAL
TLNE C,ENTSYM ; IS IT AN ENTRY POINT?
TLC B,140000 ; YES - SAY THAT INSTEAD
TLNE C,HKLSYM ; HALF KILLED?
TLO B,400000 ; YES - SET SUPRESS BIT
DMPSM2: MOVE A,BYTCNT ; GET NUMBER OF WORDS IN BUFFER
TLNE C,INDSYM ; A SYMBOL FIXUP --
CAIG A,DATLEN-4 ; -- AND ROOM FOR IT OR --
CAIL A,DATLEN ; ROOM FOR ANOTHER SYMBOL?
CALL DMPSYM ; NO - DUMP CURRENT BLOCK
AOS A,BYTCNT ; COUNT A WORD FOR THE SYMBOL
MOVEM B,BLKDAT-1(A) ; PUT SYMBOL IN BLOCK
IBP RELPNT ; A ZERO RELOCATION BYTE
TLNE C,INDSYM ; VALUE DEPENDENT ON EXTERNAL?
JRST DMPSIN ; YES - OUTPUT THAT DEPENDENCE
AOS A,BYTCNT ; COUNT ONE FOR THE VALUE
HRRZM C,BLKDAT-1(A) ; PUT VALUE INTO BLOCK
TLNN C,RELSYM ; GET THE --
TDZA C,C ; -- RELOCATION OF --
MOVEI C,1 ; -- THE SYMBOL
IDPB C,RELPNT ; PUT IT IN THE RELOCATION WORD
DMPSM3: AOBJN S,DUMPSM ; PROCESS ALL SYMBOLS
CALL DMPSYM ; DUMP THE LAST SYMBOL BLOCK
;
; NOW DUMP THE END BLOCK
;
AOS A,BYTCNT ; COUNT A WORD FOR PROGRAM BREAK
MOVEI B,1 ; RELOCATION OF PROGRAM --
IDPB B,RELPNT ; -- BREAK IS ONE
MOVE B,RELLC ; GET PROGRAM BREAK
HRRZM B,BLKDAT-1(A) ; OUTPUT IT
AOS A,BYTCNT ; COUNT A WORD FOR ABSOLUTE BREAK
MOVE B,ABSLC ; GET ABSOLUTE BREAK
HRRZM B,BLKDAT-1(A) ; PUT IT INTO THE BLOCK
MOVEI A,5 ; SET THE BLOCK --
HRLM A,BLKHED ; -- TYPE FOR END BLOCK
JRST BLKDMP ; DUMP BLOCK AND RETURN
;
; HERE IF SYMBOL IS GLOBAL REFERENCE
;
DMPSME: TLO B,600000 ; SAY SO
JRST DMPSM2 ; AND PROCESS HIM
;
; HERE IF VALUE OF SYMBOL DEPENDS ON AN EXTERNAL.
;
DMPSIN: PUSH P,B ; SAVE THE RADIX50 FOR LATER
MOVE B,INDOFF(C) ; GET THE OFFSET FROM EXTERNAL VALUE
AOS A,BYTCNT ; COUNT A BYTE
MOVEM B,BLKDAT-1(A) ; OUTPUT OFFSET AS VALUE
TLNN C,RELSYM ; OFFSET RELOCATABLE?
TDZA B,B ; NO - RELOCATION IS ZERO
MOVEI B,1 ; YES - RELOCATION IS ONE
IDPB B,RELPNT ; SET RELOCATION
MOVE N,INDREF(C) ; GET EXTERNAL SYMBOL DEPENDENT ON
CALL GRD50 ; GET ITS RADIX 50 REP.
TLO B,600000 ; SAY EXTERNAL REF.
AOS A,BYTCNT ; COUTN BYTE .....
IBP RELPNT ; .....
MOVEM B,BLKDAT-1(A) ; .....
POP P,B ; GET RADIX 50 OF FIRST AGAIN
TLO B,500000 ; SAY IS DEPENDENT
AOS A,BYTCNT ; COUNT BYTE .....
IBP RELPNT ; .....
MOVEM B,BLKDAT-1(A) ; .....
JRST DMPSM3 ; GET NEXT SYMBOL
;
; ROUTINE TO DUMP A TYPE 2 (SYMBOLS) BLOCK
;
DMPSYM: MOVEI A,2 ; SET CORRECT --
HRLM A,BLKHED ; -- BLOCK TYPE
JRST BLKDMP ; DUMP BLOCK AND RETURN
; ROUTINE TO CONVERT THE SIXBIT SYMBOL IN N
; TO RADIX 50 (PDP-10 STYLE) IN B. ENTER AT GRD50
; IF SYMBOL IS LEFT JUSTIFIED, AT GRD501 IF SYMBOL IS
; RIGHT JUSTIFIED.
;
GRD50: TRNE N,77 ; IS SYMBOL RIGHT JUSTIFIED?
JRST GRD501 ; YES - THEN CONVERT IT
LSH N,-6 ; NO - MOVE ONE CHARACTER TO THE RIGHT
JRST GRD50 ; AND CHECK IT AGAIN
GRD501: MOVE A,[440600,,N] ; A BYTE POINTER INTO THE SYMBOL
TDZA B,B ; INITIAL RESULT IS ZIP
GRDLUP: IMULI B,50 ; MULTIPLY PARTIAL RESULT BY 50
ILDB C,A ; GET A CHARACTER FROM SYMBOL
CALL SIXRAD ; GET ITS RADIX 50 CODE
ADDI B,0(C) ; INCLUDE IN RESULT
CAME A,[000600,,N]; IS WE AT END OF SYMBOL?
JRST GRDLUP ; NO - KEEP ON TRUCKIN
RET ; YES - RETURN
;
; ROUTINE TO CONVERT SIXBIT CHARACTER IN C TO
; ITS RADIX 50 (PDP-10 TYPE) CODE IN C.
;
SIXRAD: JUMPE C,CPOPJ ; RETURN ZERO FOR NULLS
CAIN C,'. ; IS IT A DOT?
JRST RADOT ; YES RETURN ITS CODE
CAIN C,'$ ; NO - IS IT A DOLLAR SIGN?
JRST RADOLR ; YES - RETURN THAT CODE
CAIN C,'% ; NO - IS IT A PERCENT SIGN?
JRST RADPER ; YES - RETURN HIS CODE
CAIL C,'0 ; NO - MAYBE IS A --
CAILE C,'9 ; -- DIGIT TYPE GUY?
JRST RAD01 ; NO - MAYBE IS LETTER
MOVEI C,-20+1(C) ; YES - RETURN PROPER CODE
RET ; RETURN
RAD01: CAIL C,'A ; ARE IT --
CAILE C,'Z ; -- A LETTER?
BUG ; NO - SOMETHING IS VERY, VERY WRONG.
MOVEI C,-41+13(C) ; YES - RETURN LETTER CODE
RET ; RETURN
RADOT: MOVEI C,45 ; CODE FOR "."
RET
RADOLR: MOVEI C,46 ; CODE FOR "$"
RET
RADPER: MOVEI C,57 ; CODE FOR "%"
RET
; HERE TO DUMP A RELOCATABLE BLOCK. WORD COUNT
; MUST BE IN BYTCNT, BLOCK TYPE MUST BE IN L.H.
; BLKHED.
;
BLKDMP: SKIPN BYTCNT ; ANY STUFF TO DUMP?
JRST BLKINI ; NO - JUST RE-INIT BLOCK
SAVE A,B,C ; YES - SAVE SOUT ACS
MOVE C,BYTCNT ; GET WORD COUNT
HRRM C,BLKHED ; PUT IN HEADER
MOVNI C,2(C) ; TOTAL BLOCK SIZE FOR SOUT
MOVE B,[444400,,BLKHED]; POINTER TO BLOCK
IFN SAIL,[
MOVE A,B
BLKD3: ILDB B,A
UNIOB BIN
AOJL C,BLKD3
]
.ELSE OUTBFR BIN
REST C,B,A ; RESTORE THE ACS WE CLOBBERED
BLKINI: SETZM BYTCNT ; RESET BYTE COUNTER
SETZM BLKREL ; CLEAR RELOCATION WORD
SETZM BLKHED ; CLEAR HEADER
MOVE A,[440200,,BLKREL]
MOVEM A,RELPNT ; NEW POINTER FOR RELOACTION
RET ; RETURN
]
IFN ITS,[
TSINT: 0 ? 0
SKIPL TSINT ;ONLY ENABLED 1ST WD INT IS PDL OV.
JRST TSINTP
SAVE A ;2ND WD INT, CHECK FOR ^S.
MOVEI A,TTI
.ITYIC A, ;A _ INT. CHARACTER.
JRST TSINT1 ;NONE, DO NOTHING.
CAIE A,^S
JRST TSINT1
SETCMM CTLSF ;COMPLEMENT TYPEOUT SWITCH.
SKIPE CTLSF ;IF JUST TURNED TYPEOUT OFF,, FLUSH ALL.
.RESET TTO,
TSINT1: REST A
.DISMI TSINT+1
TSINTP: SKIPN LINEPP
BUG
MOVE P,LINEPP ;PDL OV INSIDE "LINE": RESTART AT "LINE" AND RESTORE P.
ERROR1 PDL Overflow
.DISMI [LINE]
]
IFN TENEX,[
PSICO: MOVEM A,PSIACA ;^O INTERRUPT. SAVE AC A
MOVE A,TTOJFN
CFOBF ;CLEAR OUTPUT BUFFER
SETCMM CTLSF ;COMPLEMENTS FLAG
MOVE A,PSIACA
DEBRK
]
GETCOR: ;GET CORE
PUSH P,N ;GET A COULPLE OF WORKING REGISTERS
PUSH P,A
IFN ITS,[
LDB A,[121000,,JOBREL]
SYSCAL CORBLK,[1000,,400000 ? 1000,,-1
1000,,(A) ? 1000,,400001]
]
MOVEI A,CORINC ;UPDATE POINTERS
ADDB A,JOBREL
IFN SAIL,[
CORE A,
JRST 4,.
]
POPANJ: POP P,A ;RESTORE REGISTERS
POPNJ: POP P,N
RET
UUOH: 0
SAVE UUOH
SAVE A,B,C
LDB B,[331100,,40]
CAIG B,UUOMAX
JUMPN B,@UUODIS-1(B)
ILLUUO: BUG
UUOXIT: REST C,B,A,UUOH
JRST 2,@UUOH
UUODIS: UERROR
UERR1
UUOMAX==2
CRFOUT: ;OUTPUT WORD TO CREF
CALL CRFOU0 ;OUT TYPE CHAR, SYMBOL.
MOVEI B,CRFSYM ;INDIC. NON-DEFINITION OCCURRENCE.
JRST LSTDMP
;CREF FOR DEFINING OCCURRENCE.
CRFODF: CALL CRFOU0 ;OUTPUT TYPE, SYMBOL.
MOVEI B,CRFOPC ;INDIC. DEFINING OCCURRENCE.
JRST LSTDMP
CRFOU0: SKIPN NOCREF ;IS %XCREF 0?
TLNE A,NCRSYM
JRST POPBJ
TLNN N,770000
JRST POPBJ ;DON'T CREF LOCAL-TAGS
SAVE C ; SAVE VITAL AC'S
LDB B,TYPPNT
XCT CRFTBL(B) ;GET PROPER FLAG CHR IN B
CALL LSTDMP ;LIST CREF TYPE
MOVSI C,440600
CRFOU1: ILDB B,C ;GET A SIXBIT CHARACTER
JUMPE B,CRFOU2 ;BRANCH IF END
ADDI B,40 ;CONVERT TO SIXBIT
CALL LSTDMP ;LIST IT
TLNE C,770000 ;END OF WORD?
JRST CRFOU1 ; NO, GET ANOTHER
CRFOU2: REST C
RET
POPBJ: REST B
RET
CRFTBL: PHASE 0
MOVEI B,CRFSYM
NPOP:: MOVEI B,CRFOPC
PSOP:: MOVEI B,CRFOPC
CNOP:: MOVEI B,CRFOPC
BGOP:: MOVEI B,CRFOPC ;BASIC GROUP
OPOP:: MOVEI B,CRFOPC ;OPERATE GROUP
SCOP:: MOVEI B,CRFOPC
UNOP:: MOVEI B,CRFOPC ;UNARY OP
BCOP:: MOVEI B,CRFOPC ;BRANCH ON CONDITION OP
TROP:: MOVEI B,CRFOPC ;TRAP OP
RTOP:: MOVEI B,CRFOPC
FLOP:: MOVEI B,CRFOPC
MLOP:: MOVEI B,CRFOPC
FSOP:: MOVEI B,CRFOPC
SPOP:: MOVEI B,CRFOPC ;SPECIAL OPS (MARK, SOB)
MAOP:: MOVEI B,CRFMAC
INOP:: MOVEI B,CRFSYM ;PSEUDO-SYMS.
INVOP:: MOVEI B,CRFOPC ;INV PSEUDO
DEPHASE
INSRT: ;INSERT ITEM IN SYMBOL TABLE
CAMN N,NODEFN ;BREAK ON DEFINING TEST SYMBOL.
BUG
MOVEM N,@SYMPNT ;STORE SYMBOL
MOVEM A,@VALPNT ;STORE VALUE
RET
;SEARCH SYMBOL TABLE.
SRCH: MOVM R6,N
IDIV R6,SYMLEN
HRLI S,(S) ;MAKE AOBJN PTR STARTING AT HCODE.
ADD S,SYMAOB
SRCH1: SKIPN R6,@SYMPNT ;0 => NOT FOUND.
JRST SRCH3
CAMN N,R6
JRST SRCH2 ;IF FOUND.
SRCHCT: AOBJN S,SRCH1 ;SEARCH TILL TABLE'S END.
AOBJN S,SRCH1 ;(IN CASE WANT TO CLOBBER PREV. INSN).
MOVE S,SYMAOB ;NOW SEARCH FROM FRONT.
SRCH4: SKIPN R6,@SYMPNT
JRST SRCH3
CAMN R6,N
JRST SRCH2
AOBJN S,SRCH4
JRST ERRTMS ;SYM. TAB. FULL.
SRCH2: MOVE A,@VALPNT ;IF FOUND.
AOS (P)
RET
SRCH3: MOVSI A,UNDSYM ;NOT FOUND, SAY UNDEF.
RET
;COMPRESS SYMBOL TABLE, ELIMINATING UNUSED ENTRIES,
;PREDEFINED SYMS AND MACROS, THEN RESET SYMLEN.
COMPRS: MOVN S,SYMLEN
HRLZI S,(S) ;AOBJN PTR -> SYM. TAB.
HRRZ L,SYMTBA ;RE-INSERT THRU L & V.
HRRZ V,VALPNT
COMPR0: SKIPN A,@SYMPNT ;IF NAME IS 0, SKIP IT.
JRST COMPR1
MOVE B,@VALPNT
TLNE B,SUPSYM+37 ;IF MACRO, OP OR PREDEF, SKIP SYMBOL.
JRST COMPR1
TLNN A,770000 ;DON'T INCLUDE LOCAL TAGS
JRST COMPR1
MOVEM A,(L) ;ELSE PUT BACK LOWER IN SYM. TAB.
MOVEM B,(V)
AOJ L, ;INCREM. RE-INSERTION PTR.
AOJ V,
COMPR1: AOBJN S,COMPR0
SUB L,SYMTBA ;NUM. SYMS RE-INSERTED.
MOVEM L,SYMLEN
MOVNM L,SYMAOB
HRLZS SYMAOB
RET
;SORT SYMTAB INTO ALPHABETICAL ORDER.
SORT: SKIPN B,SYMLEN
RET
SORT1: AOS B ;SORT OVER SMALLER INTERVALS.
LSH B,-1
SORT0: MOVN S,SYMLEN
ADD S,B
MOVSI S,(S)
MOVE L,SYMTBA
ADDI L,(B)
HRRZ V,VALPNT
SUB V,SYMTBA
HRLI V,L
SORT3: MOVE A,@SYMPNT
CAMG A,(L) ;IF EARLIER IS LARGER,
AOJA L,SORT2
EXCH A,(L) ;SWITCH THE STE'S.
MOVEM A,@SYMPNT
MOVE A,@V
EXCH A,@VALPNT
MOVEM A,@V
TLO L,400000 ;SAY DID SOMETHING THIS PASS.
AOJ L,
SORT2: AOBJN S,SORT3
TLZE L,400000 ;IF DID SOMETHING, TRY AGAIN.
JRST SORT0
CAIE B,1
JRST SORT1 ;ELSE TRY SHORTER SPACING.
RET
SYMTB: CALL SORT ;LIST THE SYMBOL TABLE
MOVE S,[[ASCIZ /***Symbol Table*** /],,STITBF]
BLT S,STITBF+5
MOVE S,[STITBF+6,,STITBF+7]
SETZM STITBF+6
BLT S,STITBF+20
SETZ S, ;INITIALIZE POINTER
SYMTB1: SETOM PAGEXT ;MOVE TO NEXT INTEGER PAGE.
TRO F,HDRBIT ;FLAG NEW PAGE
MOVE C,PAGSIZ ;SET LINE COUNT
SUBI C,8
SYMTB2: SKIPE @SYMPNT
CAML S,SYMLEN ;END REACHED?
RET ; YES, EXIT
MOVE R6,S ;SAVE CURRENT POINTER
MOVEI V,SPL ;SET "SYMBOLS PER LINE"
TLNE F,TTYBIT ;TTY?
MOVEI V,SPLTTY ; YES, REDUCE
SYMTB3: SKIPE @SYMPNT
CAML S,SYMLEN
JRST SYMTB4
CALL LSTSTE ;LIST SYMBOL TABLE ENTRY
ADD S,PAGSIZ
SUBI S,8
SOJG V,SYMTB3 ;TEST FOR MORE ITEMS ON LINE
SUB S,PAGSIZ
ADDI S,9
SYMTB4: CALL LSTCR ;END OF LINE, LIST CR/LF
SOJLE C,SYMTB1 ;BRANCH IF END OF PAGE
MOVEI S,1(R6)
JRST SYMTB2 ;OK, PROCESS ANOTHER
LSTSTE: ;LIST SYMBOL TABLE ENTRY
CALL LSTTAB ;LEAD OFF WITH TAB
MOVE A,[440600,,@SYMPNT] ;SIXBIT PTR TO SYMBOL NAME.
LSTST1: ILDB B,A ;GET A CHARACTER
JUMPE B,LSTST2 ;DON'T LIST TRAILING BLANKS
ADDI B,40 ;CONVERT TO ASCII
CALL LSTOUT ;LIST CHARACTER
TLNE A,770000 ;ANY MORE CHARACTERS?
JRST LSTST1 ; YES
LSTST2: CALL LSTTAB
IFN RELCOD,[
MOVE T1,@VALPNT ; GET VALUE
TLNE T1,INDSYM ; DEPENDENT?
SKIPA A,[POINT 3,INDOFF(T1),17]; YES - POINT TO OFFSET
]
MOVE A,[POINT 3,@VALPNT,17] ;SET HEX POINTER
LSTST3: ILDB B,A ;GET OCTAL CHARACTER
ADDI B,"0 ;CONVERT TO ASCII
CALL LSTOUT ;LIST IT
TLNE A,770000 ;ANY MORE BYTES?
JRST LSTST3 ; YES
MOVE A,@VALPNT ;PICK UP VALUE POINTER
IFN RELCOD,[
MOVEI B,"' ; ASSUME RELOCATABLE
TLNN A,RELSYM ; GOOD GUESS?
JRST LSTST4 ; NO - SEE IF IS EXTERNAL
TLNE A,INDSYM ; YES - INDIRECT TOO?
MOVEI B,"! ; YES - INDICATE BOTH
CALL LSTOUT ; OUTPUT INDICATION
JRST LSTST5 ; FINNISH OFF
LSTST4: MOVEI B,"* ; ASSUME EXTERNAL
TLNE A,INDSYM+EXTSYM ; TRUE?
CALL LSTOUT ; YES - LIST THE STAR
LSTST5: MOVEI B,"E ; ASSUME IS ENTRY POINT
TLNE A,ENTSYM ; GOOD ASSUMPTION?
CALL LSTOUT ; YES - INDICATE WITH E
]
MOVEI B,"R
TLNE A,REGSYM ;REGISTER SYMBOL?
CALL LSTOUT ;YES, LIST IT
MOVEI B,"U
TLNE A,UNDSYM ;UNDEFINED?
CALL LSTOUT ;YES, LIST IT
MOVEI B,"H ;FOR HALF KILLED
TLNE A,HKLSYM
CALL LSTOUT
JRST LSTTAB ;OUTPUT A TAB AND EXIT
;PERMANENT SYMBOL TABLE
INITAB:
SIXBIT /BLO/
INISYM+BCOP,,103400
SIXBIT /BHIS/
INISYM+BCOP,,103000
IRP X,,[MOV,CMP,BIT,BIC,BIS]
SIXBIT/X/
INISYM+BGOP,,10000+.IRPCNT_12.
SIXBIT/X!B/
INISYM+BGOP,,110000+.IRPCNT_12.
TERMIN
IRP X,,[CLR,COM,INC,DEC,NEG,ADC,SBC,TST,ROR,ROL,ASR,ASL]
SIXBIT/X/
INISYM+UNOP,,5000+.IRPCNT_6
SIXBIT/X!B/
INISYM+UNOP,,105000+.IRPCNT_6
TERMIN
IRP X,,[BR,BNE,BEQ,BGE,BLT,BGT,BLE]
SIXBIT/X/
INISYM+BCOP,,.IRPCNT_10+400
TERMIN
IRP X,,[BPL,BMI,BHI,BLOS,BVC,BVS,BCC,BCS]
SIXBIT/X/
INISYM+BCOP,,.IRPCNT_10+100000
TERMIN
IRPS X,,HALT WAIT RTI BPT IOT RESET RTT
SIXBIT /X/
INISYM+OPOP,,.IRPCNT
TERMIN
IRPS X,,CLR TST ABS NEG
SIXBIT/X!F/
INISYM+UNOP,,170400+.IRPCN_6
SIXBIT/X!D/
INISYM+UNOP,,170400+.IRPCN_6
TERMIN
IRPS X,,MUL MOD ADD LD SUB CMP UNUSED DIV
IFSN X,UNUSED,[
SIXBIT/X!F/
INISYM+FLOP,,171000+.IRPCN_8
SIXBIT/X!D/
INISYM+FLOP,,171000+.IRPCN_8
]
TERMIN
DEFINE OPS B,A
IRPS X,,[A]
IFE .IRPCN&1, SIXBIT /X/
IFN .IRPCN&1, B,,X
TERMIN TERMIN
OPS INISYM+SPOP,[MARK 1,SOB 2]
OPS INISYM+OPOP,[CCC 257,CLC 241,CLN 250,CLV 242,CLZ 244
CNZ 254,NOP 240,SCC 277,SEC 261,SEN 270,SEV 262,SEZ 264
CFCC 170000,SETF 170001,SETD 170011,SETI 170002,SETL 170012]
OPS INISYM+SCOP,[JSR 4000,XOR 74000]
OPS INISYM+MLOP,[ASH 72000,ASHC 73000,MUL 70000,DIV 71000]
OPS INISYM+UNOP,[MTPI 6600,MTPD 106600,MFPI 6500,MFPD 106500
SXT 6700,SWAB 300,JMP 100
LDFPS 170100,STFPS 170200,STST 170300]
OPS INISYM+TROP,[EMT 104000,TRAP 104400]
OPS INISYM+RTOP,[RTS 200,SPL 230]
OPS INISYM+FLOP,[LDCDF 177400,LDCFD 177400,LDEXP 176400
LDCIF 177000,LDCID 177000,LDCLF 177000,LDCLD 177000]
OPS INISYM+FSOP,[STCFD 176000,STCDF 176000
STCFI 175400,STCFL 175400,STCDI 175400,STCDL 175400
STEXP 175000,STF 174000,STD 174000]
;LSI-11 FLOATING POINT INSTRUCTIONS
OPS INISYM+RTOP,[FADD 075000,FSUB 075010,FMUL 075020,FDIV 075030]
;LSI-11 PS-REFERENCING INSTRUCTIONS
OPS INISYM+UNOP,[MFPS 106700,MTPS 106400]
OPS INISYM+BGOP,[ADD 60000,SUB 160000]
OPS INOP,[%FNAM2 %FNAM2,%. L,%OFFSE LOCTR,%XCREF NOCREF
%XLIST TSLWRD,.RPCNT %RPCNT,.IRPCN %IRPCN,%NARG %NARG
%ABSAD %ABSAD,%COMPA %COMPA,%TTYFL %TTYFL,%SUCCE %SUCCE
%YEAR %YEAR,%MONTH %MONTH,%DAY %DAY]
OPS NPOP,[.LENGT ALENGT,.ADRMD AADRMD,.ADRIX AADRIX]
.ENDCX: OPS PSOP,.ENDC OPCERR
.ENDMX: OPS PSOP,.ENDM OPCERR
.ENDRX: OPS PSOP,.ENDR OPCERR
.MACRX: OPS PSOP,.MACR AMACR
.MACRY: OPS PSOP,.MACRO AMACRO
.REPTX: OPS PSOP,.REPT REPEA0
.TTYMX: OPS PSOP,.TTYMA ATTYMA
OPS PSOP,[COMMEN ACOMNT,.RAD50 RAD50]
IRPS X,,[NLIST PAGE XCREF EJECT END LIST XLIST EVEN ODD BLKB BLKW
INSRT EOT OFFSE IRP IRPC MEXIT IF IIF LIF IFF IFT IFTF ALSO IALSO LALSO
ELSE IELSE LELSE NARG NTYPE NCHR MSG REM ERROR PRINT TITLE STITL SBTTL
WORD BYTE ASCII ASCIZ ENTRY EXTRN ABS FLT2 FLT4 EXPUN]
SIXBIT /.!X/
PSOP,,A!X
TERMIN
IRPS X,,[SEE AUXIL]
SIXBIT /.!X/
INVOP,,A!X
TERMIN
IRP X,,[1,2,B,NB,DF,NDF,G,GE,L,LE,Z,NZ]
SIXBIT/.IF!X/
CNOP,,$IF!X
TERMIN
REPEAT 10,[
.RPCNT_30+SIXBIT/%0/
REGSYM+SUPSYM,,.RPCNT
] ;DEFINE INITIAL REGISTER SYMBOLS.
OPS SUPSYM+LBLSYM,[
%TKS 177560,%TKB 177562,%TKV 60
%TPS 177564,%TPB 177566,%TPV 64
%PKC 172544,%PKCSB 172542,%PKCSR 172540,%PKV 104
%PPS 177554,%PPB 177556,%PPV 74
%PRS 177550,%PRB 177552,%PRV 70
%RKDS 177400,%RKER 177402,%RKCS 177404,%RKWC 177406
%RKBA 177410,%RKDA 177412,%RKMR 177414,%RKDB 177416,%RKV 220
%LKS 177546,%LKV 100
%LPS 177514,%LPB 177516,%LPV 200
%NGCSR 164040,%NGREL 164042
%ERRV 4,%BPTV 14,%IOTV 20,%PWRV 24,%EMTV 30,%TRPV 34
%DIV 177300,%AC 177302,%MQ 177304,%MUL 177306
%SR 177310,%SC 177311,%NOR 177312,%LGS 177314,%LSH 177314,%ARS 177316,%ASH 177316
%PS 177776,%SWR 177570,%PIR 177772,%PIRV 240
%CSR 175000,%BAR 175002,%BCR 175004,%TBR 175006,%DMRV 310,%DMTV 314
%RCSR 174000,%RBUF 174002,%TSCR 174004,%TBUF 174006,%DCRV 300,%DCTV 304
%DRS 177520,%DROB 177522,%DRIB 177524,%DRV1 110,%DRV2 114
%DCS 177460,%DWC 177462,%DCA 177464,%DAR 177466
%DAE 177470,%DBR 177472,%DSA 177476,%DV 204
%WC 177462,%CMA 177464,%ADS 177476
%TCST 177340,%TCCM 177342,%TCWC 177344,%TCBA 177346,%TCDT 177350,%TCV 214
%CRS 177160,%CRB1 177162,%CRB2 177164,%CRV 230
%MTS 172520,%MTC 172522,%MTBRC 172524,%MTCMA 172526,%MTD 172530
%MTRD 172532,%MTV 224
%RCLA 177440,%RCDA 177442,%RCER 177444,%RCCS 177446,%RCWC 177450
%RCCA 177452,%RCMN 177454,%RCDB 177456,%RCV 210
%AFCS 172570,%AFBR 172572,%AFMR 172576,%AFV 134
%ADCS 176770,%ADDB 176772,%ADV 130
%DACS 176756,%DAC1 176760,%DAC2 175762,%DAC3 176704,%DAC4 176704
%DAV1 140,%DAV2 144
%UDCS 171776,%UDSR 171774,%UDV 234
]
;STUFF FOR ANTS IMP INTERFACE, SOME TRAP VECTORS
IRP X,,[IIV,IOV
SPI,EPI,IS1,IS2,SPO,EPO,OS1,OS2]NUM,,[170,174
164000,164002,164004,164006,164010,164012,164014,164016]
SIXBIT /%!X/
SUPSYM+LBLSYM,,NUM
TERMIN
INILEN==.-INITAB
;CHARACTER DISPATCH ROUTINES
C1PNTR: 420200+I,,CHJTBL
C4PNTR: 360400+I,,CHJTBL
ANPNTR: 330300+I,,CHJTBL
CPNTRM: 300300+I,,CHJTBL
SQPNTR: 220600,,CHJTBL(I) ;SQUOZE CODE FOR CHAR, OR 0.
DEFINE XBYTE $1,$2,$3,$4,$5
.WALGN
$1+0?$2+0?$3+0?$4+0?$5+0
TERMIN
CHJTBL: .BYTE 2,4,3,3,6
XBYTE MACR, ,.TRM, ;
XBYTE , , , ;
XBYTE , , , ;
XBYTE MACR, ,.TRM, ;
XBYTE , , , ;
XBYTE , , , ;
XBYTE , , , ;
XBYTE , , , ;
XBYTE , , , ;
XBYTE MASP, ,.TAB,TERMSP ; TAB
XBYTE MACR,EXND,.TRM, ; LF
XBYTE , , , ;
XBYTE , , , ; FF
XBYTE MACR,EXND,.TRM, ; CR
REPEAT 22,XBYTE
XBYTE MASP, ,.TAB,TERMSP ; SPACE
XBYTE ,EXOR,.TRM, ; !
XBYTE ,EXTM,.TRM,TERMQ2 ; "
XBYTE ,EXXR,.TRM, ; #
XBYTE ,EXTM,.ALP,TERMSY,33; $
XBYTE ,EXTM,.ALP,TERMSY,35; %
XBYTE ,EXAN,.TRM, ; &
XBYTE ,EXTM,.TRM,TERMQ1 ; '
XBYTE ,EXND,.TRM, ; (
XBYTE ,EXND,.TRM, ; )
XBYTE ,EXML,.TRM, ; *
XBYTE ,EXPL,.TRM,TERMSP ; +
XBYTE MACM,EXND,.TRM, ; ,
XBYTE ,EXMI,.TRM,TERMMI ; -
XBYTE ,EXTM,.DOT,TERMSY,34; .
XBYTE ,EXDV,.TRM, ; /
REPEAT 12,XBYTE ,EXTM,.NUM,TERMDG,.RPCNT+36 ;DIGITS.
XBYTE , ,.TRM, ; :
XBYTE MACR,EXND,.TRM, ; ;
XBYTE ,EXTM,.TRM,TERMOB ; <
XBYTE , ,.TRM, ; =
XBYTE ,EXND,.TRM, ; >
XBYTE , , , ; ?
XBYTE , ,.TRM, ; @
REPEAT 32,XBYTE ,EXTM,.ALP,TERMSY,.RPCNT+1 ;LETTERS
XBYTE , , , ; [
XBYTE , , , ; \
XBYTE , , , ; ]
XBYTE , , , ; ^
XBYTE ,EXLA,.TRM, ; _
XBYTE ;LOWER CASE @.
REPEAT 32,XBYTE ,EXTM,.LOW,TERMSY,.RPCNT+1 ;LOWER CASE LETTERS.
REPEAT 5,XBYTE ;FUNNY LOWER CASE CHARS.
.BYTE
IFN .-CHJTBL-200,.ERR CHJTBL WRONG # ENTRIES.
CONSTA
VARIAB
MACPDL: BLOCK 1000 ;MACRO PDL.
-1
JOBFFI:
;.5KILL ALL SMALL SYMBOLS EXCEPT REGS.
IRP X,,[MACR,MASP,MACM,CL1,CL2,CL3,CL4,CL5,CL6,CL7
QUEARG,QUEMAC,TAB,FF,CRR,SPACE,INDBIT,RUBOUT
TERMSP,TERMDG,TERMSY,TERMMI,TERMOB,TERMQ1,TERMQ2]
X==X
TERMIN
END PALX11