.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 TENEX, NEWBIN==1 ;;newbin==1 turn this on to force ITS newbin for making NPALX IFNDEF NEWBIN, NEWBIN==0 IF1 [ IFN ITS,[ IFE NEWBIN,[ PRINTX/Defaulting assembly to old (large) Palx output format. To use new format the NEWBIN assembly flag should be set to 1 /] .ELSE [ PRINTX/Defaulting assembly to new (compressed) Palx output format. To use old format the NEWBIN assembly flag should be set to 0. / ] ] ] 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. %LSCAL==1000 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. %OPSYS: 0 ;OPERATING SYSTEM, SO PALX CAN DO .IF Z %OPSYS-"TW %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 ] ;; buffer for ITS output conversion ifn its&newbin,[ outbuf: block datlen ; block for converting words to bytes, needs to be ; as large as DATBLK cause symbols don't shrink?? outbp: 441000,,outbuf ; byte pointer to output buffer ; used for leftover bytes ] BINDEV: 0 ;BINARY OUTPUT FILE NAMES. BINFN1: 0 BINFN2: 0 BINSNM: 0 BINTNM: 'BINOUT ;TEMP. FN2 TO USE. BINJFN: -TENEX+IFN ITS+SAIL,BIN IFE NEWBIN, BINMOD: 7 ;BLOCK IMAGE OUT. IFN NEWBIN, BINMOD: .uio 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] SYSCL TTYSET,[1000,,TTI ? [222020,,202020] ? [232020,,220220]] JFCL ;in case it is not a TTY 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 its&newbin,[ move a,[441000,,outbuf] movem a,outbp ] 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 IFN ITS, MOVEI N,"I+"T_8 ;%OPSYS IS ITS IFN SAIL, MOVEI N,"S+"A_8 ;%OPSYS IS SAIL IFN TENEX,[ ;%OPSYS IS TENEX OR TWENEX IFN TWENEX, MOVEI N,"T+"W_8 ;%OPSYS IS TWENEX IFE TWENEX, MOVEI N,"T+"E_8 ;%OPSYS IS TENEX ] MOVEM N,%OPSYS ;SAVE 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. ;; doubled symbol table size to 2**11 from 2**10 -CBF 8 Jan 83 MOVEI A,2_11. ;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 IFN NEWBIN,IFE RELCOD,MOVE B,[SIXBIT /PBIN/] IFE NEWBIN,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 MOVE A,MOD(S) MOVEI B,8 TRNE A,10 DPB B,[300600,,PNT(S)] ; CHANGE BYTE SIZE TO 8 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> ifn its&newbin, pushj p,outblk .else 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 ; ; .ENDC AIF: CALL CNT ;PROCESS CONDITION, SKIP IF TRUE. JRST UNCOND ;FAILED, SKIP BODY. JRST STCOND ;PROCESS THE BODY. ;.IIF , 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 ; 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 ; ; .ENDC AALSO: SKIPN %SUCCESS JRST UNCOND ;LAST WAS FALSE, THIS FAILS ALSO JRST STCOND ;TRUE, PROCESS BODY ; .ELSE ; ; .ENDC AELSE: SKIPE %SUCCESS ;TEST WHETHER LAST COND WAS FALSE JRST UNCOND ;TRUE, SKIP BODY. JRST STCOND ;FALSE, PROCESS THE BODY ;.IELSE AIELSE: SKIPE %SUCCESS ;REVERSE SENSE OF %SUCCESS JRST [SETZM %SUCCESS JRST ENDLR] MOVEM P,%SUCCESS ;LAST FAILED SO PROCESS JRST STMNT ;.IALSO AIALSO: SKIPN %SUCCESS JRST ENDLR JRST STMNT ;PROCESS IT ;.LELSE ; ALELSE: SKIPE %SUCCESS ;"COMPLEMENT" %SUCCESS JRST [SETZM %SUCCESS CALL ENDLR JRST ENDLR] MOVEM P,%SUCCESS ;ONLY SET LOW 16 BITS JRST ENDLR ;.LALSO ; 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_(A) ADDI A,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, 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,>" HAS 2 ARGS CAIA ;WHICH ARE "FOO" AND "". 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 \ -- 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,-(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,- ;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 NEWBIN,[ CALL SYMOUT MOVE B,@VALPNT ANDCMI B,600000 ;DON'T LET HIGH BITS CONFUSE 11SIM. CALL SYMOUT ;WRITE VALUE, TOO. ] IFN NEWBIN,[ CALL RADOUT HLRZ B,@VALPNT CALL WRDOUT HRRZ B,@VALPNT CALL WRDOUT ] AOBJN S,DUMP3 IFN NEWBIN,[ MOVEI B,0 CALL WRDOUT CALL WRDOUT CALL WRDOUT CALL WRDOUT ] RET IFN NEWBIN,[ 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 ;-,,0 SETZ B, ;GET - 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&NEWBIN,[ pushj p,outblk ] .ELSE [ 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 its&newbin,[ outblk: ;; BYTE POINTER TO DATBLK IN B, - IN C, smashes A hrlz c,c ; make into aobjn pointer hrr c,b blkd9: move a,(c) ; get a byte idpb a,outbp aobjn c,blkd9 move a,@outbp ; save last word in case its not complete move c,outbp ; calculate number of words to output tlnn c,400000 ; unless we ended exaclty ona word boundary sos outbp hrrz c,outbp subi c,outbuf-1 move b,[444400,,outbuf] syscal siot,[movei bin ? b ? c ] movei b,outbuf ; reset byte pointer to beginning of buffer hrrm b,outbp ; leaving any byte offset intact movem a,outbuf ; and put the last word at beginning of next buffer popj p, ] 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 %OPSYS %OPSYS %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