--- /dev/null
+TITLE MACRO.V36\r
+SUBTTL RPG/CMF/JF/PMH/DMN 7-SEPT-71\r
+;COPYRIGHT 1968,1969,1970,1971, DIGITAL EQUIPMENT CORP., MAYNARD, MASS.\r
+\r
+\r
+ LOC <JOBVER==137>\r
+ OCT 37\r
+ RELOC\r
+ MLON\r
+\r
+REPEAT 0,<\r
+ ASSEMBLY FEATURE SWITCHES (ACTION WHEN NON-ZERO)\r
+\r
+ SWITCHES ON (NON-ZERO) IN DEC VERSION\r
+PURESW GIVES VARIABLES IN LOW SEGMENT\r
+CCLSW GIVES RAPID PROGRAM GENERATION FEATURE\r
+FTDISK GIVES DISK FEATURES\r
+RUNSW USE RUN UUO FOR "DEV:NAME!"\r
+TEMP TMPCOR UUO IS TO BE USED\r
+RENTSW ASSEMBLE REENTERANT PROGRAMS\r
+\r
+>\r
+\fSUBTTL DEFAULT ASSEMBLY SWITCH SETTINGS\r
+\r
+IFNDEF PURESW,<PURESW==1>\r
+\r
+IFNDEF RUNSW,<RUNSW==1>\r
+\r
+IFNDEF RENTSW,<RENTSW==1>\r
+\r
+IFNDEF CCLSW,<CCLSW==1>\r
+IFN CCLSW,<FTDISK==1>\r
+\r
+IFNDEF TEMP,<TEMP==1>\r
+\r
+IFNDEF FTDISK,<FTDISK==0>\r
+\r
+\fSUBTTL OTHER PARAMETERS\r
+\r
+.PDP== ^D40 ;BASIC PUSH-DOWN POINTER\r
+IFNDEF LPTWID,<LPTWID==^D132> ;DEFAULT WIDTH OF PRINTER\r
+.LPTWD==8*<LPTWID/8> ;USEFUL WIDTH IN MAIN LISTING\r
+.CPL== .LPTWD-^D40 ;WIDTH AVAIABLE FOR TEXT WHEN\r
+ ;BINARY IS IN HALFWORD FORMAT\r
+.LPP==^D55 ;LINES/PAGE\r
+.STP== ^D40 ;STOW SIZE\r
+.TBUF== ^D80 ;TITLE BUFFER\r
+.SBUF== ^D80 ;SUB-TITLE BUFFER\r
+.IFBLK==^D5 ;IFIDN COMPARISON BLOCK SIZE\r
+.R1B==^D18\r
+.LEAF==4 ;SIZE OF BLOCKS IN MACRO TREE\r
+\r
+NCOLS==LPTWID/^D40 ;NUMBER OF COLUMNS IN SYMBOL TABLE\r
+IFN CCLSW,<IFNDEF CTLSIZ,<CTLSIZ==^D79>>\r
+IFNDEF NUMBUF,<NUMBUF==2 ;NUMBER OF INPUT BUFFERS>\r
+\r
+EXTERN JOBREL,JOBSYM,JOBDDT,JOBFF,JOBAPR,JOBSA\r
+IFN CCLSW,< EXTERN JOBERR>\r
+\r
+IFN PURESW,< HISEG >\r
+\r
+;SOME ASCII CHARACTERS\r
+\r
+HT==11\r
+LF==12\r
+VT==13\r
+FF==14\r
+CR==15\r
+EOL==33\r
+\f ;ACCUMULATORS\r
+AC0== 0\r
+AC1= AC0+1\r
+AC2= AC1+1\r
+SDEL= 3 ;SEARCH INCREMENT\r
+SX= SDEL+1 ;SEARCH INDEX\r
+ARG= 5 ;ARGUMENT\r
+V= 6 ;VALUE\r
+C= 7 ;CURRENT CHARACTER\r
+CS= C+1 ;CHARACTER STATUS BITS\r
+RC= 11 ;RELOCATION BITS\r
+MWP= 12 ;MACRO WRITE POINTER\r
+MRP= 13 ;MACRO READ POINTER\r
+IO= 14 ;IO REGISTER (LEFT)\r
+ER== IO ;ERROR REGISTER (RIGHT)\r
+FR= 15 ;FLAG REGISTER (LEFT)\r
+RX== FR ;CURRENT RADIX (RIGHT)\r
+MP= 16 ;MACRO PUSHDOWN POINTER\r
+PP= 17 ;BASIC PUSHDOWN POINTER\r
+\r
+%OP== 3\r
+%MAC== 5\r
+%DSYM== 2\r
+%SYM== 1\r
+%DMAC== %MAC+1\r
+\r
+OPDEF RESET [CALLI 0]\r
+OPDEF SETDDT [CALLI 2]\r
+OPDEF DDTOUT [CALLI 3]\r
+OPDEF DEVCHR [CALLI 4]\r
+OPDEF CORE [CALLI 11]\r
+OPDEF EXIT [CALLI 12]\r
+OPDEF UTPCLR [CALLI 13]\r
+OPDEF DATE [CALLI 14]\r
+OPDEF APRENB [CALLI 16]\r
+OPDEF MSTIME [CALLI 23]\r
+OPDEF PJOB [CALLI 30]\r
+OPDEF RUN [CALLI 35]\r
+OPDEF TMPCOR [CALLI 44]\r
+OPDEF MTWAT. [MTAPE 0]\r
+OPDEF MTREW. [MTAPE 1]\r
+OPDEF MTEOT. [MTAPE 10]\r
+OPDEF MTSKF. [MTAPE 16]\r
+OPDEF MTBSF. [MTAPE 17]\r
+\r
+\f ;FR FLAG REGISTER (FR/RX)\r
+IOSCR== 000001 ;NO CR AFTER LINE\r
+MTAPSW==000004 ;MAG TAPE\r
+ERRQSW==000010 ;IGNORE Q ERRORS\r
+LOADSW==000020 ;END OF PASS1 & NO EOF YET\r
+DCFSW== 000040 ;DECIMAL FRACTION\r
+RIM1SW==000100 ;RIM10 MODE\r
+NEGSW== 000200 ;NEGATIVE ATOM\r
+RIMSW== 000400 ;RIM OUTPUT\r
+PNCHSW==001000 ;RIM/BIN OUTPUT WANTED\r
+CREFSW==002000\r
+R1BSW== 004000 ;RIM10 BINARY OUTPUT\r
+TMPSW== 010000 ;EVALUATE CURRENT ATOM\r
+INDSW== 020000 ;INDIRECT ADDRESSING WANTED\r
+RADXSW==040000 ;RADIX ERROR SWITCH\r
+FSNSW== 100000 ;NON BLANK FIELD SEEN\r
+MWLFLG==200000 ;ON FOR DON'T ALLOW MULTI-WORD LITERALS\r
+P1== 400000 ;PASS1\r
+\r
+ ;IO FLAG REGISTER (IO/ER)\r
+FLDSW== 400000 ;ADDRESS FIELD\r
+IOMSTR==200000\r
+ARPGSW==100000 ;ALLOW RAPID PROGRAM GENERATION\r
+IOPROG==040000 ;SUPRESS LISTING (LIST/XLIST PSEUDO OP)\r
+NUMSW== 020000\r
+IOMAC== 010000 ;MACRO EXPANSION IN PROGRESS\r
+IOPALL==004000 ;SUPRESS LISTING OF MACRO EXPANSIONS\r
+IONCRF==002000 ;SUPRESS OUTPUT OF CREF INFORMATION\r
+CRPGSW==001000 ;CURRENTLY IN PROGRESS ON RPG\r
+IOCREF==000400 ;WE ARE NOW OUTPUTTING CREF INFO\r
+IOENDL==000200 ;BEEN TO STOUT\r
+IOPAGE==000100\r
+DEFCRS==000040 ;THIS IS A DEFINING OCCURANCE (MACROS)\r
+IOIOPF==000020 ;IOP INSTRUCTION SEEN\r
+MFLSW== 000010 ;MULTI-FILE MODE,PRGEND SEEN\r
+IORPTC==000004 ;REPEAT CURRENT CHARACTER\r
+IOTLSN==000002 ;TITLE SEEN\r
+IOSALL==000001 ;SUPPRESS MACRO LISTING EVEN IF BINARY IS GENERATED\r
+\r
+OPDEF JUMP1 [JUMPL FR, ] ;JUMP IF PASS 1\r
+OPDEF JUMP2 [JUMPGE FR, ] ;JUMP IF PASS 2\r
+\r
+OPDEF JUMPOC [JUMPGE IO, ] ;JUMP IF IN OP-CODE FIELD\r
+OPDEF JUMPAD [JUMPL IO, ] ;JUMP IF IN ADDRESS FIELD\r
+\r
+OPDEF JUMPCM [JUMPL CS, ] ;JUMP IF CURRENT CHAR IS COMMA\r
+OPDEF JUMPNC [JUMPGE CS, ] ;JUMP IF CURRENT CHAR IS NON-COMMA\r
+\r
+\f ;ER ERROR REGISTERS (IO/ER)\r
+ERRM== 000020 ;MULTIPLY DEFINED SYMBOL\r
+ERRE== 000040 ;ILLEGAL USE OF EXTERNAL\r
+ERRP== 000100 ;PHASE DISCREPANCY\r
+ERRO== 000200 ;UNDEFINED OP CODE\r
+ERRN== 000400 ;NUMBER ERROR\r
+ERRV== 001000 ;VALUE PREVIOUSLY UNDEFINED\r
+ERRU== 002000 ;UNDEFINED SYMBOL\r
+ERRR== 004000 ;RELOCATION ERROR\r
+ERRL== 010000 ;LITERAL ERROR\r
+ERRD== 020000 ;REFERENCE TO MULTIPLY DEFINED SYMBOL\r
+ERRA== 040000 ;PECULIAR ARGUMENT\r
+ERRX== 100000 ;MACRO DEFINITION ERROR\r
+ERRQ== 200000 ;QUESTIONABLE, NON-FATAL ERROR\r
+ERRORS==777760\r
+LPTSW== 000002\r
+TTYSW== 000001\r
+\r
+ ;SYMBOL TABLE FLAGS\r
+SYMF== 400000 ;SYMBOL\r
+TAGF== 200000 ;TAG\r
+NOOUTF==100000 ;NO DDT OUTPUT WFW\r
+SYNF== 040000 ;SYNONYM\r
+MACF== SYNF_-1 ;MACRO\r
+OPDF== SYNF_-2 ;OPDEF\r
+PNTF== 004000 ;"VALUE" IN SYMBOL TBL IS PNTR TO 36BIT VALUE\r
+UNDF== 002000 ;UNDEFINED\r
+EXTF== 001000 ;EXTERNAL\r
+INTF== 000400 ;INTERNAL\r
+ENTF== 000200 ;ENTRY\r
+VARF== 000100 ;VARIABLE\r
+MDFF== 000020 ;MULTIPLY DEFINED\r
+SPTR== 000010 ;SPECIAL EXTERNAL POINTER\r
+SUPRBT==000004 ;SUPRESS OUTPUT TO DDT\r
+LELF== 000002 ;LEFT HAND RELOCATABLE\r
+RELF== 000001 ;RIGHT HAND RELOCATABLE\r
+\r
+LITF== 200000 ;FLAG FOR PSEUDO-OPS INVALID IN LIT'S\r
+ADDF== 100000 ;FLAG FOR PSEUDO-OPS INVALID IN ADDRESSES\r
+\r
+TNODE== 200000 ;TERMINAL NODE FOR EVALEX\r
+\f\r
+;USEFUL MACROS\r
+\r
+DEFINE FORERR(AC,ABC)<\r
+ MOVE AC,SEQNO2\r
+ MOVEM AC,ABC'SEQ\r
+ MOVE AC,PAGENO\r
+ MOVEM AC,ABC'PG\r
+>\r
+\r
+\f\r
+IFN CCLSW,< ;ASSEMBLE IF RUN UUO IMPLEMENTED\r
+NUNSET: SKIPN ACDEV\r
+ MOVSI ACDEV,(SIXBIT /SYS/) ;USE SYS IF NONE SPECIFIED\r
+IFN RUNSW,<\r
+ MOVEM ACDEV,RUNDEV\r
+ MOVEM ACFILE,RUNFIL ;STORE FILE NAME\r
+ PUSHJ PP,DELETE ;COMMAND FILE\r
+ SETZM RUNPP\r
+ MOVEI 16,RUNDEV ;XWD 0,RUNDEV\r
+ TLNE IO,CRPGSW ;WAS RPG IN PROGRESS?\r
+ HRLI 16,1 ;YES START NEXT AT C(JOBSA)+1\r
+ RUN 16, ;DO "RUN DEV:NAME"\r
+ HALT ;SHOULD'T RETURN. HALT IF IT DOES\r
+>\r
+IFE RUNSW,<POPJ PP, >\r
+\r
+DELETE: HRRZ EXTMP ;IF THE EXTENSION\r
+ CAIE (SIXBIT /TMP/) ;IS .TMP\r
+ POPJ PP, ;RETURN\r
+ CLOSE CTL2, ;DELETE\r
+ SETZB 4,5 ;THE COMMAND FILE.\r
+ SETZB 6,7\r
+ RENAME CTL2,4 ;\r
+ JFCL\r
+ POPJ PP,\r
+>\r
+\fSUBTTL START ASSEMBLING\r
+\r
+ASSEMB: PUSHJ PP,INZ ;INITIALIZE FOR PASS\r
+ MOVE [ASCII /.MAIN/]\r
+ MOVEM TBUF\r
+ MOVEI SBUF\r
+ HRRM SUBTTX\r
+\r
+ASSEM1: PUSHJ PP,CHARAC ;TEST FOR FORM FEED\r
+ CAIN C,14\r
+ SKIPE SEQNO\r
+ JRST ASSEM2\r
+ PUSHJ PP,OUTFF\r
+ PUSHJ PP,OUTLI\r
+ JRST ASSEM1\r
+\r
+ASSEM2: AOS TAGINC\r
+ CAIN C,15\r
+ JRST ASSEM3\r
+ CAIN C,"\" ;BACK-SLASH?\r
+ TLZA IO,IOMAC ;YES, LIST IF IN MACRO\r
+ TLO IO,IORPTC\r
+ PUSHJ PP,STMNT ;OFF WE GO\r
+ TLZN IO,IOENDL ;WAS STOUT PRE-EMPTED?\r
+ PUSHJ PP,STOUT\r
+ JRST ASSEM1\r
+ASSEM3: PUSHJ PP,STOUT+1\r
+ JRST ASSEM1\r
+\r
+\fSUBTTL STATEMENT PROCESSOR\r
+\r
+STMNT: TLZ FR,INDSW\r
+ TLZA IO,FLDSW\r
+STMNT1: PUSHJ PP,LABEL\r
+STMNT2: PUSHJ PP,ATOM ;GET THE FIRST ATOM\r
+ CAIN C,35 ;"="?\r
+ JRST ASSIGN ;YES\r
+ CAIN C,32 ;":"?\r
+ JRST STMNT1 ;YES\r
+ JUMPAD STMNT7 ;NUMERIC EXPRESSION\r
+ SKIPE C\r
+ TLO IO,IORPTC\r
+ SKIPN AC2,AC0\r
+ POPJ PP,\r
+ PUSHJ PP,MSRCH ;SEARCH FOR MACRO/OPDEF/SYN\r
+ JRST STMNT3 ;NOT FOUND, TRY OP CODE\r
+ LDB SDEL,[POINT 3,ARG,5]\r
+ JUMPE SDEL,ERRAX ;ERROR IF NO FLAG\r
+ SOJE SDEL,OPD1 ;OPDEF IF 1\r
+ SOJE SDEL,CALLM ;MACRO IF 2\r
+ JRST STMNT4 ;SYNONYM, PROCESS WITH OP-CODES\r
+\r
+STMNT3: PUSHJ PP,OPTSCH ;SEARCH OP CODE TABLE\r
+ JRST STMNT5 ;NOT FOUND\r
+STMNT4: HLLZ AC0,V ;PUT CODE IN AC0\r
+ TRZE V,LITF ;VALID IN LITERAL?\r
+ SKIPN LITLVL ;NO, ARE WE IN A LITERAL?\r
+ JRST 0(V) ;NO, GO TO APPRORIATE PROCESSOR\r
+ MOVE AC0,AC2\r
+\r
+STMNT5: PUSHJ PP,SSRCH ;TRY SYMBOLS\r
+ JRST STMNT8 ;NOT FOUND\r
+ TLNE ARG,EXTF!UNDF ;EXTERNAL OR UNDEFINED?\r
+ JRST STMNT7 ;YES, PROCESS IN EVALEX\r
+ TLNN RC,-2 ;CHECK FOR EXTERNAL\r
+ TRNE RC,-2\r
+ JRST STMNT7\r
+ MOVE AC0,V ;FOUND, PUT VALUE IN AC0\r
+ TLO IO,NUMSW ;FLAG AS NUMERIC\r
+STMNT7: TLZ IO,IORPTC\r
+ PUSHJ PP,EVALHA ;EVALUATE EXPRESSION\r
+ JRST STOW ;YES,STOW THE CODE AND EXIT\r
+\r
+\fSTMNT8: SETZB AC0,RC ;CLEAR VALUE AND RELOCATION\r
+ TRO ER,ERRO ;FLAG AS UNDEIFNED OP-CODE\r
+ JRST OPD\r
+\r
+ ;STATEMENT OUT PASSES REMAINDER OF LINE (CMNT)\r
+ ;UNTIL A LINE TERMINATOR IS SEEN.\r
+STOUTS: TLO IO,IOENDL\r
+STOUT: TLO IO,IORPTC\r
+ PUSHJ PP,BYPAS1\r
+ CAIN C,14 ;COMMA?\r
+ SKIPL STPX ;YES, ERROR IF CODE STORED\r
+ CAIN C,33\r
+ TLOA IO,IORPTC\r
+ TRO ER,ERRQ\r
+STOUT1: PUSHJ PP,CHARAC\r
+ CAIGE C,CR\r
+ CAIG C,HT\r
+ JRST STOUT1\r
+ JRST OUTLIN\r
+\f SUBTTL LABEL PROCESSOR\r
+\r
+LABEL: JUMPAD LABEL4 ;COMPARE IF NON-SYMBOLIC\r
+ JUMPE AC0,LABEL5 ;ERROR IF BLANK\r
+ MOVEM AC0,TAG\r
+ HLLZS AC0,TAGINC\r
+ TLO IO,DEFCRS ;THIS IS A DEFINITION\r
+ PUSHJ PP,SSRCH ;SEARCH FOR OPERAND\r
+ MOVSI ARG,SYMF!UNDF!TAGF ;NOT FOUND\r
+ TLNE ARG,EXTF ;UNDEFINED ON PASS1\r
+ JRST LABEL3 ;NO, FLAG ERROR\r
+ TLZN ARG,UNDF!VARF\r
+ JRST LABEL2 ;YES, CHECK EQUALITY\r
+LABEL1: MOVE V,LOCA ;WFW\r
+ MOVE RC,MODA\r
+ TLO ARG,TAGF\r
+ JRST INSERT ;INSERT/UPDATE AND EXIT\r
+\r
+LABEL2: HRLOM V,LOCBLK ;SAVE LIST LOCATION\r
+ TLNE ARG,40\r
+ JRST LABEL6\r
+LABEL0: CAMN V,LOCA ;DOES IT COMPARE WITH PREVIOUS? WFW\r
+ CAME RC,MODA\r
+LABEL3: TLOA ARG,MDFF ;NO, FLAG MULTIPLY DEFINED AND SKIP\r
+ POPJ PP,\r
+ TRO ER,ERRM ;FLAG MULTIPLY DEFINED ERROR\r
+ JRST UPDATE ;UPDATE AND EXIT\r
+\r
+LABEL4: CAMN AC0,LOCA ;DO THEY COMPARE?\r
+ CAME RC,MODA\r
+LABEL5: TRO ER,IOPAGE ;NO, FLAG PHASE ERROR\r
+ POPJ PP,\r
+\r
+LABEL6: JUMP1 LABEL1\r
+ TRO ER,IOMSTR\r
+ TLZ ARG,40\r
+ PUSHJ PP,UPDATE\r
+ JRST LABEL0\r
+\fSUBTTL ATOM PROCESOR\r
+ATOM: PUSHJ PP,CELL ;GET FIRST CELL\r
+ TLNE IO,NUMSW ;IF NON-NUMERIC\r
+ATOM1: CAIE C,42 ;OR NOT A BINARY SHIFT,\r
+ POPJ PP, ;EXIT\r
+\r
+ PUSH PP,AC0 ;STACK REGISTERS, ITS A BINARY SHIFT\r
+ PUSH PP,AC1\r
+ PUSH PP,RC\r
+ PUSH PP,RX\r
+ HRRI RX,^D10 ;COMPUTE SHIFT RADIX 10\r
+ PUSHJ PP,CELLSF ;GET SHIFT\r
+ MOVE ARG,RC ;SAVE RELOCATION\r
+ POP PP,RX ;RESTORE REGISTERS\r
+ POP PP,RC\r
+ POP PP,AC1\r
+ MOVN SX,AC0 ;USE NEGATIVE OF SHIFT\r
+ POP PP,AC0\r
+ SKIPN 0,5\r
+ TLNN IO,NUMSW ;AND NUMERIC,\r
+ JRST NUMER2\r
+ LSHC AC0,^D35(SX)\r
+ LSH RC,^D35(SX)\r
+ JRST ATOM1\r
+\fCELLSF: TLO IO,FLDSW\r
+CELL: SETZB AC0,RC ;CLEAR RESULT AND RELOCATION\r
+ SETZB AC1,AC2 ;CLEAR WORK REGISTERS\r
+ MOVEM PP,PPTEMP ;SAVE PUSHDOWN POINTER\r
+ TLZ IO,NUMSW\r
+ TLZA FR,NEGSW!DCFSW!RADXSW\r
+\r
+CELL1: TLO IO,FLDSW\r
+ PUSHJ PP,BYPAS1\r
+ LDB V,[POINT 4,CSTAT(C),14] ;GET CODE\r
+ XCT .+1(V) ;EXECUTE, INDEX VIA BITS 11,12,13,14 OF CSTAT TABLE\r
+ JRST CELL1 ;0; BLANK, (TAB OR "+")\r
+ JRST LETTER ;1; LETTER ] $ % ( ) , ; >\r
+ TLC FR,NEGSW ;2; "-"\r
+ TLO FR,INDSW ;3; "@"\r
+ JRST NUM1 ;4; NUMERIC 0 - 9\r
+ JRST ANGLB ;5; "<"\r
+ JRST SQBRK ;6; "["\r
+ JRST QUOTES ;7; """, "'"\r
+ JRST QUAL ;10; "^"\r
+ JRST PERIOD ;11; "."\r
+ TROA ER,ERRQ ;12; ERROR, FLAG AND TREAT AS DELIMITER\r
+ ;12; ! # & * / : = ? \ _\r
+\fLETTER: TLOA AC2,(POINT 6,AC0,) ;SET BYTE POINTER\r
+LETTE1: PUSHJ PP,GETCHR ;GET CHARACTER\r
+ TLNN CS,6 ;ALPHA-NUMERIC\r
+ JRST LETTE3 ;NO,TEST FOR VARIABLE\r
+ TLNE AC2,770000 ;STORE ONLY SIX BYTES\r
+LETTE2: IDPB C,AC2 ;RETURN FROM PERIOD\r
+ JRST LETTE1\r
+\r
+LETTE3: CAIE C,03 ;"#"?\r
+ POPJ PP,\r
+ JUMPE AC0,POPOUT ;TEST FOR NULL\r
+ TLO IO,DEFCRS\r
+ PUSHJ PP,SSRCH ;YES, SEARCH FOR SYMBOL (OPERAND)\r
+ MOVSI ARG,SYMF!UNDF ;NOT FOUND, FLAGAS UNDEFINED SYM.\r
+ TLNN ARG,UNDF ;UNDEFINED?\r
+ JRST GETCHR ;NO, GET NEXT CHAR AND RETURN\r
+ TLO ARG,VARF ;YES, FLAG AS A VARIABLE\r
+ TRO ER,ERRU ;SET UNDEFINED ERROR FLAG\r
+ PUSHJ PP,INSERZ ;INSERT IT WITH A ZERO VALUE\r
+ JRST GETDEL\r
+\r
+LETTE4: PUSHJ PP,GETCHR ;AND SCAN PAST IT\r
+\r
+NUMER1: SETZB AC0,RC ;RETURN ZERO\r
+NUMER2: TRO ER,ERRN ;FLAG ERROR\r
+\r
+GETDEL: PUSHJ PP,BYPAS1\r
+GETDE1: JUMPE C,.-1\r
+ MOVEI AC1,0\r
+GETDE3: TLO IO,NUMSW!FLDSW ;FLAG NUMERIC\r
+ TLNN FR,NEGSW ;IS ATOM NEGATIVE?\r
+ POPJ PP, ;NO, EXIT\r
+ JUMPE AC1,GETDE2\r
+ MOVNS AC0,1\r
+ TDCA AC0,[-1]\r
+GETDE2: MOVNS AC0 ;YES, NEGATE VALUE\r
+ MOVNS RC ;AND RELOCATION\r
+POPOUT: POPJ PP, ;EXIT\r
+\fQUOTE0: ASH AC0,7\r
+ IOR AC0,C\r
+QUOTES: PUSHJ PP,CHARAC\r
+ CAIN C,CR\r
+ JRST QUOTE2\r
+ CAIE C,42\r
+ JRST QUOTE0\r
+ PUSHJ PP,CHARAC ;LOOK AT NEXT CHAR.\r
+ CAIN C,42\r
+ JRST QUOTE0\r
+QUOTE2: TLO IO,IORPTC\r
+ JRST GETDEL\r
+\fQUAL: PUSHJ PP,BYPAS1 ;SKIP BLANKS, GET NEXT CHARACTER\r
+ CAIN C,42 ;"B"?\r
+ JRST QUAL2 ;YES, RADIX=D2\r
+ CAIN C,57 ;"O"?\r
+ JRST QUAL8 ;YES, RADIX=D8\r
+ CAIN C,46 ;"F"?\r
+ JRST NUMDF ;YES, PROCESS DECIMAL FRACTION\r
+ CAIN C,54 ;"L"?\r
+ JRST QUALL ;YES\r
+ CAIE C,44 ;"D"?\r
+ JRST NUMER1 ;NO, FLAG NUMERIC ERROR\r
+ ADDI AC2,2\r
+QUAL8: ADDI AC2,6\r
+QUAL2: ADDI AC2,2\r
+ PUSH PP,RX\r
+ HRR RX,AC2\r
+ PUSHJ PP,CELLSF\r
+QUAL2A: POP PP,RX\r
+ TLNN IO,NUMSW\r
+ JRST NUMER1\r
+ JRST GETDE1\r
+\r
+QUALL: PUSH PP,RX\r
+ PUSHJ PP,CELLSF\r
+ MOVE AC2,AC0\r
+ MOVEI AC0,^D36\r
+ JUMPE AC2,QUAL2A\r
+ LSH AC2,-1\r
+ SOJA AC0,.-2\r
+\fSUBTTL NUMBER PROCESSOR\r
+\r
+ANGLB: PUSH PP,FR\r
+ TLZ FR,INDSW\r
+ PUSHJ PP,ATOM\r
+ TLNN IO,NUMSW\r
+ CAIE C,35\r
+ JRST ANGLB1\r
+ PUSHJ PP,ASSIG1\r
+ MOVE AC0,V\r
+ JRST ANGLB2\r
+\r
+ANGLB1: PUSHJ PP,EVALHA\r
+ANGLB2: POP PP,FR\r
+ CAIE C,36\r
+ TRO ER,ERRN\r
+ JRST GETDEL\r
+\fSUBTTL LITERAL PROCESSOR\r
+\r
+SQBRK: PUSH PP,FR\r
+ PUSH PP,EXTPNT ;ALLOW EXTERN TO PRECEDE LIT IN XWD\r
+ SETZM EXTPNT\r
+ SKIPE LITLVL ;SAVE SEQNO AND PAGE IF NOT IN LIT ALREADY\r
+ JRST SQB5\r
+ FORERR (C,LIT)\r
+SQB5: JSP AC2,SVSTOW\r
+SQB3: PUSHJ PP,STMNT\r
+ TLNE FR,MWLFLG ;CALL IT ] IF NOT MULTI-WORD FLAG\r
+ CAIN C,75 ;CHECK FOR ]\r
+ JRST SQB1\r
+ TLO IO,IORPTC\r
+ PUSHJ PP,BYPAS1\r
+ CAIN C,33 ;COMMENT?\r
+ TLOA IO,IORPTC\r
+ TRO ER,ERRQ\r
+SQB4: PUSHJ PP,CHARAC\r
+ CAIGE C,CR ;LOOK FOR END OF LINE\r
+ CAIN C,HT\r
+ JRST SQB4\r
+ PUSHJ PP,OUTIML ;DUMP\r
+ JRST SQB3\r
+SQB1: TLZ IO,IORPTC\r
+ PUSHJ PP,STOLIT\r
+ JSP AC2,GTSTOW\r
+ POP PP,EXTPNT\r
+ POP PP,FR\r
+ SKIPE LITLVL ;WERE WE NESTED?\r
+ JUMP1 NUMER2 ;YES, FORCE ERROR IF PASS 1\r
+ JRST GETDEL\r
+\r
+PERIOD: PUSHJ PP,GETCHR ;LOOK AT NEXT CHARACTER\r
+ TLNN CS,2 ;ALPHABETIC?\r
+ JRST PERNUM ;NO, TEST NUMERIC\r
+ MOVSI AC0,(SIXBIT /./) ;YES, PUT PERIOD IN AC0\r
+ MOVSI AC2,(POINT 6,AC0,5) ;SET BYTE POINTER\r
+ JRST LETTE2 ;AND TREAT AS SYMBOL\r
+\r
+PERNUM: TLNE CS,4 ;IS IT A NUMBER\r
+ JRST NUM32 ;YES\r
+ MOVE AC0,LOCA ;NO. CURRENT LOC SYMBOL (.)\r
+ MOVE RC,MODA ;SET TO CURRENT ASSEMBLY MODE\r
+ JRST GETDE1 ;GET DELIMITER\r
+NUMDF: TLO FR,DCFSW ;SET DECIMAL FRACTION FLAG\r
+NUM: PUSHJ PP,GETCHR ;GET A CHARACTER\r
+ TLNN CS,4 ;NUMERIC?\r
+ JRST NUM10 ;NO\r
+NUM1: SUBI C,20 ;CONVERT TO OCTAL\r
+ PUSH PP,C ;STACK FOR FLOATING POINT\r
+ MOVE AC0,AC1\r
+ MULI AC0,0(RX)\r
+ ADD AC1,C ;ADD IN LAST VALUE\r
+ CAIL C,0(RX) ;IS NUMBER LESS THAN CURRENT RADIX?\r
+ TLO FR,RADXSW ;NO, SET FLAG\r
+ AOJA AC2,NUM ;YES, AC2=NO. OF DECIMAL PLACES\r
+\r
+\fNUM10: CAIE C,16 ;PERIOD?\r
+ TLNE FR,DCFSW ;OR DECIMAL FRACTION?\r
+ JRST NUM31 ;YES, PROCESS FLOATING POINT\r
+ LSH AC1,1 ;NO, CLEAR THE SIGN BIT\r
+ LSHC AC0,^D35 ;AND SHIFT INTO AC0\r
+ MOVE PP,PPTEMP ;RESTORE PP\r
+ SOJE AC2,GETDE1 ;NO RADIX ERROR TEST IF ONE DIGIT\r
+ TLNE FR,RADXSW ;WAS ILLEGAL NUMBER ENCOUNTERED?\r
+ TRO ER,ERRN ;YES, FLAG N ERROR\r
+ JRST GETDE1\r
+\r
+NUM31: PUSHJ PP,GETCHR\r
+ TLNN CS,4 ;NUMERIC?\r
+ JRST NUM40 ;NO\r
+NUM32: SUBI C,20\r
+ PUSH PP,C\r
+ JRST NUM31\r
+\r
+NUM40: PUSH PP,FR ;STACK VALUES\r
+ HRRI RX,^D10\r
+ PUSH PP,AC2\r
+ PUSH PP,PPTEMP\r
+ CAIE C,45 ;"E"?\r
+ TDZA AC0,AC0\r
+ PUSHJ PP,CELL\r
+ POP PP,PPTEMP\r
+ POP PP,SX\r
+ POP PP,FR\r
+ HRRZ V,PP\r
+ MOVE PP,PPTEMP\r
+ JUMPN RC,NUMER1 ;EXPONENT MUST BE ABSOLUTE\r
+ ADD SX,AC0\r
+ HRRZ ARG,PP\r
+ ADD SX,ARG\r
+ SETZB AC0,AC2\r
+ TLNE FR,DCFSW\r
+ JRST NUM60\r
+ JOV NUM50 ;CLEAR OVERFLOW FLAG\r
+\f\r
+NUM50: JSP SDEL,NUMUP ;FLOATING POINT\r
+ JRST NUM52 ;END OF WHOLE NUMBERS\r
+ FMPR AC0,[10.0] ;MULTIPLY BY 10\r
+ TLO AC1,233000 ;CONVERT TO FLOATING POINT\r
+ FADR AC0,AC1 ;ADD IT IN\r
+ JRST NUM50\r
+\r
+NUM52: JSP SDEL,NUMDN ;PROCESS FRACTION\r
+ FADR AC0,AC2\r
+ JOV NUMER1 ;TEST FOR OVERFLOW\r
+ JRST GETDE1\r
+ TLO AC1,233000\r
+ TRNE AC1,-1\r
+ FADR AC2,AC1 ;ACCUMULATE FRACTION\r
+ FDVR AC2,[10.0]\r
+ JRST NUM52\r
+\r
+NUM60: JSP SDEL,NUMUP\r
+ JRST NUM62\r
+ IMULI AC0,^D10\r
+ ADD AC0,AC1\r
+ JRST NUM60\r
+\r
+NUM62: LSHC AC1,-^D36\r
+ JSP SDEL,NUMDN\r
+ LSHC AC1,^D37\r
+ PUSHJ PP,BYPAS2\r
+ JRST GETDE3\r
+ DIVI AC1,^D10\r
+ JRST NUM62\r
+\r
+NUMUP: MOVEI AC1,0\r
+ CAML ARG,SX\r
+ JRST 0(SDEL)\r
+ CAMGE ARG,V\r
+ MOVE AC1,1(ARG)\r
+ AOJA ARG,1(SDEL)\r
+\r
+NUMDN: MOVEI AC1,0\r
+ CAMG V,SX\r
+ JRST 0(SDEL)\r
+ CAMLE V,ARG\r
+ MOVE AC1,0(V)\r
+ SOJA V,3(SDEL)\r
+\fSUBTTL GETSYM\r
+GETSYM: MOVEI AC0,0 ;CLEAR AC0\r
+ MOVSI AC1,(POINT 6,AC0) ;PUT POINTER IN AC1\r
+ PUSHJ PP,BYPAS1 ;SKIP LEADING BLANKS\r
+ TLNN CS,2 ;ALPHABETIC?\r
+ JRST GETSY1 ;NO, ERROR\r
+ CAIE C,16 ;PERIOD?\r
+ JRST GETSY2 ;NO, A VALID SYMBOL\r
+ IDPB C,AC1 ;STORE THE CHARACTER\r
+ PUSHJ PP,GETCHR ;YES, TEST NEXT CHARACTER\r
+ TLNN CS,2 ;ALPHABETIC?\r
+GETSY1: TROA ER,ERRA\r
+GETSY2: AOS 0(PP) ;YES, SET SKIP EXIT\r
+GETSY3: TLNN CS,6 ;ALPHA-NUMERIC?\r
+ JRST BYPAS2 ;NO, GET DELIMITER\r
+ TLNE AC1,770000 ;YES, HAVE WE STORED SIX?\r
+ IDPB C,AC1 ;NO, STORE IT\r
+ PUSHJ PP,GETCHR\r
+ JRST GETSY3\r
+BYPAS1: PUSHJ PP,GETCHR\r
+BYPAS2: JUMPE C,.-1\r
+ POPJ PP,\r
+\fSUBTTL EXPRESSION EVALUATOR\r
+CV== AC0 ;CURRENT VALUE\r
+PV== AC1 ;PREVIOUS VALUE\r
+RC== RC ;CURRENT RELOCATABILITY\r
+PR== AC2 ;PREVIOUS RELOCATABILITY\r
+CS= CS ;CURRENT STATUS\r
+PS== SDEL ;PREVIOUS STATUS\r
+\r
+EVALHA: TLO FR,TMPSW\r
+EVALEX: TLO IO,FLDSW \r
+ PUSH PP,[XWD TNODE,0] ;MARK THE LIST 200000,,0\r
+ TLZN FR,TMPSW\r
+EVATOM: PUSHJ PP,ATOM ;GET THE NEXT ATOM\r
+ JUMPE AC0,EVGETD ;TEST FOR NULL/ZERO\r
+ TLOE IO,NUMSW ;SET NUMERIC, WAS IT PREVIOUSLY?\r
+ JRST EVGETD ;YES, TREAT ACCORDINGLY\r
+ PUSHJ PP,SEARCH ;SEARCH FOR MACRO OR SYMBOL\r
+ JRST EVOP ;NOT FOUND, TRY FOR OP-CODE\r
+ SKIPL ARG ;SKIP IF OPERAND\r
+ PUSHJ PP,SSRCH1 ;OPERATOR, TRY FOR SYMBOL (OPERAND)\r
+ PUSHJ PP,QSRCH ;PERFORM CROSS-REFERENCE\r
+ JUMPG ARG,EVMAC ;BRANCH IF OPERATOR\r
+ MOVE AC0,V ;SYMBOL, SET VALUE\r
+ JRST EVTSTS ;TEST STATUS\r
+\r
+EVMAC: TLNE FR,NEGSW ;UNARY MINUS?\r
+ JRST EVERRZ ;YES, INVALID BEFORE OPERATOR\r
+ LDB SDEL,[POINT 3,ARG,5] ;GET MACF/OPDF/SYNF\r
+ SOJL SDEL,EVERRZ ;ERROR IF NO FLAGS\r
+\r
+ SKIPE C ;NON-BLANK?\r
+ TLO IO,IORPTC ;YES, REPEAT CHARACTER\r
+ SOJE SDEL,CALLM ;MACRO IF 2\r
+ JUMPG SDEL,EVOPS ;SYNONYM IF 4\r
+\r
+ MOVE AC0,V ;OPDEF\r
+ MOVEI V,OPD ;SET TRANSFER VECTOR\r
+ JRST EVOPD\r
+\fEVOP: TLNE FR,NEGSW ;OPCODE, UNARY MINUS?\r
+ JRST EVERRZ ;YES, ERROR\r
+\r
+ PUSHJ PP,OPTSCH ;SEARCH SYMBOL TABLE\r
+ JRST EVOPX ;NOT FOUND\r
+EVOPS: TRZE V,LITF ;CLEAR LIT INVALID FLAG\r
+ JRST EVOPX ;PSEUDO-OP THAT GENERATES NO DATA JUMPS\r
+ HLLZ AC0,V\r
+EVOPD: SKIPE C ;OPDEF, NON-BLANK DELIMITER?\r
+ TLO IO,IORPTC ;YES, REPEAT CHARACTER\r
+ JSP AC2,SVSTOW\r
+ PUSHJ PP,0(V)\r
+ PUSHJ PP,DSTOW\r
+ JSP AC2,GTSTOW\r
+ TRNE RC,-2\r
+ HRRM RC,EXTPNT\r
+ TLNE RC,-2\r
+ HLLM RC,EXTPNT\r
+ JRST EVNUM\r
+\r
+EVOPX: MOVSI ARG,SYMF!UNDF\r
+ PUSHJ PP,INSERZ\r
+EVERRZ: SETZB AC0,RC ;CLEAR CODE AND RELOCATION\r
+EVERRU: TRO ER,ERRU\r
+ JRST EVGETD\r
+\fEVTSTS: TLNE ARG,UNDF\r
+ JRST EVERRU\r
+ TLNN ARG,EXTF\r
+ JRST EVTSTR\r
+ HRRZ RC,ARG ;GET ADRES WFW\r
+ HRRZ ARG,EXTPNT ;SAVE IT WDW\r
+ HRRM RC,EXTPNT ;WFW\r
+ TRNE ARG,-1 ;WFW\r
+ TRO ER,ERRE\r
+ SETZB AC0,ARG\r
+\r
+EVTSTR: TLNE ARG,MDFF ;MULTIPLY DEFINED?\r
+ TRO ER,ERRD ;YES, FLAG IT\r
+ TLNE FR,NEGSW ;NEGATIVE ATOM?\r
+ PUSHJ PP,GETDE2 ;YES, NEGATIVE AC0 AND RC\r
+\r
+EVGETD: PUSHJ PP,BYPAS2 \r
+ TLNE CS,6 ;NON BLANK FIELD\r
+ TLO IO,IORPTC ;YES,SET FLAG\r
+EVNUM: POP PP,SDEL ;POP THE PREVIOUS DELIMITER/TNODE\r
+ TLO PS,4000\r
+ CAMGE PS,CS ;OPERATION REQUIRED?\r
+ JRST EVPUSH ;NO, PUT VALUES BACK ON STACK\r
+ TLNN PS,TNODE ;YES, HAVE WE REACHED TERMINAL NODE?\r
+ JRST EVXCT ;NO, EXECUTION REQUIRED\r
+ TLNN CS,170000 ;YES, ARE WE POINTING AT DEL (& ! * / + - _)\r
+ POPJ PP, ;YES, EXIT\r
+ ;NO, FALL INTO EVPUSH\r
+\fEVPUSH: PUSH PP,PS ;STACK VALUES\r
+ PUSH PP,CV\r
+ PUSH PP,RC\r
+ PUSH PP,CS\r
+ JRST EVATOM ;GET NEXT ATOM\r
+\r
+EVXCT: POP PP,AC2 ;POP PREVIOUS RELOCATABILITY\r
+ POP PP,AC1 ;AND PREVIOUS VALUE\r
+ LDB PS,[POINT 3,PS,29] ;TYPE OF OPERATION TO PS\r
+ JRST .(PS) ;PREFORM PROPER OPERATION\r
+ JRST XMUL ;1;\r
+ JRST XDIV ;2;\r
+ JRST XADD ;3;\r
+ JRST XSUB ;4;\r
+ JRST XLRW ;5; "_"\r
+ TDOA CV,PV ;6; MERGE PV INTO CV\r
+ AND CV,PV ;7; AND PV INTO CV\r
+ SKIPN RC ;COMMON RELOCATION TEST\r
+ SKIPE AC2\r
+ TRO ER,ERRR ;BOTH MUST BE FIXED\r
+ JRST EVNUM ;GO TRY AGAIN\r
+\r
+XSUB: SUBM PV,CV\r
+ SUBM PR,RC\r
+ JRST EVNUM\r
+\r
+XADD: ADDM PV,CV\r
+ ADDM PR,RC\r
+ JRST EVNUM\r
+\r
+XDIV: IDIV PR,CV ;CORRECT RELOCATABILITY\r
+ IDIVM PV,CV\r
+XDIV1: EXCH PR,RC ;TAKE RELOCATION OF NUMERATOR\r
+ SKIPE PR\r
+ TRO ER,ERRR\r
+ JRST EVNUM\r
+\r
+XMUL: JUMPE PR,XMUL1 ;AT LEAST ONE OPERAND\r
+ JUMPE RC,XMUL1 ;MUST BE FIXED\r
+ TRO ER,ERRR\r
+XMUL1: IORM PR,RC ;GET RELOCATION TO RC\r
+ IMULM PV,RC\r
+ IMULM PV,CV\r
+ JRST EVNUM\r
+XLRW: EXCH PV,CV\r
+ LSH CV,0(PV)\r
+ LSH PR,0(PV)\r
+ JRST XDIV1\r
+\f SUBTTL LITERAL STORAGE HANDLER\r
+\r
+STOLER: SETZB AC0,RC ;ERROR, NO CODE STORED\r
+ PUSHJ PP,STOW ;STOW ZERO\r
+ TRO ER,ERRL ;AND FLAG THE ERROR\r
+\r
+STOLIT: MOVE SDEL,STPX\r
+ SUB SDEL,STPY ;COMPUTE NUMBER OF WORDS\r
+ JUMPE SDEL,STOLER ;ERROR IF NONE STORED\r
+ TRNN ER,ERRORS ;ANY ERRORS?\r
+ JRST STOL06 ;NO\r
+ JUMP2 STOL22 ;YES, NO SEARCH. BRANCH IF PASS2\r
+ ADDM SDEL,LITCNT\r
+ JRST STOWI\r
+\r
+STOL06: MOVEI SX,LITAB\r
+ MOVE ARG,STPX\r
+ HRL ARG,STPY\r
+ MOVE AC2,LITNUM\r
+ MOVEI SDEL,0\r
+STOL08: PUSHJ PP,DSTOW ;GET VALUE WFW\r
+STOL10: SOJL AC2,STOL24 ;TEST FOR END\r
+ MOVE SX,0(SX) ;NO, GET NEXT STORAGE CELL\r
+ MOVE V,-1(SX) ;GET RELOCATION BITS WFW\r
+ CAMN AC0,-2(SX) ;DO CODES COMPARE? WFW\r
+ CAME RC,V ;YES, HOW ABOUT RELOCATION?\r
+ AOJA SDEL,STOL10 ;NO, TRY AGAIN\r
+ SKIPGE STPX ;YES, MULTI-WORD?\r
+ JRST STOL26 ;NO, JUST RETURN LOCATION\r
+ MOVEM AC2,SAVBLK+AC2 ;YES, SAVE STARTING INFO\r
+ MOVEM SX,SAVBLK+SX\r
+\r
+STOL12: SOJL AC2,STOL23 ;TEST FOR END\r
+ PUSHJ PP,DSTOW ;GET NEXT WORD WFW\r
+ MOVE SX,0(SX) ;UPDATE POINTER\r
+ MOVE V,-1(SX) ;GET RELOCATION WFW\r
+ CAMN AC0,-2(SX) ;COMPARE VALUE WFW\r
+ CAME RC,V ;AND RELOCATION\r
+ JRST STOL14 ;NO MATCH, TRY AGAIN \r
+ SKIPL STPX ;MATCH, HAVE WE FINISHED SEARCH?\r
+ JRST STOL12 ;NO, TRY NEXT WORD\r
+ JRST STOL26 ;YES, RETURN LOCATION\r
+\r
+STOL14: MOVE AC2,SAVBLK+AC2 ;RESTORE STOW POINTERS\r
+ MOVE SX,SAVBLK+SX\r
+ HRREM ARG,STPX\r
+ HLREM ARG,STPY\r
+ AOJA SDEL,STOL08 ;BETTER LUCK NEXT TIME\r
+\f\r
+STOL22: MOVE SDEL,LITNUM\r
+STOL23: PUSHJ PP,DSTOW ;DSTOW AND CONVERT\r
+STOL24: MOVE SX,LITABX ;GET CURRENT STORAGE\r
+ PUSHJ PP,GETTOP ;GET NEXT CELL\r
+ MOVEM AC0,-2(SX) ;STORE CODE WFW\r
+ MOVEM RC,-1(SX) ;WFW\r
+ MOVEM SX,LITABX ;SET POINTER TO CURRENT CELL\r
+ AOS LITNUM ;INCREMENT NUMBER STORED\r
+ AOS LITCNT ;INCREMENT NUMBER RESERVED\r
+ SKIPL STPX ;ANY MODE CODE?\r
+ JRST STOL23 ;YES\r
+STOL26: JUMP1 POPOUT ;EXIT IF PASS ONE\r
+ MOVE SX,LITHDX ;GET HEADER BLOCK\r
+ HLRZ RC,-1(SX) ;GET BLOCK RELOCATION\r
+ HRRZ AC0,-1(SX)\r
+ ADDI AC0,0(SDEL) ;COMPUTE ACTUAL LOCATION\r
+ POPJ PP, ;EXIT\r
+\fSUBTTL INPUT ROUTINES\r
+GETCHR: PUSHJ PP,CHARAC ;GET ASCII CHARACTER\r
+ CAIG C,172 ;CHECK FOR LOWER CASE\r
+ CAIGE C,141\r
+ SKIPA ;NOT LOWER CASE\r
+ SUBI C,40 ;CONVERT LOWER CASE TO SIXBIT\r
+ SUBI C,40 ;CONVERT TO SIX BIT\r
+ CAIN C,7\r
+ JRST GETCHR\r
+ CAILE C,77\r
+ JRST GETCS1\r
+ JUMPGE C,GETCS\r
+ ADDI C,27\r
+ JUMPE C,GETCS\r
+ TLOA IO,IORPTC ;REPEAT CHARACTER\r
+\r
+GETCS1: TDO IO,[XWD IORPTC,ERRQ]\r
+ MOVEI C,33\r
+GETCS: MOVE CS,CSTAT(C) ;GET STATUS BITS\r
+ POPJ PP, ;EXIT\r
+\f\r
+CHARAC: TLZE IO,IORPTC ;REPEAT REQUESTED?\r
+ JRST CHARAX ;YES\r
+RSW0: JUMPN MRP,MREAD ;BRANCH IF TREE POINTER SET\r
+ PUSHJ PP,READ\r
+RSW1: SKIPE RPOLVL ;ARE WE IN "REPEAT ONCE"?\r
+ JRST REPO1 ;YES\r
+RSW2: SOSG CPL ;ANY ROOM IN THE IMAGE BUFFER?\r
+ PUSHJ PP,OUTPL ;NO, OUTPUT THE PARTIAL LINE\r
+ IDPB C,LBUFP ;YES, STORE IN PRINT AREA\r
+ CAIE C,HT ;TAB?\r
+ POPJ PP, ;NO, EXIT\r
+ MOVEI CS,7\r
+ ANDCAM CS,CPL ;MASK\r
+ POPJ PP, ;EXIT\r
+\r
+CHARAX: LDB C,LBUFP ;GET LAST CHARACTER\r
+ POPJ PP, ;EXIT\r
+CHARL: PUSHJ PP,CHARAC ;GET AND TEST 7-BIT ASCII\r
+ CAIE C,LF ;LINE OR FORM FEED OR VT?\r
+ CAIN C,FF\r
+ SKIPA CS,LITLVL ;IN LITERAL?\r
+ POPJ PP, ;EXIT\r
+ JUMPN CS,OUTIML ;YES\r
+CHARL1: PUSHJ PP,SAVEXS ;SAVE REGISTERS\r
+ PUSHJ PP,OUTLIN ;DUMP THE LINE\r
+ JRST RSTRXS ;RESTORE REGISTERS AND EXIT\r
+\fSUBTTL CHARACTER STATUS TABLE\r
+\r
+ DEFINE GENCS (OPLVL,ATOM,AN,SQUOZ,OPTYPE,SEQNO)\r
+<BYTE (6)OPLVL (9)ATOM (3)AN (6)SQUOZ,OPTYPE,SEQNO>\r
+\r
+ ;OPLVL PRIORITY OF BINARY OPERATORS\r
+ ;ATOM INDEX TO JUMP TABLE AT CELL1\r
+ ;AN TYPE OF CHARACTER\r
+ ; 1=OTHER, 2=ALPHA, 4=NUMERIC\r
+ ;SQUOZ VALUE IN RADIX 50\r
+ ;OPTYPE INDEX TO JUMP TABLE AT EVXCT\r
+ ;SEQNO VALUE IN SIXBIT\r
+CSTAT:\r
+ GENCS 00,00,1,00,00,00 ; ' '\r
+ GENCS 04,12,1,00,06,01 ; '!'\r
+ GENCS 00,07,1,00,00,02 ; '"'\r
+ GENCS 00,12,1,00,00,03 ; '#'\r
+ GENCS 00,01,2,46,00,04 ; '$'\r
+ GENCS 00,01,2,47,00,05 ; '%'\r
+ GENCS 04,12,1,00,07,06 ; '&'\r
+ GENCS 00,00,1,00,00,07 ; '''\r
+\r
+ GENCS 00,01,1,00,00,10 ; '('\r
+ GENCS 00,01,1,00,00,11 ; ')'\r
+ GENCS 02,12,1,00,01,12 ; '*'\r
+ GENCS 01,00,1,00,03,13 ; '+'\r
+ GENCS 40,01,1,00,00,14 ; ','\r
+ GENCS 01,02,1,00,04,15 ; '-'\r
+ GENCS 00,11,2,45,00,16 ; '.'\r
+ GENCS 02,12,1,00,02,17 ; '/'\r
+\r
+ GENCS 00,04,4,01,00,20 ; '0'\r
+ GENCS 00,04,4,02,00,21 ; '1'\r
+ GENCS 00,04,4,03,00,22 ; '2'\r
+ GENCS 00,04,4,04,00,23 ; '3'\r
+ GENCS 00,04,4,05,00,24 ; '4'\r
+ GENCS 00,04,4,06,00,25 ; '5'\r
+ GENCS 00,04,4,07,00,26 ; '6'\r
+ GENCS 00,04,4,10,00,27 ; '7'\r
+\r
+ GENCS 00,04,4,11,00,30 ; '8'\r
+ GENCS 00,04,4,12,00,31 ; '9'\r
+ GENCS 00,12,1,00,00,32 ; ':'\r
+ GENCS 00,01,1,00,00,33 ; ';'\r
+ GENCS 00,05,1,00,00,34 ; '<'\r
+ GENCS 00,12,1,00,00,35 ; '='\r
+ GENCS 00,01,1,00,00,36 ; '>'\r
+ GENCS 00,12,1,00,00,37 ; '?'\r
+\f GENCS 00,03,1,00,00,40 ; '@'\r
+ GENCS 00,01,2,13,00,41 ; 'A'\r
+ GENCS 00,01,2,14,00,42 ; 'B'\r
+ GENCS 00,01,2,15,00,43 ; 'C'\r
+ GENCS 00,01,2,16,00,44 ; 'D'\r
+ GENCS 00,01,2,17,00,45 ; 'E'\r
+ GENCS 00,01,2,20,00,46 ; 'F'\r
+ GENCS 00,01,2,21,00,47 ; 'G'\r
+\r
+ GENCS 00,01,2,22,00,50 ; 'H'\r
+ GENCS 00,01,2,23,00,51 ; 'I'\r
+ GENCS 00,01,2,24,00,52 ; 'J'\r
+ GENCS 00,01,2,25,00,53 ; 'K'\r
+ GENCS 00,01,2,26,00,54 ; 'L'\r
+ GENCS 00,01,2,27,00,55 ; 'M'\r
+ GENCS 00,01,2,30,00,56 ; 'N'\r
+ GENCS 00,01,2,31,00,57 ; 'O'\r
+\r
+ GENCS 00,01,2,32,00,60 ; 'P'\r
+ GENCS 00,01,2,33,00,61 ; 'Q'\r
+ GENCS 00,01,2,34,00,62 ; 'R'\r
+ GENCS 00,01,2,35,00,63 ; 'S'\r
+ GENCS 00,01,2,36,00,64 ; 'T'\r
+ GENCS 00,01,2,37,00,65 ; 'U'\r
+ GENCS 00,01,2,40,00,66 ; 'V'\r
+ GENCS 00,01,2,41,00,67 ; 'W'\r
+\r
+ GENCS 00,01,2,42,00,70 ; 'X'\r
+ GENCS 00,01,2,43,00,71 ; 'Y'\r
+ GENCS 00,01,2,44,00,72 ; 'Z'\r
+ GENCS 00,06,1,00,00,73 ; '['\r
+ GENCS 00,12,1,00,00,74 ; '\'\r
+ GENCS 00,01,1,00,00,75 ; ']'\r
+ GENCS 00,10,1,00,00,76 ; '^'\r
+ GENCS 10,12,1,00,05,77 ; '_'\r
+\fSUBTTL LISTING ROUTINES\r
+OUTLIN: TRNN ER,ERRORS-ERRQ ;ANY ERRORS?\r
+ TLNE FR,ERRQSW ;NO, IGNORE Q ERRORS?\r
+ TRZ ER,ERRQ ;YES, YES, ZERO THE Q ERROR\r
+ HRLZ AC0,ER ;PUT ERROR FLAGS IN AC0 LEFT\r
+ TDZ ER,TYPERR\r
+ IDPB AC0,LBUFP\r
+ JUMP1 OUTL30 ;BRANCH IF PASS ONE\r
+ JUMPN AC0,OUTL02 ;JUMP IF ANY ERRORS TO FORCE PRINTING\r
+ SKIPL STPX ;SKIP IF NO CODE, OTHERWISE\r
+ TLZ IO,IOMAC ;FORCE MACRO PRINTING\r
+ TLNN IO,IOMSTR!IOPROG!IOMAC\r
+OUTL02: IOR IO,OUTSW ;FORCE IT.\r
+ TLNN FR,CREFSW ;CREF?\r
+ PUSHJ PP,CLSCRF ;YES, WRITE END OF CREF DATA (177,003)\r
+ JUMPE AC0,OUTL20 ;BRANCH IF NO ERRORS\r
+ TLZE AC0,ERRM ;M ERROR?\r
+ TLO AC0,ERRP ;M ERROR SET - SET P ERROR.\r
+ PUSHJ PP,OUTLER ;PROCESS ERRORS\r
+\r
+OUTL20: SKIPN RC,ASGBLK \r
+ SKIPE CS,LOCBLK ;\r
+ SKIPL STPX ;ANY BINARY?\r
+ JRST OUTL23 ;YES, JUMP\r
+ JUMPE RC,OUTL22 ;SEQUENCE BREAK AND NO BINARY JUMPS\r
+ ILDB C,TABP ;ASSIGNMENT FALL THROUGH\r
+ PUSHJ PP,OUTL \r
+ ILDB C,TABP ;OUTPUT 2ND TAB, LOCATION FIELD\r
+ PUSHJ PP,OUTC ;NEXT IS BINARY LISTING FIELD\r
+ HLLO CS,LOCBLK ;LEFT HALF OF A 36BIT VALUE\r
+ TLNE CS,-1 ;SKIP IF ITS A 18BIT VALUE, OTHERWISE\r
+ PUSHJ PP,ONC1 ;PRINT LH OF A 36 BIT VALUE IN CS\r
+ HRLO CS,LOCBLK ;PICK UP THE RIGHT HALF (18BIT VALUE)\r
+ TRZ CS,0(RC) ;\r
+\fOUTL22: PUSHJ PP,ONC ;PRINT IT\r
+OUTL23: SKIPL STPX ;ANY BINARY?\r
+ PUSHJ PP,BOUT ;YES, DUMP IT\r
+ MOVE CS,@OUTLI2 ;[POINT 7,LBUF]\r
+OUTL24: ILDB C,CS\r
+ JUMPE C,OUTL25\r
+ CAIG C," "\r
+ JRST OUTL24\r
+ MOVE CS,TABP\r
+ PUSHJ PP,OUTASC ;OUTPUT TABS\r
+OUTL25: MOVEI CS,LBUF\r
+ PUSHJ PP,OUTAS0 ;DUMP THE LINE\r
+OUTL26: SKIPGE STPX ;ANY BINARY?\r
+ JRST OUTLI ;NO, CLEAN UP AND EXIT\r
+ PUSHJ PP,OUTLI2 ;YES, INITIALIZE FOR NEXT LINE\r
+ PUSHJ PP,BOUT ;YES, DUMP IT\r
+ PUSHJ PP,OUTCR ;OUTPUT CARRIAGE RETURN\r
+ JRST OUTL26 ;TEST FOR MORE BINARY\r
+\r
+\fOUTL30: AOS CS,STPX ;PASS ONE\r
+ ADDM CS,LOCO ;INCREMENT OUTPUT LOCATION\r
+ PUSHJ PP,STOWI ;INITIALIZE STOW\r
+ TLZ AC0,ERRORS-ERRM-ERRP-ERRV-400000\r
+ JUMPE AC0,OUTLI3 ;JUMP IF ERRORS\r
+ IOR ER,OUTSW ;LIST ERRORS\r
+ MOVEI CS,TAG\r
+ PUSHJ PP,OUTSIX ;OUTPUT TAG\r
+ HRRZ C,TAGINC\r
+ PUSHJ PP,DNC ;CONVERT INCREMENT TO DECIMAL\r
+ PUSHJ PP,OUTTAB ;OUTPUT TAB\r
+ PUSHJ PP,OUTLER ;OUTPUT ERROR FLAGS\r
+ PUSHJ PP,OUTTAB\r
+ JRST OUTL25 ;OUTPUT BASIC LINE\r
+\r
+OUTLER: ASH AC0,-4\r
+ MOVE CS,[POINT 6,[SIXBIT /PRINTQXADLRUVNOPEM/]]\r
+OUTLE2: ILDB C,CS ;GET ERROR MNEMONIC\r
+ JUMPGE AC0,OUTLE4 ;BRANCH IF NOT FLAGGED\r
+ ADDI C,40\r
+ PUSHJ PP,OUTL\r
+ AOS ERRCNT ;INCREMENT ERROR COUNT\r
+OUTLE4: LSH AC0,1 ;SHIFT NEXT FLAG INTO SIGN BIT\r
+ JUMPN AC0,OUTLE2 ;TEST FOR END\r
+ POPJ PP, ;EXIT\r
+OUTPL: IBP LBUFP\r
+OUTIM1: JUMP1 OUTLI3\r
+ PUSH PP,IO\r
+ TDZ IO,TYPERR\r
+ TLNN IO,250000\r
+ IOR IO,OUTSW\r
+ PUSH PP,C\r
+ TLNN FR,2000\r
+ PUSHJ PP,CLSCRF\r
+OUTIM2: MOVE CS,TABP\r
+ PUSHJ PP,OUTASC ;OUTPUT TABS\r
+ DPB C,LBUFP\r
+ MOVEI CS,LBUF\r
+ PUSHJ PP,SOUT20\r
+ POP PP,C\r
+ HLLM IO,0(PP)\r
+ POP PP,IO\r
+ JRST OUTLI2\r
+OUTLI: TLNE IO,IOPALL ;SUPRESSING ALL\r
+ SKIPN MACLVL\r
+ TLZA IO,IOMAC ;NO, CLEAR MAC FLAG\r
+ TLO IO,IOMAC ;YES, SET FLAG\r
+OUTLI3: TRZ IO,ERRORS!LPTSW!TTYSW\r
+OUTLI2: MOVE CS,[POINT 7,LBUF] ;INITIALIZE BUFFERS\r
+ MOVEM CS,LBUFP\r
+ MOVEI CS,130\r
+ MOVEM CS,CPL\r
+ MOVE CS,[POINT 7,TABI,6]\r
+ MOVEM CS,TABP\r
+ MOVSI CS,(ASCII / /)\r
+ SKIPE SEQNO ;HAVE WE SEQUENCE NUMBERS?\r
+ MOVEM CS,SEQNO ;YES, STORE TAB IN CASE OF MACRO\r
+ MOVEM CS,SEQNO+1 ;STORE TAB AND TERRMINATOR\r
+ SETZM ASGBLK\r
+ SETZM LOCBLK\r
+ POPJ PP,\r
+\fOUTIML: TRNN ER,ERRORS-ERRQ ;FOR LITERALS (MULIT-LINE) OUTPUT ERRORS\r
+ TLNE FR,ERRQSW\r
+ TRZ ER,ERRQ\r
+ HRLZ CS,ER\r
+ JUMP1 OUTML1 ;CHECK PASS1 ERRORS\r
+ TDZ ER,TYPERR\r
+ JUMPE CS,OUTIM1\r
+ PUSH PP,[0] ;ERRORS SHOULD BE ZEROED\r
+ PUSH PP,C\r
+ PUSH PP,AC0 ;SAVE ACO IN CASE CALLED FROM ASCII\r
+ MOVE AC0,CS ;ERROR ROUTINE WANTS FLAGS IN AC0\r
+ IOR ER,OUTSW\r
+ TLNN FR,CREFSW\r
+ PUSHJ PP,CLSCRF ;FIX CREF\r
+ TLZE AC0,ERRM\r
+ TLO AC0,ERRP\r
+ PUSHJ PP,OUTLER ;OUTPUT THEM\r
+ POP PP,AC0\r
+ JRST OUTIM2\r
+OUTML1: TLZ CS,ERRORS-ERRM-ERRP-ERRV-400000\r
+ JUMPE CS,OUTLI2\r
+ TRZ ER,ERRM!ERRP!ERRV!400000\r
+ TRO ER,ERRL\r
+ PUSH PP,ER ;SAVE\r
+ PUSH PP,C ;SAVE THIS\r
+ PUSH PP,AC0 ;AS ABOVE\r
+ MOVE AC0,CS ;...\r
+ TDZ ER,TYPERR\r
+ IOR ER,OUTSW\r
+ MOVEI CS,TAG\r
+ PUSHJ PP,OUTSIX\r
+ HRRZ C,TAGINC\r
+ PUSHJ PP,DNC\r
+ PUSHJ PP,OUTTAB\r
+ PUSHJ PP,OUTLER ;DO NOT FORGET ERRORS\r
+ PUSHJ PP,OUTTAB\r
+ MOVEI CS,LBUF ;PRINT REST OF LINE\r
+ PUSHJ PP,SOUT20\r
+ POP PP,AC0\r
+ POP PP,C\r
+ POP PP,ER\r
+ JRST OUTLI2\r
+\fSUBTTL OUTPUT ROUTINES\r
+UOUT: PUSHJ PP,LOOKUP ;SET FOR TABLE SCAN\r
+ TRNN ARG,PNTF ;WFW\r
+ TRNN ARG,UNDF\r
+ POPJ PP,\r
+ JUMP1 VARA1\r
+ PUSHJ PP,OUTCR\r
+ PUSHJ PP,OUTSYM\r
+ MOVEI CS,[SIXBIT /UNASSIGNED, DEFINED AS @/]\r
+ PUSHJ PP,OUTSIX\r
+ HRLO CS,V\r
+ TDZ CS,RC\r
+UOUT1: PUSHJ PP,ONC1\r
+ JRST HIGHQ\r
+\f ;OUTPUT THE ENTRIES\r
+\r
+EOUT: MOVEI C,0 ;INITIALIZE THE COUNT\r
+ MOVE SX,SYMBOL\r
+ MOVE SDEL,0(SX)\r
+EOUT1: SOJL SDEL,EOUT2\r
+ ADDI SX,2\r
+ HLRZ ARG,0(SX)\r
+ ANDCAI ARG,SYMF!INTF!ENTF\r
+ JUMPN ARG,EOUT1 ;IF INVALID, DON'T COUNT\r
+ AOJA C,EOUT1 ;BUMP COUNT\r
+\r
+EOUT2: HRLI C,4 ;BLOCK TYPE 4\r
+ PUSHJ PP,OUTBIN\r
+ SETZB C,ARG\r
+ PUSHJ PP,OUTBIN\r
+ MOVE SX,SYMBOL\r
+ MOVE SDEL,0(SX)\r
+ MOVEI V,^D18\r
+\r
+EOUT3: SOJL SDEL,POPOUT\r
+ ADDI SX,2\r
+ HLRZ C,0(SX)\r
+ ANDCAI C,SYMF!INTF!ENTF\r
+ JUMPN C,EOUT3\r
+ SOJGE V,EOUT4 ;TEST END OF BLOCK\r
+ PUSHJ PP,OUTBIN\r
+ MOVEI V,^D17 ;WFW\r
+EOUT4: MOVE AC0,-1(SX)\r
+ PUSHJ PP,SQOZE\r
+ MOVE C,AC0\r
+ PUSHJ PP,OUTBIN\r
+ JRST EOUT3\r
+\f ;OUTPUT THE SYMBOLS\r
+\r
+SOUT: MOVEI [ASCIZ /SYMBOL TABLE/]\r
+ HRRM SUBTTX ;SET NEW SUB-TITLE\r
+ PUSHJ PP,OUTFF ;FORCE NEW PAGE\r
+ MOVEI ARG,NCOLS ;SET UP FOR NCOLS ACROSS SYMBOL TABLE\r
+ MOVEM ARG,SYMCNT ;STORE ANSWER\r
+ PUSHJ PP,LOUT1 ;OUTPUT THEM\r
+ MOVE ARG,SYMCNT\r
+ CAIE ARG,NCOLS\r
+ JRST OUTCR ;NO, NEED CR\r
+ POPJ PP,\r
+\r
+LOUT1: PUSHJ PP,LOOKUP ;SET FOR TABLE SCAN\r
+ TRNN ARG,SYMF\r
+ TRNN ARG,MACF!SYNF\r
+ TRNE ARG,40 ;SKIP AND CLEAR MRP\r
+ POPJ PP, ;NO, TRY AGAIN\r
+ MOVEI MRP,0\r
+ TRNE ARG,INTF\r
+ MOVEI MRP,1\r
+ TRNE ARG,EXTF\r
+ MOVNI MRP,1 ;MRP=-1 FOR EXTERNAL\r
+ TRNE ARG,SYNF ;SYNONYM?\r
+ JUMPL MRP,POPOUT ;YES, DON'T OUTPUT IF EXTERNAL\r
+ TRNE ARG,SUPRBT ;IF SUPRESSED\r
+ JUMPGE MRP,POPOUT\r
+ TLNE IO,2000\r
+ JUMPE MRP,POPOUT\r
+ JUMPGE MRP,LOUT10\r
+ HLRZ RC,V ;PUT POINTER/FLAGS IN RC\r
+ TRNE RC,-2 ;POINTER?\r
+ MOVS RC,0(RC) ;YES\r
+ HLL V,RC ;STORE LEFT HALF\r
+\r
+LOUT10: PUSH PP,RC ;SAVE FOR LATER\r
+ PUSHJ PP,OUTSYM ;OUTPUT THE NAME\r
+ MOVE RC,0(PP) ;GET COPY\r
+ MOVEI AC1,0\r
+ JUMPLE MRP,LOUT15 ;SET DEFFERRED BITS IF EXTERNAL\r
+ TLNE RC,-2 ;CHECK FOR LEFT FIXUP\r
+ IORI AC1,40 ;AND SET BITS\r
+ TRNE RC,-2 ;CHECK FOR RIGHT FIXUP\r
+ IORI AC1,20 ;AND SET BITS\r
+LOUT15: TLNE RC,-2 ;FIX RELOC AS 0 IF EXTERNAL\r
+ HRRZS AC0,RC\r
+ TRNE RC,-2\r
+ HLLZS AC0,RC\r
+ TLZE RC,-1\r
+ TRO RC,2\r
+ HRL MRP,RC\r
+ MOVEI RC,0\r
+ TRNE ARG,NOOUTF ;ENTRY DMN\r
+ ADDI MRP,3 ;YES WFW\r
+ IOR AC1,SOUTC(MRP)\r
+ MOVE ARG,AC1\r
+ PUSHJ PP,NOUT2 ;SQUOZE AND DUMP THE SYMBOL\r
+ MOVEM AC0,SVSYM ;SAVE IT\r
+ MOVE AC0,V ;GET THE VALUE\r
+ HLRZ RC,MRP ;AND THE RELOCATION\r
+ PUSHJ PP,COUT\r
+ HLLO CS,V\r
+ TRNE RC,2 ;LEFT HALF RELOCATABLE?\r
+ TRZA CS,1 ;NO, FLAG AND PRINT\r
+ TLNE CS,-1 ;IS THE LEFT HALF ZERO?\r
+ PUSHJ PP,ONC1 ;NO, OUTPUT IT\r
+ PUSHJ PP,OUTTAB \r
+ HRLO CS,V\r
+ TDZ CS,RC ;SET RELOCATION\r
+ PUSHJ PP,ONC1\r
+ PUSHJ PP,OUTTAB\r
+ POP PP,RC ;GET BACK RELOC AND CHECK EXTERNAL\r
+ TRNN RC,-2 ;IS IT?\r
+ JRST SOUT50 ;NO\r
+ MOVE AC0,1(RC) ;GET NAME\r
+ MOVEI ARG,60 ;EXTERNAL REQ\r
+ PUSHJ PP,SQOZE\r
+ HLLZS AC0,RC ;NO RELOC\r
+ PUSHJ PP,COUT ;OUTPUT IT\r
+ MOVE AC0,SVSYM ;GET SYMBOL NAME\r
+ TLO AC0,500000 ;SET AS ADDITIVE SYMBOL\r
+ TLZ AC0,200000 ;BUT NOT LEFT HALF ETC\r
+ PUSHJ PP,COUT\r
+\f\r
+SOUT50: MOVSS RC ;CHECK LEFT HALF\r
+ TRNN RC,-2\r
+ JRST SOUT30\r
+ MOVE AC0,1(RC)\r
+ MOVEI ARG,60\r
+ PUSHJ PP,SQOZE\r
+ MOVEI RC,0\r
+ PUSHJ PP,COUT\r
+ MOVE AC0,SVSYM\r
+ TLO AC0,700000\r
+ PUSHJ PP,COUT\r
+\r
+SOUT30: MOVEI CS,SOUTC(MRP)\r
+ PUSHJ PP,OUTAS0\r
+ SOSLE SYMCNT\r
+ JRST OUTAB2\r
+ MOVEI CS,3\r
+ MOVEM CS,SYMCNT\r
+ JRST OUTCR\r
+\r
+SOUT20: PUSHJ PP,OUTAS0\r
+ JRST OUTCR\r
+\r
+ <ASCII /EXT/>!60 ;DMN\r
+SOUTC: EXP 10\r
+ <ASCII /INT/>!04\r
+ <ASCII /EXT/>!60\r
+ <ASCII /DLD/>!50 \r
+ <ASCII /INT/>!04 ;DMN\r
+\f ;OUTPUT THE BINARY\r
+\r
+BOUT: HRLO CS,LOCO ;PICKUP THE LOCATION\r
+ PUSHJ PP,ONC ;OUTPUT IT TO THE LISTING FILE\r
+ PUSHJ PP,DSTOW ;GET THE CODE\r
+ PUSH PP,RC ;SAVE RELOCATION\r
+ TLNE RC,-2 ;CHECK LEFT EXTERNAL\r
+ HRRZS RC ;MAKE LEFT NON-RELOC\r
+ TRNN RC,-2 ;RIGHT EXT?\r
+ JRST BOUT30 ;NO\r
+ HRRZ AC1,AC0 ;YES\r
+ JUMPE AC1,BOUT20 ;PROCESS IF ZERO CODE THERE\r
+ HLLZS AC0,RC ;MAKE NON-RELOC\r
+ JRST BOUT30 ;PROCESS\r
+ TRNN RC,-2\r
+ JRST BOUT30\r
+\r
+BOUT20: HRRM AC1,0(PP) ;FIX RC IN STACK SO NO CONFUSION WFW (AC1 HAS 0)\r
+ HRR AC0,0(RC) ;NO, SET ADDRESS LINK\r
+ MOVE AC1,LOCO ;GET CURRENT LOCATION\r
+ HRRM AC1,0(RC) ;SET NEW LINK\r
+ HLRZ AC1,0(RC) ;GET FLAGS/POINTER\r
+ TRNN AC1,-2 ;POINTER?\r
+ HRR AC1,RC ;NO, SET TO FLAGS\r
+ HLR RC,0(AC1) ;PUT FLAGS IN RC\r
+ HRL AC1,MODO ;GET CURRENT MODE\r
+ TRZE RC,-2 ;LEFT HALF RELOCATABLE+\r
+ TLO AC1,2 ;YES, SET FLAG\r
+ HLLM AC1,0(AC1) ;STORE NEW FLAGS\r
+BOUT30: HLLO CS,AC0\r
+ TLZE RC,1 ;PACK RELOCATION BITS\r
+ TRO RC,2\r
+ TRNE RC,2 ;LEFT HALF RELOCATABLE?\r
+ TRZ CS,1 ;YES, RESET BIT\r
+ PUSHJ PP,ONC\r
+ HRLO CS,AC0\r
+ TDZ CS,RC ;SET RELOCATION\r
+ PUSHJ PP,ONC\r
+ HRRZ CS,LOCO ;CS = RIGHT RELOCATION\r
+ TLNE FR,RIMSW!RIM1SW!R1BSW ;RIM OUTPUT?\r
+ JRST ROUT ;YES, GO PROCESS\r
+\r
+ HRL CS,MODO\r
+ CAME CS,MODLOC ;SEQUENCE OR RELOCATION BREAK?\r
+ PUSHJ PP,COUTD ;YES, DUMP THE BUFFER\r
+ SKIPL COUTX ;NEW BUFFER?\r
+ JRST BOUT40 ;NO, STORE CODE AND EXIT\r
+ MOVEM CS,MODLOC ;YES, STORE NEW VALUES\r
+ EXCH AC0,LOCO\r
+ EXCH RC,MODO\r
+ PUSHJ PP,COUT ;STORE BLOCK LOCATION AND MODE\r
+ EXCH RC,MODO ;RESTORE CURRENT VALUES\r
+ EXCH AC0,LOCO\r
+\fBOUT40: PUSHJ PP,COUT ;EXIT CODE\r
+ POP PP,RC ;RETREIVE EXTERNAL BITS\r
+ TRNN RC,-2 ;RIGHT EXTERNAL?\r
+ JRST BOUT50 ;TRY FOR LEFT\r
+ PUSHJ PP,COUTD\r
+ PUSH PP,BLKTYP ;TERMINATE TYPE AND SAVE\r
+ MOVEI AC0,2 ;BLOCK TYPE 2\r
+ MOVEM AC0,BLKTYP\r
+ MOVE AC0,1(11) ;GET SYMBOL\r
+ MOVEI ARG,60 ;CODE BITS\r
+ PUSHJ PP,SQOZE ;CONVERT TO RADIX 50\r
+ HLLZS RC ;SYMBOL HAS NO RELOCATION\r
+ PUSHJ PP,COUT ;EMIT\r
+ MOVE AC0,LOCO ;GET CURRENT LOC\r
+ HRLI AC0,400000 ;ADDITIVE REQ\r
+ HRR RC,MODO ;CURRENT MODE\r
+ PUSHJ PP,COUT ;EMIT\r
+ MOVSS RC ;NOW FOR LEFT\r
+ TRNN RC,-2\r
+ JRST BOUT60\r
+ JRST BOUT70\r
+BOUT50: MOVSS RC ;CHECK OTHER HALF\r
+ TRNN RC,-2 ;LEFT HALF EXTERNAL?\r
+ JRST BOUT80 ;NO, FALSE ALARM\r
+ PUSHJ PP,COUTD ;CHANGE MODE\r
+ PUSH PP,BLKTYP\r
+ MOVEI AC0,2\r
+ MOVEM AC0,BLKTYP\r
+BOUT70: MOVE AC0,1(RC)\r
+ MOVEI ARG,60\r
+ PUSHJ PP,SQOZE\r
+ HLLZS AC0,RC\r
+ PUSHJ PP,COUT\r
+ MOVE AC0,LOCO\r
+ HRLI AC0,600000 ;LEFT HALF ADD\r
+ HRR RC,MODO\r
+ PUSHJ PP,COUT ;EMIT\r
+BOUT60: PUSHJ PP,COUTD ;CHANGE MODE\r
+ POP PP,BLKTYP ;TO OLD ONE\r
+BOUT80: AOS LOCO\r
+ AOS MODLOC\r
+ POPJ PP,\r
+\fNOUT: MOVE V,[POINT 7,TBUF] ;POINTER TO ASCII LINE\r
+ MOVSI CS,(POINT 6,AC0) ;POINTER TO SIXBIT AC0\r
+ SETZB ARG,AC0\r
+NOUT1: ILDB C,V ;GET ASCII\r
+ CAIL C,"A"+40\r
+ CAILE C,"Z"+40\r
+ SKIPA\r
+ SUBI C,40 ;CONVERT TO LOWER CASE\r
+ SUBI C,40 ;CONVERT TO SIXBIT\r
+ JUMPLE C,NOUT3 ;TEST FORM NON-SIXBIT\r
+ CAILE C,77 ;AND NOT GREATER THAN SIXBIT\r
+ JRST NOUT3 ;...\r
+ IDPB C,CS ;DEPOSIT IN AC0\r
+ TLNE CS,770000 ;TEST FOR SIX CHARACTERS\r
+ JRST NOUT1\r
+NOUT3:\r
+\r
+IFN CCLSW,< TLNN IO,IOTLSN ;AND IF WE HAVE NOT SEEN A TITLE\r
+ PUSHJ PP,PRNAM ;THEN PRINT THE NAME>\r
+NOUT2: PUSHJ PP,SQOZE ;CONVERT TO SIXBIT\r
+ JRST COUT ;DUMP AND EXIT\r
+\r
+IFN RENTSW,<\r
+HOUT:\r
+ MOVE AC0,HHIGH ;GET HIGH SEG IF TWO SEGMENTS\r
+ MOVEI RC,1 ;RELOCATABL\r
+ PUSHJ PP,COUT ;OUTPUT IT\r
+ SETZB AC0,RC\r
+ JRST COUT ;OUTPUT THE HIGHEST LOCATION>\r
+\r
+VOUT: SKIPN RC,VECREL ;IS VECTOR ABSOLUTE ZERO?\r
+ SKIPE VECTOR ;ALSO CHECK RELOCATION\r
+ SKIPA \r
+ POPJ PP, ;YES, EXIT\r
+ MOVE AC0,VECTOR ;ACO SHOULD BE FLAGS\r
+COUT: AOS C,COUTX ;INCREMENT INDEX\r
+ MOVEM AC0,COUTDB(C) ;STORE CODE\r
+ IDPB RC,COUTP ;STORE RELOCATION BITS\r
+ CAIE C,^D17 ;IS THE BUFFER FULL?\r
+ POPJ PP, ;NO, EXIT\r
+\r
+COUTD: AOSG C,COUTX ;DUMP THE BUFFER\r
+ JRST COUTI ;BUFFER WAS EMPTY\r
+ HRL C,BLKTYP ;SET BLOCK TYPE\r
+ PUSHJ PP,OUTBIN ;OUTPUT COUNT AND TYPE\r
+ SETOB C,COUTY ;INITIALIZE INDEX\r
+\r
+COUTD2: MOVE C,COUTDB(C) ;GET RELOCATION BITS/CODE\r
+ PUSHJ PP,OUTBIN ;DUMP IT\r
+ AOS C,COUTY ;INCREMENT INDEX\r
+ CAMGE C,COUTX ;TEST FOR END\r
+ JRST COUTD2 ;NO, GET NEXT WORD\r
+\r
+COUTI: SETOM COUTX ;INITIALIZE BUFFER INDEX\r
+ SETZM COUTRB ;ZERO RELOCATION BITS\r
+ MOVE C,[POINT 2,COUTRB]\r
+ MOVEM C,COUTP ;INITIALIZE BIT POINTER\r
+ POPJ PP, ;EXIT\r
+\fSTOWZ: MOVEI RC,0 ;USE STANDARD FORM\r
+STOW: JUMP1 STOW20 ;SKIP TEST IF PASS ONE\r
+ TRNE RC,-2 ;RIGHT HALF ZERO OR 1?\r
+ PUSHJ PP,STOWT ;NO, HANDLE EXTERNAL\r
+ TLNN RC,-2 ;LEFT HALF ZERO OR 1? WFW\r
+ JRST STOW10 ;YES, SKIP TEST\r
+ MOVSS RC ;SWAP HALVES\r
+ PUSHJ PP,STOWT1 ;HANDLE EXTERNAL WFW\r
+ MOVSS RC ;RESTORE VALUES\r
+\r
+STOW10: SKIPE EXTPNT ;ANY EXTERNALS REMAINING?\r
+ TRO ER,ERRE ;YES, SET EXTERNAL ERROR FLAG\r
+\r
+STOW20: AOS AC1,STPX ;INCREMEMT POINTER\r
+ MOVEM AC0,STCODE(AC1) ;STOW CODE\r
+ MOVEM RC,STOWRC(AC1) ;STOW RELOCATION BITS\r
+ SKIPN LITLVL ;ARE WE IN LITERAL?\r
+ AOS LOCA ;NO, INCREMENT ASSEMBLY LOCATION\r
+ CAIGE AC1,.STP-1 ;OVERFLOW\r
+ POPJ PP, ;NO, EXIT\r
+\r
+ SKIPE LITLVL ;ARE WE IN A LITERAL?\r
+ TROA ER,ERRL ;YES, FLAG ERRRO BUT DON'T DUMP\r
+ JRST CHARL1 ;NO, SAVE REGISTERS AND DUMP THE BUFFER\r
+ JRST STOWI ;INITIALIZE BUFFER\r
+\r
+DSTOW: AOS AC1,STPY ;INCREMENT POINTER\r
+ MOVE AC0,STCODE(AC1) ;FETCH CODE\r
+ MOVE RC,STOWRC(AC1) ;FETCH RELOCATION BITS\r
+ CAMGE AC1,STPX ;IS THIS THE END?\r
+ POPJ PP, ;NO, EXIT\r
+STOWI: SETOM STPX ;INITIALIZE FOR INPUT\r
+ SETOM STPY ;INITIALIZE FOR OUTPUT\r
+ SETZM EXTPNT\r
+ POPJ PP, ;EXIT\r
+\r
+\fSVSTOW: AOS LITLVL ;NESTED LITERALS\r
+ PUSH PP,STPX ;MAKE ROOM FOR ANOTHER\r
+ PUSH PP,STPY\r
+ MOVE AC1,STPX\r
+ MOVEM AC1,STPY\r
+ JRST 0(AC2)\r
+\r
+GTSTOW: POP PP,STPY ;BACK UP A LEVEL\r
+ POP PP,STPX\r
+ SOS LITLVL\r
+ JRST 0(AC2)\r
+\r
+ ;EXTERNAL RIGHT\r
+STOWT: HRRZ AC1,EXTPNT ;GET RIGHT POINTER\r
+ CAIN AC1,0(RC) ;DOES IT MATCH\r
+ JRST STOWT0 ;EXTERNAL OR RELOCATION ERROR\r
+ HRRI RC,0\r
+ TRO ER,ERRE\r
+STOWT0: HLLZS EXTPNT\r
+ POPJ PP, ;EXIT\r
+\r
+ ;EXTERNAL LEFT\r
+STOWT1: HLRZ AC1,EXTPNT ;GET LEFT HALF\r
+ CAIN AC1,0(RC) ;SEE ABOVE\r
+ JRST STOWT2\r
+ HRRI RC,0\r
+ TRO ER,ERRE\r
+STOWT2: HRRZS EXTPNT\r
+ POPJ PP, ;EXIT\r
+\fONC: ILDB C,TABP ;ENTRY TO ADVANCE TAB POINTER\r
+ PUSHJ PP,OUTL ;OUTPUT A TAB\r
+ ;OUTPUT 6 OCT NUMBERS FROM CS LEFT\r
+ONC1: MOVEI C,6 ;CONVERT TO ASCII\r
+ LSHC C,3 ;SHIFT IN OCTAL\r
+ PUSHJ PP,OUTL ;OUTPUT ASCII FROM C\r
+ TRNE CS,-1 ;ARE WE THROUGH?\r
+ JRST ONC1 ;NO, GET ANOTHER\r
+ MOVEI C,"'"\r
+ TLNN CS,1 ;RELOCATABLE?\r
+ PUSHJ PP,OUTC ;OUTPUT IF EXTERN OR RELOCATABLE\r
+ POPJ PP, ;EXIT\r
+\r
+DNC: IDIVI C,^D10\r
+ HRLM CS,0(PP)\r
+ SKIPE C\r
+ PUSHJ PP,DNC ;RECURSE IF NON-ZERO\r
+ HLRZ C,0(PP)\r
+ ADDI C,"0" ;FORM ASCII\r
+ JRST PRINT ;DUMP AND TEST FOR END\r
+\r
+OUTAS0: HRLI CS,(POINT 7,,) ;ENTRY TO SET POINTER\r
+OUTASC: ILDB C,CS ;GET NEXT BYTE\r
+ JUMPE C,POPOUT ;EXIT ON ZERO DELIMITER\r
+ PUSHJ PP,PRINT\r
+ JRST OUTASC\r
+\r
+OUTSIX: HRLI CS,(POINT 6,,) ;OUTPUT SIXBIT\r
+ ILDB C,CS ;GET SIXBIT\r
+ CAIN C,40 ;"@" DELIMITER?\r
+ POPJ PP, ;YES, EXIT\r
+ ADDI C,40 ;NO, FORM ASCII\r
+ PUSHJ PP,OUTL ;OUTPUTASCII CHAR FROM C\r
+ JRST OUTSIX+1\r
+\r
+OUTSYM: MOVE CS,AC0 ;PLACE NAME IN CS\r
+OUTSY1: MOVEI C,0 ;CLEAR C\r
+ LSHC C,6 ;MOVE NEXT SIXBIT CHARACTER IN\r
+ JUMPE C,OUTTAB ;TEST FOR END\r
+ ADDI C,40 ;CONVERT TO ASCII\r
+ PUSHJ PP,OUTL ;OUTPUT\r
+ JRST OUTSY1 ;LOOP\r
+\fOUTSET: AOS SX,0(PP) ;GET RETURN LOCATION\r
+ MOVE SX,-1(SX) ;GET XWD CODE\r
+ HLRM SX,BLKTYP ;SET BLOCK TYPE\r
+ SETZB ARG,RC \r
+ PUSHJ PP,0(SX) ;GO TO PRESCRIBED ROUTINE\r
+ JRST COUTD ;TERMINATE BLOCK AND EXIT\r
+\r
+ ;LOOKUP SCANS ALL THE SYMBOLS IN THE SYMBOL TABLE\r
+\r
+LOOKUP: POP PP,LOOKX ;INTERCEPT RETURN POP\r
+ MOVE SX,SYMBOL\r
+ MOVE SDEL,0(SX) ;SET FOR TABLE SCAN\r
+LOOKL: SOJL SDEL,POPOUT ;TEST FOR END\r
+ ADDI SX,2\r
+ MOVE AC0,-1(SX)\r
+ PUSHJ PP,SRCH7 ;LOAD REGISTERS\r
+ HLRZS ARG\r
+ PUSHJ PP,@LOOKX ;RETURN TO CALLING ROUTINE\r
+ JRST LOOKL ;TRY AGAIN\r
+\fEND0: AOS LITLVL\r
+ PUSHJ PP,STMNT\r
+ SOS LITLVL\r
+ SKIPL STPX\r
+ PUSHJ PP,DSTOW\r
+ TLZN RC,-2\r
+ TRZE RC,-2\r
+ TRO ER,ERRE\r
+ MOVEM AC0,VECTOR\r
+ MOVEM RC,VECREL\r
+ PUSHJ PP,VARA\r
+ PUSHJ PP,LIT1\r
+ JUMP2 ENDP2\r
+ PUSHJ PP,UOUT\r
+ PUSHJ PP,REC2\r
+ PUSHJ PP,INZ\r
+\r
+PASS20: SETZM CTLSAV\r
+ PUSHJ PP,COUTI\r
+ PUSHJ PP,EOUT ;OUTPUT THE ENTRIES\r
+ PUSHJ PP,OUTSET\r
+ XWD 6,NOUT ;OUTPUT THE HISEG BLOCK\r
+PASS21: MOVEI 1\r
+ HRRM BLKTYP ;SET FOR TYPE 1 BLOCK\r
+ TLZ FR,P1!MWLFLG ;SET FOR PASS 2 AND TURN OFF FLAG\r
+ TLO IO,IOPALL ;PUT THESE BACK\r
+ TLZ IO,IOPROG!IOCREF!DEFCRS ;SO LISTINGS WILL BE THE WAY THEY SHOULD\r
+ TLNN FR,R1BSW\r
+ JRST STOWI\r
+ MOVE CS,[XWD $ST-1-$CKSM,R1BLDR]\r
+ MOVE C,0(CS)\r
+ PUSHJ PP,PTPBIN\r
+ AOBJN CS,.-2\r
+ PUSHJ PP,R1BI\r
+ JRST STOWI\r
+\f\r
+R1BLDR:\r
+ PHASE 0\r
+ IOWD $ADR,$ST\r
+$ST: CONO PTR,60\r
+ HRRI $A,$RD+1\r
+$RD: CONSO PTR,10\r
+ JRST .-1\r
+ DATAI PTR,@$TBL1-$RD+1($A)\r
+ XCT $TBL1-$RD+1($A)\r
+ XCT $TBL2-$RD+1($A)\r
+$A: SOJA $A,\r
+$TBL1: CAME $CKSM,$ADR\r
+ ADD $CKSM,1($ADR)\r
+ SKIPL $CKSM,$ADR\r
+$TBL2: JRST 4,$ST\r
+ AOBJN $ADR,$RD\r
+$ADR: JRST $ST+1\r
+$CKSM:\r
+ DEPHASE\r
+\r
+IF2,< PURGE $ST,$RD,$A,$TBL1,$TBL2,$ADR,$CKSM>\r
+\fENDP2: PUSHJ PP,COUTD ;DUMP THE BUFFER\r
+IFN RENTSW,<\r
+ MOVE AC0,HHIGH\r
+ CAMN AC0,LOCO\r
+ HRRZM AC2,HHIGH\r
+>\r
+ TLNN FR,CREFSW\r
+ TLNN IO,IOCREF ;CLOSE CREF IF NECESSARY\r
+ SKIPA\r
+ PUSHJ PP,CLSCR2 ;CLOSE IT UP\r
+ HRR ER,OUTSW ;SET OUTPUT SWITCH\r
+ SKIPN TYPERR\r
+ TRO ER,TTYSW\r
+ PUSHJ PP,UOUT ;OUTPUT UNDEFINEDS\r
+ TRO ER,TTYSW\r
+ SKIPG C,ERRCNT ;GET ERROR COUNT AND CHECK FOR POSITIVE\r
+ JRST NOERW\r
+IFN CCLSW,<ADDM C,JOBERR ;REMEMBER ERROR COUNT FOR EXECUTION DELETION>\r
+ PUSHJ PP,OUTCR\r
+ MOVE C,ERRCNT\r
+ CAIN C,1 ;1 IS A SPECIAL CASE\r
+ JRST ONERW ;PRINT MESSAGE\r
+ MOVEI C,"?" ;? FOR BATCH\r
+ PUSHJ PP,OUTL ;...\r
+ MOVE C,ERRCNT ;PRINT NUMBER OF ERRORS\r
+ PUSHJ PP,DNC\r
+ SKIPA CS,[EXP ERRMS3] ;LOAD TO PRINT\r
+ONERW: MOVEI CS,ERRMS2 ;ONE ERROR DECTECTED\r
+ONERW1: PUSHJ PP,OUTSIX ;PRINT\r
+ JRST ENDP2D\r
+NOERW: MOVEI CS,ERRMS1\r
+ TLNE IO,CRPGSW ;IF RPG, DON'T PRINT MESSAGE\r
+ TRZ IO,TTYSW ;NO TTY OUTPUT\r
+ IOR IO,OUTSW ;UNLESS NEEDED FOR LISTING\r
+ PUSHJ PP,OUTCR\r
+ JRST ONERW1\r
+ENDP2D: PUSHJ PP,OUTCR\r
+IFN CCLSW,<TLNE IO,CRPGSW ;IF RPG, DON'T PRINT PGM BREAK\r
+ TRZ IO,TTYSW ;...>\r
+IFE CCLSW,< SKIPA ;SO PRGEND CODE CAN WORK>\r
+ IOR IO,OUTSW ;...\r
+ PUSHJ PP,OUTCR\r
+ MOVEI CS,[SIXBIT /PROGRAM BREAK IS @/]\r
+ PUSHJ PP,OUTSIX\r
+IFN RENTSW,<\r
+ HRLO CS,HHIGH ;GET PROGRAM BREAK\r
+ PUSHJ PP,UOUT1>\r
+ PUSHJ PP,OUTCR\r
+ TLNE FR,RIMSW!R1BSW ;RIM MODE?\r
+ PUSHJ PP,RIMFIN ;YES, FINISH IT\r
+ HRR IO,OUTSW\r
+ PUSHJ PP,OUTSET\r
+ XWD 2,SOUT ;OUTPUT THE SYMBOLS (BLKTYP-2)\r
+ PUSHJ PP,OUTSET\r
+ XWD 7,VOUT ;OUTPUT TRANSFER VECTOR (..-7)\r
+IFN RENTSW,<\r
+ PUSHJ PP,OUTSET\r
+ XWD 5,HOUT ;OUTPUT HIGHEST RELOCATABLE (..-5)>\r
+ PUSHJ PP,COUTD\r
+ JRST FINIS\r
+RIMFIN: TLNE FR,R1BSW\r
+ PUSHJ PP,R1BDMP\r
+ SKIPN C,VECTOR\r
+ MOVSI C,(JRST 4,)\r
+ TLNN C,777000\r
+ TLO C,(JRST)\r
+ PUSHJ PP,PTPBIN\r
+ MOVEI C,0\r
+ JRST PTPBIN\r
+\fSUBTTL PASS INITIALIZE\r
+INZ: AOS MODA\r
+ AOS MODO\r
+ PUSHJ PP,OUTFF\r
+ SETZM SEQNO\r
+ SETZM TAG\r
+ HRRI RX,^D8\r
+ MOVEI VARHD\r
+ MOVEM VARHDX\r
+ MOVEI LITHD\r
+ MOVEM LITHDX\r
+ PUSHJ PP,LITI\r
+ PUSHJ PP,STOWI\r
+ JRST OUTLI\r
+RCPNTR: POINT 1,ARG,^L<RELF>-18 ;POINT 1,ARG,22\r
+\fSUBTTL PSEUDO-OP HANDLERS\r
+\r
+TAPE0: PUSHJ PP,STOUTS\r
+ JRST GOTEND\r
+\r
+RADIX0: PUSHJ PP,EVAL10 ;EVALUATE RADIX D10\r
+ CAIG AC0,^D10 ;IF GREATER THAN 10\r
+ CAIG AC0,1 ;OR LESS THAN 2.\r
+ERRAX: TROA ER,ERRA ;FLAG ERROR AND SKIP\r
+ HRR RX,AC0 ;SET NEW RADIX\r
+ POPJ PP,\r
+\r
+IOSET: JUMP1 POPOUT ;NOSYM (IONSYM), XALL (IOPALL), XLIST (IOPROG)\r
+ HLRZ SX,AC0 ;STORE FLAGS\r
+ PUSHJ PP,STOUTS ;POLISH OFF LINE\r
+ TLOA IO,0(SX) ;NOW SUPPRESS PRINTING\r
+IORSET: TDZ IO,AC0 ;RESET FLAG IOPALL/IOPROG\r
+ POPJ PP,\r
+\r
+BLOCK0: PUSHJ PP,HIGHQ \r
+ PUSHJ PP,EVALEX ;EVALUATE\r
+ TRZE RC,-1 ;EXTERNAL OR RELOCATABLE?\r
+ PUSHJ PP,QEXT ;UPDATE ASSEMBLY LOCATION\r
+ ADDM AC0,LOCO ;SAVE START OF BLOCK\r
+BLOCK1: EXCH AC0,LOCA ;UPDATE OUTPUT LOCATION\r
+ ADDM AC0,LOCA\r
+BLOCK2: HRLOM AC0,LOCBLK\r
+ JUMP2 POPOUT\r
+ TRNE ER,ERRU\r
+ TRO ER,ERRV\r
+ POPJ PP,\r
+\f\r
+PRINT0: MOVNI AC0,5\r
+ ADDM AC0,ERRCNT\r
+ TRO ER,400000\r
+ POPJ PP,\r
+\r
+REMAR0: PUSHJ PP,GETCHR\r
+ CAIE C,EOL\r
+ JRST REMAR0\r
+ POPJ PP,\r
+\fLIT0: PUSHJ PP,BLOCK1\r
+LIT1: JUMP2 LIT20\r
+\r
+;ON PASS ONE, WE JUST STEP THE LOCATION COUNTER AND CLEAR\r
+\r
+ PUSHJ PP,STOUTS\r
+ MOVE AC0,LITCNT\r
+ MOVE SX,LITHDX\r
+ HRLM AC0,0(SX)\r
+ MOVE V,LOCA\r
+ HRL V,MODA\r
+ MOVEM V,-1(SX)\r
+ JRST LIT24\r
+\r
+LIT20: PUSH PP,LOCA\r
+ PUSH PP,LOCO\r
+ SKIPN LITNUM\r
+ JRST LIT20A\r
+ MOVE SX,LITHDX\r
+ HRRZ AC0,-1(SX)\r
+ CAME AC0,LOCA\r
+ TRO ER,ERRP\r
+LIT20A: PUSHJ PP,STOUTS\r
+ MOVE SX,LITAB\r
+LIT21: SOSGE LITNUM\r
+ JRST LIT22\r
+ MOVE AC0,-2(SX) ;WFW\r
+ MOVE RC,-1(SX) ;WFW\r
+ MOVE SX,0(SX) ;WFW POINTER TO THE NEXT LIT\r
+ PUSHJ PP,STOW20 ;STOW CODE\r
+ MOVEI C,12 ;SET LINE FEED\r
+ IDPB C,LBUFP\r
+ PUSHJ PP,OUTLIN ;OUTPUT THE LINE\r
+ JRST LIT21\r
+\fLIT22: HRRZ AC2,LOCO\r
+ POP PP,LOCO\r
+ POP PP,LOCA\r
+ MOVE SX,LITHDX\r
+ HLRZ AC0,0(SX)\r
+ SUB AC2,LOCO ;COMPUTE LENGTH USED\r
+ CAMGE AC0,AC2 ;USE LARGER\r
+ MOVE AC0,AC2\r
+ ADD AC2,LOCO\r
+LIT24: ADDM AC0,LOCA\r
+ ADDM AC0,LOCO\r
+ PUSHJ PP,GETTOP\r
+ HRRM SX,LITHDX\r
+LITI: SETZM LITCNT\r
+ SETZM LITNUM\r
+ MOVEI LITAB\r
+ MOVEM LITABX\r
+ JRST HIGHQ\r
+GETTOP: HRRZ AC1,SX ;VARHD\r
+ HRRZ SX,0(SX)\r
+ JUMPN SX,POPOUT\r
+ MOVEI SX,3 ;WFW\r
+ ADDB SX,FREE\r
+ CAML SX,SYMBOL\r
+ PUSHJ PP,XCEED\r
+ SETZM 0(SX) ;CLEAR FORWARE LINK\r
+ HRRM SX,0(AC1) ;STORE ADDRESS IN LAST LINK\r
+ POPJ PP,\r
+\fVAR0: PUSHJ PP,BLOCK1 ;PRINT LOCATION\r
+ PUSHJ PP,VARA\r
+ JRST STOUTS\r
+\r
+VARA: MOVE SX,VARHDX\r
+ MOVE AC0,LOCA ;GET LOCATION FOR CHECK\r
+ JUMP1 VARB ;DO NOT CHECK START ON PASS 1\r
+ CAME AC0,-1(SX) ;CHECK START OF VAR AREA\r
+ TRO ER,ERRP ;AND GIVE ERROR\r
+VARB: MOVEM AC0,-1(SX) ;SAVE START FOR PASS 2\r
+ HLRZ AC0,0(SX)\r
+ ADDM AC0,LOCA\r
+ ADDM AC0,LOCO\r
+ PUSHJ PP,GETTOP\r
+ HRRM SX,VARHDX\r
+ JUMP2 POPOUT\r
+\r
+ PUSHJ PP,LOOKUP ;SET FOR TABLE SCAN\r
+ TRZN ARG,VARF\r
+ POPJ PP, ;NO, EXIT\r
+ TRZ ARG,UNDF ;TURN OFF FLAG NOW\r
+ MOVSI V,1 ;NUMBER TO ADD TO\r
+ ADDM V,0(AC1) ;UPDATE COUNT\r
+VARA1: IOR ARG,MODA ;SET TO ASSEMBLY MODE\r
+ HRL ARG,LOCA\r
+\r
+ MOVSM ARG,0(SX) ;UPDATE 2ND WRD OF SYM TAB ENTRY\r
+ AOS LOCA\r
+ AOS LOCO\r
+ JRST HIGHQ1\r
+\fIF: PUSH PP,AC0 ;SAVE AC0\r
+ PUSH PP,IO\r
+ PUSHJ PP,EVALXQ ;EVALUATE AND TEST EXTERNAL\r
+ POP PP,AC1\r
+ SKIPL AC1\r
+ TLZ IO,FLDSW\r
+IFPOP: POP PP,AC1 ;RETRIEVE SKIP INSTRUCTION\r
+IFSET: TLO IO,IORPTC ;REPEAT CHARACTER\r
+IFXCT: XCT AC1 ;EXECUTE INSTRUCTION\r
+ TDZA AC0,AC0 ;FALSE\r
+ MOVEI AC0,1 ;TRUE\r
+IFEXIT: JUMPOC REPEA1 ;BRANCH IF IN OP-CODE FIELD\r
+IFEX1: PUSHJ PP,GETCHR ;SEARCH FOR "<"\r
+ CAIN C,EOL ;ERROR IF END OF LINE\r
+ JRST ERRAX\r
+ CAIE C,34\r
+ JRST IFEX1\r
+ JUMPE AC0,IFEX2 ;TEST FOR 0\r
+ TLO IO,IORPTC ;NO, PROCESS AS CELL\r
+ PUSHJ PP,CELL\r
+ JRST STOW ;STOW CODE AND EXIT\r
+\r
+IFPASS: TLZ 14,4\r
+ HRRI AC0,P1 ;MAKE IT TLNX IO,P1\r
+ MOVE AC1,AC0 ;PLACE IT IN AC1\r
+ JRST IFSET ;EXECUTE INSTRUCTION\r
+\r
+IFB0: HLLO AC1,AC0 ;FORM AND STORE TEST INSTRUCTION\r
+IFB2: PUSHJ PP,CHARAC ;GET FIRST NON-BLANK\r
+ CAIN C,74\r
+ AOJA RC,IFB2\r
+ CAIN C,76\r
+ SOJLE RC,IFXCT\r
+ CAIE C," " ;BLANK\r
+ TRO AC0,0(RC)\r
+ JRST IFB2\r
+\fIFDEF0: HRRI AC0,UNDF ;MAKE IT TLNX ARG,UNDF\r
+ PUSH PP,AC0 ;STACK IT\r
+ PUSHJ PP,GETSYM ;TAKES SKIP RETURN IF SYM NAME IS LEGAL\r
+ TROA ER,ERRA ;ILLEGAL!\r
+ PUSHJ PP,SEARCH\r
+ JRST [PUSHJ PP,OPTSCH\r
+ TLO ARG,UNDF\r
+ JRST .+1]\r
+ PUSHJ PP,SSRCH3 ;EMIT TO CREF ANYWAY\r
+ JRST IFPOP\r
+\r
+\fIFIDN0: HLRZS AC0\r
+ MOVEI V,2*.IFBLK-1\r
+ SETZM IFBLK(V) ;CLEAR COMPARISON BLOCK\r
+ SOJGE V,.-1\r
+ MOVEI RC,IFBLK ;SET FOR FIRST BLOCK\r
+ PUSHJ PP,IFCL ;GET FIRST STRING\r
+ MOVEI RC,IFBLKA\r
+ PUSHJ PP,IFCL ;GET SECOND STRING\r
+ MOVEI V,.IFBLK-1\r
+ MOVE SX,IFBLK(V) ;GET WORD FROM FIRST STRING\r
+ CAMN SX,IFBLKA(V) ;COMPARE WITH SECOND STRING\r
+ SOJGE V,.-2 ;EQUAL, TRY NEXT WORD\r
+ SKIPL V ;DID WE FINISH STRING\r
+ XORI AC0,1 ;NO, TOGGLE REQUEST\r
+ JRST IFEXIT ;DO NOT TURN ON IORPTC WFW\r
+\r
+IFCL: HRLI RC,(POINT 7,,)\r
+IFCL1: PUSHJ PP,CHARAC ;GET AND LIST CHARACTERS\r
+ CAIE C,74 ;SKIP SPACES\r
+ JRST IFCL1\r
+ MOVEI SX,30\r
+IFCL2: PUSHJ PP,CHARAC\r
+ CAIN C,76\r
+ POPJ PP,\r
+ IDPB C,RC\r
+ SOJLE SX,POPOUT\r
+ JRST IFCL2\r
+\f\r
+IFEX2: PUSHJ PP,GETCHR\r
+ CAIN C,EOL ;EXIT WITH ERROR IF END OF LINE\r
+ JRST ERRAX\r
+ CAIN C,34 ;"<"?\r
+ AOJA IFEX2 ;YES, INCREMENT COUNT\r
+ CAIE C,36 ;">"?\r
+ JRST IFEX2 ;NO, TRY AGAIN\r
+ SOJGE IFEX2 ;YES, TEST FOR MATCH\r
+ PUSHJ PP,BYPAS1 ;YES, MOVE TO NEXT DELIMITER\r
+ AOJA AC0,STOWZ ;STOW ZERO\r
+\r
+\r
+INTER0: HLLZM AC0,INTENT ;AC0 CONTAINS INTF/ENTF FLAGS\r
+\r
+INTER1: PUSHJ PP,GETSYM ;GET A SYMBOL\r
+ JRST INTER3 ;INVALID, SKIP\r
+ PUSHJ PP,SSRCH ;SEARCH THE TABLE\r
+ MOVSI ARG,SYMF!INTF!UNDF\r
+ TLNE ARG,UNDF ;ALLOW FORWARD REFERENCE\r
+ TRO ER,ERRA\r
+ TLNN ARG,SYNF!EXTF\r
+ TDOA ARG,INTENT ;SET APPROPRIATE FLAGS\r
+INTER3: TROA ER,ERRA ;FLAG ARG EROR AND SKIP\r
+ PUSHJ PP,INSERQ ;INSERT/UPDATE\r
+ JUMPCM INTER1\r
+ POPJ PP, ;NO, EXIT\r
+\fEXTER0: PUSHJ PP,GETSYM ;GET A SYMBOL\r
+ JRST EXTER3 ;INVALID, ERROR\r
+ PUSHJ PP,SSRCH ;OK, SEARCH SYMBOL TABLE\r
+ JRST EXTER2 ;NOT THER, INSERT IT\r
+ TLNN ARG,EXTF!VARF!UNDF\r
+ TROA ER,ERRE ;FLAG ERROR AND BYPASS\r
+ TLNE ARG,EXTF ;VALID, ALREADY DEFINED\r
+ JRST EXTER3\r
+EXTER2: MOVEI V,2 ;NO, GET 2 CELLS FROM THE TREE\r
+ ADDB V,FREE\r
+ CAML V,SYMBOL ;HAVE WE RUN OUT OF CORE?\r
+ PUSHJ PP,XCEEDS ;YES, TRY TO BORROW SOME MORE\r
+ SUBI V,1 ;GET RIGHT CELL FOR POINTER\r
+ SETZB RC,0(V) ;ALL SET, ZERO VALUES\r
+ MOVSI ARG,SYMF!EXTF\r
+ PUSHJ PP,INSERT ;INSERT/UPDATE IT\r
+ MOVSI ARG,PNTF\r
+ IORM ARG,0(SX)\r
+ MOVE ARG,-1(SX) ;GET THE SIXBIT FOR THE NAME\r
+ MOVEM ARG,1(V) ;AND STORE IT FOR ADDITIVE GLOBAL FIXUPS\r
+EXTER3: JUMPCM EXTER0\r
+ POPJ PP, ;NO EXIT\r
+\fEVAL10: PUSH PP,RX\r
+ HRRI RX,^D10\r
+ PUSHJ PP,EVALEX ;EVALUATE\r
+ POP PP,RX ;RESET RADIX\r
+ JUMPE RC,POPOUT ;EXIT IF ABSOLUTE\r
+\r
+QEXT: SKIPE EXTPNT ;ANY POSSIBILITIES?\r
+ TROA ER,ERRE ;YES, FLAG EXTERNAL ERROR\r
+ TRO ER,ERRR ;NO, FLAG RELOCATION ERROR\r
+ HLLZS RC ;CLEAR RELOCATION/EXTERNAL\r
+ POPJ PP,\r
+\r
+EVALXQ: PUSHJ PP,EVALEX ;EVALUTE EXPRESSION\r
+ TLZN RC,-2 ;WAS AN EXTERNAL FOUND?\r
+ TRZE RC,-2\r
+ TRO ER,ERRE ;YES, FLAG ERROR\r
+ POPJ PP, ;RETURN\r
+\fOPDEF0: PUSHJ PP,GETSYM ;GET THE FIRST SYMBOL\r
+ POPJ PP, ;ERROR IF INVALID SYMBOL\r
+ CAIE C,73 ;"["?\r
+ JRST ERRAX ;NO, ERROR\r
+ PUSH PP,AC0 ;STACK MNEMONIC\r
+ AOS LITLVL ;SHORT OUT LOCATION INCREMENT\r
+ PUSHJ PP,STMNT ;EVALUATE STATEMENT\r
+ PUSHJ PP,DSTOW ;GET AND DECODE VALUE\r
+ SOS LITLVL\r
+ EXCH AC0,0(PP) ;EXCHANGE VALUE FOR MNEMONIC\r
+ PUSH PP,RC ;STACK RELOCATION\r
+ TLO IO,DEFCRS ;SAY WE ARE DEFINING IT\r
+ PUSHJ PP,MSRCH ;SEARCH SYMBOL TABLE\r
+ MOVSI ARG,OPDF ;NOT FOUND\r
+ POP PP,RC ;RESTORE VALUES\r
+ POP PP,V\r
+ TLNE ARG,SYNF!MACF\r
+ JRST ERRAX ;YES "A" ERROR\r
+ PUSHJ PP,INSERT ;NO, INSERT/UPDATE\r
+ TLZ IO,DEFCRS ;JUST IN CASE\r
+ PUSHJ PP,BYPAS1\r
+ JRST STOWI ;BE SURE STOW IS RESET\r
+\r
+\r
+DEPHA0: MOVE AC0,LOCO\r
+ SKIPA RC,MODO ;SET TO OUTPUT VALUES AND SKIP\r
+PHASE0: PUSHJ PP,EVALXQ ;EVALUATE AND CHECK FOR EXTERNAL\r
+ MOVEM AC0,LOCA ;SET ASSEMBLY LOCATION COUNTER\r
+ MOVEM RC,MODA\r
+ JRST BLOCK2\r
+\fASSIGN: JUMPAD ERRAX ;NO, ERROR\r
+ PUSHJ PP,ASSIG1\r
+ HRROM RC,ASGBLK\r
+ MOVEM V,LOCBLK\r
+ POPJ PP,\r
+\r
+ASSIG1: PUSH PP,AC0\r
+ MOVEI AC0,0\r
+ PUSHJ PP,GETCHR\r
+ CAIN C,35 ;EQUALS?\r
+ TLOA AC0,NOOUTF ;YES, NOT OUT TO DDT WFW\r
+ TLO IO,IORPTC\r
+ MOVEM AC0,HDAS ;STORE THESE BITS WFW\r
+ SETZM EXTPNT\r
+ PUSHJ PP,EVALEX ;EVALUATE EXPRESSION\r
+ EXCH AC0,0(PP) ;SWAP VALUE FOR SYMBOL\r
+ PUSH PP,RC\r
+ TRNN RC,-2 ;CHECK EXTERNAL AGREEMENT\r
+ JRST ASSIG2\r
+ HRRZS RC\r
+ HRRZ ARG,EXTPNT\r
+ CAME RC,ARG\r
+ JRST ASSIG4\r
+ASSIG2: HLRZ RC,0(PP)\r
+ TRNN RC,-2\r
+ JRST ASSIG3\r
+ HLRZ ARG,EXTPNT\r
+ CAME RC,ARG\r
+ JRST ASSIG4\r
+ASSIG3: TLO IO,DEFCRS\r
+ PUSHJ PP,SSRCH\r
+ MOVSI ARG,400000\r
+ IOR ARG,HDAS\r
+ TLZA ARG,UNDF!VARF!40 ;CANCEL UNDEFINED AND VARIABLE FLAGS\r
+ASSIG4: TRO ER,ERRE\r
+ SETZM EXTPNT ;FOR REST OF WORLD\r
+ TRNE ER,ERRORS-ERRQ\r
+ TLO ARG,UNDF ;YES,SO TURN UNDF ON\r
+ POP PP,RC\r
+ POP PP,V\r
+ TLNE ARG,TAGF!EXTF\r
+ JRST ERRAX\r
+ JRST INSERT\r
+\fLOC0: PUSHJ PP,HIGHQ ;AC0=0,0\r
+ HRR AC0,LOCO\r
+ EXCH AC0,RELLOC\r
+ PUSHJ PP,BYPAS1\r
+ TLO IO,IORPTC\r
+ CAIE C,EOL\r
+ PUSHJ PP,EVALXQ\r
+ HLL AC0,RELLOC\r
+ HRRZM AC0,LOCA ;SET ASSEMBLY LOCATION\r
+ HRRZM AC0,LOCO ;AND OUTPUT LOCATION\r
+ HLRZM AC0,MODA ;SET MODE\r
+ HLRZM AC0,MODO\r
+ JRST BLOCK2\r
+\f\r
+IFN RENTSW,<\r
+HISEG0: PUSHJ PP,HIGHQ ;SET CURRENT PROGRAM BREAK\r
+ PUSHJ PP,COUTD ;DUMP CURRENT TYPE OF BLOCK\r
+ PUSH PP,BLKTYP\r
+ MOVEI AC0,3\r
+ MOVEM AC0,BLKTYP\r
+ PUSHJ PP,BYPAS1 ;GO GET EXPRESSION\r
+ TLO IO,IORPTC\r
+ PUSHJ PP,EVALXQ ;CHECK FOR EXTERNAL\r
+ HRRZM AC0,LOCA ;SET LOC COUNTERS\r
+ HRRZM AC0,LOCO\r
+ MOVEI RC,1 ;ASSUME RELOCATABLE\r
+ PUSHJ PP,COUT\r
+ MOVEM RC,MODA ;SET MODES\r
+ MOVEM RC,MODO\r
+ PUSHJ PP,COUTD\r
+ POP PP,BLKTYP\r
+ JRST BLOCK2\r
+\fHIGHQ: JUMP1 POPOUT\r
+HIGHQ1: SKIPN MODO\r
+ POPJ PP,\r
+ MOVE V,LOCO ;GET ASSEMBLY LOCATION\r
+ CAMLE V,HHIGH ;IS IT GREATER THAN "HIGH"?\r
+ MOVEM V,HHIGH ;YES, REPLACE WITH LARGER VALUE\r
+ POPJ PP,>\r
+IFE RENTSW,<\r
+HIGHQ: JUMP1 POPOUT\r
+HIGHQ1: MOVE V,LOCO\r
+ POPJ PP,\r
+>\r
+ONML: TLOA FR,MWLFLG ;MULTI-WORD LITERALS OK\r
+OFFML: TLZ FR,MWLFLG\r
+ POPJ PP,\r
+SUPRE0: PUSHJ PP,GETSYM ;GET A SYMBOL TO SUPRES\r
+ JRST SUPRE1 ;ERROR\r
+ PUSHJ PP,SSRCH ;SYMBOL ONLY\r
+ JRST SUPRE1 ;GIVE ERROR MESSAGE\r
+ TLOA ARG,SUPRBT ;SET THE SUPRESS BIT\r
+SUPRE1: TROA ER,ERRA\r
+ IORM ARG,(SX) ;PUT BACK\r
+ JUMPCM SUPRE0\r
+SUPRS1: SETZM EXTPNT\r
+ POPJ PP,\r
+\r
+SUPRSA: PUSHJ PP,LOOKUP ;SUPRESS ALL\r
+ MOVSI ARG,SUPRBT\r
+ IORM ARG,(SX)\r
+ SETZM EXTPNT ;JUST IN CASE\r
+ POPJ PP,\r
+\r
+\fTITLE0: JUMP2 REMAR0\r
+ MOVEI SX,.TBUF-1\r
+ HRRI AC0,TBUF\r
+ PUSHJ PP,SUBTT1 ;GO READ IT\r
+ TLOE IO,IOTLSN ;HAVE WE SEEN ONE\r
+IFE CCLSW,<TRO ER,ERRM ;YES, COMPLAIN>\r
+IFN CCLSW,<TROA ER,ERRM ;YES, MESSAGE\r
+ JRST PRNAM ;PRINT NAME IF FIRST ONE>\r
+ POPJ PP, ;EXIT OTHERWISE\r
+\r
+SUBTT0: JUMP1 REMAR0 ;OTHERWISE EXIT IF PASS ONE\r
+ MOVEI SX,.SBUF-1\r
+ HRRI SBUF\r
+SUBTT1: PUSHJ PP,BYPAS1 ;BYPASS LEADING BLANKS\r
+ TLO IO,IORPTC\r
+SUBTT3: PUSHJ PP,CHARAC ;GET ASCII CHARACTER\r
+ IDPB C,AC0 ;STORE IN BLOCK\r
+ CAIGE C,40 ;TEST FOR TERMINATOR\r
+ CAIN C,HT\r
+ SOJGE SX,SUBTT3 ;TEST FOR BUFFER FULL\r
+ DPB RC,AC0 ;END, STORE TERMINATOR\r
+ POPJ PP,\r
+IFN CCLSW,<\r
+PRNAM: TLNN IO,CRPGSW ;NOT IF NOT RPG\r
+ POPJ PP,\r
+ MOVE AC0,[POINT 7,TBUF]\r
+ MOVE SX,[POINT 7,OTBUF]\r
+ MOVEI RC,6 ;MAX OF SIX CHRS\r
+PN1: ILDB C,AC0\r
+ CAILE C," " ;CHECK FOR LEGAL\r
+ CAILE C,"Z"+40 ;CHECK AGAINST LOWER CASE Z\r
+ JRST PN2\r
+ IDPB C,SX ;PUT IN OUTPUT BUFFER\r
+ SOJG RC,PN1 ;GET MORE\r
+PN2: MOVEI C,0\r
+ IDPB C,SX ;TERMINATOR\r
+ MOVEI C,OTBUF\r
+ DDTOUT C,\r
+ MOVEI C,[ASCIZ /\r
+/]\r
+ DDTOUT C,\r
+ POPJ PP,\r
+>\r
+\fSYN0: PUSHJ PP,GETSYM ;GET THE FIRST SYMBOL\r
+ JRST ERRAX ;ERROR, EXIT\r
+ PUSHJ PP,MSRCH ;TRY FOR MACRO/OPDEF\r
+ JRST SYN3 ;NO,0THRY FOR OPERAND\r
+SYN1: MOVEI SX,MSRCH ;YES, SET FLAG\r
+SYN2: PUSHJ PP,SAVEXS ;SAVE REGISTERS\r
+ JUMPNC ERRAX ;ERROR IF NO COMMA\r
+ PUSHJ PP,GETSYM ;GET THE SECOND SYMBOL\r
+ POPJ PP,\r
+ PUSHJ PP,@SAVBLK+SX ;SEARCH FOR SECOND SYMBOL\r
+ JFCL\r
+ MOVE ARG,SAVBLK+ARG ;GET VALUES\r
+ MOVE RC,SAVERC\r
+ MOVE V,SAVBLK+V\r
+ TLNE ARG,MACF ;MACRO?\r
+ PUSHJ PP,REFINC ;YES, INCREMENT REFERENCE\r
+ JRST INSERT ;INSERT AND EXIT\r
+\r
+SYN3: PUSHJ PP,SSRCH ;SEARCH FOR OPERAND\r
+ JRST SYN4 ;NOT FOUND, EXIT WITH ERROR\r
+ TLO ARG,SYNF ;FLAG AS SYNONYM\r
+ TLNE ARG,EXTF ;EXTERNAL?\r
+ HRRZ V,ARG ;YES, RELPACE WITH POINTER\r
+ MOVEI SX,SSRCH ;SET FLAG\r
+ JRST SYN2\r
+\r
+SYN4: PUSHJ PP,OPTSCH ;SEARCH FOR OP-CODE\r
+ JRST ERRAX ;NOT FOUND, EXIT WITH ERROR\r
+ MOVSI ARG,SYNF ;FLAG AS SYNONYM\r
+ JRST SYN1\r
+\fPURGE0: PUSHJ PP,GETSYM ;GET A MNEMONIC\r
+ JRST PURGE5\r
+ PUSHJ PP,MSRCH ;SEARCH MACRO SYMBOL TABLE\r
+ JRST PURGE2 ;NOT FOUND, TRY SYMBOLS\r
+ TLNE ARG,MACF ;MACRO?\r
+ PUSHJ PP,REFDEC ;YES, DECREMENT THE REFERENCE\r
+ JRST PURGE4 ;REMOVE SYMBOL FROM TABLE\r
+\r
+PURGE2: PUSHJ PP,SSRCH ;TRY OPERAND SYMBOL TABLE\r
+ JRST PURGE3 ;NOT FOUND GET NEXT SYMBOL\r
+ TRNN RC,-2 ;CHECK COMPLEX EXTERNAL\r
+ TLNE RC,-2\r
+ TLNE ARG,SYNF\r
+ SKIPA\r
+ JRST PURGE3\r
+ TLNE ARG,EXTF!UNDF ;ERROR IF EXTERNAL OR UNDEFINED\r
+ TLNE ARG,SYNF ;BUT NOT A SYNONYM \r
+ JRST PURGE4\r
+PURGE3: TROA ER,ERRA ;NOT FOUND, ERROR\r
+PURGE4: PUSHJ PP,REMOVE ;REMOVE FROM THE SYMBOL TABLE\r
+PURGE5: JUMPCM PURGE0\r
+ POPJ PP, ;EXIT\r
+\fOPD1: MOVE AC0,V ;PUT VALUE IN AC0\r
+OP:\r
+OPD: SKIPA 2,[POINT 4,0(PP),12]\r
+IOP: MOVSI AC2,(POINT 9,0(PP),11)\r
+ PUSH PP,RC\r
+ PUSH PP,AC0 ;STACK CODE\r
+ PUSH PP,AC2\r
+ PUSHJ PP,EVALEX ;EVALUATE FIRST EXPRESSION\r
+ POP PP,AC2\r
+ JUMPNC OP2\r
+ LDB AC1,AC2\r
+ ADD AC1,AC0\r
+ DPB AC1,AC2\r
+ SKIPE RC ;EXTERNAL OR RELOCATABLE?\r
+ PUSHJ PP,QEXT ;YES, DETERMINE WHICH AND FLAG AN ERROR\r
+OP1A: PUSHJ PP,EVALEX ;GET ADDRESS PART\r
+OP2: PUSHJ PP,EVADR ;EVALUATE STANDARD ADDRESS\r
+OP3: POP PP,AC0 ;PUT IN AC0\r
+ POP PP,RC\r
+ JRST STOW ;NO,STOW CODE AND EXIT\r
+\fEVADR: TLCE AC0,-1 ;OK IF ALL 0'S\r
+ TLNN AC0,-1\r
+ SKIPA\r
+ TRO ER,ERRQ ;NO,FLAG Q ERROR\r
+ ADD AC0,-1(PP) ;ADD ADDRESS PORTIONS\r
+ HLL AC0,-1(PP) ;GET LEFT HALF\r
+ TLZE FR,INDSW ;INDIRECT BIT?\r
+ TLO AC0,20\r
+ MOVEM AC0,-1(PP) ;RE-STACK CODE\r
+ ADD RC,-2(PP) ;UPDATE RELOCATION\r
+ HRRM RC,-2(PP) ;USE HALF WORD ADD\r
+ CAIE C,10 ;"("?\r
+ POPJ PP, ;NO, EXIT\r
+ MOVSS EXTPNT ;WFW\r
+ PUSHJ PP,EVALEX ;EVALUATE\r
+ MOVSS EXTPNT ;WFW\r
+ MOVSS V,AC0 ;SWAP HALVES\r
+ MOVSS SX,RC\r
+ IOR SX,V ;MERGE RELOCATION\r
+ TRNN SX,-1 ;RIGHT HALF ZERO?\r
+ JRST OP2A ;YES, DO SIMPLE ADD\r
+ MOVE ARG,RC ;NO, SWAP RC INTO ARG\r
+ ADD V,-1(PP) ;ADD RIGHT HALVES\r
+ ADD ARG,-2(PP)\r
+ HRRM V,-1(PP) ;UPDATE WITHOUT CARRY\r
+ HRRM ARG,-2(PP)\r
+ HLLZS AC0 ;PREPARE LEFT HALVES\r
+ HLLZS RC\r
+ TLNE SX,-1 ;IS LEFT HALF ZERO?\r
+ TRO ER,ERRQ ;NO FLAG FORMAT ERROR\r
+OP2A: ADDM AC0,-1(PP) ;MERGE WITH PREVIOUS VALUE\r
+ ADDM RC,-2(PP)\r
+ CAIE C,11 ;")"?\r
+ JRST ERRAX ;NO, FLAG ERROR\r
+ JRST BYPAS1 ;YES, BYPASS PARENTHESIS\r
+\r
+EXPRES: HRLZ AC0,RX ;FUDGE FOR OCT0\r
+\r
+OCT0: PUSH PP,RX\r
+ HLR RX,AC0\r
+OCT1: PUSHJ PP,EVALEX ;EVALUATE\r
+ PUSHJ PP,STOW ;STOW CODE\r
+ JUMPCM OCT1\r
+ POP PP,RX ;YES, RESTORE RADIX\r
+ POPJ PP, ;EXIT\r
+\fSIXB10: MOVSI RC,(POINT 6,AC0);SET UP POINTER\r
+ MOVEI AC0,0 ;CLEAR WORD\r
+\r
+SIXB20: PUSHJ PP,CHARL ;GET NEXT CHARACTER\r
+ CAMN C,SX ;IS THIS PRESET DELIMITER?\r
+ JRST ASC60 ;YES\r
+ CAIL C,"A"+40\r
+ CAILE C,"Z"+40\r
+ SKIPA \r
+ SUBI C,40 ;CONVERT LOWER CASE TO SIXBIT\r
+ SUBI C,40 ;CONVERT TO SIXBIT\r
+ JUMPL C,ASC55 ;TEST FOR INVALID CHARACTER\r
+ IDPB C,RC ;NO, DEPOSIT THE BYTE\r
+ TLNE RC,770000 ;IS THE WORD FULL?\r
+ JRST SIXB20 ;NO, GET NEXT CHARACTER\r
+ PUSHJ PP,STOWZ ;YES, STORE\r
+ JRST SIXB10 ;GET NEXT WORD\r
+\fASCII0: HLLZ SDEL,AC0 ;STORE ASCII/ASCIZ FLAG\r
+ASC10: PUSHJ PP,CHARL ;GET FIRST NON-BLANK\r
+ CAIE C," "\r
+ CAIN C,HT\r
+ JRST ASC10\r
+ CAIG C,CR ;CHECK FOR CRRET AS DELIM\r
+ CAIGE C,LF\r
+ SKIPA\r
+ JRST ERRAX\r
+ MOVE SX,SEQNO2\r
+ MOVEM SX,TXTSEQ\r
+ MOVE SX,PAGENO\r
+ MOVEM SX,TXTPG\r
+ SETOM INTXT\r
+ MOVE SX,C ;SAVE FOR COMPARISON\r
+ JUMPG SDEL,SIXB10 ;BRANCH IF SIXBIT\r
+\r
+ASC20: MOVSI RC,(POINT 7,AC0) ;SET UP POINTER\r
+ MOVEI AC0,0 ;CLEAR WORD\r
+ASC30: PUSHJ PP,CHARL ;GET ASCII CHARACTER AND LIST\r
+ CAMN C,SX ;TEST FOR DELIMITER\r
+ JRST ASC50 ;FOUND\r
+ IDPB C,RC ;DEPOSIT BYTE\r
+ TLNE RC,760000 ;HAVE WE FINISHED WORD?\r
+ JRST ASC30 ;NO,GET NEXT CHARACTER\r
+ PUSHJ PP,STOWZ ;YES, STOW IT\r
+ JRST ASC20 ;GET NEXT WORD\r
+\r
+ASC50: TDZA RC,SDEL ;TEST FOR ASCIIZ\r
+ASC55: TROA ER,ERRA ;SIXBIT FOUND EXIT\r
+ASC60: PUSHJ PP,BYPAS1 ;POLISH OFF TERMINATE\r
+ SETZM INTXT ;WE ARE OUT OF IT\r
+ ANDCM RC,STPX ;STORE AT LEAST ONE WORD\r
+ JUMPGE RC,STOWZ ;STOW\r
+ POPJ PP, ;ASCII, NO BYTES STORED, SO EXIT\r
+\fPOINT0: PUSH PP,RC ;STACK REGISTERS\r
+ PUSH PP,AC0\r
+ PUSHJ PP,EVAL10 ;EVALUATE RADIX 10\r
+ DPB AC0,[POINT 6,0(PP),11] ;STORE BYTE SIZE\r
+ JUMPNC POINT2\r
+ PUSHJ PP,EVALEX ;NO, GET ADDRESS\r
+ PUSHJ PP,EVADR ;EVALUATE STANDARD ADDRESS\r
+ JUMPNC POINT2\r
+ PUSHJ PP,EVAL10 ;EVALUATE RADIX 10\r
+ TLNE IO,NUMSW ;IF NUMERIC\r
+ TDCA AC0,[-1] ;POSITION=D35-RHB\r
+POINT2: MOVEI AC0,0 ;OTHERWISE SET TO D36\r
+ ADDI AC0,^D36\r
+ LSH AC0,^D30\r
+ ADDM AC0,0(PP) ;UPDATE VALUE\r
+ JRST OP3\r
+\fXWD0: PUSH PP,RC\r
+ PUSH PP,AC0 ;STORE ZERO ON STACK\r
+ PUSHJ PP,EVALEX ;EVALUATE EXPRESSION\r
+ JUMPNC OP2\r
+ HRLM AC0,0(PP) ;SET LEFT HALF\r
+ HRLM RC,-1(PP)\r
+ MOVSS EXTPNT ;WFW\r
+ JRST OP1A ;EXIT THROUGH OP\r
+\r
+IOWD0: PUSHJ PP,EVALXQ ;EVALUATE AND TEST FOR EXTERNAL\r
+ CAIE C,14 ;","?\r
+ SOJA AC0,STOW ;NO, TREAT AS RIGHT HALF\r
+ PUSH PP,AC0 ;YES, STACK LEFT HALF\r
+ PUSHJ PP,EVALEX ;WFW\r
+ SUBI AC0,1\r
+ POP PP,AC1 ;RETRIEVE LEFT HALF\r
+ MOVNS AC1\r
+ HRL AC0,AC1\r
+ JRST STOW ;STOW CODE AND EXIT\r
+\fBYTE0: PUSHJ PP,BYPAS1 ;GET FIRST NON-BLANK\r
+ CAIE C,10 ;"("?\r
+ JRST ERRAX ;NO, FLAG ERROR AND EXIT\r
+ PUSH PP,RC\r
+ PUSH PP,AC0 ;INITIALIZE STACK TO ZERO\r
+ MOVSI ARG,(POINT -1,(PP))\r
+\r
+BYTE1: PUSH PP,ARG\r
+ PUSHJ PP,EVAL10 ;EVALUATE RADIX 10\r
+ POP PP,ARG\r
+ CAIG AC0,^D36 ;TEST SIZE\r
+ CAIGE AC0,0\r
+ TRO ER,ERRA\r
+ DPB AC0,[POINT 6,ARG,11] ;STORE BYTE SIZE\r
+\r
+BYTE2: IBP ARG ;INCREMENT BYTE\r
+ TRZN ARG,-1 ;OVERFLOW?\r
+ JRST BYTE3 ;NO\r
+ SETZB AC0,RC ;YES\r
+ EXCH AC0,0(PP) ;GET CURRENT VALUES\r
+ EXCH RC,-1(PP) ;AND STACK ZEROS\r
+ PUSHJ PP,STOW ;STOW FULL WORD\r
+\r
+BYTE3: PUSH PP,ARG\r
+ PUSHJ PP,EVALEX ;COMPUTE NEXT BYTE\r
+ POP PP,ARG\r
+ DPB AC0,ARG ;STORE BYTE\r
+ HLLO AC0,ARG\r
+ DPB RC,AC0\r
+\r
+ JUMPCM BYTE2\r
+ CAIN C,10 ;"("?\r
+ JRST BYTE1 ;YES, GET NEW BYTE SIZE\r
+ JRST OP3 ;NO, EXIT\r
+\fRADX50: PUSHJ PP,EVALEX ;EVALUATE CODE\r
+ JUMPN RC,ERRAX ;ERROR IF NOT ABSOLUTE\r
+ MOVE ARG,AC0\r
+ JUMPNC ERRAX\r
+ PUSHJ PP,GETSYM ;YET, GET SYMBOL\r
+ POPJ PP,\r
+ PUSHJ PP,SQOZE ;SQUOZE SIXBIT AND ADD CODE\r
+ JRST STOW ;STOW CODE AND EXIT\r
+\r
+\r
+SQOZE: MOVE AC1+1,AC0 ;PUT SIXBIT IN AC1+1\r
+ MOVEI AC0,0 ;CLEAR RESULT\r
+SQOZ1: MOVEI AC1,0\r
+ LSHC AC1,6 ;PUT 6-BIT CHARACTER IN AC1\r
+ LDB AC1,[POINT 6,CSTAT(AC1),23] ;CONVERT TO RADIX50\r
+ IMULI AC0,50 ;MULTIPLY PREVIOUS RESULT\r
+ ADD AC0,AC1 ;ADD NEW CHARACTER\r
+ JUMPN AC1+1,SQOZ1 ;TEST FOR END\r
+ LSH ARG,^D30 ;LEFT-JUSTIFY CODE\r
+ IOR AC0,ARG ;MERGE WITH RESULT\r
+ POPJ PP,\r
+\fSUBTTL MACRO/REPEAT HANDLERS\r
+\r
+REPEA0: PUSHJ PP,EVALXQ ;EVALUATE REPEAT EXP, EXTERNS ARE ILL\r
+ JUMPNC ERRAX\r
+\r
+REPEA1: JUMPLE AC0,REPZ ;PASS THE EXP., DONT PROCESS\r
+ SOJE AC0,REPO ;REPEAT ONCE\r
+REPEA2: PUSHJ PP,GCHARQ ;GET STARTING "<"\r
+ CAIE C,"<"\r
+ JRST REPEA2\r
+ PUSHJ PP,SKELI1 ;INITIALZE SKELETON\r
+ PUSH MP,REPEXP\r
+ MOVEM AC0,REPEXP\r
+ PUSH MP,REPPNT ;STACK PREVIOUS REPEAT POINTER\r
+ MOVEM ARG,REPPNT ;STORE NEW POINTER\r
+ TDZA SDEL,SDEL ;YES, INITIALIZE BRACKET COUNT AND SKIP\r
+\r
+REPEA4: PUSHJ PP,WCHARQ ;WRITE A CHARACTER\r
+ PUSHJ PP,GCHARQ ;GET A CHARACTER\r
+ CAIN C,"<" ;"<"?\r
+ AOJA SDEL,REPEA4 ;YES, INCREMENT AND WRITE\r
+ CAIE C,">" ;">"?\r
+ JRST REPEA4 ;NO, WRITE THE CHARACTER\r
+ SOJGE SDEL,REPEA4 ;YES, WRITE IF NON-NEGATIVE COUNT\r
+ MOVSI CS,(BYTE (7) 177,3) ;SET "REPEAT" END\r
+ PUSHJ PP,WWRXE ;WRITE END\r
+ PUSH MP,MRP ;STACK PREVIOUS READ POINTER\r
+REPEA5: HLRZ MRP,@REPPNT\r
+REPEA8: MOVEI C,LF\r
+ JRST RSW1\r
+\r
+REPEND: SOSL REPEXP\r
+ JRST REPEA5\r
+ HRRZ V,REPPNT ;GET START OF TREE\r
+ PUSHJ PP,REFDEC ;DECREMENT REFERENCE\r
+ POP MP,MRP\r
+ POP MP,REPPNT\r
+ POP MP,REPEXP\r
+ JRST RSW0\r
+\fREPZ: MOVE SDEL,SEQNO2\r
+ MOVEM SDEL,REPSEQ\r
+ MOVE SDEL,PAGENO\r
+ MOVEM SDEL,REPPG\r
+ SETOM INREP\r
+ MOVEI SDEL,0 ;SET COUNT\r
+REPZ1: PUSHJ PP,GCHAR ;GET NEXT CHARACTER\r
+ CAIN C,"<" ;"<"?\r
+ AOJA SDEL,REPZ1 ;YES, INCREMENT COUNT\r
+ CAIN C,">" ;">"?\r
+ SOJLE SDEL,REPZ2 ;YES, EXIT IF MATCHING\r
+ JRST REPZ1 ;NO, RECYCLE\r
+REPZ2: SETZM INREP\r
+ JRST GETCHR\r
+\r
+REPO: PUSHJ PP,GCHAR ;GET "<"\r
+ CAIE C,"<"\r
+ JRST REPO\r
+ SKIPE RPOLVL ;ARE WE NESTED?\r
+ AOS RPOLVL ;YES, DECREMENT CURRENT\r
+ PUSH MP,RPOLVL\r
+ SETOM RPOLVL\r
+ JRST STMNT\r
+\r
+REPO1: CAIN C,"<"\r
+ SOS RPOLVL\r
+ CAIN C,">"\r
+ AOSE RPOLVL\r
+ JRST RSW2\r
+ POP MP,RPOLVL\r
+ PUSHJ PP,RSW2\r
+ JRST RSW0\r
+\fDEFIN0: PUSHJ PP,GETSYM ;GET MACRO NAME\r
+ JRST ERRAX ;EXIT ON ERROR\r
+ MOVEM PP,PPTMP1 ;SAVE POINTER\r
+ MOVEM AC0,PPTMP2 ;SAVE NAME\r
+ TLO IO,IORPTC\r
+ MOVE SX,SEQNO2\r
+ MOVEM SX,DEFSEQ\r
+ MOVE SX,PAGENO\r
+ MOVEM SX,DEFPG\r
+ SETOM INDEF\r
+ MOVEI SX,0\r
+DEF02: PUSHJ PP,GCHAR\r
+ CAIN C,74\r
+ JRST DEF20\r
+ CAIE C,50\r
+ JRST DEF02\r
+DEF10: PUSHJ PP,GETSYM ;YES, GET DUMMY SYMBOL\r
+ TRO ER,ERRA ;FLAG ERROR\r
+ ADDI SX,1000 ;INCREMENT ARG COUNT\r
+ PUSH PP,AC0 ;STACK IT\r
+ CAIE C,11 ;")"?\r
+ JRST DEF10 ;NO, GET NEXT DUMMY SYMBOL\r
+DEF12: PUSHJ PP,GCHAR\r
+ CAIE C,"<" ;"<"?\r
+ JRST DEF12 ;NO\r
+DEF20: PUSH PP,[0] ;YES, MARK THE LIST\r
+ AOS ARG,SX\r
+ PUSHJ PP,SKELI ;INITIALIZE MACRO SKELETON\r
+ MOVE AC0,PPTMP2 ;GET NAME\r
+ MOVEM PP,PPTMP2\r
+ TLO IO,DEFCRS\r
+ PUSHJ PP,MSRCH ;SEARCH THE TABLE\r
+ JRST DEF24 ;NOT FOUND\r
+ TLNN ARG,MACF ;FOUND, IS IT A MACRO?\r
+ TROA ER,ERRX ;NO, FLAG ERROR AND SKIP\r
+ PUSHJ PP,REFDEC ;YES, DECREMENT THE REFERENCE\r
+DEF24: HRRZ V,WWRXX ;GET START OF TREE\r
+ MOVSI ARG,MACF\r
+ PUSHJ PP,INSERT ;INSERT/UPDATE\r
+ TLZ IO,DEFCRS ;JUST IN CASE\r
+ TDZA SDEL,SDEL ;CLEAR BRACKET COUNT\r
+\fDEF30: PUSHJ PP,WCHAR ;WRITE CHARACTER\r
+DEF31: PUSHJ PP,GCHAR ;GET A CHARACTER\r
+DEF32: MOVE CS,C ;GET A COPY\r
+ CAIG CS,"Z"+40 ;CONVERT LOWER CASE\r
+ CAIGE CS,"A"+40\r
+ SKIPA \r
+ SUBI CS,40\r
+ CAIL CS,40\r
+ CAILE CS,77+40\r
+ JRST DEF30 ;TEST FOR SPECIAL\r
+ MOVE CS,CSTAT-40(CS) ;GET STATUS BITS\r
+ TLNE CS,6 ;ALPHA-NUMERIC?\r
+ JRST DEF40 ;YES\r
+ CAIN C,74\r
+ AOJA SDEL,DEF30\r
+ CAIN C,76\r
+ SOJL SDEL,DEF70\r
+ CAIE C,47 ;IS THIS A '?\r
+ JRST DEF30\r
+ SKIPE SDEL\r
+CPEEK1: PUSHJ PP,WCHAR\r
+ PUSHJ PP,GCHAR\r
+ CAIE C,47\r
+ JRST DEF32\r
+ JRST CPEEK1\r
+\fDEF40: MOVEI AC0,0 ;CLEAR ATOM\r
+ MOVSI AC1,(POINT 6,AC0) ;SET POINTER\r
+DEF42: PUSH PP,C\r
+ TLNE AC1,770000\r
+ IDPB CS,1\r
+ PUSHJ PP,GCHAR ;GET NEXT CHARACTER\r
+ MOVE CS,C\r
+ CAIG CS,"Z"+40\r
+ CAIGE CS,"A"+40\r
+ SKIPA \r
+ SUBI CS,40 ;CONVERT LOWER TO UPPER\r
+ CAIL CS,40\r
+ CAILE CS,77+40\r
+ JRST DEF44 ;TEST SPECIAL\r
+ MOVE CS,CSTAT-40(CS) ;GET STATUS\r
+ TLNE CS,6 ;ALPHA-NUMERIC?\r
+ JRST DEF42 ;YES, GET ANOTHER\r
+DEF44: PUSH PP,[0] ;NO, MARK THE LIST\r
+ MOVE SX,PPTMP1 ;GET POINTER TO TP\r
+\r
+DEF46: SKIPN 1(SX) ;END OF LIST?\r
+ JRST DEF51 ;YES\r
+ CAME AC0,1(SX) ;NO, DO THEY COMPARE\r
+ AOJA SX,DEF46 ;NO, TRY AGAIN\r
+ SUB SX,PPTMP1 ;YES, GET DUMMY SYMBOL NUMBER\r
+ LSH SX,4\r
+ MOVSI CS,0776020(SX) ;(<BYTE (7) 177,101>)(SX) ;SET ESCAPE CODE MACEND\r
+ LSH AC0,-^D30\r
+ CAIN AC0,5 ;"%"?\r
+ TLO CS,1000 ;YES, SET CRESYM FLAG\r
+ PUSHJ PP,WWORD ;WRITE THE WORD\r
+DEF48: MOVE PP,PPTMP2 ;RESET PUSHDOWN POINTER\r
+ TLO IO,IORPTC ;ECHO LAST CHARACTER\r
+ JRST DEF31\r
+\r
+DEF51: MOVE C,2(SX) ;GET CHARACTER\r
+ JUMPE C,DEF48 ;CLEAN UP IF END\r
+ PUSHJ PP,WCHAR ;WRITE THE CHARACTER\r
+ AOJA SX,DEF51 ;GET NEXT\r
+\r
+DEF70: MOVE PP,PPTMP1 ;RESTORE PUSHDOWN POINTER\r
+ MOVSI CS,(BYTE (7) 177,1)\r
+ PUSHJ PP,WWRXE ;WRITE END\r
+ SETZM INDEF ;OUT OF IT\r
+ JRST BYPAS1\r
+\fSUBTTL MACRO CALL PROCESSOR\r
+CALLM: SKIPGE MACENL ;ARE WE TRYING TO RE-ENTER?\r
+ JRST ERRAX ;YES, BOMB OUT WITH ERROR\r
+ HRROS MACENL ;FLAG "CALLM IN PROGRESS"\r
+ EXCH MP,RP\r
+ PUSH MP,V ;STACK FOR REFDEC\r
+ EXCH MP,RP\r
+ MOVE SDEL,SEQNO2\r
+ MOVEM SDEL,CALSEQ\r
+ MOVE SDEL,PAGENO\r
+ MOVEM SDEL,CALPG\r
+ HLRZ V,0(V)\r
+ AOS SDEL,0(V) ;INCREMENT ARG COUNT\r
+ LSHC SDEL,-^D<9+36> ;ZERO SDEL, GET ARG COUNT IN SX\r
+ ANDI SX,777 ;MASK\r
+ PUSH PP,V ;STORE COUNT OF ARGS\r
+ PUSH PP,RP ;STACK FOR MACPNT\r
+ JUMPE SX,MAC20 ;TEST FOR NO ARGS\r
+ PUSHJ PP,CHARAC\r
+ CAIE C,"(" ;"("\r
+ TROA SDEL,-1 ;YES, END OF ARGUMENT STRING\r
+\r
+MAC10: PUSHJ PP,GCHAR\r
+ CAIG C,CR\r
+ CAIGE C,LF\r
+ SKIPA\r
+ JRST MAC21\r
+ CAIN C,";" ;";"?\r
+ JRST MAC21 ;YES, END OF ARGUMENT STRING\r
+ PUSHJ PP,SKELI1 ;NO, INITIALIZE SKELETON\r
+ CAIN C,"<" ;"<"?\r
+ JRST MAC30 ;YES, PROCESS AS SPECIAL\r
+ CAIE C,176\r
+ CAIN C,134 ;"\"\r
+ JRST MAC40\r
+MAC14: CAIN C,"," ;","?\r
+ JRST MAC16 ;YES, NULL SYMBOL\r
+ CAIN C,"(" ;"("?\r
+ ADDI SDEL,1 ;YES, INCREMENT COUNT\r
+ CAIN C,")" ;")"?\r
+ SOJL SDEL,MAC16 ;YES, TEST FOR END\r
+ PUSHJ PP,WCHAR ;WRITE INTO SKELETON\r
+MAC14A: PUSHJ PP,CHARAC ;GET NEXT CHARACTER\r
+ CAIG C,CR\r
+ CAIGE C,LF\r
+ SKIPA\r
+ JRST MAC15 ;TEST FOR END OF LINE\r
+ CAIE C,";" ;";"?\r
+ JRST MAC14 ;YES, END OF LINE\r
+\r
+MAC15: TLO IO,IORPTC\r
+MAC16: MOVSI CS,(BYTE (7) 177,2)\r
+ PUSHJ PP,WWRXE ;WRITE END\r
+ EXCH MP,RP\r
+ PUSH MP,WWRXX\r
+ EXCH MP,RP\r
+ SOJG SX,MAC10 ;BRANCH IF NO MORE ARGS\r
+\fMAC20: TLZN IO,IORPTC\r
+ PUSHJ PP,CHARAC\r
+MAC21: EXCH MP,RP\r
+MAC21A: PUSH MP,[-1] ;NO MISSING ARGS\r
+ SOJGE SX,MAC21A\r
+ SETZM 0(MP)\r
+ LDB C,LBUFP\r
+ MOVEI SX,"^"\r
+ JUMPAD MAC24\r
+ CAIN C,";"\r
+ SKIPE MRP\r
+ JRST MAC24\r
+ PUSHJ PP,STOUT ;LIST COMMOENT OR CR-LF\r
+ TLNE IO,IOPALL ;MACRO EXPANSION SUPPRESSION?\r
+ TLO IO,IOMAC ; NO, SET TEMP BIT\r
+ TDOA C,[-1] ;FLAG LAST CHARACTER\r
+MAC24: DPB SX,LBUFP\r
+ PUSH MP,MACPNT\r
+ POP PP,MACPNT\r
+ PUSH MP,C\r
+ PUSH MP,MRP ;STACK WORD COUNT\r
+ POP PP,MRP ;STACK MACRO POINTER\r
+ EXCH MP,RP\r
+ AOS MACLVL\r
+ HRRZS MACENL ;RESET "CALLM IN PROGRESS"\r
+ JUMPOC STMNT2 ;OP-CODE FIELD\r
+ JRST EVATOM ;ADDRESS FIELD\r
+\r
+\fMAC30: MOVEI AC0,0 ;INITIALIZE BRACKET COUNTER\r
+MAC31: PUSHJ PP,GCHAR ;GET A CHARACTER\r
+ CAIN C,"<" ;"<"?\r
+ ADDI AC0,1 ;YES, INCREMENT COUNT\r
+ CAIN C,">" ;">"?\r
+ SOJL MAC14A ;YES, EXIT IF MATCHING\r
+ PUSHJ PP,WCHAR ;WRITE INTO SKELETON\r
+ JRST MAC31 ;GO BACK FOR ANOTHER\r
+\r
+MAC40: PUSH PP,SX ;STACK REGISTERS\r
+ PUSH PP,SDEL\r
+ HLLM IO,TAGINC ;SAVE IO FLAGS\r
+ PUSHJ PP,CELL ;GET AN ATOM\r
+ MOVE V,AC0 ;ASSUME NUMERIC\r
+ TLNE IO,NUMSW ;GOOD GUESS?\r
+ JRST MAC41 ;YES\r
+ PUSHJ PP,SSRCH ;SEARCH THE SYMBOL TABLE\r
+ TROA ER,ERRX ;NOT FOUND, ERROR\r
+MAC41: PUSHJ PP,MAC42 ;FORM ASCII STRING\r
+ HLL IO,TAGINC ;RESTORE IO FLAGS\r
+ POP PP,SDEL\r
+ POP PP,SX\r
+ TLO IO,IORPTC ;REPEAT LAST CHARACTER\r
+ JRST MAC14A ;RETURN TO MAIN SCAN\r
+\r
+MAC42: MOVE C,V\r
+MAC44: LSHC C,-^D35\r
+ LSH CS,-1\r
+ DIVI C,0(RX) ;DIVIDE BY CURRENT RADIX\r
+ HRLM CS,0(PP)\r
+ SKIPE C ;TEST FOR END\r
+ PUSHJ PP,MAC44\r
+ HLRZ C,0(PP)\r
+ ADDI C,"0" ;FORM TEXT\r
+ JRST WCHAR ;WRITE INTO SKELETON\r
+\fMACEN0: SOS MACENL\r
+MACEND: SKIPGE C,MACENL ;TEST "CALLM IN PROGRESS"\r
+ AOS MACENL ;INCREMENT END LEVEL AND EXIT\r
+ JUMPL C,REPEA8\r
+ EXCH MP,RP\r
+ POP MP,MRP ;RETRIEVE READ POINTER\r
+ MOVEI C,"^"\r
+ SKIPL 0(MP) ;TEST FLAG\r
+ PUSHJ PP,RSW2 ;MARK END OF SUBSTITUTION\r
+ POP MP,C\r
+ POP MP,ARG\r
+ SKIPA MP,MACPNT ;RESET MP AND SKIP\r
+MACEN1: PUSHJ PP,REFDEC ;DECREMENT REFERENCE\r
+MACEN2: AOS V,MACPNT ;GET POINTER\r
+ MOVE V,0(V)\r
+ JUMPG V,MACEN1 ;IF >0, DECREMENT REFERENCE\r
+ JUMPL V,MACEN2 ;IF <0, BYPASS\r
+ POP MP,V ;IF=0, RETRIEVE POINTER\r
+ PUSHJ PP,REFDEC ;DECREMENT REFERENCE\r
+ MOVEM ARG,MACPNT\r
+ EXCH MP,RP\r
+ SOS MACLVL\r
+ HLRZ CS,0(MRP)\r
+ SKIPE MACENL ;CHECK UPROCESSED END LEVEL\r
+ JUMPE CS,MACEN0 ;THEN POP THE MACRO STACK NOW\r
+ JUMPL C,REPEA8 ;IF FLAG SET SUBSTITUTE\r
+ JRST RSW1\r
+\fIRP0: SKIPN MACLVL ;ARE WE IN A MACRO\r
+ JRST ERRAX ;NO, BOMB OUT\r
+IRP10: PUSHJ PP,MREADS ;YES, GET DATA SPEC\r
+ CAIE C,40 ;SKIP LEADING BLANKS\r
+ CAIN C,"(" ;"("?\r
+ JRST IRP10 ;YES, BYPASS\r
+ CAIN C,11\r
+ JRST IRP10\r
+ CAIE C,177 ;NO, IS IT SPECIAL?\r
+ JRST ERRAX ;NO, ERROR\r
+ PUSHJ PP,MREADS ;YES\r
+ TRZN C,100 ;CREATED?\r
+ JRST ERRAX\r
+ CAIL C,40 ;TOO BIG?\r
+ JRST ERRAX\r
+ ADD C,MACPNT ;NO, FORM POINTER TO STACK\r
+ PUSH MP,IRPCF ;STACK PREVIOUS POINTERS\r
+ PUSH MP,IRPSW\r
+ PUSH MP,IRPARP\r
+ PUSH MP,IRPARG\r
+ PUSH MP,0(C)\r
+ PUSH MP,IRPPOI\r
+\r
+ HRRZM C,IRPARP\r
+ MOVEM AC0,IRPCF ;IRPC FLAG FOUND IN AC0\r
+ SETOM AC0,IRPSW ;RESET IRP SWITCH\r
+ MOVE CS,0(C)\r
+ MOVEM CS,IRPARG\r
+ PUSHJ PP,MREADS\r
+ CAIE C,"<" ;"<">\r
+ JRST .-2 ;NO, SEARCH UNTIL FOUND\r
+ PUSHJ PP,SKELI1 ;INITIALIZE NEW STRING\r
+ MOVEM ARG,IRPPOI ;SET NEW POINTER\r
+\r
+ TDZA SDEL,SDEL ;ZERO BRACKET COUNT AND SKIP\r
+IRP20: PUSHJ PP,WCHAR\r
+ PUSHJ PP,MREADS\r
+ CAIN C,"<" ;"<"?\r
+ AOJA SDEL,IRP20 ;YES, INCREMENT COUNT AND WRITE\r
+ CAIE C,">" ;">"?\r
+ JRST IRP20 ;NO, JUST WRITE IT\r
+ SOJGE SDEL,IRP20 ;YES, WRITE IF NOT MATCHING\r
+ MOVE CS,[BYTE (7) 15,177,4]\r
+ PUSHJ PP,WWRXE ;WRITE END\r
+ PUSH MP,MRP ;STACK PREVIOUS READ POINTER\r
+ SKIPG CS,IRPARG\r
+ JRST IRPPOP ;EXIT IF NOT VALID ARGUMENT\r
+ HLRZ C,0(CS) ;INITIALIZE POINTER\r
+ MOVEM C,IRPARG\r
+\fIRPSET: EXCH MRP,IRPARG ;SWAP READ POINTERS\r
+ PUSHJ PP,SKELI1 ;INITIALIZE SKELETON FOR DATA\r
+ HRRZM ARG,@IRPARP ;STORE NEW DS POINTER\r
+ SETZB SX,SDEL ;ZERO FOUND FLAG AND BRACKET COUNT\r
+IRPSE1: PUSHJ PP,MREADS\r
+ CAIE C,177 ;SPECIAL?\r
+ AOJA SX,IRPSE2 ;NO, FLAG AS FOUND\r
+ MOVEM MRP,V\r
+ PUSHJ PP,MREADS ;LOOK AT NEXT CHARACTER\r
+ MOVE MRP,V\r
+ SETZM IRPSW ;SET IRP SWITCH\r
+ JUMPG SX,IRPSE4 ;IF ARG FOUND, PROCESS IT\r
+ JRST IRPPOP ;NO, CLEAN UP AND EXIT\r
+\r
+IRPSE2: SKIPE IRPCF ;IRPC?\r
+ JRST IRPSE3 ;YES, WRITE IT\r
+ CAIN C,"," ;NO, IS IT A COMMA?\r
+ JUMPE SDEL,IRPSE4 ;YES, EXIT IF NOT NESTED\r
+ CAIN C,"<" ;"<"?\r
+ ADDI SDEL,1 ;YES, INCREMENT COUNT\r
+ CAIN C,">" ;">"?\r
+ SUBI SDEL,1 ;YES, DECREMENT COUNT\r
+\r
+IRPSE3: PUSHJ PP,WCHAR\r
+ SKIPN IRPCF ;IRPC?\r
+ JRST IRPSE1 ;NO, GET NEXT CHARACTER\r
+\r
+IRPSE4: MOVSI CS,(BYTE (7) 177,2)\r
+ PUSHJ PP,WWRXE ;WRITE END\r
+ MOVEM MRP,IRPARG ;SAVE POINTER\r
+ HLRZ MRP,@IRPPOI ;SET FOR NEW SCAN\r
+ JRST REPEA8 ;ON ARG COUNT\r
+\fSTOPI0: SKIPN IRPARP ;IRP IN PROGRESS?\r
+ JRST ERRAX ;NO, ERROR\r
+ SETZM IRPSW ;YES, SET SWITCH\r
+ POPJ PP,\r
+\r
+IRPEND: MOVE V,@IRPARP\r
+ PUSHJ PP,REFDEC\r
+ SKIPE IRPSW ;MORE TO COME?\r
+ JRST IRPSET ;YES\r
+\r
+IRPPOP: MOVE V,IRPPOI\r
+ PUSHJ PP,REFDEC ;DECREMENT REFERENCE\r
+ POP MP,MRP ;RESTORE CELLS\r
+ POP MP,IRPPOI\r
+ POP MP,@IRPARP\r
+ POP MP,IRPARG\r
+ POP MP,IRPARP\r
+ POP MP,IRPSW\r
+ POP MP,IRPCF\r
+ JRST REPEA8\r
+\fGETDS: MOVE CS,C ;USE CS FOR WORK REGISTER\r
+ ANDI CS,37 ;MASK\r
+ ADD CS,MACPNT ;ADD BASE ADDRESS\r
+ MOVE V,0(CS) ;GET POINTER FLAG\r
+ JUMPG V,GETDS1 ;BRANCH IF POINTER\r
+ TRNN C,40 ;NOT POINTER, SHOULD WE CREATE?\r
+ JRST RSW0 ;NO, FORGET THIS ARG\r
+ PUSH PP,WWRXX\r
+ PUSH PP,MWP ;STACK MACRO WRITE POINTER\r
+ PUSHJ PP,SKELI1 ;INITIALIZE SKELETON\r
+ MOVEM ARG,0(CS) ;STORE POINTER\r
+ MOVE CS,[BYTE (7) 0,170,170,170,171] ;CREATE A SYMBOL\r
+ ADD CS,LSTSYM ;LSTSYM= # OF LAST CREATED\r
+ TDZ CS,[BYTE (7) 0,170,170,170,170]\r
+ MOVEM CS,LSTSYM\r
+ IOR CS,[ASCII /.0000/]\r
+ MOVEI C,"."\r
+ PUSHJ PP,WCHAR ;WRITE INTO SKELETON\r
+ PUSHJ PP,WWORD\r
+ MOVSI CS,(BYTE (7) 177,2)\r
+ PUSHJ PP,WWRXE ;WRITE END CODE\r
+ POP PP,MWP ;RESTORE MACRO WRITE POINTER\r
+ POP PP,WWRXX\r
+ MOVE V,ARG ;SET UP FOR REFINC\r
+\r
+GETDS1: PUSHJ PP,REFINC ;INCREMENT REFERENCE\r
+ PUSH MP,V ;STACK V FOR DECREMENT\r
+ PUSH MP,MRP ;STACK READ POINTER\r
+ HLRZ MRP,0(V) ;FORM READ POINTER\r
+ JRST RSW0 ;EXIT\r
+\r
+DSEND: POP MP,MRP\r
+ POP MP,V\r
+ PUSHJ PP,REFDEC ;DECREMENT REFERENCE\r
+ JRST RSW0 ;EXIT\r
+\fSKELI1: MOVEI ARG,1 ;ENTRY FOR SINGLE ARG\r
+SKELI: MOVE MWP,LADR\r
+ PUSHJ PP,SKELWL ;GET POINTER WORD\r
+ HRRZM MWP,WWRXX ;SAVE FIRST ADDRESS\r
+ PUSHJ PP,SKELWL\r
+ HRRM ARG,0(MWP) ;STORE COUNT\r
+ HRRZ ARG,WWRXX ;SET FIRST ADDRESS\r
+ ;SKEW RETURNS WITH ADR OF NEXT FREE LOC IN V (RIGHT)\r
+\r
+SKELWL: SKIPE V,NEXT ;GET FIRST FREE ADDRESS\r
+ JRST SKELW1 ;IF NON-ZERO, UPDATE FREE\r
+ AOS V,FREE ;INCREMENT BY LEAF SIZE\r
+ CAML V,SYMBOL ;OVERFLOW?\r
+ PUSHJ PP,XCEED ;YES, BOMB OUT\r
+ SETZM (V) ;CLEAR LINK\r
+\r
+SKELW1: HLL V,0(V) ;GET ADDRESS\r
+ HLRM V,NEXT ;UPDATE NEXT\r
+ HRLM V,0(MWP) ;STORE LINK IN FIRST WORD OF LEAF\r
+ HRRZ MWP,V\r
+ TLO MWP,(POINT 7,,21) ;2 ASCII CHARS\r
+ POPJ PP,\r
+\r
+ ;WWRXX POINTS TO END OF TREE\r
+ ;MWP IDPB POINTER TO NEXT HOLE\r
+ ;NEXT FIRST OF A LINKED PORTION THAT IS NOT BEING USED (LEAVES)\r
+ ;FREE POINTS TO FREE CORE BETWEEN TREE AND SYM-TABLE\r
+ ;LADR POINTS TO BEG OF LINKED PORTION.\r
+\fGCHARQ: SKIPE MACLVL\r
+ JRST MREADS ;IF GETTING CHAR. FROM TREE\r
+GCHAR: PUSHJ PP,CHARAC ;GET ASCII CHARACTER\r
+ CAIE C,LF ;TEST FOR LF, VT OR FF\r
+ CAIN C,FF\r
+ PUSHJ PP,OUTIM1 ;YES, LIST IT\r
+ POPJ PP,\r
+\r
+WCHARQ: SKIPE MACLVL\r
+ JRST WCHAR\r
+WCHAR: TLNN MWP,770000 ;END OF WORD?\r
+ PUSHJ PP,SKELWL ;YES, GET ANOTHER\r
+ IDPB C,MWP\r
+ POPJ PP,\r
+\r
+WWORD: LSHC C,7 ;MOVE ASCII INTO C\r
+ PUSHJ PP,WCHAR ;STORE IT\r
+ JUMPN CS,WWORD ;TEST FOR END\r
+ POPJ PP, ;YES, EXIT\r
+\r
+WWRXE: PUSHJ PP,WWORD ;WRITE LAST WORD\r
+ HRRZS (MWP) ;ZERO LEFT HALF OF LAST LEAF\r
+ HRRM MWP,@WWRXX ;SET POINTER TO END\r
+ POPJ PP,\r
+\fMREAD: PUSHJ PP,MREADS ;READ ON CHARACTER\r
+ CAIE C,177 ;SPECIAL?\r
+ JRST RSW1 ;NO, EXIT\r
+ PUSHJ PP,MREADS ;YES, GET CODE WORD\r
+ TRZE C,100 ;SYMBOL?\r
+ JRST GETDS ;YES\r
+ CAILE C,4 ;POSSIBLY ILLEGAL\r
+ JRST ERRAX ;YES\r
+ JRST .+1(C)\r
+ PUSHJ PP,XCEED\r
+ JRST MACEND ;1; END OF MACRO\r
+ JRST DSEND ;2; END OF DUMMY SYMBOL\r
+ JRST REPEND ;3; END OF REPEAT\r
+ JRST IRPEND ;4; END OF IRP\r
+\r
+MREADS: TLNE MRP,770000 ;HAVE WE FINISHED WORD?\r
+ JRST MREADC ;STILL CHAR. IN LEAF\r
+ HLRZ MRP,0(MRP) ;YES, GET LINK\r
+ HRLI MRP,(POINT 7,,21) ;SET POINTER\r
+MREADC: ILDB C,MRP ;GET CHARACTER\r
+ POPJ PP,\r
+\r
+\fREFINC: HLRZ CS,0(V) ;GET POINTER TO FREE\r
+ AOS 0(CS) ;INCREMENT REFERENCE\r
+ POPJ PP,\r
+REFDEC: HLRZ CS,0(V) ;GET POINTER TO TREE\r
+ SOS CS,0(CS) ;DECREMENT REFERENCE\r
+ TRNE CS,000777 ;IS IT ZERO?\r
+ POPJ PP, ;NO, EXIT\r
+ HRRZ CS,0(V) ;YES, GET POINTER TO END\r
+ HRL CS,NEXT ;GET POINTER TO NEXT RE-USABLE\r
+ HLLM CS,0(CS) ;SET LINK\r
+ HRRM V,NEXT ;RESET NEXT\r
+ POPJ PP,\r
+\r
+\fA== 0 ;ASCII MODE\r
+AL== 1 ;ASCII LINE MODE\r
+IB== 13 ;IMAGE BINARY MODE\r
+B== 14 ;BINARY MODE\r
+\r
+CTL== 0 ;CONTROL DEVICE NUMBER\r
+IFN CCLSW,<CTL2==4 ;INPUT DEV FOR CCL FILE>\r
+BIN== 1 ;BINARY DEVICE NUMBER\r
+CHAR== 2 ;INPUT DEVICE NUMBER\r
+LST== 3 ;LISTING DEVICE NUMBER\r
+\r
+; COMMAND STRING ACCUMULATORS\r
+\r
+ACDEV== 1 ;DEVICE\r
+ACFILE==2 ;FILE\r
+ACEXT== 3 ;EXTENSION\r
+ACPPN== 4 ;PPN\r
+ACDEL== 4 ;DELIMITER\r
+ACPNTR==5 ;BYTE POINTER\r
+\r
+TIO== 6\r
+\r
+TIORW== 1000\r
+TIOLE== 2000\r
+TIOCLD==20000\r
+\r
+DIRBIT==4 ;DIRECTORY DEVICE\r
+TTYBIT==10 ;TTY\r
+MTABIT==20 ;MTA\r
+DTABIT==100 ;DTA\r
+DISBIT==2000 ;DISPLAY\r
+CONBIT==20000 ;CONTROLING TTY\r
+LPTBIT==40000 ;LPT\r
+DSKBIT==200000 ;DSK\r
+\r
+;GETSTS ERROR BITS\r
+\r
+IOIMPM==400000 ;IMPROPER MODE (WRITE LOCK)\r
+IODERR==200000 ;DEVICE DATA ERROR\r
+IODTER==100000 ;CHECKSUM OR PARITY ERROR\r
+IOBKTL== 40000 ;BLOCK TOO LARGE\r
+ERRBIT==IOIMPM!IODERR!IODTER!IOBKTL\r
+\fSUBTTL I/O ROUTINES\r
+BEG:\r
+IFN CCLSW,<TLZA IO,ARPGSW ;DON'T ALLOW RAPID PROGRAM GENERATION\r
+ TLO IO,ARPGSW ;ALLOW RAPID PROGRAM GENERATION\r
+ TLZA IO,CRPGSW ;SET TO INITI NEW COMMAND FILE\r
+M: TLNN IO,CRPGSW ;CURRENTLY DOING RPG?>\r
+IFE CCLSW,<M:>\r
+ RESET ;INITIALIZE PROGRAM\r
+ SETZB MRP,PASS1I\r
+ MOVE [XWD PASS1I,PASS1I+1]\r
+ BLT PASS2X-1 ;ZERO THE PASS1 AND PASS2 VARIABLE\r
+ MOVEI PP,JOBFFI ;SET TEMP PUSH-DOWN POINTER\r
+ MOVE CS,[POINT 7,DBUF] ;INITIALIZE FOR DATA\r
+ MSTIME 2, ;GET TIME FROM MONITOR\r
+ IDIVI 2,^D60*^D1000\r
+ IDIVI 2,^D60\r
+ PUSH PP,3 ;SAVE MINUTES\r
+ PUSHJ PP,OTOD1\r
+ POP PP,2\r
+ PUSHJ PP,OTOD1\r
+ DATE 1,\r
+ IDIVI 1,^D31 ;GET DAY\r
+ ADDI 2,1\r
+ CAIG 2,^D9 ;TWO DIGITS?\r
+ ADDI 2,7760*^D10 ;NO, PUT IN SPACE\r
+ PUSHJ PP,OTOD1 ;STORE DAY\r
+ IDIVI 1,^D12 ;GET MONTH\r
+ MOVE 2,DTAB(2) ;GET MNEMONIC\r
+ ADDI CS,1\r
+ MOVEM 2,0(CS)\r
+ MOVEI 2,^D64(1) ;GET YEAR\r
+ PUSHJ PP,OTOD ;STORE IT\r
+ MOVSI FR,P1!CREFSW\r
+IFN CCLSW,<TLNE IO,CRPGSW ;RPG IN PROGRESS?\r
+ JRST GOSET ;YES, GO READ NEXT COMMAND\r
+ TLNE IO,ARPGSW ;NO, RPG ALLOWED?\r
+ JRST RPGSET ;YES, GO TRY\r
+CTLSET: RELEAS CTL2, ;IN CASE OF LOOKUP FAILURE>\r
+IFE CCLSW,<CTLSET:>\r
+ MOVSI IO,IOPALL ;ZERO FLAGS\r
+ INIT CTL,AL ;INITIALIZE USER CONSOLE\r
+ SIXBIT /TTY/\r
+ XWD CTOBUF,CTIBUF\r
+ EXIT ;NO TTY, NO ASSEMBLY\r
+ INBUF CTL,1 ;INITIALIZE SINGLE CONTROL\r
+ OUTBUF CTL,1 ;BUFFERS\r
+ PUSHJ PP,CRLF ;OUTPUT CARRIAGE RETURN - LINE FEED\r
+ MOVEI C,"*"\r
+ IDPB C,CTOBUF+1\r
+ OUTPUT CTL,0\r
+ INPUT CTL,0\r
+\fIFN CCLSW,<JRST BINSET ;BEGIN WITH BINARY FILE\r
+RPGSET:\r
+IFN TEMP,<HRRZ 3,JOBFF ;GET START OF BUFFER AREA\r
+ HRRM 3,TMPFIL+1 ;STORE IN TMPCOR UUO IOWD\r
+ SOS TMPFIL+1 ;MAKE IT THE PROPER IOWD FORMAT\r
+ HRRM 3,CTLBLK+1 ;DUMMY UP BUFFER HEADER\r
+ MOVE 0,[XWD 2,TMPFIL] ;SET UP FOR TEMP CORE READ\r
+ TMPCOR ;READ AND DELETE FILE "MAC"\r
+ JRST RPGTMP ;NO SUCH FILE IN CORE TRY DISK\r
+ ADD 3,0 ;CALCULATE END OF BUFFER\r
+ MOVEM 3,JOBFF ;FIX JOBFF SO FILE WONT BE KILLED\r
+ IMULI 0,5 ;CALCULATE CHARACTER COUNT\r
+ MOVEM 0,CTLBLK+2 ;SET UP CHAR CNT IN BUFFER HEADER\r
+ MOVEI 0,440700 ;SET UP BYTE POINTER IN HEADER\r
+ HRLM 0,CTLBLK+1 ;BUUFER HEADER NOW SET UP\r
+ SETOM TMPFLG ;MARK THAT A TMPCOR UUO WAS DONE\r
+ JRST RPGS2A ;CONTINUE IN MAIN STREAM\r
+RPGTMP:>\r
+ INIT CTL2,AL ;LOOK FOR DISK\r
+ SIXBIT /DSK/ ;...\r
+ XWD 0,CTLBLK ;...\r
+ JRST CTLSET ;DSK NOT THERE\r
+\r
+ HRLZI 3,(SIXBIT /MAC/) ;###MAC\r
+ MOVEI 3 ;COUNT\r
+ PJOB AC1, ;RETURNS JOB NO. TO AC1\r
+RPGLUP: IDIVI AC1,12 ;CONVERT\r
+ ADDI AC2,"0"-40 ;SIXBITIZE IT\r
+ LSHC AC2,-6 ;\r
+ SOJG RPGLUP ;3 TIMES\r
+ MOVEM 3,CTLBUF ;###MAC\r
+ HRLZI (SIXBIT /TMP/) ;\r
+ MOVEM CTLBUF+1 ;TMP\r
+ SETZM CTLBUF+3 ;PROG-PRO\r
+ LOOKUP CTL2,CTLBUF ;COMMAND FILE\r
+ JRST CTLSET ;NOT THERE\r
+ HLRM EXTMP ;SAVE THE EXTENSION\r
+RPGS2: INBUF CTL2,1 ;SINGLE BUFFERED\r
+RPGS2A: INIT CTL,AL ;TTY FOR CONSOLE MESSAGES\r
+ SIXBIT /TTY/ ;...\r
+ XWD CTOBUF,0 ;...\r
+ EXIT ;NO TTY, NO ASSEMBLY\r
+ OUTBUF CTL,1 ;SINGLE BUFFERED\r
+ MOVE JOBFF ;REMEMBER WHERE BINARY BUFFERS BEGIN\r
+ MOVEM SAVFF ;...\r
+ TLNE IO,CRPGSW ;ARE WE ALREAD IN RPG MODE?\r
+ JRST M ;MUST HAVE COME FROM @ COMMAND, RESET\r
+\r
+\fGOSET: MOVSI IO,IOPALL!CRPGSW ;SET INITIAL FLAGS\r
+ MOVEI CS,CTLSIZ ;MAXIMUM CHARS IN A LINE\r
+ MOVE AC1,[POINT 7,CTLBUF] ;WHERE TO STASH CHARS\r
+ MOVEM AC1,CTIBUF+1 ;...\r
+GOSET1: SOSG CTLBLK+2 ;ANY MORE CHARS?\r
+ PUSHJ PP,[IFN TEMP,<SKIPE TMPFLG ;TMPCOR UUO IN PROGRESS?\r
+ EXIT ;YES EXIT>\r
+ IN CTL2, ;READ ANOTHER BUFFERFUL\r
+ POPJ PP, ;EVERYTHING OK, RETURN\r
+ STATO CTL2,20000 ;EOF?\r
+ JRST [HRROI RC,[SIXBIT /ERROR READING COMMAND FILE@/]\r
+ JRST ERRNE0] ;GO COMPLAIN\r
+ PUSHJ PP,DELETE ;CMD FILE\r
+ EXIT] ;EOF AND FINISHED\r
+ ILDB C,CTLBLK+1 ;GET NEXT CHAR\r
+ MOVE RC,@CTLBLK+1 ;CHECK FOR SEQUENCE NUMBERS\r
+ TRNE RC,1 ;...\r
+ JRST [AOS CTLBLK+1 ;SKIP OVER ANOTHER 5 CHARS\r
+ MOVNI RC,5 ;...\r
+ ADDM RC,CTLBLK+2 ;...\r
+ JRST GOSET1] ;GO READ ANOTHER CHAR\r
+ JUMPE C,GOSET1 ;IGNORE NULLS\r
+ IDPB C,CTIBUF+1 ;GET NEXT CHAR\r
+ CAIE C,12 ;LINE FEED OR\r
+ CAIN C,175 ;ALTMODE?\r
+ JRST GOSET2 ;YES, FINISHED WITH COMMAND\r
+ CAIE C,176\r
+ CAIN C,33\r
+ JRST GOSET2 ;ALTMODE.\r
+ SOJG CS,GOSET1 ;GO READ ANOTHER\r
+ HRROI RC,[SIXBIT /COMMAND LINE TOO LONG@/]\r
+ JRST ERRNE0 ;GO COMPLAIN\r
+GOSET2: MOVEI C,12 ;MAKE SURE THERE'S A LF\r
+ IDPB C,CTIBUF+1 ;...\r
+ MOVEM AC1,CTIBUF+1 ;SET POINTER TO BEGINNING\r
+ MOVE AC0,SAVFF ;RESET JOBFF FOR NEW BINARY\r
+ MOVEM AC0,JOBFF ;...\r
+ JRST BINSET\r
+\fRPGS1: PUSHJ PP,DELETE ;DELETE COMMAND FILE\r
+ MOVEM ACDEV,RPGDEV ;GET SET TO INIT\r
+ PUSHJ PP,RPGINI\r
+ MOVEM ACFILE,INDIR ;USE INPUT BLOCK\r
+ MOVEM ACEXT,INDIR+1\r
+ LOOKUP CTL2,INDIR\r
+ JRST RPGLOS\r
+ HLRM ACEXT,EXTMP ;SAVE THE EXTENSION\r
+ HLRZ JOBSA ;RESET JOBFF TO ORIGINAL\r
+ MOVEM JOBFF\r
+ TLO IO,CRPGSW ;TURN ON SWITHC SO WE RESET WORLD\r
+ JRST RPGS2 ;AND GO\r
+RPGLOS: RELEAS CTL2,0\r
+ TLZ IO,CRPGSW ;STOPS IO TO UNASGD CHAN\r
+ JRST ERRCF ;NO FILE FOUND\r
+>\r
+\fBINSET: PUSHJ PP,NAME1 ;GET FIRST NAME\r
+IFN CCLSW,<CAIN C,"!" ;CHECK FOR A NEW RPG FILE\r
+ JRST NUNSET\r
+ CAIN C,"@" ;CHEK FOR A NEW RPG FILE\r
+ JRST RPGS1>\r
+ TLNN FR,CREFSW ;CROSS REF REQUESTED?\r
+ JRST LSTSE1 ;YES, SKIP BINARY\r
+ CAIN C,"," ;COMMA?\r
+ JUMPE ACDEV,LSTSET ;YES, SKIP BINARY IF NO DEVICE SPECIFIED\r
+ CAIN C,"_" ;LEFT ARROW?\r
+ JUMPE ACDEV,LSTSE1 ;YES, SKIP BINARY IF NO DEVICE SPECIFIED\r
+ JUMPE ACDEV,ERRCM ;IGNORE IF JUST <CR-LF>\r
+ TLO FR,PNCHSW ;OK, SET SWITCH\r
+ MOVEM ACDEV,BINDEV ;STORE DEVICE NAME\r
+ MOVEM ACFILE,INDIR ;STORE FILE NAME IN DIRECTORY\r
+ SKIPN ACEXT ;EXTENSION SPECIFIED?\r
+ MOVSI ACEXT,(SIXBIT /REL/) ;NO, ASSUME RELOCATABLE BINARY\r
+ MOVEM ACEXT,INDIR+1 ;STORE IN DIRECTORY\r
+ PUSHJ PP,BININI ;INITIALIZE BINARY\r
+ TLZE TIO,TIOLE ;SKIP TO EOT\r
+ MTEOT. BIN,\r
+ TLZE TIO,TIORW ;REWIND REQUESTED?\r
+ MTREW. BIN, ;YES\r
+ JUMPGE CS,BINSE2 ;BRANCH IF NO BACK-SPACE\r
+ MTBSF. BIN, ;BACK-SPACE A FILE\r
+ AOJL CS,.-1 ;TEST FOR END\r
+ MTWAT. BIN,\r
+ STATO BIN,1B24 ;LOAD POINT?\r
+ MTSKF. BIN, ;NO, GO FORWARD ONE\r
+BINSE2: SOJG CS,.-1 ;TEST FORWARD SPACING\r
+\r
+ TLNE TIO,TIOCLD ;DIRECTORY CLEAR REQUESTED?\r
+ UTPCLR BIN, ;YES, CLEAR IT\r
+ OUTBUF BIN,2 ;SET UP TWO RING BUFFER\r
+ ENTER BIN,INDIR\r
+ JRST ERREF\r
+ CAIN C,"_"\r
+ JRST GETSET ;NO LISTING\r
+\fLSTSET: PUSHJ PP,NAME1 ;GET NEXT DEVICE\r
+LSTSE1: CAIE C,"_"\r
+ JRST ERRCM\r
+ TLNE FR,CREFSW ;CROSS-REF REQUESTED?\r
+ JRST LSTSE2 ;NO, BRANCH\r
+ SKIPN ACDEV ;YES, WAS DEVICE SPECIFIED?\r
+ MOVSI ACDEV,(SIXBIT /DSK/) ;NO, ASSUME DSK\r
+ SKIPN ACFILE\r
+ MOVE ACFILE,[SIXBIT /CREF/]\r
+ SKIPN ACEXT\r
+ MOVSI ACEXT,(SIXBIT /LST/)\r
+LSTSE2: JUMPE ACDEV,GETSET ;FORGET LISTING IF NO DEVICE SPECIFIED\r
+ MOVEM ACDEV,LSTDEV\r
+ MOVE AC0,1\r
+ DEVCHR AC0,\r
+ TLNN AC0,2\r
+ TLNE FR,CREFSW ; WAS CROSS-REF REQUESTED?\r
+ AOSA OUTSW ;NO, ASSUME TTY\r
+ JRST ERRCM ;YES, ERROR - CREF DEV MUST NO TBE LPT, DIS OR TTY\r
+ TLNE AC0,TTYBIT ;CONTROLING TELETYPE LISTING?\r
+ JRST GETSET ;YES, BUFFER ALREADY SET\r
+ AOS OUTSW ;SET FOR LPT\r
+ MOVEM ACFILE,INDIR\r
+ SKIPN ACEXT\r
+ MOVSI ACEXT,(SIXBIT /LST/)\r
+ MOVEM ACEXT,INDIR+1\r
+ PUSHJ PP,LSTINI\r
+ TLZE TIO,TIOLE\r
+ MTEOT. LST,\r
+ TLZE TIO,TIORW\r
+ MTREW. LST,\r
+ JUMPGE CS,LSTSE3\r
+ MTBSF. LST,\r
+ AOJL CS,.-1\r
+ MTWAT. LST,\r
+ STATO LST,1B24\r
+ MTSKF. LST,\r
+LSTSE3: SOJG CS,.-1\r
+ TLNE TIO,TIOCLD ;DIRECTORY CLEAR REQUESTED?\r
+ UTPCLR LST, ;YES, CLEAR IT\r
+ OUTBUF LST,2 ;SET UP A TWO RING BUFFER\r
+ ENTER LST,INDIR\r
+ JRST ERREF\r
+\fGETSET: MOVEI 3,PDPERR\r
+ HRRM 3,JOBAPR ;SET TRAP LOCATION\r
+ MOVEI 3,1B19 ;SET FOR PUSH-DOWN OVERFLOW\r
+ APRENB 3,\r
+ SOS 3,PDP ;GET PDP REQUEST MINUS 1\r
+ IMULI 3,.PDP ;COMPUTE SIZE (50*<NUMBER OF /P'S +1>)\r
+ HRLZ MP,3\r
+ HRR MP,JOBFF ;SET BASIC POINTER\r
+ MOVE PP,MP\r
+ SUB PP,3\r
+ MOVEM PP,RP ;SET RP\r
+ SUB PP,3\r
+ ASH 3,1 ;DOUBLE SIZE OF BASIC POINTER\r
+ HRL PP,3\r
+ SUBM PP,3 ;COMPUTE TOP LOCATION\r
+ HRRZM 3,LADR ;SET START OF MACRO TREE\r
+ HRRZM 3,FREE\r
+\r
+GETSE1: HRRZ JOBREL\r
+ SKIPE JOBDDT\r
+ HRRZ JOBSYM\r
+ SUBI 1\r
+ MOVEM SYMTOP\r
+ SUBI LENGTH\r
+ CAMLE LADR\r
+ JRST GETSE2\r
+\r
+ HRRZ 2,JOBREL ;NO, TRY FOR MORE CORE\r
+ ADDI 2,2000\r
+ CORE 2,\r
+ JRST XCEED2 ;NO MORE, INFORM USER\r
+ JRST GETSE1 ;TRY AGAIN\r
+\r
+GETSE2: MOVEM SYMBOL ;SET START OF SYMBOL TABLE\r
+ HRLI SYMNUM\r
+ BLT @SYMTOP ;STORE SYMBOLS\r
+ PUSHJ PP,SRCHI\r
+ MOVE AC0,CTIBUF+1\r
+ MOVEM AC0,CTLSAV\r
+ MOVSI AC0,(SIXBIT 'DSK')\r
+ MOVEM AC0,ACDEVX\r
+ PUSHJ PP,INSET\r
+\r
+ MOVEI CS,[ASCIZ /MACRO: /] ;PUBLISH COMPILER NAME\r
+ TLNE IO,CRPGSW ;PUNCH REQUESTED?\r
+ DDTOUT CS,\r
+ JRST ASSEMB\r
+\r
+\fFINIS: CLOSE BIN, ;DUMP BUFFER\r
+ TLNE FR,PNCHSW ;PUNCH REQUESTED?\r
+ PUSHJ PP,TSTBIN ;YES, TEST FOR ERRORS\r
+ RELEAS BIN,\r
+ CLOSE LST,\r
+ SOSLE OUTSW ;LPT TYPE OUTPUT?\r
+ PUSHJ PP,TSTLST ;YES, TEST FOR ERRORS\r
+ RELEAS LST,\r
+ CLOSE CHAR,\r
+ RELEAS CHAR,\r
+ OUTPUT CTL,0 ;FLUSH TTY OUTPUT\r
+ JRST M\r
+\fINSET: MOVEI JOBFFI ;POINTER TO INPUT BUFFER\r
+ HRRM JOBFF ;INFORM SYSTEM OF BUFFER AREA\r
+ PUSHJ PP,NAME2 ;GET NEXT COMMAND NAME\r
+ JUMPE ACDEV,ERRNE ;ERROR IF NONE LEFT\r
+ MOVEM ACDEV,INDEV ;STORE DEVICE\r
+ MOVEM ACFILE,INDIR ;STORE FILE IN DIRECTORY\r
+ PUSHJ PP,INDEVI\r
+ DEVCHR ACDEV, ;TEST CHARACTERISTICS\r
+ TLNN ACDEV,MTABIT ;MAG TAPE?\r
+ JRST INSET3 ;NO\r
+ TLZN FR,MTAPSW ;FIRST MAG TAPE IS PASS 2?\r
+ JRST INSET1 ;NO\r
+ TLNN TIO,TIORW ;YES, REWIND REQUESTED?\r
+ SUB CS,RECCNT ;NO, PREPARE TO BACK-SPACE TAPE\r
+INSET1: AOS RECCNT ;INCREMENT FILE COUNTER\r
+ ADDM CS,RECCNT ;UPDATE COUNT\r
+ TLZE TIO,TIOLE\r
+ MTEOT. CHAR,\r
+ TLZE TIO,TIORW ;REWIND?\r
+ MTREW. CHAR, ;YES\r
+ JUMPGE CS,INSET2\r
+ MTBSF. CHAR,\r
+ MTBSF. CHAR,\r
+ AOJL CS,.-1\r
+ MTWAT. CHAR,\r
+ STATO CHAR,1B24\r
+ MTSKF. CHAR,\r
+INSET2: SOJGE CS,.-1\r
+\r
+INSET3: INBUF CHAR,1\r
+ MOVEI ACPNTR,JOBFFI\r
+ EXCH ACPNTR,JOBFF\r
+ SUBI ACPNTR,JOBFFI\r
+ MOVEI ACDEL,NUMBUF*203+1\r
+ IDIV ACDEL,ACPNTR\r
+ INBUF CHAR,(ACDEL)\r
+ JUMPN SDEL,INSET4 ;TAKE USER'S EXTENSION IF NON-BLANK\r
+ MOVSI SDEL,(SIXBIT /MAC/) ;BLANK, TRY .MAC FIRST\r
+ PUSHJ PP,INSETI\r
+INSET4: PUSHJ PP,INSETI\r
+ JUMPE ACEXT,ERRCF ;ERROR IF ZERO\r
+ TLNE ACDEV,TTYBIT ;TELETYPE?\r
+ SETSTS CHAR,AL ;YES, CHANGE TO ASCII LINE\r
+ POPJ PP,\r
+\r
+INSETI: HLLM ACEXT,INDIR+1 ;STORE EXTENSION\r
+ LOOKUP CHAR,INDIR\r
+ TDZA ACEXT,ACEXT\r
+ AOS 0(PP)\r
+ POPJ PP,\r
+\fREC2: MOVE CTLSAV\r
+ MOVEM CTIBUF+1\r
+ MOVEI "_"\r
+ HRLM BLKTYP\r
+ SETZM ACDEVX\r
+ MOVE [XWD PASS2I,PASS2I+1]\r
+ BLT PASS2X-1 ;ZERO PASS2 VARIABLES\r
+ TLOA FR,MTAPSW!LOADSW ;SET FLAGS\r
+ INPUT CHAR,\r
+\r
+GOTEND: STATO CHAR,1B22 ;TEST FOR EOF\r
+ JRST .-2\r
+\r
+EOT: PUSHJ PP,SAVEXS ;SAVE REGISTERS\r
+ RELEAS CHAR,\r
+ PUSHJ PP,INSET ;GET THE NEXT INPUT DEVICE\r
+ HRROI RC,[SIXBIT /END OF PASS 1@/] ;ASSUME END OF PASS\r
+ TLZN FR,LOADSW ;ZERO ONLY ON END OF PASS 1\r
+ HRROI RC,[SIXBIT /LOAD THE NEXT FILE@/] ;NOT END OF PASS\r
+ TLNN ACDEV,(1B13!1B15) ;WAS ALL THAT WORK NECESSARY?\r
+ PUSHJ PP,TYPMSG ;YES\r
+\r
+RSTRXS: MOVSI RC,SAVBLK ;SET POINTER\r
+ BLT RC,RC-1\r
+ MOVE RC,SAVERC ;RESTORE RC\r
+ POPJ PP,\r
+\r
+SAVEXS: MOVEM RC,SAVERC ;SAVE RC\r
+ MOVEI RC,SAVBLK ;SET POINTER\r
+ BLT RC,SAVBLK+RC-1 ;BLT ALL REGISTERS BELOW EC\r
+ POPJ PP, ;EXIT\r
+\r
+\fNAME2: SKIPA ACDEV,ACDEVX\r
+NAME1: SETZB ACDEV,INDIR+2\r
+ MOVEI ACFILE,0 ;CLEAR FILE\r
+ HLRZ ACDEL,ACDELX ;GET PREVIOUS DELIMITER\r
+ SETZB TIO,CS\r
+ SETZB ACEXT,INDIR+3 ;RESET EXTENSION AND PROGRAM-NUMBER PAIR\r
+NAME3: MOVSI ACPNTR,(POINT 6,AC0) ;SET POINTER\r
+ TDZA AC0,AC0 ;CLEAR SYMBOL\r
+\r
+SLASH: PUSHJ PP,SW0\r
+GETIOC: PUSHJ PP,TTYIN ;GET INPUT CHARACTER\r
+ CAIN C,"/"\r
+ JRST SLASH\r
+ CAIN C,"("\r
+ JRST SWITCH\r
+ CAIN C,":"\r
+ JRST DEVICE\r
+ CAIN C,"."\r
+ JRST NAME\r
+IFN CCLSW,<CAIE C,"!" ;IS CHAR AN IMPARTIVE?\r
+ CAIN C,"@"\r
+ JRST TERM ;YES, GO DO IT>\r
+ CAIE C,33 ;CHECK FOR THREE FLAVORS OF ALT-MODE\r
+ CAIN C,176 ;...\r
+ JRST TERM ;...\r
+ CAIE C,175 ;OR 3RD ALTMOD\r
+ CAIN C,CR ;CR?\r
+ JRST TERM\r
+ CAIN C,"["\r
+ JRST PROGNP\r
+ CAIE C,","\r
+ CAIN C,"_"\r
+ JRST TERM\r
+ SUBI C,40 ;CONVERT TO 6-BIT\r
+ TLNE ACPNTR,770000 ;HAVE WE STORED SIX BYTES?\r
+ IDPB C,ACPNTR ;NO, STORE IT\r
+ JRST GETIOC ;GET NEXT CHARACTER\r
+\r
+DEVICE: SKIPA ACDEV,0 ;ERROR IF ALREADY SET\r
+\r
+NAME: MOVE ACFILE,AC0 ;FILE NAME\r
+ MOVE ACDEL,C ;SET DELIMITER\r
+ JRST NAME3\r
+\r
+TERM: JUMPE ACDEL,TERM1 ;IF NO PREVIOUS TERMINATOR, THEN FILENAME\r
+ CAIN ACDEL,"_" ;...\r
+ JRST TERM1 ;...\r
+ CAIE ACDEL,":" ;IF PREVIOUS DELIMITER\r
+ CAIN ACDEL,"," ;WAS COLON OR COMMA\r
+TERM1: MOVE ACFILE,AC0 ;SET FILE\r
+ CAIN ACDEL,"." ;IF PERIOD\r
+ HLLZ ACEXT,AC0 ;SET EXTENSION\r
+ HRLM C,ACDELX ;SAVE PREVIOUS DELIMITER\r
+ MOVEM ACDEV,ACDEVX ;USE LAST DEVICE\r
+ CAIN C,"!" ;IMPERATIVE?\r
+ POPJ PP, ;YES, DON'T ASSUME DEV\r
+ JUMPE ACFILE,POPOUT ;IF THERE IS A FILE,\r
+ SKIPN ACDEV ;BUT NO DEVICE\r
+ MOVSI ACDEV,(SIXBIT /DSK/) ;THEN ASSUME DISK\r
+ POPJ PP, ;EXIT\r
+\r
+\fPROGNP: JUMPL PP,PROGN2\r
+\r
+ERRCM: HRROI RC,[SIXBIT /COMMAND ERROR@/]\r
+ JRST ERRNE0\r
+\r
+PROGN1: HRLZM RC,INDIR+3\r
+PROGN2: MOVEI RC,0 ;CLEAR AC\r
+PROGN3: PUSHJ PP,TTYIN\r
+ CAIN C,","\r
+ JRST PROGN1 ;STORE LEFT HALF\r
+ HRRM RC,INDIR+3\r
+ CAIN C,135\r
+ JRST GETIOC\r
+ LSH RC,3 ;SHIFT PREVIOUS RESULT\r
+ ADDI RC,-"0"(C) ;ADD IN NEW NUMBER\r
+ JRST PROGN3\r
+\fSWITC0: PUSHJ PP,SW1\r
+SWITCH: PUSHJ PP,TTYIN ;GET NEXT CHARACTER\r
+ CAIE C,")" ;END OF STRING?\r
+ JRST SWITC0 ;NO\r
+ JRST GETIOC ;YES\r
+\r
+SW0: PUSHJ PP,TTYIN\r
+SW1: MOVEI C,-"A"(C) ;CONVERT FROM ASCII TO NUMERIC\r
+ CAILE C,"Z"-"A" ;WITHIN BOUNDS? (IS IT ALPHA?)\r
+ JRST ERRCM ;NO, ERROR\r
+ MOVE RC,[POINT 4,BYTAB]\r
+ IBP RC\r
+ SOJGE C,.-1 ;MOVE TO PROPER BYTE\r
+ LDB C,RC ;PICK UP BYTE\r
+ JUMPE C,ERRCM ;TEST FOR VALID SWITCH\r
+ CAIG C,SWTABT-SWTAB ;LEGAL ON SOURCE?\r
+ JUMPL PP,ERRCM ;NO, TEST FOR SOURCE\r
+ LDB RC,[POINT 4,SWTAB-1(C),12]\r
+ CAIN RC,IO\r
+ SKIPN CTLSAV ;IF PASS2 OR IO SWITCH\r
+ XCT SWTAB-1(C) ;EXECUTE INSTRUCTION\r
+ POPJ PP,\r
+\r
+\f DEFINE SETSW (LETTER,INSTRUCTION) < INSTRUCTION\r
+J= <"LETTER"-"A">-9*<I=<"LETTER"-"A">/9>\r
+ SETCOD \I,J>\r
+\r
+ DEFINE SETCOD (I,J)\r
+ <BYTAB'I=BYTAB'I!<.-SWTAB>B<4*J+3>>\r
+\r
+BYTAB0= 0 ;INITIALIZE TABLE\r
+BYTAB1= 0\r
+BYTAB2= 0\r
+\r
+SWTAB:\r
+ SETSW Z,<TLO TIO,TIOCLD >\r
+ SETSW C,<TLZ FR,CREFSW >\r
+ SETSW P,<SOS PDP >\r
+SWTABT: ;THE ABOVE SW'S ARE LEGAL ON OUTPUT ONLY\r
+ SETSW A,<ADDI CS,1 >\r
+ SETSW B,<SUBI CS,1 >\r
+ SETSW E,<TLZ IO,IOPALL >\r
+ SETSW L,<TLZ IO,IOMSTR >\r
+ SETSW N,<HLLOS TYPERR >\r
+ SETSW Q,<TLO FR,ERRQSW >\r
+ SETSW S,<TLO IO,IOMSTR >\r
+ SETSW T,<TLO TIO,TIOLE >\r
+ SETSW W,<TLO TIO,TIORW >\r
+ SETSW X,<TLO IO,IOPALL >\r
+IFG .-SWTAB-17,<PRINTX SWITCH TABLE TOO LONG, CHANGE BYTE SIZE>\r
+\r
+BYTAB: ;BYTAB CONTAINS AN INDEX TO SWTAB\r
+ ;IT CONSIST OF 9 4BIT BYTES/WORD\r
+ ;OR ONE BYTE FOR EACH LETTER\r
+\r
+ +BYTAB0 ;A-G BYTE = 1 THROUGH 17 = INDEX\r
+ +BYTAB1 ;H-N BYTE = 0 = COMMAND ERROR\r
+ +BYTAB2 ;O-U\r
+\r
+\fTTYIN: ILDB C,CTIBUF+1 ;GET CHARACTER\r
+ CAIE C," " ;SKIP BLANKS\r
+ CAIN C,HT ;AND TABS\r
+ JRST TTYIN\r
+ CAIE C,LF\r
+ POPJ PP,\r
+\r
+ERRNE: HRROI RC,[SIXBIT /?NO END STATEMENT ENCOUNTERED ON INPUT FILE@/]\r
+ PUSHJ PP,TYPMSG\r
+ SKIPN LITLVL ;SET IF IN LITERAL\r
+ JRST ERRNE1 ;NO, TRY OTHERS\r
+ MOVE V,[XWD [SIXBIT /LITERAL@/],LITPG]\r
+ PUSHJ PP,PRNUM\r
+ERRNE1: MOVEI V,0 ;CHECK FOR OTHER PLACES\r
+ SKIPE INDEF\r
+ MOVE V,[XWD [SIXBIT /DEFINE@/],DEFPG]\r
+ SKIPE INTXT\r
+ MOVE V,[XWD [SIXBIT /TEXT@/],TXTPG]\r
+ SKIPE INREP\r
+ MOVE V,[XWD [SIXBIT /CONDITIONAL OR REPEAT@/],REPPG]\r
+ SKIPGE MACENL\r
+ MOVE V,[XWD [SIXBIT /MACRO CALL@/],CALPG]\r
+ SKIPE V\r
+ PUSHJ PP,PRNUM ;GO PRINT INFORMATION\r
+ HRROI RC,[SIXBIT /@/] ;WILL GET A RETURN\r
+ JRST ERRNE0\r
+\r
+ERRMS3: SIXBIT / ERRORS DETECTED@/\r
+ERRMS2: SIXBIT /?1 ERROR DETECTED@/\r
+ERRMS1: SIXBIT /NO ERRORS DETECTED@/\r
+EINIT: MOVE RC,[XWD ACDEV,[SIXBIT /NOT AVAILABLE@/]]\r
+ JRST ERRNE0\r
+\fERREF: SKIPA RC,[XWD [SIXBIT /CANNOT ENTER FILE@/],ACFILE]\r
+ERRCF: MOVE RC,[XWD [SIXBIT /CANNOT FIND@/],ACFILE]\r
+ERRNE0: PUSHJ PP,CRLF\r
+ MOVEI C,77\r
+ PUSHJ PP,TYO\r
+ PUSHJ PP,TYPMS1\r
+ JRST M\r
+\fTYPMSG: PUSHJ PP,CRLF ;MOVE TO NEXT LINE\r
+TYPMS1: HLRZ CS,RC ;GET FIRST MESSAGE\r
+ CAIE CS,-1 ;SKIP IF MINUS ONE\r
+ PUSHJ PP,TYPM2 ;TYPE MESSAGE\r
+ HRRZ CS,RC ;GET SECOND HALF\r
+ PUSHJ PP,TYPM2\r
+\r
+CRLF: MOVEI C,CR ;OUTPUT CARRIAGE RETURN\r
+ PUSHJ PP,TYO\r
+ MOVEI C,LF ;AND LINE FEED\r
+\r
+TYO: SOSG CTOBUF+2 ;BUFFER FULL?\r
+ OUTPUT CTL,0 ;YES, DUMP IT\r
+ IDPB C,CTOBUF+1 ;STORE BYTE\r
+ CAIE C,FF ;FORM FEED?\r
+ CAIN C,LF ;V TAB OR LINE FEED?\r
+ OUTPUT CTL,0 ;YES\r
+ POPJ PP, ;AND EXIT\r
+\r
+TYPM2: MOVSI C,(1B0) ;ANTICIPATE REGISTER WORD\r
+ CAIG CS,17 ;IS IT?\r
+ MOVEM C,1(CS)\r
+ HRLI CS,(POINT 6,,) ;FORM BYTE POINTER\r
+\r
+TYPM3: ILDB C,CS ;GET A SIXBIT BYTE\r
+ CAIN C,40 ;"@"?\r
+ JRST TYO ;YES, TYPE SPACE AND EXIT\r
+ ADDI C,40 ;NO, FORM 7-BIT ASCII\r
+ PUSHJ PP,TYO ;OUTPUT CHARACTER\r
+ JRST TYPM3\r
+\r
+\fXCEEDS: ADDI SX,2000 ;ADJUST SYMBOL POINTER\r
+XCEED: PUSHJ PP,SAVEXS ;SAVE THE REGISTERS\r
+ HRRZ 1,JOBREL ;GET CURRENT TOP\r
+ MOVEI 0,2000(1)\r
+XCEED2: HRROI RC,[SIXBIT /INSUFFICIENT CORE@/]\r
+ CORE 0 ;REQUEST MORE CORE\r
+ JRST ERRNE0 ;ERROR, BOMB OUT\r
+ HRRZ 2,JOBREL ;GET NEW TOP\r
+\r
+XCEED1: MOVE 0,0(1) ;GET ORIGIONAL\r
+ MOVEM 0,0(2) ;STORE IN NEW LOCATION\r
+ SUBI 2,1 ;DECREMENT UPPER\r
+ CAMLE 1,SYMBOL ;HAVE WE ARRIVED?\r
+ SOJA 1,XCEED1 ;NO, GET ANOTHER\r
+ MOVEI 1,2000\r
+ ADDM 1,SYMBOL\r
+ ADDM 1,116\r
+ ADDM 1,SYMTOP\r
+ PUSHJ PP,SRCHI ;RE-INITIALIZE SYMBOL TABLE\r
+ JRST RSTRXS ;RESTORE REGISTERS AND EXIT\r
+\r
+PDPERR: HRROI RC,[SIXBIT .PDP OVERFLOW, TRY /P@.]\r
+ JRST ERRNE0\r
+\r
+PRNUM: HLRZ CS,V ;GET MESSAGE\r
+ PUSHJ PP,TYPM2\r
+ MOVE AC0,(V) ;GET PAGE\r
+ PUSHJ PP,DP1 ;PRINT NUMBER\r
+ MOVEI C,40\r
+ PUSHJ PP,TYO\r
+ SKIPN AC1,1(V) ;GET SEQ NUM IF THERE\r
+ POPJ PP,\r
+ MOVEM AC1,OUTSQ\r
+ MOVEI AC0,OUTSQ\r
+ OUTPUT CTL,0 ;TO MAKE THINGS PRINT IN RIGHT ORDER\r
+ DDTOUT AC0,\r
+ MOVEI C,40\r
+ JRST TYO ;AND RETURN\r
+\r
+DP1: IDIVI AC0,^D10\r
+ HRLM AC1,(PP)\r
+ SKIPE AC0\r
+ PUSHJ PP,DP1\r
+ HLRZ C,(PP)\r
+ ADDI C,"0"\r
+ JRST TYO\r
+\fRIM0: TDO FR,AC0 ;SET RIM/RIM10 FLAG\r
+ TLNE FR,PNCHSW ;FORGET IT IF PUNCH RESET\r
+ SETSTS BIN,IB ;SET TO IMAGE BINARY MODE\r
+ POPJ PP,\r
+\r
+ROUT: EXCH CS,RIMLOC\r
+ SUB PP,[XWD 1,1] ;CLEAR OUT STACK WFW\r
+ TLNE FR,R1BSW\r
+ JRST ROUT6\r
+ TLNN FR,RIM1SW\r
+ JRST ROUT1\r
+ JUMPE CS,ROUT1\r
+ SUB CS,RIMLOC\r
+ JUMPE CS,ROUT1\r
+ JUMPG CS,ERRAX\r
+ MOVEI C,0\r
+ PUSHJ PP,PTPBIN\r
+ AOJL CS,.-1\r
+ROUT1: MOVSI C,(DATAI PTR,) ;RIM OUTPUT\r
+ HRR C,LOCO ;GET ADDRESS\r
+ TLNE FR,RIM1SW ;NO DATAI IF RIM10 \r
+ AOSA RIMLOC\r
+ PUSHJ PP,PTPBIN ;OUTPUT\r
+ MOVE C,AC0 ;CODE\r
+ AOSA LOCO ;INCREMENT CURRENT LOCATION\r
+\r
+OUTBIN: TLNN FR,RIMSW!RIM1SW!R1BSW ;EXIT IF RIM MODE\r
+PTPBIN: TLNN FR,PNCHSW ;EXIT IF PUNCH NOT REQUESTED\r
+ POPJ PP,\r
+ SOSG BINBUF+2 ;TEST FOR BUFFER FULL\r
+ PUSHJ PP,DMPBIN ;YES, DUMP IT\r
+ IDPB C,BINBUF+1 ;DEPOSIT BYTE\r
+ POPJ PP, ;EXIT\r
+\fDMPBIN: OUTPUT BIN,0 ;DUMP THE BUFFER\r
+TSTBIN: STATO BIN,740000 ;GET STATUS BITS\r
+ POPJ PP, ;NO, EXIT\r
+ MOVE AC0,BINDEV ;YES, GET TAG\r
+ JRST ERRLST\r
+\f\r
+R1BDMP: SETCM CS,R1BCNT\r
+ JUMPE CS,R1BI\r
+ HRLZS C,CS\r
+ HRR C,R1BLOC\r
+ HRRI C,-1(C)\r
+ MOVEM C,R1BCHK\r
+ PUSHJ PP,PTPBIN\r
+ HRRI CS,R1BBLK\r
+R1BDM1: MOVE C,0(CS)\r
+ ADDM C,R1BCHK\r
+ PUSHJ PP,PTPBIN\r
+ AOBJN CS,R1BDM1\r
+ MOVE C,R1BCHK\r
+ PUSHJ PP,PTPBIN\r
+R1BI: SETOM R1BCNT\r
+ PUSH PP,LOCO\r
+ POP PP,R1BLOC\r
+ POPJ PP,\r
+\r
+ROUT6: CAME CS,RIMLOC\r
+ PUSHJ PP,R1BDMP\r
+ AOS C,R1BCNT\r
+ MOVEM 0,R1BBLK(C)\r
+ AOS LOCO\r
+ CAIN C,21\r
+ PUSHJ PP,R1BDMP\r
+ AOS RIMLOC\r
+ POPJ PP,\r
+\fREAD0: PUSHJ PP,EOT\r
+READ: SOSG IBUF+2 ;BUFFER EMPTY?\r
+ JRST READ3 ;YES\r
+READ1: ILDB C,IBUF+1 ;PLACE CHARACTER IN C\r
+ MOVE CS,@IBUF+1 ;CHECK FOR SEQUENCE NUMBER\r
+ TRNN CS,1\r
+ JRST READ1A\r
+ CAIN CS,1 ;CHECK FOR SPECIAL\r
+ MOVE CS,[<ASCII/ />+1]\r
+ MOVEM CS,SEQNO\r
+ MOVEM CS,SEQNO2\r
+ MOVNI CS,4\r
+ ADDM CS,IBUF+2 ;ADJUST WORD COUNT\r
+REPEAT 4,< IBP IBUF+1> ;SKIP SEQ NU\r
+ PUSHJ PP,READ ;AND THE TAB\r
+ JRST READ ;GET NEXT CHARACTER\r
+\r
+READ1A: JUMPE C,READ ;IGNORE NULL\r
+ JUMP2 READ1B\r
+ CAIN C,14\r
+ AOS PAGENO\r
+READ1B: CAIN C,32 ;IF IT'S A "^Z"\r
+ MOVEI C,LF ;TREAT IT AS A "LF"\r
+ CAIE C,37 ;CONTROL _\r
+ POPJ PP,\r
+READ2: PUSHJ PP,READ ;YES, TEST FOR LINE FEED\r
+ PUSHJ PP,RSW2 ;LIST IN ANY EVENT\r
+ CAIE C,LF ;IS IT LF\r
+ JRST READ2 ;NO\r
+ PUSHJ PP,OUTIM1 ;YES, DUMP THE LINE\r
+ JRST READ ;RETURN NEXT CHARACTER\r
+\r
+READ3: INPUT CHAR,0 ;GET NEXT BUFFER\r
+ STATO CHAR,762000 ;NO ERRORS\r
+ JRST READ1\r
+ STATO CHAR,742000 ;ERRORS?\r
+ JRST READ0 ;EOF\r
+ MOVE AC0,INDEV\r
+ MOVSI RC,[SIXBIT /INPUT ERROR ON DEVICE@/]\r
+ JRST ERRNE0\r
+\fOUTAB2: PUSHJ PP,OUTTAB ;PRINT TWO TABS\r
+OUTTAB: MOVEI C,HT\r
+PRINT: CAIN C,LF ;IS THIS A LF?\r
+ JRST OUTCR ;YES, GO PROCESS\r
+ CAIN C,CR ;OR CR?\r
+ POPJ PP,\r
+ CAIN C,FF ;FORM FEED?\r
+ JRST OUTFF ;YES FORCE NEW PAGE\r
+ JRST OUTL\r
+\r
+OUTCR: TRNN ER,ERRORS!LPTSW!TTYSW\r
+ POPJ PP,\r
+ MOVEI C,CR ;CARRIAGE RETURN, LINE FEED\r
+ PUSHJ PP,OUTL\r
+ SOSGE LPP ;END OF PAGE?\r
+ TLO IO,IOPAGE ;YES, SET FLAG\r
+ TRCA C,7 ;FORM LINE FEED AND SKIP\r
+\r
+OUTL: TLZN IO,IOPAGE ;NEW PAGE REQUESTED?\r
+ JRST OUTC ;NO\r
+ JUMP1 OUTC ;YES, BYPASS IF PASS ONE\r
+ PUSH PP,C ;SAVE C AND CS\r
+ PUSH PP,CS\r
+ PUSH PP,ER\r
+ TLNN IO,IOMSTR!IOPROG\r
+ HRR ER,OUTSW\r
+ MOVEI C,.LPP \r
+ MOVEM C,LPP ;SET NEW COUNTER\r
+ MOVEI C,CR\r
+ PUSHJ PP,OUTC\r
+ MOVEI C,FF\r
+ PUSHJ PP,OUTC ;OUTPUT FORM FEED\r
+ MOVEI CS,TBUF\r
+ PUSHJ PP,OUTAS0 ;OUTPUT TITLE\r
+ MOVEI CS,VBUF\r
+ PUSHJ PP,OUTAS0 ;OUTPUT VERSION\r
+ MOVE C,PAGENO\r
+ PUSHJ PP,DNC ;OUTPUT PAGE NUMBER\r
+ AOSG PAGEN. ;FIRST PAGE OF THIS NUMBER?\r
+ JRST OUTL1\r
+ MOVEI C,"-" ;NO, PUT OUT MODIFIER\r
+ PUSHJ PP,OUTC\r
+ MOVE C,PAGEN.\r
+ PUSHJ PP,DNC\r
+OUTL1: PUSHJ PP,OUTCR\r
+ HRRZ CS,SUBTTX ;SWITCH FOR SUB-TITLE\r
+ SKIPE 0(CS) ;IS THERE A SUB-TITLE?\r
+ PUSHJ PP,OUTTAB ;YES, OUTPUT A TAB\r
+ PUSHJ PP,SOUT20 ;OUTPUT ASCII WITH CARRIAGE RETURN\r
+ PUSHJ PP,OUTCR\r
+ POP PP,ER\r
+ POP PP,CS\r
+ POP PP,C\r
+\r
+OUTC: TRNE ER,ERRORS!TTYSW\r
+ PUSHJ PP,TYO\r
+ TRNN ER,LPTSW\r
+ POPJ PP,\r
+OUTLST: SOSG LSTBUF+2 ;BUFFER FULL?\r
+ PUSHJ PP,DMPLST ;YES, DUMP IT\r
+ IDPB C,LSTBUF+1 ;STORE BYTE\r
+ POPJ PP,\r
+DMPLST: OUTPUT LST,0 ;OUTPUT BUFFER\r
+TSTLST: STATO LST,740000\r
+ POPJ PP,\r
+ MOVE 0,LSTDEV\r
+ERRLST: MOVSI RC,[SIXBIT /DATA ERROR DEVICE@/]\r
+ JRST ERRNE0\r
+\fPAGE0:\r
+OUTFF: AOS PAGENO\r
+ SETOM PAGEN.\r
+ TLO IO,IOPAGE\r
+ POPJ PP,\r
+\r
+OTOD1: IBP CS\r
+OTOD: IDIVI 2,^D10\r
+ ADDI 2,60 ;FORM ASCII\r
+ IDPB 2,CS\r
+ ADDI 3,60\r
+ IDPB 3,CS\r
+ POPJ PP,\r
+\r
+DTAB: ASCII "JAN-"\r
+ ASCII "FEB-"\r
+ ASCII "MAR-"\r
+ ASCII "APR-"\r
+ ASCII "MAY-"\r
+ ASCII "JUN-"\r
+ ASCII "JUL-"\r
+ ASCII "AUG-"\r
+ ASCII "SEP-"\r
+ ASCII "OCT-"\r
+ ASCII "NOV-"\r
+ ASCII "DEC-"\r
+\fSUBTTL MACHINE INSTRUCTION SEARCH ROUTINES\r
+OPTSCH: MOVEI RC,0\r
+ MOVEI ARG,1B^L<OP1END-OP1TOP> ;SET UP INDEX\r
+ MOVEI V,1B^L<OP1END-OP1TOP>/2 ;SET UP INCREMENT\r
+OPT1A: CAMN AC0,OP1TOP(ARG) ;ARE WE POINTING AT SYMBOL?\r
+ JRST OPT1D ;YES, GET THE CODE\r
+ JUMPE V,POPOUT ;TEST FOR END\r
+ CAML AC0,OP1TOP(ARG) ;NO, SHOULD WE MOVE DOWN?\r
+ TDOA ARG,V ;NO, INCREMENT\r
+OPT1B: SUB ARG,V ;YES, DECREMENT\r
+ ASH V,-1 ;HALVE INCREMENT\r
+ CAIG ARG,OP1END-OP1TOP ;ARE WE OUT OF BOUNDS?\r
+ JRST OPT1A ;NO, TRY AGAIN\r
+ JRST OPT1B ;YES, BRING IT DOWN A PEG\r
+OPT1D: IDIVI ARG,4 ;ARG HAS INDEX USED IN OPTTAB\r
+ LDB V,OPTTAB(V) ;V HAS INDEX TO OPTTAB\r
+ CAIL V,700 ;PSEUDO-OP OR IO INSTRUCTION?\r
+ JRST OPT1G ;YES\r
+ ROT V,-^D9 ;LEFT JUSTIFY\r
+ HRRI V,OPD ;POINT TO BASIC FORMAT\r
+OPT1F: AOS 0(PP) ;SET FOR SKIP EXIT\r
+ MOVEI SDEL,%OP ;SET OP-CODE CROSS-REF FLAG\r
+ JRST CREF ;TEST AND OUTPUT, AC0=SYMBOL, V=VALUE\r
+OPT1G: TLNN AC0,200000 ;PSEUDO-OP OR IO INST., TEST FOR PROPER TABLE\r
+ SKIPA V,OP2TAB-700(V) ;2ND TABLE, FIRST LETTER IS "A" TO "O"\r
+ MOVE V,OP1TAB-700(V) ;1ST TABLE, ..."P" TO "Z"\r
+ JRST OPT1F ;EXIT\r
+OPTTAB:\r
+ POINT 9,OP1COD-1(ARG),35\r
+ POINT 9,OP1COD(ARG),8\r
+ POINT 9,OP1COD(ARG),17\r
+ POINT 9,OP1COD(ARG),26\r
+\r
+\fIFDEF .XCREF,< .XCREF ;DON'T CREF THIS MESS>\r
+ RELOC .-1\r
+OP1TOP:\r
+ RELOC\r
+\r
+ IF1,<N1=0\r
+ DEFINE X <N1=N1+1 ;>>\r
+\r
+ IF2, <\r
+ N2=^D36\r
+ CC=0\r
+ RELOC OP1COD\r
+ RELOC\r
+DEFINE X (SYMBOL,CODE) \r
+<SIXBIT /SYMBOL/\r
+CC=CC+CODE_<N2=N2-9>\r
+IFE N2, <OUTLIT>>\r
+\r
+DEFINE OUTLIT <\r
+ RELOC\r
+ +CC\r
+ RELOC\r
+N2=^D36+<CC=0>>>\r
+ SYN X,XX ;JUST THE SAME MACRO\r
+\fX ADD , 270\r
+X ADDB , 273\r
+X ADDI , 271\r
+X ADDM , 272\r
+\r
+X AND , 404\r
+X ANDB , 407\r
+X ANDCA , 410\r
+X ANDCAB, 413\r
+X ANDCAI, 411\r
+X ANDCAM, 412\r
+X ANDCB , 440\r
+X ANDCBB, 443\r
+X ANDCBI, 441\r
+X ANDCBM, 442\r
+X ANDCM , 420\r
+X ANDCMB, 423\r
+X ANDCMI, 421\r
+X ANDCMM, 422\r
+X ANDI , 405\r
+X ANDM , 406\r
+\r
+X AOBJN , 253\r
+X AOBJP , 252\r
+\r
+X AOJ , 340\r
+X AOJA , 344\r
+X AOJE , 342\r
+X AOJG , 347\r
+X AOJGE , 345\r
+X AOJL , 341\r
+X AOJLE , 343\r
+X AOJN , 346\r
+\r
+XX AOS , 350\r
+X AOSA , 354\r
+X AOSE , 352\r
+X AOSG , 357\r
+X AOSGE , 355\r
+X AOSL , 351\r
+X AOSLE , 353\r
+X AOSN , 356\r
+X ARG , 320\r
+X ASCII , 700\r
+XX ASCIZ , 701\r
+\r
+X ASH , 240\r
+X ASHC , 244\r
+\r
+X ASUPPR, 705\r
+X BLKI , 702\r
+X BLKO , 703\r
+X BLOCK , 704\r
+\r
+X BLT , 251\r
+\r
+X BYTE , 707\r
+\r
+XX CAI , 300\r
+X CAIA , 304\r
+X CAIE , 302\r
+X CAIG , 307\r
+X CAIGE , 305\r
+X CAIL , 301\r
+X CAILE , 303\r
+X CAIN , 306\r
+\r
+X CALL , 040\r
+XX CALLI , 047\r
+\r
+XX CAM , 310\r
+X CAMA , 314\r
+X CAME , 312\r
+X CAMG , 317\r
+X CAMGE , 315\r
+X CAML , 311\r
+X CAMLE , 313\r
+X CAMN , 316\r
+\r
+XX CLEAR , 400\r
+XX CLEARB, 403\r
+XX CLEARI, 401\r
+XX CLEARM, 402\r
+\r
+X CLOSE , 070\r
+\r
+\r
+X CONI , 710\r
+X CONO , 711\r
+X CONSO , 712\r
+X CONSZ , 713\r
+\r
+XX DATA. , 020\r
+\r
+X DATAI , 714\r
+X DATAO , 715\r
+X DEC , 716\r
+X DEFINE, 717\r
+X DEPHAS, 720\r
+\r
+X DFN , 131\r
+\r
+X DIV , 234\r
+X DIVB , 237\r
+X DIVI , 235\r
+X DIVM , 236\r
+\r
+X DPB , 137\r
+\r
+X END , 721\r
+\r
+X ENTER , 077\r
+\r
+X ENTRY , 722\r
+\r
+X EQV , 444\r
+X EQVB , 447\r
+X EQVI , 445\r
+X EQVM , 446\r
+\r
+X EXCH , 250\r
+\r
+X EXP , 723\r
+XX EXTERN, 724\r
+\r
+X FAD , 140\r
+X FADB , 143\r
+X FADL , 141\r
+X FADM , 142\r
+\r
+X FADR , 144\r
+X FADRB , 147\r
+X FADRI , 145\r
+X FADRM , 146\r
+\r
+X FDV , 170\r
+X FDVB , 173\r
+X FDVL , 171\r
+X FDVM , 172\r
+\r
+X FDVR , 174\r
+X FDVRB , 177\r
+X FDVRI , 175\r
+X FDVRM , 176\r
+\r
+XX FIN. , 021\r
+\r
+\r
+X FMP , 160\r
+X FMPB , 163\r
+X FMPL , 161\r
+X FMPM , 162\r
+\r
+\fX FMPR , 164\r
+X FMPRB , 167\r
+X FMPRI , 165\r
+X FMPRM , 166\r
+\r
+X FSB , 150\r
+X FSBB , 153\r
+X FSBL , 151\r
+X FSBM , 152\r
+\r
+X FSBR , 154\r
+X FSBRB , 157\r
+X FSBRI , 155\r
+X FSBRM , 156\r
+\r
+X FSC , 132\r
+\r
+X GETSTS, 062\r
+\r
+\fX HALT , 725\r
+IFN RENTSW, <X HISEG , 706>\r
+\r
+X HLL , 500\r
+X HLLE , 530\r
+X HLLEI , 531\r
+X HLLEM , 532\r
+X HLLES , 533\r
+X HLLI , 501\r
+X HLLM , 502\r
+X HLLO , 520\r
+X HLLOI , 521\r
+X HLLOM , 522\r
+X HLLOS , 523\r
+X HLLS , 503\r
+X HLLZ , 510\r
+X HLLZI , 511\r
+X HLLZM , 512\r
+X HLLZS , 513\r
+\r
+X HLR , 544\r
+X HLRE , 574\r
+X HLREI , 575\r
+X HLREM , 576\r
+X HLRES , 577\r
+X HLRI , 545\r
+X HLRM , 546\r
+X HLRO , 564\r
+X HLROI , 565\r
+X HLROM , 566\r
+X HLROS , 567\r
+X HLRS , 547\r
+X HLRZ , 554\r
+X HLRZI , 555\r
+X HLRZM , 556\r
+X HLRZS , 557\r
+\r
+\fX HRL , 504\r
+X HRLE , 534\r
+X HRLEI , 535\r
+X HRLEM , 536\r
+X HRLES , 537\r
+X HRLI , 505\r
+X HRLM , 506\r
+X HRLO , 524\r
+X HRLOI , 525\r
+X HRLOM , 526\r
+X HRLOS , 527\r
+X HRLS , 507\r
+X HRLZ , 514\r
+X HRLZI , 515\r
+X HRLZM , 516\r
+X HRLZS , 517\r
+\r
+X HRR , 540\r
+X HRRE , 570\r
+X HRREI , 571\r
+X HRREM , 572\r
+X HRRES , 573\r
+X HRRI , 541\r
+X HRRM , 542\r
+X HRRO , 560\r
+X HRROI , 561\r
+X HRROM , 562\r
+X HRROS , 563\r
+X HRRS , 543\r
+X HRRZ , 550\r
+X HRRZI , 551\r
+X HRRZM , 552\r
+X HRRZS , 553\r
+\r
+X IBP , 133\r
+\r
+X IDIV , 230\r
+X IDIVB , 233\r
+X IDIVI , 231\r
+X IDIVM , 232\r
+\r
+X IDPB , 136\r
+\r
+X IF1 , 726\r
+X IF2 , 727\r
+X IFB , 730\r
+X IFDEF , 731\r
+X IFDIF , 732\r
+X IFE , 733\r
+X IFG , 734\r
+X IFGE , 735\r
+X IFIDN , 736\r
+X IFL , 737\r
+X IFLE , 740\r
+X IFN , 741\r
+X IFNB , 742\r
+X IFNDEF, 743\r
+\r
+X ILDB , 134\r
+\r
+X IMUL , 220\r
+X IMULB , 223\r
+X IMULI , 221\r
+X IMULM , 222\r
+\r
+X IN , 056\r
+XX IN. , 016\r
+X INBUF , 064\r
+XX INF. , 026\r
+X INIT , 041\r
+X INPUT , 066\r
+\r
+XX INTERN, 744\r
+\r
+X IOR , 434\r
+X IORB , 437\r
+X IORI , 435\r
+X IORM , 436\r
+\r
+\r
+X IOWD , 745\r
+X IRP , 746\r
+X IRPC , 747\r
+X JCRY , 750\r
+X JCRY0 , 751\r
+X JCRY1 , 752\r
+X JEN , 753\r
+\r
+XX JFCL , 255\r
+\r
+X JFFO , 243\r
+X JFOV , 765\r
+X JOV , 754\r
+\r
+X JRA , 267\r
+XX JRST , 254\r
+\r
+X JRSTF , 755\r
+\r
+X JSA , 266\r
+XX JSP , 265\r
+X JSR , 264\r
+\r
+XX JUMP , 320\r
+XX JUMPA , 324\r
+X JUMPE , 322\r
+X JUMPG , 327\r
+X JUMPGE, 325\r
+X JUMPL , 321\r
+X JUMPLE, 323\r
+X JUMPN , 326\r
+\r
+X LALL , 756\r
+\r
+X LDB , 135\r
+\r
+X LIST , 757\r
+X LIT , 760\r
+X LOC , 761\r
+\r
+X LOOKUP, 076\r
+\r
+X LSH , 242\r
+X LSHC , 246\r
+X MLOFF , 767\r
+X MLON , 766\r
+XX MOVE , 200\r
+XX MOVEI , 201\r
+XX MOVEM , 202\r
+X MOVES , 203\r
+X MOVM , 214\r
+X MOVMI , 215\r
+X MOVMM , 216\r
+X MOVMS , 217\r
+X MOVN , 210\r
+X MOVNI , 211\r
+X MOVNM , 212\r
+X MOVNS , 213\r
+X MOVS , 204\r
+X MOVSI , 205\r
+X MOVSM , 206\r
+X MOVSS , 207\r
+\r
+\r
+X MTAPE , 072\r
+XX MTOP. , 024\r
+\r
+X MUL , 224\r
+X MULB , 227\r
+X MULI , 225\r
+X MULM , 226\r
+XX NLI. , 031\r
+XX NLO. , 032\r
+\r
+X NOSYM , 762\r
+\r
+\fX OCT , 763\r
+X OPDEF , 764\r
+\r
+X OPEN , 050\r
+\r
+X OR , 434\r
+X ORB , 437\r
+X ORCA , 454\r
+X ORCAB , 457\r
+X ORCAI , 455\r
+X ORCAM , 456\r
+X ORCB , 470\r
+X ORCBB , 473\r
+\r
+X ORCBI , 471\r
+X ORCBM , 472\r
+X ORCM , 464\r
+X ORCMB , 467\r
+X ORCMI , 465\r
+X ORCMM , 466\r
+X ORI , 435\r
+X ORM , 436\r
+\r
+X OUT , 057\r
+XX OUT. , 017\r
+X OUTBUF, 065\r
+XX OUTF. , 027\r
+X OUTPUT, 067\r
+\r
+\fX PAGE , 700\r
+X PASS2 , 701\r
+X PHASE , 702\r
+X POINT , 703\r
+\r
+XX POP , 262\r
+XX POPJ , 263\r
+\r
+X PRINTX, 704\r
+X PURGE , 705\r
+\r
+XX PUSH , 261\r
+XX PUSHJ , 260\r
+\r
+X RADIX , 706\r
+X RADIX5, 707\r
+\r
+X RELEAS, 071\r
+\r
+X RELOC , 710\r
+X REMARK, 711\r
+\r
+X RENAME, 055\r
+\r
+X REPEAT, 712\r
+\r
+XX RESET., 015\r
+X RIM , 715\r
+X RIM10 , 735\r
+X RIM10B, 736\r
+\r
+X ROT , 241\r
+X ROTC , 245\r
+\r
+X RSW , 716\r
+XX RTB. , 022\r
+\r
+X SETA , 424\r
+X SETAB , 427\r
+X SETAI , 425\r
+X SETAM , 426\r
+X SETCA , 450\r
+X SETCAB, 453\r
+X SETCAI, 451\r
+X SETCAM, 452\r
+X SETCM , 460\r
+X SETCMB, 463\r
+X SETCMI, 461\r
+X SETCMM, 462\r
+X SETM , 414\r
+X SETMB , 417\r
+X SETMI , 415\r
+X SETMM , 416\r
+X SETO , 474\r
+X SETOB , 477\r
+X SETOI , 475\r
+X SETOM , 476\r
+X SETSTS, 060\r
+X SETZ , 400\r
+X SETZB , 403\r
+X SETZI , 401\r
+XX SETZM , 402\r
+\r
+XX SIXBIT, 717\r
+\r
+XX SKIP , 330\r
+X SKIPA , 334\r
+X SKIPE , 332\r
+X SKIPG , 337\r
+X SKIPGE, 335\r
+X SKIPL , 331\r
+X SKIPLE, 333\r
+X SKIPN , 336\r
+\r
+XX SLIST., 025\r
+\r
+X SOJ , 360\r
+X SOJA , 364\r
+X SOJE , 362\r
+X SOJG , 367\r
+X SOJGE , 365\r
+X SOJL , 361\r
+X SOJLE , 363\r
+X SOJN , 366\r
+\r
+XX SOS , 370\r
+X SOSA , 374\r
+X SOSE , 372\r
+X SOSG , 377\r
+X SOSGE , 375\r
+X SOSL , 371\r
+X SOSLE , 373\r
+X SOSN , 376\r
+\r
+X SQUOZE, 707\r
+\r
+X STATO , 061\r
+X STATUS, 062\r
+X STATZ , 063\r
+\r
+X STOPI , 722\r
+\r
+X SUB , 274\r
+X SUBB , 277\r
+X SUBI , 275\r
+X SUBM , 276\r
+\r
+IF2,<SUBTL:>\r
+X SUBTTL, 723\r
+X SUPPRE, 713\r
+X SYN , 724\r
+X TAPE , 725\r
+\r
+\fX TDC , 650\r
+X TDCA , 654\r
+X TDCE , 652\r
+X TDCN , 656\r
+X TDN , 610\r
+X TDNA , 614\r
+X TDNE , 612\r
+X TDNN , 616\r
+X TDO , 670\r
+X TDOA , 674\r
+X TDOE , 672\r
+X TDON , 676\r
+X TDZ , 630\r
+X TDZA , 634\r
+X TDZE , 632\r
+X TDZN , 636\r
+\r
+X TITLE , 726\r
+\r
+X TLC , 641\r
+X TLCA , 645\r
+X TLCE , 643\r
+X TLCN , 647\r
+X TLN , 601\r
+X TLNA , 605\r
+XX TLNE , 603\r
+XX TLNN , 607\r
+XX TLO , 661\r
+X TLOA , 665\r
+X TLOE , 663\r
+X TLON , 667\r
+XX TLZ , 621\r
+XX TLZA , 625\r
+XX TLZE , 623\r
+XX TLZN , 627\r
+\r
+\fX TRC , 640\r
+X TRCA , 644\r
+X TRCE , 642\r
+X TRCN , 646\r
+X TRN , 600\r
+X TRNA , 604\r
+XX TRNE , 602\r
+XX TRNN , 606\r
+X TRO , 660\r
+X TROA , 664\r
+X TROE , 662\r
+X TRON , 666\r
+XX TRZ , 620\r
+X TRZA , 624\r
+X TRZE , 622\r
+X TRZN , 626\r
+\r
+X TSC , 651\r
+X TSCA , 655\r
+X TSCE , 653\r
+X TSCN , 657\r
+X TSN , 611\r
+X TSNA , 615\r
+X TSNE , 613\r
+\r
+X TSNN , 617\r
+X TSO , 671\r
+X TSOA , 675\r
+X TSOE , 673\r
+X TSON , 677\r
+X TSZ , 631\r
+X TSZA , 635\r
+X TSZE , 633\r
+X TSZN , 637\r
+X TTCALL, 051\r
+X UFA , 130\r
+X UGETF , 073\r
+X USETI , 074\r
+X USETO , 075\r
+\r
+X VAR , 727\r
+\r
+XX WTB. , 023\r
+\r
+X XALL , 732\r
+\r
+X XCT , 256\r
+\r
+X XLIST , 733\r
+\r
+X XOR , 430\r
+X XORB , 433\r
+X XORI , 431\r
+X XORM , 432\r
+\r
+X XWD , 734\r
+\r
+X Z , 000\r
+\r
+\r
+\r
+\f\r
+IF1, < BLOCK N1>\r
+OP1END: -1B36\r
+OP1COD: BLOCK N1/4\r
+ CC\r
+\r
+\r
+IFDEF .CREF,< .CREF ;START CREFFING AGAIN\r
+>\r
+\fSUBTTL PERMANENT SYMBOLS\r
+SYMNUM: EXP LENGTH/2 ;NUMBER OF PERMANENT SYMBOLS\r
+DEFINE P (A,B)<\r
+ SIXBIT /A/\r
+ XWD SYMF!40,B>\r
+\r
+P @, 0\r
+PRMTBL: ;PERMANENT SYMBOLS\r
+P APR, 0\r
+P CCI, 14\r
+P CDP, 110\r
+P CDR, 114\r
+P CPA, 0\r
+P CR, 150\r
+P DC, 200\r
+P DCSA, 300\r
+P DCSB, 304\r
+P DF, 270\r
+P DIS, 130\r
+P DLS, 240\r
+P DRUM, 400\r
+P DSK, 170\r
+P DTC, 210\r
+P DTS, 214\r
+P LPT, 124\r
+P MDF, 260\r
+P MTC, 220\r
+P MTM, 230\r
+P MTS, 224\r
+P PI, 4\r
+P PLT, 140\r
+P PTP, 100\r
+P PTR, 104\r
+P TDC, 320\r
+P TDS, 324\r
+P TMC, 340\r
+P TMS, 344\r
+P TTY, 120\r
+P UTC, 210\r
+P UTS, 214\r
+P ??????, 0\r
+PRMEND: ;END OF PERMANENT SYMBOLS\r
+\r
+LENGTH= .-SYMNUM ;LENGTH OF INITIAL SYMBOLS\r
+\r
+\f OPDEF ZL [Z LITF] ;INVALID IN LITERALS\r
+ OPDEF ZA [Z ADDF] ;INVALID IN ADDRESSES\r
+ OPDEF ZAL [Z ADDF!LITF]\r
+\r
+OP1TAB:\r
+\r
+ ZL PAGE0 ;PAGE\r
+ ZL PASS20 ;PASS2\r
+ ZL PHASE0 ;PHASE\r
+ Z POINT0 ;POINT\r
+ ZL PRINT0 ;PRINTX\r
+ ZL PURGE0 ;PURGE\r
+ ZL RADIX0 ;RADIX\r
+ Z RADX50 ;RADIX50,SQUOZE\r
+ ZL LOC0 (1) ;RELOC\r
+ ZL REMAR0 ;REMARK\r
+ ZL REPEA0 ;REPEAT\r
+ ZL SUPRE0 ;SUPRESS\r
+ Z ;?\r
+ ZL RIM0 (RIMSW) ;RIM\r
+ DATAI 0,IOP ;RSW\r
+ Z ASCII0 (1) ;SIXBIT\r
+ Z\r
+ Z\r
+; ZL IOSET (IOPALL!IOSALL) ;SALL\r
+ ZL STOPI0 ;STOPI\r
+ ZL SUBTT0 (Z (POINT 7,,)) ;SUBTTL\r
+ ZL SYN0 ;SYN\r
+ ZL TAPE0 ;TAPE\r
+ ZL TITLE0 (Z (POINT 7,,)) ;TITLE\r
+ ZL VAR0 ;VAR\r
+\r
+ Z\r
+ Z\r
+ ZL IOSET (IOPALL) ;XALL\r
+ ZL IOSET (IOPROG) ;XLIST\r
+ Z XWD0 ;XWD\r
+ ZL RIM0 (RIM1SW) ;RIM10\r
+ ZL RIM0 (R1BSW) ;RIM10B\r
+\fOP2TAB:\r
+\r
+ Z ASCII0 (0) ;ASCII\r
+ Z ASCII0 (1B18) ;ASCIZ\r
+ BLKI IOP ;BLKI\r
+ BLKO IOP ;BLKO\r
+ ZL BLOCK0 ;BLOCK\r
+ ZL SUPRSA ;ASUPPRESS\r
+IFN RENTSW,< ZL HISEG0 ;HISEG>\r
+IFE RENTSW,< Z ;HISEG>\r
+ Z BYTE0 ;BYTE\r
+ CONI IOP ;CONI\r
+ CONO IOP ;CONO\r
+ CONSO IOP ;CONSO\r
+ CONSZ IOP ;CONSZ\r
+ DATAI IOP ;DATAI\r
+ DATAO IOP ;DATAO\r
+ Z OCT0 (^D10) ;DEC\r
+ ZL DEFIN0 ;DEFINE\r
+\r
+ ZL DEPHA0 ;DEPHASE\r
+ ZL END0 ;END\r
+ ZL INTER0 (INTF!ENTF) ;ENTRY\r
+ Z EXPRES ;EXP\r
+ ZL EXTER0 ;EXTERN\r
+ JRST 4,OP ;HALT\r
+ TLNN FR,IFPASS ;IF1\r
+ TLNE FR,IFPASS ;IF2\r
+\r
+ TRNE AC0,IFB0 ;IFB\r
+ TLNE ARG,IFDEF0 ;IFDEF\r
+ Z IFIDN0 (0) ;IFDIF\r
+ SKIPE IF ;IFE\r
+ SKIPG IF ;IFG\r
+ SKIPGE IF ;IFGE\r
+ Z IFIDN0 (1) ;IFIDN\r
+ SKIPL IF ;IFL\r
+\r
+ SKIPLE IF ;IFLE\r
+ SKIPN IF ;IFN\r
+ TRNN AC0,IFB0 ;IFNB\r
+ TLNN ARG,IFDEF0 ;IFNDEF\r
+ ZL INTER0 (INTF) ;INTERN\r
+ Z IOWD0 ;IOWD\r
+ ZL IRP0 (0) ;IRP\r
+ ZL IRP0 (400000) ;IRPC\r
+\r
+ JFCL 6,OP ;JCRY\r
+ JFCL 4,OP ;JCRY0\r
+ JFCL 2,OP ;JCRY1\r
+ JRST 12,OP ;JEN\r
+ JFCL 10,OP ;JOV\r
+ JRST 2,OP ;JRSTF\r
+ ZL IORSET (IOPALL) ;LALL\r
+ ZL IORSET (IOPROG) ;LIST\r
+ ZL LIT0 ;LIT\r
+ ZL LOC0 (0) ;LOC\r
+ ZL IOSET (IONCRF) ;CREF\r
+; ZL OFFSYM ;NOSYM\r
+ Z OCT0 (^D8) ;OCT\r
+ ZL OPDEF0 ;OPDEF\r
+ JFCL 1,OP ;JFOV\r
+ ZL ONML ;MLON\r
+ ZL OFFML ;MLOFF\r
+; TRN ASCII0 (3B19) ;COMMENT\r
+\r
+\f SUBTTL USER-DEFINED SYMBOL SEARCH ROUTINES\r
+MSRCH: PUSHJ PP,SEARCH ;PERFORM GENERAL SEARCH\r
+ POPJ PP, ;NOT FOUND, EXIT\r
+ JUMPG ARG,MSRCH2 ;SKIP-EXIT AND CROSS-REF IF FOUND\r
+ CAME AC0,1(SX) ;WE ARE LOOKING AT SYMBOL, TRY ONE ABOVE\r
+ POPJ PP, ;NO, EXIT\r
+ ADDI SX,2 ;YES, POINT TO IT\r
+ PUSHJ PP,SRCH5 ;LOAD REGISTERS\r
+MSRCH2: AOSA 0(PP) ;SET SKIP-EXIT\r
+QSRCH: JUMPL ARG,SSRCH3 ;BRANCH IF OPERAND\r
+ MOVEI SDEL,%MAC ;SET OPERATOR FLAG\r
+ TLZE IO,DEFCRS ;IS IT A DEFINITION?\r
+ MOVEI SDEL,%DMAC ;YES\r
+ JRST CREF ;CROSS-REF AND EXIT\r
+\r
+SSRCH: PUSHJ PP,SEARCH ;PERFORM GENERAL SEARCH\r
+ POPJ PP, ;NOT FOUND, EXIT\r
+ JUMPL ARG,SSRCH2 ;SKIP-EXIT AND CROSS-REF IF FOUND\r
+SSRCH1: CAME AC0,-3(SX) ;WE ARE LOOKING AT MACRO, LOOK ONE SLOT BELOW\r
+ POPJ PP, ;NO DICE, EXIT\r
+ SUBI SX,2 ;YES, POINT TO IT\r
+ PUSHJ PP,SRCH5 ;LOAD REGISTERS\r
+SSRCH2: AOS 0(PP) ;SET FOR SKIP-EXIT\r
+SSRCH3: MOVEI SDEL,%SYM ;SET OPERAND FLAG\r
+\r
+CREF: TLNE FR,P1!CREFSW ;PASS ONE OR CROSS-REF SUPPRESSION?\r
+ POPJ PP, ;YES, EXIT\r
+ EXCH SDEL,C ;PUT FLAG IN C, SACE C\r
+ PUSH PP,CS\r
+ TLOE IO,IOCREF ;HAVE WE PUT OUT THE 177,102\r
+ JRST CREF3 ;YES\r
+ PUSH PP,C ;START OF CREF DATA\r
+ MOVEI C,0\r
+REPEAT 0,< ;NEEDS CHANGE TO CREF\r
+ MOVEI C,177\r
+ PUSHJ PP,OUTLST\r
+ MOVEI C,102\r
+ PUSHJ PP,OUTLST\r
+ TLO IO,IOCREF ;WE NOW ARE IN THAT STATE\r
+ POP PP,C ;WE HAVE NOW\r
+CREF3: JUMPE C,NOFLG ;JUST CLOSE IT\r
+ PUSHJ PP,OUTLST ;TYPE OF SYMBOL (%MAC,%DMAC,%SYM)\r
+ MOVSI CS,770000 ;COUNT CHRS\r
+ TDZA C,C ;STARTING AT 0\r
+ LSH CS,-6 ;TRY NEXT\r
+ TDNE AC0,CS ;IS THAT ONE THERE?\r
+ AOJA C,.-2 ;YES\r
+ PUSHJ PP,OUTLST ;PRINT NUMBER OF SYMBOL CONSTITUENTS\r
+ MOVE CS,AC0\r
+\r
+CREF2: MOVEI C,0\r
+ LSHC C,6\r
+ ADDI C,40\r
+ PUSHJ PP,OUTLST ;THE ASCII SYMBOL\r
+ JUMPN CS,CREF2\r
+ MOVEI C,%DSYM\r
+ TLZE IO,DEFCRS\r
+ PUSHJ PP,OUTLST ;MARK IT AS A DEFINING OCCURENCE\r
+NOFLG: MOVE C,SDEL\r
+ POP PP,CS\r
+ POPJ PP,\r
+\r
+CLSCRF: TRNN ER,LPTSW\r
+ POPJ PP, ;LEAVE IF WE SHOULD NOT BE PRINTING\r
+CLSCR2: MOVEI C,177\r
+ PUSHJ PP,PRINT\r
+ TLZE IO,IOCREF ;WAS IT OPEN?\r
+ JRST CLSCR1 ;YES, JUST CLOSE IT\r
+ MOVEI C,102 ;NO, OPEN IT FIRST\r
+ PUSHJ PP,OUTLST ;MARK BEGINNING OF CREF DATA\r
+ MOVEI C,177\r
+ PUSHJ PP,OUTLST\r
+CLSCR1: MOVEI C,103\r
+ JRST OUTLST ;MARK END OF CREF DATA\r
+\r
+CLSC3: TLZ IO,IOCREF\r
+ MOVEI C,177\r
+ PUSHJ PP,OUTLST\r
+ MOVEI C,104\r
+ JRST OUTLST ;177,104 CLOSES IT FOR NOW\r
+> ;END OF REPEAT 0\r
+REPEAT 1,< ;WORKS WITH EXISTING CREF\r
+ TLNE IO,IOPAGE\r
+ PUSHJ PP,OUTL ;GET CORRECT SUBTTL\r
+ MOVEI C,177\r
+ PUSHJ PP,OUTLST\r
+ MOVEI C,102\r
+ PUSHJ PP,OUTLST\r
+ POP PP,C ;WE HAVE NOW\r
+CREF3: PUSHJ PP,OUTLST ;TYPE OF SYMBOL (%MAC,%DMAC,%SYM)\r
+ MOVSI CS,770000 ;COUNT CHRS\r
+ TDZA C,C ;STARTING AT 0\r
+ LSH CS,-6 ;TRY NEXT\r
+ TDNE AC0,CS ;IS THAT ONE THERE?\r
+ AOJA C,.-2 ;YES\r
+ PUSHJ PP,OUTLST ;PRINT NUMBER OF SYMBOL CONSTITUENTS\r
+ MOVE CS,AC0\r
+\r
+CREF2: MOVEI C,0\r
+ LSHC C,6\r
+ ADDI C,40\r
+ PUSHJ PP,OUTLST ;THE ASCII SYMBOL\r
+ JUMPN CS,CREF2\r
+ MOVEI C,%DSYM\r
+ TLZE IO,DEFCRS\r
+ PUSHJ PP,OUTLST ;MARK IT AS A DEFINING OCCURENCE\r
+ MOVE C,SDEL\r
+ POP PP,CS\r
+ POPJ PP,\r
+\r
+CLSCRF: TRNN ER,LPTSW\r
+ POPJ PP, ;LEAVE IF WE SHOULD NOT BE PRINTING\r
+CLSCR2: TLZE IO,IOCREF ;FINISH UP LINE\r
+ JRST CLSCR1\r
+ MOVEI C,177\r
+ PUSHJ PP,PRINT\r
+ MOVEI C,102\r
+ PUSHJ PP,OUTLST ;MARK BEGINNING OF CREF DATA\r
+CLSCR1: MOVEI C,177\r
+ PUSHJ PP,OUTLST\r
+ MOVEI C,103\r
+ JRST OUTLST ;MARK END OF CREF DATA\r
+> ;END OF REPEAT 1\r
+\fSEARCH: HLRZ SX,SRCHX\r
+ HRRZ SDEL,SRCHX\r
+\r
+SRCH1: CAML AC0,-1(SX)\r
+ JRST SRCH3\r
+SRCH2: SUB SX,SDEL\r
+ LSH SDEL,-1\r
+ CAMG SX,SYMTOP\r
+ JUMPN SDEL,SRCH1\r
+ JUMPN SDEL,SRCH2\r
+ SOJA SX,POPOUT ;NOT FOUND\r
+\r
+SRCH3: CAMN AC0,-1(SX)\r
+ JRST SRCH4 ;NORMAL / FOUND EXIT\r
+ ADD SX,SDEL\r
+ LSH SDEL,-1\r
+ CAMG SX,SYMTOP\r
+ JUMPN SDEL,SRCH1\r
+ JUMPN SDEL,SRCH2\r
+ SOJA SX,POPOUT ;NOT FOUND\r
+\r
+SRCH4: AOS 0(PP) ;SET FOR SKIP EXIT\r
+SRCH5: MOVSI ARG,SUPRBT ;HE IS USING IT, TURN OFF BIT\r
+ ANDCAM ARG,0(SX) ; IN THE TABLE\r
+SRCH7: MOVE ARG,0(SX) ;FLAG AND VALUE TO ARG\r
+ LDB RC,RCPNTR ;POINT 1,ARG,17\r
+ TLNE ARG,LELF ;CHECK LEFT RELOCATE\r
+ TLO RC,1\r
+ HRRZ V,ARG\r
+ TLNE ARG,SPTR ;CHECK SPECIAL EXTESN POINTER\r
+ JRST SRCH6\r
+ TLNE ARG,PNTF\r
+ MOVE V,0(ARG) ;36BIT VALUE TO V\r
+ POPJ PP,\r
+\r
+SRCH6: MOVE V,0(ARG) ;VALUE\r
+ MOVE RC,1(ARG) ;AND RELOC\r
+ TLNE RC,-2 ;CHECK AND SET EXTPNT\r
+ HLLM RC,EXTPNT\r
+ TRNE RC,-2\r
+ HRRM RC,EXTPNT\r
+ POPJ PP,\r
+\fINSERQ: TLNE ARG,UNDF!VARF\r
+INSERZ: SETZB RC,V\r
+INSERT: CAME AC0,-1(SX) ;ARE WE LOOKING AT MATCHING MNEMONIC?\r
+ JRST INSRT2 ;NO, JUST INSERT\r
+ JUMPL ARG,INSRT1 ;YES, BRANCH IF OPERAND\r
+ SKIPL 0(SX) ;OPERATOR, ARE WE LOOKING AT ONE?\r
+ JRST UPDATE ;YES, UPDATE\r
+ JRST INSRT2 ;NO, INSERT\r
+\r
+INSRT1: SKIPG 0(SX) ;OPERAND, ARE WE LOOKING AT ONE?\r
+ JRST UPDATE ;YES, UPDATE\r
+ SUBI SX,2 ;NO, MOVE UNDER OPERATOR AND INSERT\r
+INSRT2: MOVE SDEL,SYMBOL\r
+ SUBI SDEL,2\r
+ CAMLE SDEL,FREE\r
+ JRST INSRT3\r
+ PUSHJ PP,XCEED\r
+ ADDI SDEL,2000\r
+ ADDI SX,2000\r
+INSRT3: MOVEM SDEL,SYMBOL ;MAKE ROOM FOR A TWO WORD ENTRY\r
+ HRLI SDEL,2(SDEL)\r
+ BLT SDEL,-2(SX) ;PUSH EVERYONE DOWN TWO LOACTIONS\r
+ AOS @SYMBOL ;INCREMENT THE SYMBOL COUNT\r
+ TLNN RC,-2 ;SPECIAL LEFT OR RIGHT EXTERNAL?\r
+ TRNE RC,-2\r
+ JRST INSRT5 ;YES, JUMP\r
+ TLNN V,-1 ;SKIP IF V IS A 36BIT VALUE\r
+ JRST INSRT4 ;JUMP, ITS A 18BIT VALUE\r
+ AOS SDEL,FREE ;36BIT, SO GET A CELL FROM FREE CORE\r
+ CAML SDEL,SYMBOL ;MORE CORE NEEDED\r
+ PUSHJ PP,XCEEDS ;YES\r
+ HRR ARG,SDEL ;POINT TO ARG\r
+ MOVEM V,0(ARG) ;36BIT VALUE TO FREE CORE\r
+ TLOA ARG,PNTF ;NOTE THAT ARG IS APOINTER, NOT A 18BIT VALUE\r
+\r
+INSRT4: HRR ARG,V ;18BIT VALUE TO ARG\r
+ DPB RC,RCPNTR ;FIX RIGHT RELOCATION\r
+ TLNE RC,1\r
+ TLO ARG,LELF ;FIX LEFT RELOCATION\r
+INSRT6: MOVEM ARG,0(SX) ;INSERT FLAGS AND VALUE.\r
+ MOVEM AC0,-1(SX) ;INSERT SYMBOL NAME.\r
+ PUSHJ PP,SRCHI ;INITILIAZE SRCHX\r
+ JRST QSRCH ;EXIT THROUGH CREF\r
+\r
+INSRT5: MOVEI SDEL,2 ;GET TWO CELLS FROM FREE CORE\r
+ ADDB SDEL,FREE\r
+ CAML SDEL,SYMBOL ;MORE CORE NEEDED?\r
+ PUSHJ PP,XCEEDS ;YES\r
+ MOVEM RC,0(SDEL)\r
+ HRRI ARG,-1(SDEL) ;POINT TO THE ARG\r
+ MOVEM V,0(ARG)\r
+ TLO ARG,SPTR ;SET SPECIAL POINTER, POINTS TO TWO CELLS\r
+ JRST INSRT6\r
+\fREMOVE: SUBI SX,2 ;MOVE EVERYONE UP TWO LOCATIONS\r
+REMOV1: MOVE 0,0(SX)\r
+ MOVEM 0,2(SX) ;OVERWRITE THE DELETED SYMBOL\r
+ CAME SX,SYMBOL ;SKIP WHEN DONE\r
+ SOJA SX,REMOV1\r
+ ADDI SX,2\r
+ MOVEM SX,SYMBOL\r
+ SOS 0,0(SX) ;DECREMENT THE SYMBOL COUNT\r
+\r
+SRCHI: MOVEI AC2,0 ;THIS CODE SETS UP SRCHX\r
+ FAD AC2,@SYMBOL\r
+ LSH AC2,-^D27\r
+ MOVEI AC1,1000\r
+ LSH AC1,-357(AC2)\r
+ HRRM AC1,SRCHX\r
+ LSH AC1,1\r
+ ADD AC1,SYMBOL\r
+ HRLM AC1,SRCHX\r
+ POPJ PP,\r
+\fUPDATE: DPB RC,RCPNTR ;FIX RIGHT RELOCATION\r
+ TLNE ARG,SPTR ;SKIP IF THERE IS NO SPECIAL POINTER\r
+ JRST UPDAT4 ;YES, USE THE TWO CELLS\r
+ TLNN RC,-2 ;NEED TO CHANGE ANY CURRENT EXTERNS\r
+ TRNE RC,-2\r
+ JRST UPDAT5 ;YES, JUMP\r
+ TLZ ARG,LELF ;CLEAR LELF\r
+ TLNE RC,1 ;LEFT RELOCATABLE?\r
+ TLO ARG,LELF ;YES, SET THE FLAG\r
+ TLNE ARG,PNTF ;WAS THERE A 36BIT VALUE?\r
+ JRST UPDAT2 ;YES, USE IT.\r
+ TLNE V,-1 ;NO,IS THERE A 36BIT VALUE?\r
+ JRST UPDAT1 ;YES, GET A CELL\r
+ HRR ARG,V ;NO, USE RH OF ARG\r
+UPDAT3: MOVEM ARG,0(SX) ;OVERWRITE THE ONE IN THE TABLE\r
+ POPJ PP, ;AND EXIT\r
+\r
+UPDAT1: AOS SDEL,FREE ;GET ONE CELL\r
+ CAML SDEL,SYMBOL ;NEED MORE CORE?\r
+ PUSHJ PP,XCEEDS ;YES\r
+ HRR ARG,SDEL ;POINT TO ARG\r
+ TLO ARG,PNTF ;AND NOTE IT.\r
+UPDAT2: TLNE ARG,EXTF ;IS THERE A EXTERNAL?\r
+ JRST UPDAT3 ;YES, - JUST SAVE A LOCATION\r
+ MOVEM ARG,0(SX) ;NO, OVERWRITE THE POINTER IN THE TABLE\r
+ MOVEM V,0(ARG) ;STORE VALUE AS A 36BIT VALUES\r
+ POPJ PP, ;AND EXIT\r
+\r
+UPDAT4: MOVEM ARG,0(SX) ;WE HAVE TWO CELLS, WE USE THEM\r
+ MOVEM V,0(ARG) ;SAVE AS 36BIT VALUE\r
+ MOVEM RC,1(ARG) ;SAVE RELCATION BITS\r
+ POPJ PP, ;AND EXIT\r
+\r
+UPDAT5: MOVEI SDEL,2 ;THERE IS A EXTERNAL\r
+ ADDB SDEL,FREE ;SO WE NEED TWO LOCATIONS\r
+ CAML SDEL,SYMBOL ;NEED MORE CORE?\r
+ PUSHJ PP,XCEEDS ;YES\r
+ MOVEM RC,0(SDEL) ;SAVE RELOCATION BITS\r
+ HRRI ARG,-1(SDEL) ;SAVE THE POINTER IN ARG\r
+ MOVEM V,0(ARG) ;SAVE A 36BIT VALUE\r
+ TLO ARG,SPTR ;SET SPECIAL PNTR FLAG\r
+ TLZ ARG,PNTF ;CLEAR POINTER FLAG\r
+ JRST UPDAT3 ;SAVE THE POINTER AND EXIT\r
+\r
+\fSUBTTL STORAGE CELLS\r
+\r
+IFN PURESW,<\r
+ LOC 140\r
+>\r
+PASS1I:\r
+\r
+RP: BLOCK 1\r
+IFE CCLSW,<CTIBUF: BLOCK 3\r
+CTOBUF: BLOCK 3\r
+>\r
+\r
+IFN CCLSW,<CTLBUF: BLOCK <CTLSIZ+5>/5\r
+IFN RUNSW,<RUNDEV: BLOCK 1\r
+RUNFIL: BLOCK 3\r
+RUNPP: BLOCK 2>>\r
+LSTBUF: BLOCK 3\r
+BINBUF: BLOCK 3\r
+IBUF: BLOCK 3\r
+IFN CCLSW,<IFE RUNSW,<NUNDIR:>>\r
+INDIR: BLOCK 4\r
+\r
+ACDELX: ;LEFT HALF\r
+BLKTYP: BLOCK 1 ;RIGHT HALF\r
+\r
+COUTX: BLOCK 1\r
+COUTY: BLOCK 1\r
+COUTP: BLOCK 1\r
+COUTRB: BLOCK 1\r
+COUTDB: BLOCK ^D18\r
+\r
+ERRCNT: BLOCK 1\r
+FREE: BLOCK 1\r
+IFN RENTSW,<HHIGH: BLOCK 1 ;SAVE BREAK OF HIGH SEG. IN TWO SEG PROG.>\r
+IFBLK: BLOCK .IFBLK\r
+IFBLKA: BLOCK .IFBLK\r
+LADR: BLOCK 1\r
+LBUFP: BLOCK 1\r
+LBUF: BLOCK <.CPL+5>/5\r
+ BLOCK 1\r
+VARHD: BLOCK 1\r
+VARHDX: BLOCK 1\r
+\r
+LITAB: BLOCK 1\r
+LITABX: BLOCK 1\r
+ BLOCK 1\r
+LITHD: BLOCK 1\r
+LITHDX: BLOCK 1\r
+LITCNT: BLOCK 1\r
+LITNUM: BLOCK 1\r
+\r
+LOOKX: BLOCK 1\r
+NEXT: BLOCK 1\r
+OUTSW: BLOCK 1\r
+PDP: BLOCK 1\r
+RECCNT: BLOCK 1\r
+SAVBLK: BLOCK RC\r
+SAVERC: BLOCK 1\r
+SBUF: BLOCK .SBUF/5\r
+SRCHX: BLOCK 1\r
+SUBTTX: BLOCK 1\r
+SVSYM: BLOCK 1\r
+SYMBOL: BLOCK 1\r
+SYMTOP: BLOCK 1\r
+SYMCNT: BLOCK 1 \r
+\r
+STPX: BLOCK 1\r
+STPY: BLOCK 1\r
+STCODE: BLOCK .STP\r
+STOWRC: BLOCK .STP\r
+\r
+TABP: BLOCK 1\r
+TBUF: BLOCK .TBUF/5\r
+TYPERR: BLOCK 1\r
+\r
+\fPASS2I:\r
+\r
+ACDEVX: BLOCK 1\r
+CPL: BLOCK 1\r
+CTLSAV: BLOCK 1\r
+EXTPNT: BLOCK 1\r
+INTENT: BLOCK 1\r
+INREP: BLOCK 1 \r
+INDEF: BLOCK 1 \r
+INTXT: BLOCK 1 \r
+CALPG: BLOCK 1 \r
+CALSEQ: BLOCK 1 \r
+DEFPG: BLOCK 1 \r
+DEFSEQ: BLOCK 1 \r
+LITPG: BLOCK 1 \r
+LITSEQ: BLOCK 1 \r
+REPPG: BLOCK 1 \r
+REPSEQ: BLOCK 1 \r
+TXTPG: BLOCK 1 \r
+TXTSEQ: BLOCK 1 \r
+IRPARG: BLOCK 1\r
+IRPARP: BLOCK 1\r
+IRPCF: BLOCK 1\r
+IRPPOI: BLOCK 1\r
+IRPSW: BLOCK 1\r
+LITLVL: BLOCK 1\r
+\r
+ASGBLK: BLOCK 1\r
+LOCBLK: BLOCK 1\r
+\r
+LOCA: BLOCK 1\r
+LOCO: BLOCK 1\r
+RELLOC: BLOCK 1\r
+LPP: BLOCK 1\r
+LSTSYM: BLOCK 1\r
+MACENL: BLOCK 1\r
+MACLVL: BLOCK 1\r
+MACPNT: BLOCK 1\r
+MODA: BLOCK 1\r
+MODLOC: BLOCK 1\r
+MODO: BLOCK 1\r
+IFN CCLSW,<OTBUF: BLOCK 2 >\r
+OUTSQ: BLOCK 2\r
+PAGENO: BLOCK 1\r
+PAGEN.: BLOCK 1\r
+PPTEMP: BLOCK 1\r
+PPTMP1: BLOCK 1\r
+PPTMP2: BLOCK 1\r
+\r
+REPCNT: BLOCK 1\r
+REPEXP: BLOCK 1\r
+REPPNT: BLOCK 1\r
+RPOLVL: BLOCK 1\r
+R1BCNT: BLOCK 1 \r
+R1BCHK: BLOCK 1 \r
+R1BBLK: BLOCK .R1B\r
+R1BLOC: BLOCK 1 \r
+RIMLOC: BLOCK 1\r
+SEQNO2: BLOCK 1 \r
+TAGINC: BLOCK 1\r
+VECREL: BLOCK 1\r
+VECTOR: BLOCK 1\r
+WWRXX: BLOCK 1\r
+PASS2X: \r
+\fSUBTTL MULTI-ASSEMBLY STORAGE CELLS\r
+\r
+HDAS: BLOCK 1\r
+IFN CCLSW,<EXTMP: BLOCK 1 ;HOLDS EXT OF COMMAND FILE (RH)\r
+SAVFF: BLOCK 1\r
+CTLBLK: BLOCK 3\r
+CTIBUF: BLOCK 3\r
+CTOBUF: BLOCK 3 >\r
+IFN TEMP,<TMPFLG: BLOCK 1>\r
+ VAR ;CLEAR VARIABLES\r
+\r
+\f SUBTTL CONSTANTS\r
+\r
+IFN TEMP,<TMPFIL: SIXBIT /MAC/\r
+ XWD -200,0>\r
+TAG: BLOCK 1\r
+ SIXBIT / + @/\r
+TABI:\r
+ BYTE (7) 0, 11, 11, 11, 11\r
+SEQNO: BLOCK 1\r
+ ASCIZ / /\r
+BININI: INIT 1,B\r
+BINDEV: BLOCK 1\r
+ XWD BINBUF,0\r
+ JRST EINIT\r
+ POPJ PP,\r
+LSTINI: INIT 3,AL\r
+LSTDEV: BLOCK 1\r
+ XWD LSTBUF,0\r
+ JRST EINIT\r
+ POPJ PP,\r
+ INIT 1,16\r
+ BLOCK 2\r
+ JRST EINIT\r
+ POPJ PP,\r
+IFN CCLSW,<\r
+RPGINI: INIT 4,1\r
+RPGDEV: BLOCK 1\r
+ XWD 0,CTLBLK\r
+ JRST EINIT\r
+ POPJ PP,\r
+>\r
+INDEVI: INIT 2,0\r
+INDEV: BLOCK 1\r
+ XWD 0,IBUF\r
+ JRST EINIT\r
+ POPJ PP,\r
+VBUF: ASCII / MACRO.V36/ ;MUST BE LAST LOCATIONS IN BLOCK\r
+DBUF: ASCIZ / TI:ME DY-MON-YR PAGE /\r
+JOBFFI: BLOCK 203*NUMBUF+1 ;INPUT BUFFER PLUS ONES\r
+IFN PURESW,<LOWEND==.-1\r
+ Z\r
+ RELOC>\r
+\r
+ END BEG\r
+\f\r
git://git.sky-visions.com / retro-software/dec/tops10/v4.5.git / commitdiff