src/mac37.mac

   1 TITLE   MACRO.V36\r
   2 SUBTTL   RPG/CMF/JF/PMH/DMN     7-SEPT-71\r
   3 ;COPYRIGHT 1968,1969,1970,1971, DIGITAL EQUIPMENT CORP., MAYNARD, MASS.\r
   4 \r
   5 \r
   6         LOC     <JOBVER==137>\r
   7         OCT     37\r
   8         RELOC\r
   9         MLON\r
  10 \r
  11 REPEAT 0,<\r
  12         ASSEMBLY FEATURE SWITCHES (ACTION WHEN NON-ZERO)\r
  13 \r
  14         SWITCHES ON (NON-ZERO) IN DEC VERSION\r
  15 PURESW          GIVES VARIABLES IN LOW SEGMENT\r
  16 CCLSW           GIVES RAPID PROGRAM GENERATION FEATURE\r
  17 FTDISK          GIVES DISK FEATURES\r
  18 RUNSW           USE RUN UUO FOR "DEV:NAME!"\r
  19 TEMP            TMPCOR UUO IS TO BE USED\r
  20 RENTSW          ASSEMBLE REENTERANT PROGRAMS\r
  21 \r
  22 >\r
  23 \fSUBTTL DEFAULT ASSEMBLY SWITCH SETTINGS\r
  24 \r
  25 IFNDEF PURESW,<PURESW==1>\r
  26 \r
  27 IFNDEF RUNSW,<RUNSW==1>\r
  28 \r
  29 IFNDEF RENTSW,<RENTSW==1>\r
  30 \r
  31 IFNDEF CCLSW,<CCLSW==1>\r
  32 IFN CCLSW,<FTDISK==1>\r
  33 \r
  34 IFNDEF TEMP,<TEMP==1>\r
  35 \r
  36 IFNDEF FTDISK,<FTDISK==0>\r
  37 \r
  38 \fSUBTTL OTHER PARAMETERS\r
  39 \r
  40 .PDP==  ^D40            ;BASIC PUSH-DOWN POINTER\r
  41 IFNDEF LPTWID,<LPTWID==^D132>   ;DEFAULT WIDTH OF PRINTER\r
  42 .LPTWD==8*<LPTWID/8>            ;USEFUL WIDTH IN MAIN LISTING\r
  43 .CPL==  .LPTWD-^D40             ;WIDTH AVAIABLE FOR TEXT WHEN\r
  44                                 ;BINARY IS IN HALFWORD FORMAT\r
  45 .LPP==^D55      ;LINES/PAGE\r
  46 .STP==  ^D40            ;STOW SIZE\r
  47 .TBUF== ^D80            ;TITLE BUFFER\r
  48 .SBUF== ^D80            ;SUB-TITLE BUFFER\r
  49 .IFBLK==^D5             ;IFIDN COMPARISON BLOCK SIZE\r
  50 .R1B==^D18\r
  51 .LEAF==4                ;SIZE OF BLOCKS IN MACRO TREE\r
  52 \r
  53 NCOLS==LPTWID/^D40              ;NUMBER OF COLUMNS IN SYMBOL TABLE\r
  54 IFN CCLSW,<IFNDEF CTLSIZ,<CTLSIZ==^D79>>\r
  55 IFNDEF NUMBUF,<NUMBUF==2        ;NUMBER OF INPUT BUFFERS>\r
  56 \r
  57 EXTERN  JOBREL,JOBSYM,JOBDDT,JOBFF,JOBAPR,JOBSA\r
  58 IFN CCLSW,<     EXTERN  JOBERR>\r
  59 \r
  60 IFN PURESW,< HISEG >\r
  61 \r
  62 ;SOME ASCII CHARACTERS\r
  63 \r
  64 HT==11\r
  65 LF==12\r
  66 VT==13\r
  67 FF==14\r
  68 CR==15\r
  69 EOL==33\r
  70 \f                       ;ACCUMULATORS\r
  71 AC0==   0\r
  72 AC1=    AC0+1\r
  73 AC2=    AC1+1\r
  74 SDEL=   3               ;SEARCH INCREMENT\r
  75 SX=     SDEL+1          ;SEARCH INDEX\r
  76 ARG=    5               ;ARGUMENT\r
  77 V=      6               ;VALUE\r
  78 C=      7               ;CURRENT CHARACTER\r
  79 CS=     C+1             ;CHARACTER STATUS BITS\r
  80 RC=     11              ;RELOCATION BITS\r
  81 MWP=    12              ;MACRO WRITE POINTER\r
  82 MRP=    13              ;MACRO READ POINTER\r
  83 IO=     14              ;IO REGISTER (LEFT)\r
  84 ER==    IO              ;ERROR REGISTER (RIGHT)\r
  85 FR=     15              ;FLAG REGISTER (LEFT)\r
  86 RX==    FR              ;CURRENT RADIX (RIGHT)\r
  87 MP=     16              ;MACRO PUSHDOWN POINTER\r
  88 PP=     17              ;BASIC PUSHDOWN POINTER\r
  89 \r
  90 %OP==   3\r
  91 %MAC==  5\r
  92 %DSYM== 2\r
  93 %SYM==  1\r
  94 %DMAC== %MAC+1\r
  95 \r
  96 OPDEF   RESET   [CALLI   0]\r
  97 OPDEF   SETDDT  [CALLI   2]\r
  98 OPDEF   DDTOUT  [CALLI   3]\r
  99 OPDEF   DEVCHR  [CALLI   4]\r
 100 OPDEF   CORE    [CALLI  11]\r
 101 OPDEF   EXIT    [CALLI  12]\r
 102 OPDEF   UTPCLR  [CALLI  13]\r
 103 OPDEF   DATE    [CALLI  14]\r
 104 OPDEF   APRENB  [CALLI  16]\r
 105 OPDEF   MSTIME  [CALLI  23]\r
 106 OPDEF   PJOB    [CALLI  30]\r
 107 OPDEF   RUN     [CALLI  35]\r
 108 OPDEF   TMPCOR  [CALLI  44]\r
 109 OPDEF   MTWAT.  [MTAPE   0]\r
 110 OPDEF   MTREW.  [MTAPE   1]\r
 111 OPDEF   MTEOT.  [MTAPE  10]\r
 112 OPDEF   MTSKF.  [MTAPE  16]\r
 113 OPDEF   MTBSF.  [MTAPE  17]\r
 114 \r
 115 \f                       ;FR  FLAG REGISTER (FR/RX)\r
 116 IOSCR== 000001          ;NO CR AFTER LINE\r
 117 MTAPSW==000004          ;MAG TAPE\r
 118 ERRQSW==000010          ;IGNORE Q ERRORS\r
 119 LOADSW==000020          ;END OF PASS1 & NO EOF YET\r
 120 DCFSW== 000040          ;DECIMAL FRACTION\r
 121 RIM1SW==000100          ;RIM10 MODE\r
 122 NEGSW== 000200          ;NEGATIVE ATOM\r
 123 RIMSW== 000400          ;RIM OUTPUT\r
 124 PNCHSW==001000          ;RIM/BIN OUTPUT WANTED\r
 125 CREFSW==002000\r
 126 R1BSW== 004000          ;RIM10 BINARY OUTPUT\r
 127 TMPSW== 010000          ;EVALUATE CURRENT ATOM\r
 128 INDSW== 020000          ;INDIRECT ADDRESSING WANTED\r
 129 RADXSW==040000          ;RADIX ERROR SWITCH\r
 130 FSNSW== 100000          ;NON BLANK FIELD SEEN\r
 131 MWLFLG==200000          ;ON FOR DON'T ALLOW MULTI-WORD LITERALS\r
 132 P1==    400000          ;PASS1\r
 133 \r
 134                         ;IO FLAG REGISTER (IO/ER)\r
 135 FLDSW== 400000          ;ADDRESS FIELD\r
 136 IOMSTR==200000\r
 137 ARPGSW==100000          ;ALLOW RAPID PROGRAM GENERATION\r
 138 IOPROG==040000          ;SUPRESS LISTING (LIST/XLIST PSEUDO OP)\r
 139 NUMSW== 020000\r
 140 IOMAC== 010000          ;MACRO EXPANSION IN PROGRESS\r
 141 IOPALL==004000          ;SUPRESS LISTING OF MACRO EXPANSIONS\r
 142 IONCRF==002000          ;SUPRESS OUTPUT OF CREF INFORMATION\r
 143 CRPGSW==001000          ;CURRENTLY IN PROGRESS ON RPG\r
 144 IOCREF==000400          ;WE ARE NOW OUTPUTTING CREF INFO\r
 145 IOENDL==000200          ;BEEN TO STOUT\r
 146 IOPAGE==000100\r
 147 DEFCRS==000040          ;THIS IS A DEFINING OCCURANCE (MACROS)\r
 148 IOIOPF==000020          ;IOP INSTRUCTION SEEN\r
 149 MFLSW== 000010          ;MULTI-FILE MODE,PRGEND SEEN\r
 150 IORPTC==000004          ;REPEAT CURRENT CHARACTER\r
 151 IOTLSN==000002          ;TITLE SEEN\r
 152 IOSALL==000001          ;SUPPRESS MACRO LISTING EVEN IF BINARY IS GENERATED\r
 153 \r
 154 OPDEF   JUMP1   [JUMPL  FR,  ]  ;JUMP IF PASS 1\r
 155 OPDEF   JUMP2   [JUMPGE FR,  ]  ;JUMP IF PASS 2\r
 156 \r
 157 OPDEF   JUMPOC  [JUMPGE IO,  ]  ;JUMP IF IN OP-CODE FIELD\r
 158 OPDEF   JUMPAD  [JUMPL  IO,  ]  ;JUMP IF IN ADDRESS FIELD\r
 159 \r
 160 OPDEF   JUMPCM  [JUMPL  CS,  ]  ;JUMP IF CURRENT CHAR IS COMMA\r
 161 OPDEF   JUMPNC  [JUMPGE CS,  ]  ;JUMP IF CURRENT CHAR IS NON-COMMA\r
 162 \r
 163 \f                       ;ER ERROR REGISTERS (IO/ER)\r
 164 ERRM==  000020          ;MULTIPLY DEFINED SYMBOL\r
 165 ERRE==  000040          ;ILLEGAL USE OF EXTERNAL\r
 166 ERRP==  000100          ;PHASE DISCREPANCY\r
 167 ERRO==  000200          ;UNDEFINED OP CODE\r
 168 ERRN==  000400          ;NUMBER ERROR\r
 169 ERRV==  001000          ;VALUE PREVIOUSLY UNDEFINED\r
 170 ERRU==  002000          ;UNDEFINED SYMBOL\r
 171 ERRR==  004000          ;RELOCATION ERROR\r
 172 ERRL==  010000          ;LITERAL ERROR\r
 173 ERRD==  020000          ;REFERENCE TO MULTIPLY DEFINED SYMBOL\r
 174 ERRA==  040000          ;PECULIAR ARGUMENT\r
 175 ERRX==  100000          ;MACRO DEFINITION ERROR\r
 176 ERRQ==  200000          ;QUESTIONABLE, NON-FATAL ERROR\r
 177 ERRORS==777760\r
 178 LPTSW== 000002\r
 179 TTYSW== 000001\r
 180 \r
 181                         ;SYMBOL TABLE FLAGS\r
 182 SYMF==  400000          ;SYMBOL\r
 183 TAGF==  200000          ;TAG\r
 184 NOOUTF==100000          ;NO DDT OUTPUT WFW\r
 185 SYNF==  040000          ;SYNONYM\r
 186 MACF==  SYNF_-1         ;MACRO\r
 187 OPDF==  SYNF_-2         ;OPDEF\r
 188 PNTF==  004000          ;"VALUE" IN SYMBOL TBL IS PNTR TO 36BIT VALUE\r
 189 UNDF==  002000          ;UNDEFINED\r
 190 EXTF==  001000          ;EXTERNAL\r
 191 INTF==  000400          ;INTERNAL\r
 192 ENTF==  000200          ;ENTRY\r
 193 VARF==  000100          ;VARIABLE\r
 194 MDFF==  000020          ;MULTIPLY DEFINED\r
 195 SPTR==  000010          ;SPECIAL EXTERNAL POINTER\r
 196 SUPRBT==000004          ;SUPRESS OUTPUT TO DDT\r
 197 LELF==  000002          ;LEFT HAND RELOCATABLE\r
 198 RELF==  000001          ;RIGHT HAND RELOCATABLE\r
 199 \r
 200 LITF==  200000          ;FLAG FOR PSEUDO-OPS INVALID IN LIT'S\r
 201 ADDF==  100000          ;FLAG FOR PSEUDO-OPS INVALID IN ADDRESSES\r
 202 \r
 203 TNODE== 200000          ;TERMINAL NODE FOR EVALEX\r
 204 \f\r
 205 ;USEFUL MACROS\r
 206 \r
 207 DEFINE FORERR(AC,ABC)<\r
 208         MOVE    AC,SEQNO2\r
 209         MOVEM   AC,ABC'SEQ\r
 210         MOVE    AC,PAGENO\r
 211         MOVEM   AC,ABC'PG\r
 212 >\r
 213 \r
 214 \f\r
 215 IFN CCLSW,<             ;ASSEMBLE IF RUN UUO IMPLEMENTED\r
 216 NUNSET: SKIPN   ACDEV\r
 217         MOVSI   ACDEV,(SIXBIT /SYS/)    ;USE SYS IF NONE SPECIFIED\r
 218 IFN RUNSW,<\r
 219         MOVEM ACDEV,RUNDEV\r
 220         MOVEM ACFILE,RUNFIL     ;STORE FILE NAME\r
 221         PUSHJ PP,DELETE         ;COMMAND FILE\r
 222         SETZM RUNPP\r
 223         MOVEI 16,RUNDEV ;XWD 0,RUNDEV\r
 224         TLNE IO,CRPGSW  ;WAS RPG IN PROGRESS?\r
 225         HRLI 16,1       ;YES  START NEXT AT C(JOBSA)+1\r
 226         RUN 16,         ;DO "RUN DEV:NAME"\r
 227         HALT            ;SHOULD'T RETURN. HALT IF IT DOES\r
 228 >\r
 229 IFE RUNSW,<POPJ PP, >\r
 230 \r
 231 DELETE: HRRZ    EXTMP           ;IF THE EXTENSION\r
 232         CAIE    (SIXBIT /TMP/)  ;IS .TMP\r
 233         POPJ    PP,             ;RETURN\r
 234         CLOSE   CTL2,           ;DELETE\r
 235         SETZB   4,5             ;THE COMMAND FILE.\r
 236         SETZB   6,7\r
 237         RENAME  CTL2,4          ;\r
 238         JFCL\r
 239         POPJ    PP,\r
 240 >\r
 241 \fSUBTTL START ASSEMBLING\r
 242 \r
 243 ASSEMB: PUSHJ   PP,INZ          ;INITIALIZE FOR PASS\r
 244         MOVE    [ASCII /.MAIN/]\r
 245         MOVEM   TBUF\r
 246         MOVEI   SBUF\r
 247         HRRM    SUBTTX\r
 248 \r
 249 ASSEM1: PUSHJ   PP,CHARAC       ;TEST FOR FORM FEED\r
 250         CAIN    C,14\r
 251         SKIPE   SEQNO\r
 252         JRST    ASSEM2\r
 253         PUSHJ   PP,OUTFF\r
 254         PUSHJ   PP,OUTLI\r
 255         JRST    ASSEM1\r
 256 \r
 257 ASSEM2: AOS     TAGINC\r
 258         CAIN    C,15\r
 259         JRST    ASSEM3\r
 260         CAIN    C,"\"           ;BACK-SLASH?\r
 261         TLZA    IO,IOMAC        ;YES, LIST IF IN MACRO\r
 262         TLO     IO,IORPTC\r
 263         PUSHJ   PP,STMNT        ;OFF WE GO\r
 264         TLZN    IO,IOENDL       ;WAS STOUT PRE-EMPTED?\r
 265         PUSHJ   PP,STOUT\r
 266         JRST    ASSEM1\r
 267 ASSEM3: PUSHJ   PP,STOUT+1\r
 268         JRST    ASSEM1\r
 269 \r
 270 \fSUBTTL STATEMENT PROCESSOR\r
 271 \r
 272 STMNT:  TLZ     FR,INDSW\r
 273         TLZA    IO,FLDSW\r
 274 STMNT1: PUSHJ   PP,LABEL\r
 275 STMNT2: PUSHJ   PP,ATOM         ;GET THE FIRST ATOM\r
 276         CAIN    C,35            ;"="?\r
 277         JRST    ASSIGN          ;YES\r
 278         CAIN    C,32            ;":"?\r
 279         JRST    STMNT1          ;YES\r
 280         JUMPAD  STMNT7          ;NUMERIC EXPRESSION\r
 281         SKIPE   C\r
 282         TLO     IO,IORPTC\r
 283         SKIPN   AC2,AC0\r
 284         POPJ    PP,\r
 285         PUSHJ   PP,MSRCH        ;SEARCH FOR MACRO/OPDEF/SYN\r
 286         JRST    STMNT3          ;NOT FOUND, TRY OP CODE\r
 287         LDB     SDEL,[POINT 3,ARG,5]\r
 288         JUMPE   SDEL,ERRAX      ;ERROR IF NO FLAG\r
 289         SOJE    SDEL,OPD1       ;OPDEF IF 1\r
 290         SOJE    SDEL,CALLM      ;MACRO IF 2\r
 291         JRST    STMNT4          ;SYNONYM, PROCESS WITH OP-CODES\r
 292 \r
 293 STMNT3: PUSHJ   PP,OPTSCH       ;SEARCH OP CODE TABLE\r
 294         JRST    STMNT5          ;NOT FOUND\r
 295 STMNT4: HLLZ    AC0,V           ;PUT CODE IN AC0\r
 296         TRZE    V,LITF          ;VALID IN LITERAL?\r
 297         SKIPN   LITLVL          ;NO, ARE WE IN A LITERAL?\r
 298         JRST    0(V)            ;NO, GO TO APPRORIATE PROCESSOR\r
 299         MOVE    AC0,AC2\r
 300 \r
 301 STMNT5: PUSHJ   PP,SSRCH        ;TRY SYMBOLS\r
 302         JRST    STMNT8          ;NOT FOUND\r
 303         TLNE    ARG,EXTF!UNDF   ;EXTERNAL OR UNDEFINED?\r
 304         JRST    STMNT7          ;YES, PROCESS IN EVALEX\r
 305         TLNN RC,-2              ;CHECK FOR EXTERNAL\r
 306         TRNE RC,-2\r
 307         JRST STMNT7\r
 308         MOVE    AC0,V           ;FOUND, PUT VALUE IN AC0\r
 309         TLO     IO,NUMSW        ;FLAG AS NUMERIC\r
 310 STMNT7: TLZ     IO,IORPTC\r
 311         PUSHJ   PP,EVALHA       ;EVALUATE EXPRESSION\r
 312         JRST    STOW            ;YES,STOW THE CODE AND EXIT\r
 313 \r
 314 \fSTMNT8:        SETZB   AC0,RC          ;CLEAR VALUE AND RELOCATION\r
 315         TRO     ER,ERRO         ;FLAG AS UNDEIFNED OP-CODE\r
 316         JRST    OPD\r
 317 \r
 318                 ;STATEMENT OUT PASSES REMAINDER OF LINE (CMNT)\r
 319                         ;UNTIL A LINE TERMINATOR IS SEEN.\r
 320 STOUTS: TLO     IO,IOENDL\r
 321 STOUT:  TLO     IO,IORPTC\r
 322         PUSHJ   PP,BYPAS1\r
 323         CAIN    C,14            ;COMMA?\r
 324         SKIPL   STPX            ;YES, ERROR IF CODE STORED\r
 325         CAIN    C,33\r
 326         TLOA    IO,IORPTC\r
 327         TRO     ER,ERRQ\r
 328 STOUT1: PUSHJ   PP,CHARAC\r
 329         CAIGE   C,CR\r
 330         CAIG    C,HT\r
 331         JRST    STOUT1\r
 332         JRST    OUTLIN\r
 333 \f       SUBTTL  LABEL PROCESSOR\r
 334 \r
 335 LABEL:  JUMPAD  LABEL4          ;COMPARE IF NON-SYMBOLIC\r
 336         JUMPE   AC0,LABEL5      ;ERROR IF BLANK\r
 337         MOVEM   AC0,TAG\r
 338         HLLZS   AC0,TAGINC\r
 339         TLO     IO,DEFCRS       ;THIS IS A DEFINITION\r
 340         PUSHJ   PP,SSRCH        ;SEARCH FOR OPERAND\r
 341         MOVSI   ARG,SYMF!UNDF!TAGF      ;NOT FOUND\r
 342         TLNE    ARG,EXTF        ;UNDEFINED ON PASS1\r
 343         JRST    LABEL3          ;NO, FLAG ERROR\r
 344         TLZN    ARG,UNDF!VARF\r
 345         JRST    LABEL2          ;YES, CHECK EQUALITY\r
 346 LABEL1: MOVE    V,LOCA  ;WFW\r
 347         MOVE    RC,MODA\r
 348         TLO     ARG,TAGF\r
 349         JRST    INSERT          ;INSERT/UPDATE AND EXIT\r
 350 \r
 351 LABEL2: HRLOM   V,LOCBLK        ;SAVE LIST LOCATION\r
 352         TLNE    ARG,40\r
 353         JRST    LABEL6\r
 354 LABEL0: CAMN    V,LOCA          ;DOES IT COMPARE WITH PREVIOUS? WFW\r
 355         CAME    RC,MODA\r
 356 LABEL3: TLOA    ARG,MDFF        ;NO, FLAG MULTIPLY DEFINED AND SKIP\r
 357         POPJ    PP,\r
 358         TRO     ER,ERRM         ;FLAG MULTIPLY DEFINED ERROR\r
 359         JRST    UPDATE          ;UPDATE AND EXIT\r
 360 \r
 361 LABEL4: CAMN    AC0,LOCA        ;DO THEY COMPARE?\r
 362         CAME    RC,MODA\r
 363 LABEL5: TRO     ER,IOPAGE       ;NO, FLAG PHASE ERROR\r
 364         POPJ    PP,\r
 365 \r
 366 LABEL6: JUMP1   LABEL1\r
 367         TRO     ER,IOMSTR\r
 368         TLZ     ARG,40\r
 369         PUSHJ   PP,UPDATE\r
 370         JRST    LABEL0\r
 371 \fSUBTTL ATOM PROCESOR\r
 372 ATOM:   PUSHJ   PP,CELL         ;GET FIRST CELL\r
 373         TLNE    IO,NUMSW        ;IF NON-NUMERIC\r
 374 ATOM1:  CAIE    C,42            ;OR NOT A BINARY SHIFT,\r
 375         POPJ    PP,             ;EXIT\r
 376 \r
 377         PUSH    PP,AC0          ;STACK REGISTERS, ITS A BINARY SHIFT\r
 378         PUSH    PP,AC1\r
 379         PUSH    PP,RC\r
 380         PUSH    PP,RX\r
 381         HRRI    RX,^D10         ;COMPUTE SHIFT RADIX 10\r
 382         PUSHJ   PP,CELLSF       ;GET SHIFT\r
 383         MOVE    ARG,RC          ;SAVE RELOCATION\r
 384         POP     PP,RX           ;RESTORE REGISTERS\r
 385         POP     PP,RC\r
 386         POP     PP,AC1\r
 387         MOVN    SX,AC0          ;USE NEGATIVE OF SHIFT\r
 388         POP     PP,AC0\r
 389         SKIPN   0,5\r
 390         TLNN    IO,NUMSW        ;AND NUMERIC,\r
 391         JRST    NUMER2\r
 392         LSHC    AC0,^D35(SX)\r
 393         LSH     RC,^D35(SX)\r
 394         JRST    ATOM1\r
 395 \fCELLSF:        TLO     IO,FLDSW\r
 396 CELL:   SETZB   AC0,RC          ;CLEAR RESULT AND RELOCATION\r
 397         SETZB   AC1,AC2         ;CLEAR WORK REGISTERS\r
 398         MOVEM   PP,PPTEMP       ;SAVE PUSHDOWN POINTER\r
 399         TLZ     IO,NUMSW\r
 400         TLZA    FR,NEGSW!DCFSW!RADXSW\r
 401 \r
 402 CELL1:  TLO     IO,FLDSW\r
 403         PUSHJ   PP,BYPAS1\r
 404         LDB     V,[POINT 4,CSTAT(C),14] ;GET CODE\r
 405         XCT     .+1(V)          ;EXECUTE, INDEX VIA BITS 11,12,13,14 OF CSTAT TABLE\r
 406         JRST    CELL1           ;0; BLANK, (TAB OR "+")\r
 407         JRST    LETTER          ;1; LETTER ] $ % ( ) , ; >\r
 408         TLC     FR,NEGSW        ;2; "-"\r
 409         TLO     FR,INDSW        ;3; "@"\r
 410         JRST    NUM1            ;4; NUMERIC 0 - 9\r
 411         JRST    ANGLB           ;5; "<"\r
 412         JRST    SQBRK           ;6; "["\r
 413         JRST    QUOTES          ;7; """, "'"\r
 414         JRST    QUAL            ;10; "^"\r
 415         JRST    PERIOD          ;11; "."\r
 416         TROA    ER,ERRQ         ;12; ERROR, FLAG AND TREAT AS DELIMITER\r
 417                                 ;12;     ! # & * / : = ? \ _\r
 418 \fLETTER:        TLOA    AC2,(POINT 6,AC0,)      ;SET BYTE POINTER\r
 419 LETTE1: PUSHJ   PP,GETCHR       ;GET CHARACTER\r
 420         TLNN    CS,6            ;ALPHA-NUMERIC\r
 421         JRST    LETTE3          ;NO,TEST FOR VARIABLE\r
 422         TLNE    AC2,770000      ;STORE ONLY SIX BYTES\r
 423 LETTE2: IDPB    C,AC2           ;RETURN FROM PERIOD\r
 424         JRST    LETTE1\r
 425 \r
 426 LETTE3: CAIE    C,03            ;"#"?\r
 427         POPJ    PP,\r
 428         JUMPE   AC0,POPOUT      ;TEST FOR NULL\r
 429         TLO     IO,DEFCRS\r
 430         PUSHJ   PP,SSRCH        ;YES, SEARCH FOR SYMBOL (OPERAND)\r
 431         MOVSI   ARG,SYMF!UNDF   ;NOT FOUND, FLAGAS UNDEFINED SYM.\r
 432         TLNN    ARG,UNDF        ;UNDEFINED?\r
 433         JRST    GETCHR          ;NO, GET NEXT CHAR AND RETURN\r
 434         TLO     ARG,VARF        ;YES, FLAG AS A VARIABLE\r
 435         TRO     ER,ERRU         ;SET UNDEFINED ERROR FLAG\r
 436         PUSHJ   PP,INSERZ       ;INSERT IT WITH A ZERO VALUE\r
 437         JRST    GETDEL\r
 438 \r
 439 LETTE4: PUSHJ   PP,GETCHR       ;AND SCAN PAST IT\r
 440 \r
 441 NUMER1: SETZB   AC0,RC          ;RETURN ZERO\r
 442 NUMER2: TRO     ER,ERRN         ;FLAG ERROR\r
 443 \r
 444 GETDEL: PUSHJ   PP,BYPAS1\r
 445 GETDE1: JUMPE   C,.-1\r
 446         MOVEI   AC1,0\r
 447 GETDE3: TLO     IO,NUMSW!FLDSW  ;FLAG NUMERIC\r
 448         TLNN    FR,NEGSW        ;IS ATOM NEGATIVE?\r
 449         POPJ    PP,             ;NO, EXIT\r
 450         JUMPE   AC1,GETDE2\r
 451         MOVNS   AC0,1\r
 452         TDCA    AC0,[-1]\r
 453 GETDE2: MOVNS   AC0             ;YES, NEGATE VALUE\r
 454         MOVNS   RC              ;AND RELOCATION\r
 455 POPOUT: POPJ    PP,             ;EXIT\r
 456 \fQUOTE0:        ASH     AC0,7\r
 457         IOR     AC0,C\r
 458 QUOTES: PUSHJ   PP,CHARAC\r
 459         CAIN    C,CR\r
 460         JRST    QUOTE2\r
 461         CAIE    C,42\r
 462         JRST    QUOTE0\r
 463         PUSHJ   PP,CHARAC       ;LOOK AT NEXT CHAR.\r
 464         CAIN    C,42\r
 465         JRST    QUOTE0\r
 466 QUOTE2: TLO     IO,IORPTC\r
 467         JRST    GETDEL\r
 468 \fQUAL:  PUSHJ   PP,BYPAS1       ;SKIP BLANKS, GET NEXT CHARACTER\r
 469         CAIN    C,42            ;"B"?\r
 470         JRST    QUAL2           ;YES, RADIX=D2\r
 471         CAIN    C,57            ;"O"?\r
 472         JRST    QUAL8           ;YES, RADIX=D8\r
 473         CAIN    C,46            ;"F"?\r
 474         JRST    NUMDF           ;YES, PROCESS DECIMAL FRACTION\r
 475         CAIN    C,54            ;"L"?\r
 476         JRST    QUALL           ;YES\r
 477         CAIE    C,44            ;"D"?\r
 478         JRST    NUMER1          ;NO, FLAG NUMERIC ERROR\r
 479         ADDI    AC2,2\r
 480 QUAL8:  ADDI    AC2,6\r
 481 QUAL2:  ADDI    AC2,2\r
 482         PUSH    PP,RX\r
 483         HRR     RX,AC2\r
 484         PUSHJ   PP,CELLSF\r
 485 QUAL2A: POP     PP,RX\r
 486         TLNN    IO,NUMSW\r
 487         JRST    NUMER1\r
 488         JRST    GETDE1\r
 489 \r
 490 QUALL:  PUSH    PP,RX\r
 491         PUSHJ   PP,CELLSF\r
 492         MOVE    AC2,AC0\r
 493         MOVEI   AC0,^D36\r
 494         JUMPE   AC2,QUAL2A\r
 495         LSH     AC2,-1\r
 496         SOJA    AC0,.-2\r
 497 \fSUBTTL NUMBER PROCESSOR\r
 498 \r
 499 ANGLB:  PUSH    PP,FR\r
 500         TLZ     FR,INDSW\r
 501         PUSHJ   PP,ATOM\r
 502         TLNN    IO,NUMSW\r
 503         CAIE    C,35\r
 504         JRST    ANGLB1\r
 505         PUSHJ   PP,ASSIG1\r
 506         MOVE    AC0,V\r
 507         JRST    ANGLB2\r
 508 \r
 509 ANGLB1: PUSHJ   PP,EVALHA\r
 510 ANGLB2: POP     PP,FR\r
 511         CAIE    C,36\r
 512         TRO     ER,ERRN\r
 513         JRST    GETDEL\r
 514 \fSUBTTL LITERAL PROCESSOR\r
 515 \r
 516 SQBRK:  PUSH    PP,FR\r
 517         PUSH    PP,EXTPNT               ;ALLOW EXTERN TO PRECEDE LIT IN XWD\r
 518         SETZM   EXTPNT\r
 519         SKIPE LITLVL    ;SAVE SEQNO AND PAGE IF NOT IN LIT ALREADY\r
 520         JRST SQB5\r
 521         FORERR  (C,LIT)\r
 522 SQB5:   JSP     AC2,SVSTOW\r
 523 SQB3:   PUSHJ   PP,STMNT\r
 524         TLNE FR,MWLFLG          ;CALL IT ] IF NOT MULTI-WORD FLAG\r
 525         CAIN C,75               ;CHECK FOR ]\r
 526         JRST SQB1\r
 527         TLO IO,IORPTC\r
 528         PUSHJ PP,BYPAS1\r
 529         CAIN C,33               ;COMMENT?\r
 530         TLOA IO,IORPTC\r
 531         TRO ER,ERRQ\r
 532 SQB4:   PUSHJ PP,CHARAC\r
 533         CAIGE C,CR              ;LOOK FOR END OF LINE\r
 534         CAIN C,HT\r
 535         JRST SQB4\r
 536         PUSHJ PP,OUTIML         ;DUMP\r
 537         JRST SQB3\r
 538 SQB1:   TLZ IO,IORPTC\r
 539         PUSHJ PP,STOLIT\r
 540         JSP AC2,GTSTOW\r
 541         POP PP,EXTPNT\r
 542         POP PP,FR\r
 543         SKIPE LITLVL            ;WERE WE NESTED?\r
 544         JUMP1 NUMER2            ;YES, FORCE ERROR IF PASS 1\r
 545         JRST GETDEL\r
 546 \r
 547 PERIOD: PUSHJ   PP,GETCHR               ;LOOK AT NEXT CHARACTER\r
 548         TLNN    CS,2            ;ALPHABETIC?\r
 549         JRST    PERNUM          ;NO, TEST NUMERIC\r
 550         MOVSI   AC0,(SIXBIT /./)        ;YES, PUT PERIOD IN AC0\r
 551         MOVSI   AC2,(POINT 6,AC0,5)     ;SET BYTE POINTER\r
 552         JRST    LETTE2          ;AND TREAT AS SYMBOL\r
 553 \r
 554 PERNUM: TLNE    CS,4            ;IS IT A NUMBER\r
 555         JRST    NUM32           ;YES\r
 556         MOVE    AC0,LOCA        ;NO. CURRENT LOC SYMBOL (.)\r
 557         MOVE    RC,MODA         ;SET TO CURRENT ASSEMBLY MODE\r
 558         JRST    GETDE1          ;GET DELIMITER\r
 559 NUMDF:  TLO     FR,DCFSW        ;SET DECIMAL FRACTION FLAG\r
 560 NUM:    PUSHJ   PP,GETCHR       ;GET A CHARACTER\r
 561         TLNN    CS,4            ;NUMERIC?\r
 562         JRST    NUM10           ;NO\r
 563 NUM1:   SUBI    C,20            ;CONVERT TO OCTAL\r
 564         PUSH    PP,C            ;STACK FOR FLOATING POINT\r
 565         MOVE    AC0,AC1\r
 566         MULI    AC0,0(RX)\r
 567         ADD     AC1,C           ;ADD IN LAST VALUE\r
 568         CAIL    C,0(RX)         ;IS NUMBER LESS THAN CURRENT RADIX?\r
 569         TLO     FR,RADXSW       ;NO, SET FLAG\r
 570         AOJA    AC2,NUM         ;YES, AC2=NO. OF DECIMAL PLACES\r
 571 \r
 572 \fNUM10: CAIE    C,16            ;PERIOD?\r
 573         TLNE    FR,DCFSW        ;OR DECIMAL FRACTION?\r
 574         JRST    NUM31           ;YES, PROCESS FLOATING POINT\r
 575         LSH     AC1,1           ;NO, CLEAR THE SIGN BIT\r
 576         LSHC    AC0,^D35        ;AND SHIFT INTO AC0\r
 577         MOVE    PP,PPTEMP       ;RESTORE PP\r
 578         SOJE    AC2,GETDE1      ;NO RADIX ERROR TEST IF ONE DIGIT\r
 579         TLNE    FR,RADXSW       ;WAS ILLEGAL NUMBER ENCOUNTERED?\r
 580         TRO     ER,ERRN         ;YES, FLAG N ERROR\r
 581         JRST    GETDE1\r
 582 \r
 583 NUM31:  PUSHJ   PP,GETCHR\r
 584         TLNN    CS,4            ;NUMERIC?\r
 585         JRST    NUM40           ;NO\r
 586 NUM32:  SUBI    C,20\r
 587         PUSH    PP,C\r
 588         JRST    NUM31\r
 589 \r
 590 NUM40:  PUSH    PP,FR           ;STACK VALUES\r
 591         HRRI    RX,^D10\r
 592         PUSH    PP,AC2\r
 593         PUSH    PP,PPTEMP\r
 594         CAIE    C,45            ;"E"?\r
 595         TDZA    AC0,AC0\r
 596         PUSHJ   PP,CELL\r
 597         POP     PP,PPTEMP\r
 598         POP     PP,SX\r
 599         POP     PP,FR\r
 600         HRRZ    V,PP\r
 601         MOVE    PP,PPTEMP\r
 602         JUMPN   RC,NUMER1       ;EXPONENT MUST BE ABSOLUTE\r
 603         ADD     SX,AC0\r
 604         HRRZ    ARG,PP\r
 605         ADD     SX,ARG\r
 606         SETZB   AC0,AC2\r
 607         TLNE    FR,DCFSW\r
 608         JRST    NUM60\r
 609         JOV     NUM50           ;CLEAR OVERFLOW FLAG\r
 610 \f\r
 611 NUM50:  JSP     SDEL,NUMUP      ;FLOATING POINT\r
 612         JRST    NUM52           ;END OF WHOLE NUMBERS\r
 613         FMPR    AC0,[10.0]      ;MULTIPLY BY 10\r
 614         TLO     AC1,233000      ;CONVERT TO FLOATING POINT\r
 615         FADR    AC0,AC1         ;ADD IT IN\r
 616         JRST    NUM50\r
 617 \r
 618 NUM52:  JSP     SDEL,NUMDN      ;PROCESS FRACTION\r
 619         FADR    AC0,AC2\r
 620         JOV     NUMER1          ;TEST FOR OVERFLOW\r
 621         JRST    GETDE1\r
 622         TLO     AC1,233000\r
 623         TRNE    AC1,-1\r
 624         FADR    AC2,AC1         ;ACCUMULATE FRACTION\r
 625         FDVR    AC2,[10.0]\r
 626         JRST    NUM52\r
 627 \r
 628 NUM60:  JSP     SDEL,NUMUP\r
 629         JRST    NUM62\r
 630         IMULI   AC0,^D10\r
 631         ADD     AC0,AC1\r
 632         JRST    NUM60\r
 633 \r
 634 NUM62:  LSHC    AC1,-^D36\r
 635         JSP     SDEL,NUMDN\r
 636         LSHC    AC1,^D37\r
 637         PUSHJ   PP,BYPAS2\r
 638         JRST    GETDE3\r
 639         DIVI    AC1,^D10\r
 640         JRST    NUM62\r
 641 \r
 642 NUMUP:  MOVEI   AC1,0\r
 643         CAML    ARG,SX\r
 644         JRST    0(SDEL)\r
 645         CAMGE   ARG,V\r
 646         MOVE    AC1,1(ARG)\r
 647         AOJA    ARG,1(SDEL)\r
 648 \r
 649 NUMDN:  MOVEI   AC1,0\r
 650         CAMG    V,SX\r
 651         JRST    0(SDEL)\r
 652         CAMLE   V,ARG\r
 653         MOVE    AC1,0(V)\r
 654         SOJA    V,3(SDEL)\r
 655 \fSUBTTL GETSYM\r
 656 GETSYM: MOVEI   AC0,0           ;CLEAR AC0\r
 657         MOVSI   AC1,(POINT 6,AC0)       ;PUT POINTER IN AC1\r
 658         PUSHJ   PP,BYPAS1       ;SKIP LEADING BLANKS\r
 659         TLNN    CS,2            ;ALPHABETIC?\r
 660         JRST    GETSY1          ;NO, ERROR\r
 661         CAIE    C,16            ;PERIOD?\r
 662         JRST    GETSY2          ;NO, A VALID SYMBOL\r
 663         IDPB    C,AC1           ;STORE THE CHARACTER\r
 664         PUSHJ   PP,GETCHR       ;YES, TEST NEXT CHARACTER\r
 665         TLNN    CS,2            ;ALPHABETIC?\r
 666 GETSY1: TROA    ER,ERRA\r
 667 GETSY2: AOS     0(PP)           ;YES, SET SKIP EXIT\r
 668 GETSY3: TLNN    CS,6            ;ALPHA-NUMERIC?\r
 669         JRST    BYPAS2          ;NO, GET DELIMITER\r
 670         TLNE    AC1,770000      ;YES, HAVE WE STORED SIX?\r
 671         IDPB    C,AC1           ;NO, STORE IT\r
 672         PUSHJ   PP,GETCHR\r
 673         JRST    GETSY3\r
 674 BYPAS1: PUSHJ   PP,GETCHR\r
 675 BYPAS2: JUMPE   C,.-1\r
 676         POPJ    PP,\r
 677 \fSUBTTL EXPRESSION EVALUATOR\r
 678 CV==    AC0                     ;CURRENT VALUE\r
 679 PV==    AC1                     ;PREVIOUS VALUE\r
 680 RC==    RC                      ;CURRENT RELOCATABILITY\r
 681 PR==    AC2                     ;PREVIOUS RELOCATABILITY\r
 682 CS=     CS                      ;CURRENT STATUS\r
 683 PS==    SDEL                    ;PREVIOUS STATUS\r
 684 \r
 685 EVALHA: TLO     FR,TMPSW\r
 686 EVALEX: TLO     IO,FLDSW                \r
 687         PUSH    PP,[XWD TNODE,0]        ;MARK THE LIST 200000,,0\r
 688         TLZN    FR,TMPSW\r
 689 EVATOM: PUSHJ   PP,ATOM         ;GET THE NEXT ATOM\r
 690         JUMPE   AC0,EVGETD      ;TEST FOR NULL/ZERO\r
 691         TLOE    IO,NUMSW        ;SET NUMERIC, WAS IT PREVIOUSLY?\r
 692         JRST    EVGETD          ;YES, TREAT ACCORDINGLY\r
 693         PUSHJ   PP,SEARCH       ;SEARCH FOR MACRO OR SYMBOL\r
 694         JRST    EVOP            ;NOT FOUND, TRY FOR OP-CODE\r
 695         SKIPL   ARG             ;SKIP IF OPERAND\r
 696         PUSHJ   PP,SSRCH1       ;OPERATOR, TRY FOR SYMBOL (OPERAND)\r
 697         PUSHJ   PP,QSRCH        ;PERFORM CROSS-REFERENCE\r
 698         JUMPG   ARG,EVMAC       ;BRANCH IF OPERATOR\r
 699         MOVE    AC0,V           ;SYMBOL, SET VALUE\r
 700         JRST    EVTSTS          ;TEST STATUS\r
 701 \r
 702 EVMAC:  TLNE    FR,NEGSW        ;UNARY MINUS?\r
 703         JRST    EVERRZ          ;YES, INVALID BEFORE OPERATOR\r
 704         LDB     SDEL,[POINT 3,ARG,5]    ;GET MACF/OPDF/SYNF\r
 705         SOJL    SDEL,EVERRZ     ;ERROR IF NO FLAGS\r
 706 \r
 707         SKIPE   C               ;NON-BLANK?\r
 708         TLO     IO,IORPTC       ;YES, REPEAT CHARACTER\r
 709         SOJE    SDEL,CALLM      ;MACRO IF 2\r
 710         JUMPG   SDEL,EVOPS      ;SYNONYM IF 4\r
 711 \r
 712         MOVE    AC0,V           ;OPDEF\r
 713         MOVEI   V,OPD           ;SET TRANSFER VECTOR\r
 714         JRST    EVOPD\r
 715 \fEVOP:  TLNE    FR,NEGSW        ;OPCODE, UNARY MINUS?\r
 716         JRST    EVERRZ          ;YES, ERROR\r
 717 \r
 718         PUSHJ   PP,OPTSCH       ;SEARCH SYMBOL TABLE\r
 719         JRST    EVOPX           ;NOT FOUND\r
 720 EVOPS:  TRZE    V,LITF          ;CLEAR LIT INVALID FLAG\r
 721         JRST    EVOPX           ;PSEUDO-OP THAT GENERATES NO DATA JUMPS\r
 722         HLLZ    AC0,V\r
 723 EVOPD:  SKIPE   C               ;OPDEF, NON-BLANK DELIMITER?\r
 724         TLO     IO,IORPTC       ;YES, REPEAT CHARACTER\r
 725         JSP     AC2,SVSTOW\r
 726         PUSHJ   PP,0(V)\r
 727         PUSHJ   PP,DSTOW\r
 728         JSP     AC2,GTSTOW\r
 729         TRNE    RC,-2\r
 730         HRRM    RC,EXTPNT\r
 731         TLNE RC,-2\r
 732         HLLM RC,EXTPNT\r
 733         JRST    EVNUM\r
 734 \r
 735 EVOPX:  MOVSI   ARG,SYMF!UNDF\r
 736         PUSHJ   PP,INSERZ\r
 737 EVERRZ: SETZB   AC0,RC          ;CLEAR CODE AND RELOCATION\r
 738 EVERRU: TRO     ER,ERRU\r
 739         JRST    EVGETD\r
 740 \fEVTSTS:        TLNE    ARG,UNDF\r
 741         JRST    EVERRU\r
 742         TLNN    ARG,EXTF\r
 743         JRST    EVTSTR\r
 744         HRRZ    RC,ARG          ;GET ADRES WFW\r
 745         HRRZ    ARG,EXTPNT      ;SAVE IT WDW\r
 746         HRRM    RC,EXTPNT       ;WFW\r
 747         TRNE    ARG,-1          ;WFW\r
 748         TRO     ER,ERRE\r
 749         SETZB   AC0,ARG\r
 750 \r
 751 EVTSTR: TLNE    ARG,MDFF        ;MULTIPLY DEFINED?\r
 752         TRO     ER,ERRD         ;YES, FLAG IT\r
 753         TLNE    FR,NEGSW        ;NEGATIVE ATOM?\r
 754         PUSHJ   PP,GETDE2       ;YES, NEGATIVE AC0 AND RC\r
 755 \r
 756 EVGETD: PUSHJ   PP,BYPAS2               \r
 757         TLNE    CS,6            ;NON BLANK FIELD\r
 758         TLO     IO,IORPTC       ;YES,SET FLAG\r
 759 EVNUM:  POP     PP,SDEL         ;POP THE PREVIOUS DELIMITER/TNODE\r
 760         TLO     PS,4000\r
 761         CAMGE   PS,CS           ;OPERATION REQUIRED?\r
 762         JRST    EVPUSH          ;NO, PUT VALUES BACK ON STACK\r
 763         TLNN    PS,TNODE        ;YES, HAVE WE REACHED TERMINAL NODE?\r
 764         JRST    EVXCT           ;NO, EXECUTION REQUIRED\r
 765         TLNN    CS,170000       ;YES, ARE WE POINTING AT DEL (& ! * / + - _)\r
 766         POPJ    PP,             ;YES, EXIT\r
 767                                 ;NO, FALL INTO EVPUSH\r
 768 \fEVPUSH:        PUSH    PP,PS           ;STACK VALUES\r
 769         PUSH    PP,CV\r
 770         PUSH    PP,RC\r
 771         PUSH    PP,CS\r
 772         JRST    EVATOM          ;GET NEXT ATOM\r
 773 \r
 774 EVXCT:  POP     PP,AC2          ;POP PREVIOUS RELOCATABILITY\r
 775         POP     PP,AC1          ;AND PREVIOUS VALUE\r
 776         LDB     PS,[POINT 3,PS,29]      ;TYPE OF OPERATION TO PS\r
 777         JRST    .(PS)           ;PREFORM PROPER OPERATION\r
 778         JRST    XMUL            ;1;\r
 779         JRST    XDIV            ;2;\r
 780         JRST    XADD            ;3;\r
 781         JRST    XSUB            ;4;\r
 782         JRST    XLRW            ;5; "_"\r
 783         TDOA    CV,PV           ;6; MERGE PV INTO CV\r
 784         AND     CV,PV           ;7; AND PV INTO CV\r
 785         SKIPN   RC              ;COMMON RELOCATION TEST\r
 786         SKIPE   AC2\r
 787         TRO     ER,ERRR         ;BOTH MUST BE FIXED\r
 788         JRST    EVNUM           ;GO TRY AGAIN\r
 789 \r
 790 XSUB:   SUBM    PV,CV\r
 791         SUBM    PR,RC\r
 792         JRST    EVNUM\r
 793 \r
 794 XADD:   ADDM    PV,CV\r
 795         ADDM    PR,RC\r
 796         JRST    EVNUM\r
 797 \r
 798 XDIV:   IDIV    PR,CV           ;CORRECT RELOCATABILITY\r
 799         IDIVM   PV,CV\r
 800 XDIV1:  EXCH    PR,RC           ;TAKE RELOCATION OF NUMERATOR\r
 801         SKIPE   PR\r
 802         TRO     ER,ERRR\r
 803         JRST    EVNUM\r
 804 \r
 805 XMUL:   JUMPE   PR,XMUL1        ;AT LEAST ONE OPERAND\r
 806         JUMPE   RC,XMUL1        ;MUST BE FIXED\r
 807         TRO     ER,ERRR\r
 808 XMUL1:  IORM    PR,RC           ;GET RELOCATION TO RC\r
 809         IMULM   PV,RC\r
 810         IMULM   PV,CV\r
 811         JRST    EVNUM\r
 812 XLRW:   EXCH    PV,CV\r
 813         LSH     CV,0(PV)\r
 814         LSH     PR,0(PV)\r
 815         JRST    XDIV1\r
 816 \f       SUBTTL  LITERAL STORAGE HANDLER\r
 817 \r
 818 STOLER: SETZB   AC0,RC          ;ERROR, NO CODE STORED\r
 819         PUSHJ   PP,STOW         ;STOW ZERO\r
 820         TRO     ER,ERRL         ;AND FLAG THE ERROR\r
 821 \r
 822 STOLIT: MOVE    SDEL,STPX\r
 823         SUB     SDEL,STPY       ;COMPUTE NUMBER OF WORDS\r
 824         JUMPE   SDEL,STOLER     ;ERROR IF NONE STORED\r
 825         TRNN    ER,ERRORS       ;ANY ERRORS?\r
 826         JRST    STOL06          ;NO\r
 827         JUMP2   STOL22          ;YES, NO SEARCH.  BRANCH IF PASS2\r
 828         ADDM    SDEL,LITCNT\r
 829         JRST    STOWI\r
 830 \r
 831 STOL06: MOVEI   SX,LITAB\r
 832         MOVE    ARG,STPX\r
 833         HRL     ARG,STPY\r
 834         MOVE    AC2,LITNUM\r
 835         MOVEI   SDEL,0\r
 836 STOL08: PUSHJ   PP,DSTOW        ;GET VALUE WFW\r
 837 STOL10: SOJL    AC2,STOL24      ;TEST FOR END\r
 838         MOVE    SX,0(SX)        ;NO, GET NEXT STORAGE CELL\r
 839         MOVE    V,-1(SX)        ;GET RELOCATION BITS WFW\r
 840         CAMN    AC0,-2(SX)      ;DO CODES COMPARE? WFW\r
 841         CAME    RC,V            ;YES, HOW ABOUT RELOCATION?\r
 842         AOJA    SDEL,STOL10     ;NO, TRY AGAIN\r
 843         SKIPGE  STPX            ;YES, MULTI-WORD?\r
 844         JRST    STOL26          ;NO, JUST RETURN LOCATION\r
 845         MOVEM   AC2,SAVBLK+AC2  ;YES, SAVE STARTING INFO\r
 846         MOVEM   SX,SAVBLK+SX\r
 847 \r
 848 STOL12: SOJL    AC2,STOL23      ;TEST FOR END\r
 849         PUSHJ   PP,DSTOW        ;GET NEXT WORD WFW\r
 850         MOVE    SX,0(SX)        ;UPDATE POINTER\r
 851         MOVE    V,-1(SX)                ;GET RELOCATION WFW\r
 852         CAMN    AC0,-2(SX)      ;COMPARE VALUE WFW\r
 853         CAME    RC,V            ;AND RELOCATION\r
 854         JRST    STOL14          ;NO MATCH, TRY AGAIN            \r
 855         SKIPL   STPX            ;MATCH, HAVE WE FINISHED SEARCH?\r
 856         JRST    STOL12          ;NO, TRY NEXT WORD\r
 857         JRST    STOL26          ;YES, RETURN LOCATION\r
 858 \r
 859 STOL14: MOVE    AC2,SAVBLK+AC2  ;RESTORE STOW POINTERS\r
 860         MOVE    SX,SAVBLK+SX\r
 861         HRREM   ARG,STPX\r
 862         HLREM   ARG,STPY\r
 863         AOJA    SDEL,STOL08     ;BETTER LUCK NEXT TIME\r
 864 \f\r
 865 STOL22: MOVE    SDEL,LITNUM\r
 866 STOL23: PUSHJ   PP,DSTOW        ;DSTOW AND CONVERT\r
 867 STOL24: MOVE    SX,LITABX       ;GET CURRENT STORAGE\r
 868         PUSHJ   PP,GETTOP       ;GET NEXT CELL\r
 869         MOVEM   AC0,-2(SX)      ;STORE CODE WFW\r
 870         MOVEM   RC,-1(SX)       ;WFW\r
 871         MOVEM   SX,LITABX       ;SET POINTER TO CURRENT CELL\r
 872         AOS     LITNUM          ;INCREMENT NUMBER STORED\r
 873         AOS     LITCNT          ;INCREMENT NUMBER RESERVED\r
 874         SKIPL   STPX            ;ANY MODE CODE?\r
 875         JRST    STOL23          ;YES\r
 876 STOL26: JUMP1   POPOUT          ;EXIT IF PASS ONE\r
 877         MOVE    SX,LITHDX       ;GET HEADER BLOCK\r
 878         HLRZ    RC,-1(SX)       ;GET BLOCK RELOCATION\r
 879         HRRZ    AC0,-1(SX)\r
 880         ADDI    AC0,0(SDEL)     ;COMPUTE ACTUAL LOCATION\r
 881         POPJ    PP,             ;EXIT\r
 882 \fSUBTTL INPUT   ROUTINES\r
 883 GETCHR: PUSHJ   PP,CHARAC       ;GET ASCII CHARACTER\r
 884         CAIG    C,172           ;CHECK FOR LOWER CASE\r
 885         CAIGE   C,141\r
 886         SKIPA                   ;NOT LOWER CASE\r
 887         SUBI    C,40            ;CONVERT LOWER CASE TO SIXBIT\r
 888         SUBI    C,40            ;CONVERT TO SIX BIT\r
 889         CAIN    C,7\r
 890         JRST    GETCHR\r
 891         CAILE   C,77\r
 892         JRST    GETCS1\r
 893         JUMPGE  C,GETCS\r
 894         ADDI    C,27\r
 895         JUMPE   C,GETCS\r
 896         TLOA    IO,IORPTC       ;REPEAT CHARACTER\r
 897 \r
 898 GETCS1: TDO     IO,[XWD IORPTC,ERRQ]\r
 899         MOVEI   C,33\r
 900 GETCS:  MOVE    CS,CSTAT(C)     ;GET STATUS BITS\r
 901         POPJ    PP,             ;EXIT\r
 902 \f\r
 903 CHARAC: TLZE    IO,IORPTC       ;REPEAT REQUESTED?\r
 904         JRST    CHARAX          ;YES\r
 905 RSW0:   JUMPN   MRP,MREAD       ;BRANCH IF TREE POINTER SET\r
 906         PUSHJ   PP,READ\r
 907 RSW1:   SKIPE   RPOLVL          ;ARE WE IN "REPEAT ONCE"?\r
 908         JRST    REPO1           ;YES\r
 909 RSW2:   SOSG    CPL             ;ANY ROOM IN THE IMAGE BUFFER?\r
 910         PUSHJ   PP,OUTPL        ;NO, OUTPUT THE PARTIAL LINE\r
 911         IDPB    C,LBUFP         ;YES, STORE IN PRINT AREA\r
 912         CAIE    C,HT            ;TAB?\r
 913         POPJ    PP,             ;NO, EXIT\r
 914         MOVEI   CS,7\r
 915         ANDCAM  CS,CPL          ;MASK\r
 916         POPJ    PP,             ;EXIT\r
 917 \r
 918 CHARAX: LDB     C,LBUFP         ;GET LAST CHARACTER\r
 919         POPJ    PP,             ;EXIT\r
 920 CHARL:  PUSHJ   PP,CHARAC       ;GET AND TEST 7-BIT ASCII\r
 921         CAIE    C,LF            ;LINE OR FORM FEED OR VT?\r
 922         CAIN    C,FF\r
 923         SKIPA   CS,LITLVL       ;IN LITERAL?\r
 924         POPJ    PP,             ;EXIT\r
 925         JUMPN   CS,OUTIML       ;YES\r
 926 CHARL1: PUSHJ   PP,SAVEXS       ;SAVE REGISTERS\r
 927         PUSHJ   PP,OUTLIN       ;DUMP THE LINE\r
 928         JRST    RSTRXS          ;RESTORE REGISTERS AND EXIT\r
 929 \fSUBTTL CHARACTER STATUS TABLE\r
 930 \r
 931         DEFINE  GENCS   (OPLVL,ATOM,AN,SQUOZ,OPTYPE,SEQNO)\r
 932 <BYTE (6)OPLVL (9)ATOM (3)AN (6)SQUOZ,OPTYPE,SEQNO>\r
 933 \r
 934         ;OPLVL  PRIORITY OF BINARY OPERATORS\r
 935         ;ATOM   INDEX TO JUMP TABLE AT CELL1\r
 936         ;AN     TYPE OF CHARACTER\r
 937         ;       1=OTHER, 2=ALPHA, 4=NUMERIC\r
 938         ;SQUOZ  VALUE IN RADIX 50\r
 939         ;OPTYPE INDEX TO JUMP TABLE AT EVXCT\r
 940         ;SEQNO  VALUE IN SIXBIT\r
 941 CSTAT:\r
 942         GENCS   00,00,1,00,00,00        ; ' '\r
 943         GENCS   04,12,1,00,06,01        ; '!'\r
 944         GENCS   00,07,1,00,00,02        ; '"'\r
 945         GENCS   00,12,1,00,00,03        ; '#'\r
 946         GENCS   00,01,2,46,00,04        ; '$'\r
 947         GENCS   00,01,2,47,00,05        ; '%'\r
 948         GENCS   04,12,1,00,07,06        ; '&'\r
 949         GENCS   00,00,1,00,00,07        ; '''\r
 950 \r
 951         GENCS   00,01,1,00,00,10        ; '('\r
 952         GENCS   00,01,1,00,00,11        ; ')'\r
 953         GENCS   02,12,1,00,01,12        ; '*'\r
 954         GENCS   01,00,1,00,03,13        ; '+'\r
 955         GENCS   40,01,1,00,00,14        ; ','\r
 956         GENCS   01,02,1,00,04,15        ; '-'\r
 957         GENCS   00,11,2,45,00,16        ; '.'\r
 958         GENCS   02,12,1,00,02,17        ; '/'\r
 959 \r
 960         GENCS   00,04,4,01,00,20        ; '0'\r
 961         GENCS   00,04,4,02,00,21        ; '1'\r
 962         GENCS   00,04,4,03,00,22        ; '2'\r
 963         GENCS   00,04,4,04,00,23        ; '3'\r
 964         GENCS   00,04,4,05,00,24        ; '4'\r
 965         GENCS   00,04,4,06,00,25        ; '5'\r
 966         GENCS   00,04,4,07,00,26        ; '6'\r
 967         GENCS   00,04,4,10,00,27        ; '7'\r
 968 \r
 969         GENCS   00,04,4,11,00,30        ; '8'\r
 970         GENCS   00,04,4,12,00,31        ; '9'\r
 971         GENCS   00,12,1,00,00,32        ; ':'\r
 972         GENCS   00,01,1,00,00,33        ; ';'\r
 973         GENCS   00,05,1,00,00,34        ; '<'\r
 974         GENCS   00,12,1,00,00,35        ; '='\r
 975         GENCS   00,01,1,00,00,36        ; '>'\r
 976         GENCS   00,12,1,00,00,37        ; '?'\r
 977 \f       GENCS   00,03,1,00,00,40        ; '@'\r
 978         GENCS   00,01,2,13,00,41        ; 'A'\r
 979         GENCS   00,01,2,14,00,42        ; 'B'\r
 980         GENCS   00,01,2,15,00,43        ; 'C'\r
 981         GENCS   00,01,2,16,00,44        ; 'D'\r
 982         GENCS   00,01,2,17,00,45        ; 'E'\r
 983         GENCS   00,01,2,20,00,46        ; 'F'\r
 984         GENCS   00,01,2,21,00,47        ; 'G'\r
 985 \r
 986         GENCS   00,01,2,22,00,50        ; 'H'\r
 987         GENCS   00,01,2,23,00,51        ; 'I'\r
 988         GENCS   00,01,2,24,00,52        ; 'J'\r
 989         GENCS   00,01,2,25,00,53        ; 'K'\r
 990         GENCS   00,01,2,26,00,54        ; 'L'\r
 991         GENCS   00,01,2,27,00,55        ; 'M'\r
 992         GENCS   00,01,2,30,00,56        ; 'N'\r
 993         GENCS   00,01,2,31,00,57        ; 'O'\r
 994 \r
 995         GENCS   00,01,2,32,00,60        ; 'P'\r
 996         GENCS   00,01,2,33,00,61        ; 'Q'\r
 997         GENCS   00,01,2,34,00,62        ; 'R'\r
 998         GENCS   00,01,2,35,00,63        ; 'S'\r
 999         GENCS   00,01,2,36,00,64        ; 'T'\r
1000         GENCS   00,01,2,37,00,65        ; 'U'\r
1001         GENCS   00,01,2,40,00,66        ; 'V'\r
1002         GENCS   00,01,2,41,00,67        ; 'W'\r
1003 \r
1004         GENCS   00,01,2,42,00,70        ; 'X'\r
1005         GENCS   00,01,2,43,00,71        ; 'Y'\r
1006         GENCS   00,01,2,44,00,72        ; 'Z'\r
1007         GENCS   00,06,1,00,00,73        ; '['\r
1008         GENCS   00,12,1,00,00,74        ; '\'\r
1009         GENCS   00,01,1,00,00,75        ; ']'\r
1010         GENCS   00,10,1,00,00,76        ; '^'\r
1011         GENCS   10,12,1,00,05,77        ; '_'\r
1012 \fSUBTTL LISTING ROUTINES\r
1013 OUTLIN: TRNN    ER,ERRORS-ERRQ  ;ANY ERRORS?\r
1014         TLNE    FR,ERRQSW       ;NO, IGNORE Q ERRORS?\r
1015         TRZ     ER,ERRQ         ;YES, YES, ZERO THE Q ERROR\r
1016         HRLZ    AC0,ER          ;PUT ERROR FLAGS IN AC0 LEFT\r
1017         TDZ     ER,TYPERR\r
1018         IDPB    AC0,LBUFP\r
1019         JUMP1   OUTL30          ;BRANCH IF PASS ONE\r
1020         JUMPN   AC0,OUTL02      ;JUMP IF ANY ERRORS TO FORCE PRINTING\r
1021         SKIPL   STPX            ;SKIP IF NO CODE, OTHERWISE\r
1022         TLZ     IO,IOMAC        ;FORCE MACRO PRINTING\r
1023         TLNN    IO,IOMSTR!IOPROG!IOMAC\r
1024 OUTL02: IOR     IO,OUTSW        ;FORCE IT.\r
1025         TLNN    FR,CREFSW       ;CREF?\r
1026         PUSHJ   PP,CLSCRF       ;YES, WRITE END OF CREF DATA (177,003)\r
1027         JUMPE   AC0,OUTL20      ;BRANCH IF NO ERRORS\r
1028         TLZE    AC0,ERRM        ;M ERROR?\r
1029         TLO     AC0,ERRP        ;M ERROR SET - SET P ERROR.\r
1030         PUSHJ   PP,OUTLER       ;PROCESS ERRORS\r
1031 \r
1032 OUTL20: SKIPN   RC,ASGBLK       \r
1033         SKIPE   CS,LOCBLK       ;\r
1034         SKIPL   STPX            ;ANY BINARY?\r
1035         JRST    OUTL23          ;YES, JUMP\r
1036         JUMPE   RC,OUTL22       ;SEQUENCE BREAK AND NO BINARY JUMPS\r
1037         ILDB    C,TABP          ;ASSIGNMENT FALL THROUGH\r
1038         PUSHJ   PP,OUTL         \r
1039         ILDB    C,TABP          ;OUTPUT 2ND TAB, LOCATION FIELD\r
1040         PUSHJ   PP,OUTC         ;NEXT IS BINARY LISTING FIELD\r
1041         HLLO    CS,LOCBLK       ;LEFT HALF OF A 36BIT VALUE\r
1042         TLNE    CS,-1           ;SKIP IF ITS A 18BIT VALUE, OTHERWISE\r
1043         PUSHJ   PP,ONC1         ;PRINT LH OF A 36 BIT VALUE IN CS\r
1044         HRLO    CS,LOCBLK       ;PICK UP THE RIGHT HALF (18BIT VALUE)\r
1045         TRZ     CS,0(RC)        ;\r
1046 \fOUTL22:        PUSHJ   PP,ONC          ;PRINT IT\r
1047 OUTL23: SKIPL   STPX            ;ANY BINARY?\r
1048         PUSHJ   PP,BOUT         ;YES, DUMP IT\r
1049         MOVE    CS,@OUTLI2      ;[POINT 7,LBUF]\r
1050 OUTL24: ILDB    C,CS\r
1051         JUMPE   C,OUTL25\r
1052         CAIG    C," "\r
1053         JRST    OUTL24\r
1054         MOVE    CS,TABP\r
1055         PUSHJ   PP,OUTASC       ;OUTPUT TABS\r
1056 OUTL25: MOVEI   CS,LBUF\r
1057         PUSHJ   PP,OUTAS0       ;DUMP THE LINE\r
1058 OUTL26: SKIPGE  STPX            ;ANY BINARY?\r
1059         JRST    OUTLI           ;NO, CLEAN UP AND EXIT\r
1060         PUSHJ   PP,OUTLI2       ;YES, INITIALIZE FOR NEXT LINE\r
1061         PUSHJ   PP,BOUT         ;YES, DUMP IT\r
1062         PUSHJ   PP,OUTCR        ;OUTPUT CARRIAGE RETURN\r
1063         JRST    OUTL26          ;TEST FOR MORE BINARY\r
1064 \r
1065 \fOUTL30:        AOS     CS,STPX         ;PASS ONE\r
1066         ADDM    CS,LOCO         ;INCREMENT OUTPUT LOCATION\r
1067         PUSHJ   PP,STOWI        ;INITIALIZE STOW\r
1068         TLZ     AC0,ERRORS-ERRM-ERRP-ERRV-400000\r
1069         JUMPE   AC0,OUTLI3      ;JUMP IF ERRORS\r
1070         IOR     ER,OUTSW        ;LIST ERRORS\r
1071         MOVEI   CS,TAG\r
1072         PUSHJ   PP,OUTSIX       ;OUTPUT TAG\r
1073         HRRZ    C,TAGINC\r
1074         PUSHJ   PP,DNC          ;CONVERT INCREMENT TO DECIMAL\r
1075         PUSHJ   PP,OUTTAB       ;OUTPUT TAB\r
1076         PUSHJ   PP,OUTLER       ;OUTPUT ERROR FLAGS\r
1077         PUSHJ   PP,OUTTAB\r
1078         JRST    OUTL25          ;OUTPUT BASIC LINE\r
1079 \r
1080 OUTLER: ASH AC0,-4\r
1081         MOVE CS,[POINT 6,[SIXBIT /PRINTQXADLRUVNOPEM/]]\r
1082 OUTLE2: ILDB    C,CS            ;GET ERROR MNEMONIC\r
1083         JUMPGE  AC0,OUTLE4      ;BRANCH IF NOT FLAGGED\r
1084         ADDI    C,40\r
1085         PUSHJ   PP,OUTL\r
1086         AOS     ERRCNT          ;INCREMENT ERROR COUNT\r
1087 OUTLE4: LSH     AC0,1           ;SHIFT NEXT FLAG INTO SIGN BIT\r
1088         JUMPN   AC0,OUTLE2      ;TEST FOR END\r
1089         POPJ    PP,             ;EXIT\r
1090 OUTPL:  IBP     LBUFP\r
1091 OUTIM1: JUMP1   OUTLI3\r
1092         PUSH    PP,IO\r
1093         TDZ     IO,TYPERR\r
1094         TLNN    IO,250000\r
1095         IOR     IO,OUTSW\r
1096         PUSH    PP,C\r
1097         TLNN    FR,2000\r
1098         PUSHJ   PP,CLSCRF\r
1099 OUTIM2: MOVE    CS,TABP\r
1100         PUSHJ   PP,OUTASC       ;OUTPUT TABS\r
1101         DPB     C,LBUFP\r
1102         MOVEI   CS,LBUF\r
1103         PUSHJ   PP,SOUT20\r
1104         POP     PP,C\r
1105         HLLM    IO,0(PP)\r
1106         POP     PP,IO\r
1107         JRST    OUTLI2\r
1108 OUTLI:  TLNE    IO,IOPALL       ;SUPRESSING ALL\r
1109         SKIPN   MACLVL\r
1110         TLZA    IO,IOMAC        ;NO, CLEAR MAC FLAG\r
1111         TLO     IO,IOMAC        ;YES, SET FLAG\r
1112 OUTLI3: TRZ     IO,ERRORS!LPTSW!TTYSW\r
1113 OUTLI2: MOVE    CS,[POINT 7,LBUF]       ;INITIALIZE BUFFERS\r
1114         MOVEM   CS,LBUFP\r
1115         MOVEI   CS,130\r
1116         MOVEM   CS,CPL\r
1117         MOVE    CS,[POINT 7,TABI,6]\r
1118         MOVEM   CS,TABP\r
1119         MOVSI   CS,(ASCII /     /)\r
1120         SKIPE   SEQNO           ;HAVE WE SEQUENCE NUMBERS?\r
1121         MOVEM   CS,SEQNO        ;YES, STORE TAB IN CASE OF MACRO\r
1122         MOVEM   CS,SEQNO+1      ;STORE TAB AND TERRMINATOR\r
1123         SETZM   ASGBLK\r
1124         SETZM   LOCBLK\r
1125         POPJ    PP,\r
1126 \fOUTIML:        TRNN    ER,ERRORS-ERRQ  ;FOR LITERALS (MULIT-LINE) OUTPUT ERRORS\r
1127         TLNE FR,ERRQSW\r
1128         TRZ ER,ERRQ\r
1129         HRLZ CS,ER\r
1130         JUMP1 OUTML1            ;CHECK PASS1 ERRORS\r
1131         TDZ ER,TYPERR\r
1132         JUMPE CS,OUTIM1\r
1133         PUSH PP,[0]             ;ERRORS SHOULD BE ZEROED\r
1134         PUSH PP,C\r
1135         PUSH    PP,AC0          ;SAVE ACO IN CASE CALLED FROM ASCII\r
1136         MOVE    AC0,CS          ;ERROR ROUTINE WANTS FLAGS IN AC0\r
1137         IOR ER,OUTSW\r
1138         TLNN FR,CREFSW\r
1139         PUSHJ PP,CLSCRF         ;FIX CREF\r
1140         TLZE AC0,ERRM\r
1141         TLO AC0,ERRP\r
1142         PUSHJ PP,OUTLER         ;OUTPUT THEM\r
1143         POP     PP,AC0\r
1144         JRST OUTIM2\r
1145 OUTML1: TLZ CS,ERRORS-ERRM-ERRP-ERRV-400000\r
1146         JUMPE CS,OUTLI2\r
1147         TRZ ER,ERRM!ERRP!ERRV!400000\r
1148         TRO ER,ERRL\r
1149         PUSH PP,ER      ;SAVE\r
1150         PUSH PP,C       ;SAVE THIS\r
1151         PUSH    PP,AC0  ;AS ABOVE\r
1152         MOVE    AC0,CS          ;...\r
1153         TDZ ER,TYPERR\r
1154         IOR ER,OUTSW\r
1155         MOVEI CS,TAG\r
1156         PUSHJ PP,OUTSIX\r
1157         HRRZ C,TAGINC\r
1158         PUSHJ PP,DNC\r
1159         PUSHJ PP,OUTTAB\r
1160         PUSHJ PP,OUTLER ;DO NOT FORGET ERRORS\r
1161         PUSHJ PP,OUTTAB\r
1162         MOVEI CS,LBUF   ;PRINT REST OF LINE\r
1163         PUSHJ PP,SOUT20\r
1164         POP     PP,AC0\r
1165         POP PP,C\r
1166         POP PP,ER\r
1167         JRST OUTLI2\r
1168 \fSUBTTL OUTPUT ROUTINES\r
1169 UOUT:   PUSHJ   PP,LOOKUP               ;SET FOR TABLE SCAN\r
1170         TRNN ARG,PNTF   ;WFW\r
1171         TRNN    ARG,UNDF\r
1172         POPJ    PP,\r
1173         JUMP1   VARA1\r
1174         PUSHJ   PP,OUTCR\r
1175         PUSHJ   PP,OUTSYM\r
1176         MOVEI   CS,[SIXBIT /UNASSIGNED, DEFINED AS @/]\r
1177         PUSHJ   PP,OUTSIX\r
1178         HRLO    CS,V\r
1179         TDZ     CS,RC\r
1180 UOUT1:  PUSHJ   PP,ONC1\r
1181         JRST    HIGHQ\r
1182 \f                               ;OUTPUT THE ENTRIES\r
1183 \r
1184 EOUT:   MOVEI   C,0             ;INITIALIZE THE COUNT\r
1185         MOVE    SX,SYMBOL\r
1186         MOVE    SDEL,0(SX)\r
1187 EOUT1:  SOJL    SDEL,EOUT2\r
1188         ADDI    SX,2\r
1189         HLRZ    ARG,0(SX)\r
1190         ANDCAI  ARG,SYMF!INTF!ENTF\r
1191         JUMPN   ARG,EOUT1       ;IF INVALID, DON'T COUNT\r
1192         AOJA    C,EOUT1         ;BUMP COUNT\r
1193 \r
1194 EOUT2:  HRLI    C,4             ;BLOCK TYPE 4\r
1195         PUSHJ   PP,OUTBIN\r
1196         SETZB   C,ARG\r
1197         PUSHJ   PP,OUTBIN\r
1198         MOVE    SX,SYMBOL\r
1199         MOVE    SDEL,0(SX)\r
1200         MOVEI   V,^D18\r
1201 \r
1202 EOUT3:  SOJL    SDEL,POPOUT\r
1203         ADDI    SX,2\r
1204         HLRZ    C,0(SX)\r
1205         ANDCAI  C,SYMF!INTF!ENTF\r
1206         JUMPN   C,EOUT3\r
1207         SOJGE   V,EOUT4         ;TEST END OF BLOCK\r
1208         PUSHJ   PP,OUTBIN\r
1209         MOVEI   V,^D17  ;WFW\r
1210 EOUT4:  MOVE    AC0,-1(SX)\r
1211         PUSHJ   PP,SQOZE\r
1212         MOVE    C,AC0\r
1213         PUSHJ   PP,OUTBIN\r
1214         JRST    EOUT3\r
1215 \f                               ;OUTPUT THE SYMBOLS\r
1216 \r
1217 SOUT:   MOVEI   [ASCIZ /SYMBOL TABLE/]\r
1218         HRRM    SUBTTX          ;SET NEW SUB-TITLE\r
1219         PUSHJ PP,OUTFF          ;FORCE NEW PAGE\r
1220         MOVEI ARG,NCOLS         ;SET UP FOR NCOLS ACROSS SYMBOL TABLE\r
1221         MOVEM ARG,SYMCNT        ;STORE ANSWER\r
1222         PUSHJ PP,LOUT1          ;OUTPUT THEM\r
1223         MOVE    ARG,SYMCNT\r
1224         CAIE    ARG,NCOLS\r
1225         JRST    OUTCR           ;NO, NEED CR\r
1226         POPJ    PP,\r
1227 \r
1228 LOUT1:  PUSHJ   PP,LOOKUP       ;SET FOR TABLE SCAN\r
1229         TRNN    ARG,SYMF\r
1230         TRNN    ARG,MACF!SYNF\r
1231         TRNE    ARG,40          ;SKIP AND CLEAR MRP\r
1232         POPJ    PP,             ;NO, TRY AGAIN\r
1233         MOVEI   MRP,0\r
1234         TRNE    ARG,INTF\r
1235         MOVEI   MRP,1\r
1236         TRNE    ARG,EXTF\r
1237         MOVNI   MRP,1           ;MRP=-1 FOR EXTERNAL\r
1238         TRNE    ARG,SYNF        ;SYNONYM?\r
1239         JUMPL   MRP,POPOUT      ;YES, DON'T OUTPUT IF EXTERNAL\r
1240         TRNE ARG,SUPRBT         ;IF SUPRESSED\r
1241         JUMPGE  MRP,POPOUT\r
1242         TLNE    IO,2000\r
1243         JUMPE   MRP,POPOUT\r
1244         JUMPGE  MRP,LOUT10\r
1245         HLRZ    RC,V            ;PUT POINTER/FLAGS IN RC\r
1246         TRNE    RC,-2           ;POINTER?\r
1247         MOVS    RC,0(RC)        ;YES\r
1248         HLL     V,RC            ;STORE LEFT HALF\r
1249 \r
1250 LOUT10: PUSH PP,RC      ;SAVE FOR LATER\r
1251         PUSHJ   PP,OUTSYM       ;OUTPUT THE NAME\r
1252         MOVE RC,0(PP)   ;GET COPY\r
1253         MOVEI   AC1,0\r
1254         JUMPLE  MRP,LOUT15      ;SET DEFFERRED BITS IF EXTERNAL\r
1255         TLNE    RC,-2           ;CHECK FOR LEFT FIXUP\r
1256         IORI    AC1,40          ;AND SET BITS\r
1257         TRNE RC,-2              ;CHECK FOR RIGHT FIXUP\r
1258         IORI AC1,20             ;AND SET BITS\r
1259 LOUT15: TLNE RC,-2              ;FIX RELOC AS 0 IF EXTERNAL\r
1260         HRRZS AC0,RC\r
1261         TRNE RC,-2\r
1262         HLLZS AC0,RC\r
1263         TLZE RC,-1\r
1264         TRO RC,2\r
1265         HRL MRP,RC\r
1266         MOVEI   RC,0\r
1267         TRNE    ARG,NOOUTF      ;ENTRY DMN\r
1268         ADDI MRP,3              ;YES WFW\r
1269         IOR     AC1,SOUTC(MRP)\r
1270         MOVE ARG,AC1\r
1271         PUSHJ PP,NOUT2          ;SQUOZE AND DUMP THE SYMBOL\r
1272         MOVEM AC0,SVSYM         ;SAVE IT\r
1273         MOVE    AC0,V           ;GET THE VALUE\r
1274         HLRZ    RC,MRP          ;AND THE RELOCATION\r
1275         PUSHJ   PP,COUT\r
1276         HLLO    CS,V\r
1277         TRNE    RC,2            ;LEFT HALF RELOCATABLE?\r
1278         TRZA    CS,1            ;NO, FLAG AND PRINT\r
1279         TLNE    CS,-1           ;IS THE LEFT HALF ZERO?\r
1280         PUSHJ   PP,ONC1         ;NO, OUTPUT IT\r
1281         PUSHJ   PP,OUTTAB       \r
1282         HRLO    CS,V\r
1283         TDZ     CS,RC           ;SET RELOCATION\r
1284         PUSHJ   PP,ONC1\r
1285         PUSHJ   PP,OUTTAB\r
1286         POP     PP,RC           ;GET BACK RELOC AND CHECK EXTERNAL\r
1287         TRNN    RC,-2           ;IS IT?\r
1288         JRST    SOUT50          ;NO\r
1289         MOVE    AC0,1(RC)       ;GET NAME\r
1290         MOVEI   ARG,60          ;EXTERNAL REQ\r
1291         PUSHJ   PP,SQOZE\r
1292         HLLZS   AC0,RC          ;NO RELOC\r
1293         PUSHJ   PP,COUT         ;OUTPUT IT\r
1294         MOVE    AC0,SVSYM       ;GET SYMBOL NAME\r
1295         TLO     AC0,500000      ;SET AS ADDITIVE SYMBOL\r
1296         TLZ     AC0,200000      ;BUT NOT LEFT HALF ETC\r
1297         PUSHJ   PP,COUT\r
1298 \f\r
1299 SOUT50: MOVSS RC                ;CHECK LEFT HALF\r
1300         TRNN RC,-2\r
1301         JRST SOUT30\r
1302         MOVE AC0,1(RC)\r
1303         MOVEI ARG,60\r
1304         PUSHJ PP,SQOZE\r
1305         MOVEI RC,0\r
1306         PUSHJ PP,COUT\r
1307         MOVE AC0,SVSYM\r
1308         TLO AC0,700000\r
1309         PUSHJ   PP,COUT\r
1310 \r
1311 SOUT30: MOVEI   CS,SOUTC(MRP)\r
1312         PUSHJ   PP,OUTAS0\r
1313         SOSLE   SYMCNT\r
1314         JRST    OUTAB2\r
1315         MOVEI   CS,3\r
1316         MOVEM   CS,SYMCNT\r
1317         JRST    OUTCR\r
1318 \r
1319 SOUT20: PUSHJ   PP,OUTAS0\r
1320         JRST    OUTCR\r
1321 \r
1322        <ASCII /EXT/>!60        ;DMN\r
1323 SOUTC:   EXP     10\r
1324        <ASCII /INT/>!04\r
1325        <ASCII /EXT/>!60\r
1326        <ASCII /DLD/>!50 \r
1327        <ASCII /INT/>!04        ;DMN\r
1328 \f                               ;OUTPUT THE BINARY\r
1329 \r
1330 BOUT:   HRLO    CS,LOCO         ;PICKUP THE LOCATION\r
1331         PUSHJ   PP,ONC          ;OUTPUT IT TO THE LISTING FILE\r
1332         PUSHJ   PP,DSTOW        ;GET THE CODE\r
1333         PUSH PP,RC      ;SAVE RELOCATION\r
1334         TLNE RC,-2      ;CHECK LEFT EXTERNAL\r
1335         HRRZS RC        ;MAKE LEFT NON-RELOC\r
1336         TRNN RC,-2      ;RIGHT EXT?\r
1337         JRST BOUT30     ;NO\r
1338         HRRZ AC1,AC0    ;YES\r
1339         JUMPE AC1,BOUT20        ;PROCESS IF ZERO CODE THERE\r
1340         HLLZS AC0,RC    ;MAKE NON-RELOC\r
1341         JRST BOUT30     ;PROCESS\r
1342         TRNN RC,-2\r
1343         JRST BOUT30\r
1344 \r
1345 BOUT20: HRRM AC1,0(PP)  ;FIX RC IN STACK SO NO CONFUSION WFW (AC1 HAS 0)\r
1346         HRR     AC0,0(RC)       ;NO, SET ADDRESS LINK\r
1347         MOVE    AC1,LOCO        ;GET CURRENT LOCATION\r
1348         HRRM    AC1,0(RC)       ;SET NEW LINK\r
1349         HLRZ    AC1,0(RC)       ;GET FLAGS/POINTER\r
1350         TRNN    AC1,-2          ;POINTER?\r
1351         HRR     AC1,RC          ;NO, SET TO FLAGS\r
1352         HLR     RC,0(AC1)       ;PUT FLAGS IN RC\r
1353         HRL     AC1,MODO        ;GET CURRENT MODE\r
1354         TRZE    RC,-2           ;LEFT HALF RELOCATABLE+\r
1355         TLO     AC1,2           ;YES, SET FLAG\r
1356         HLLM    AC1,0(AC1)      ;STORE NEW FLAGS\r
1357 BOUT30: HLLO    CS,AC0\r
1358         TLZE    RC,1            ;PACK RELOCATION BITS\r
1359         TRO     RC,2\r
1360         TRNE    RC,2            ;LEFT HALF RELOCATABLE?\r
1361         TRZ     CS,1            ;YES, RESET BIT\r
1362         PUSHJ   PP,ONC\r
1363         HRLO    CS,AC0\r
1364         TDZ     CS,RC           ;SET RELOCATION\r
1365         PUSHJ   PP,ONC\r
1366         HRRZ    CS,LOCO         ;CS = RIGHT RELOCATION\r
1367         TLNE    FR,RIMSW!RIM1SW!R1BSW   ;RIM OUTPUT?\r
1368         JRST    ROUT            ;YES, GO PROCESS\r
1369 \r
1370         HRL     CS,MODO\r
1371         CAME    CS,MODLOC       ;SEQUENCE OR RELOCATION BREAK?\r
1372         PUSHJ   PP,COUTD        ;YES, DUMP THE BUFFER\r
1373         SKIPL   COUTX           ;NEW BUFFER?\r
1374         JRST    BOUT40          ;NO, STORE CODE AND EXIT\r
1375         MOVEM   CS,MODLOC       ;YES, STORE NEW VALUES\r
1376         EXCH    AC0,LOCO\r
1377         EXCH    RC,MODO\r
1378         PUSHJ   PP,COUT         ;STORE BLOCK LOCATION AND MODE\r
1379         EXCH    RC,MODO         ;RESTORE CURRENT VALUES\r
1380         EXCH    AC0,LOCO\r
1381 \fBOUT40:        PUSHJ PP,COUT           ;EXIT CODE\r
1382         POP PP,RC       ;RETREIVE EXTERNAL BITS\r
1383         TRNN RC,-2      ;RIGHT EXTERNAL?\r
1384         JRST BOUT50     ;TRY FOR LEFT\r
1385         PUSHJ PP,COUTD\r
1386         PUSH PP,BLKTYP  ;TERMINATE TYPE AND SAVE\r
1387         MOVEI AC0,2     ;BLOCK TYPE 2\r
1388         MOVEM AC0,BLKTYP\r
1389         MOVE AC0,1(11)  ;GET SYMBOL\r
1390         MOVEI ARG,60    ;CODE BITS\r
1391         PUSHJ PP,SQOZE  ;CONVERT TO RADIX 50\r
1392         HLLZS RC        ;SYMBOL HAS NO RELOCATION\r
1393         PUSHJ PP,COUT   ;EMIT\r
1394         MOVE AC0,LOCO   ;GET CURRENT LOC\r
1395         HRLI AC0,400000 ;ADDITIVE REQ\r
1396         HRR RC,MODO     ;CURRENT MODE\r
1397         PUSHJ PP,COUT   ;EMIT\r
1398         MOVSS RC        ;NOW FOR LEFT\r
1399         TRNN RC,-2\r
1400         JRST BOUT60\r
1401         JRST BOUT70\r
1402 BOUT50: MOVSS RC        ;CHECK OTHER HALF\r
1403         TRNN RC,-2      ;LEFT HALF EXTERNAL?\r
1404         JRST BOUT80     ;NO, FALSE ALARM\r
1405         PUSHJ PP,COUTD  ;CHANGE MODE\r
1406         PUSH PP,BLKTYP\r
1407         MOVEI AC0,2\r
1408         MOVEM AC0,BLKTYP\r
1409 BOUT70: MOVE AC0,1(RC)\r
1410         MOVEI ARG,60\r
1411         PUSHJ PP,SQOZE\r
1412         HLLZS AC0,RC\r
1413         PUSHJ PP,COUT\r
1414         MOVE AC0,LOCO\r
1415         HRLI AC0,600000 ;LEFT HALF ADD\r
1416         HRR RC,MODO\r
1417         PUSHJ PP,COUT   ;EMIT\r
1418 BOUT60: PUSHJ PP,COUTD  ;CHANGE MODE\r
1419         POP PP,BLKTYP   ;TO OLD ONE\r
1420 BOUT80: AOS LOCO\r
1421         AOS MODLOC\r
1422         POPJ PP,\r
1423 \fNOUT:  MOVE    V,[POINT 7,TBUF]        ;POINTER TO ASCII LINE\r
1424         MOVSI   CS,(POINT 6,AC0)        ;POINTER TO SIXBIT AC0\r
1425         SETZB   ARG,AC0\r
1426 NOUT1:  ILDB    C,V             ;GET ASCII\r
1427         CAIL C,"A"+40\r
1428         CAILE C,"Z"+40\r
1429         SKIPA\r
1430         SUBI    C,40            ;CONVERT TO LOWER CASE\r
1431         SUBI    C,40            ;CONVERT TO SIXBIT\r
1432         JUMPLE  C,NOUT3         ;TEST FORM NON-SIXBIT\r
1433         CAILE   C,77            ;AND NOT GREATER THAN SIXBIT\r
1434         JRST    NOUT3           ;...\r
1435         IDPB    C,CS            ;DEPOSIT IN AC0\r
1436         TLNE    CS,770000               ;TEST FOR SIX CHARACTERS\r
1437         JRST    NOUT1\r
1438 NOUT3:\r
1439 \r
1440 IFN CCLSW,<     TLNN IO,IOTLSN          ;AND IF WE HAVE NOT SEEN A TITLE\r
1441         PUSHJ PP,PRNAM          ;THEN PRINT THE NAME>\r
1442 NOUT2:  PUSHJ   PP,SQOZE        ;CONVERT TO SIXBIT\r
1443         JRST    COUT            ;DUMP AND EXIT\r
1444 \r
1445 IFN RENTSW,<\r
1446 HOUT:\r
1447         MOVE    AC0,HHIGH       ;GET HIGH SEG IF TWO SEGMENTS\r
1448         MOVEI   RC,1            ;RELOCATABL\r
1449         PUSHJ   PP,COUT         ;OUTPUT IT\r
1450         SETZB   AC0,RC\r
1451         JRST    COUT            ;OUTPUT THE HIGHEST LOCATION>\r
1452 \r
1453 VOUT:   SKIPN   RC,VECREL       ;IS VECTOR ABSOLUTE ZERO?\r
1454         SKIPE   VECTOR          ;ALSO CHECK RELOCATION\r
1455         SKIPA   \r
1456         POPJ    PP,             ;YES, EXIT\r
1457         MOVE    AC0,VECTOR      ;ACO SHOULD BE FLAGS\r
1458 COUT:   AOS     C,COUTX         ;INCREMENT INDEX\r
1459         MOVEM   AC0,COUTDB(C)   ;STORE CODE\r
1460         IDPB    RC,COUTP        ;STORE RELOCATION BITS\r
1461         CAIE    C,^D17          ;IS THE BUFFER FULL?\r
1462         POPJ    PP,             ;NO, EXIT\r
1463 \r
1464 COUTD:  AOSG    C,COUTX         ;DUMP THE BUFFER\r
1465         JRST    COUTI           ;BUFFER WAS EMPTY\r
1466         HRL     C,BLKTYP        ;SET BLOCK TYPE\r
1467         PUSHJ   PP,OUTBIN       ;OUTPUT COUNT AND TYPE\r
1468         SETOB   C,COUTY         ;INITIALIZE INDEX\r
1469 \r
1470 COUTD2: MOVE    C,COUTDB(C)     ;GET RELOCATION BITS/CODE\r
1471         PUSHJ   PP,OUTBIN       ;DUMP IT\r
1472         AOS     C,COUTY         ;INCREMENT INDEX\r
1473         CAMGE   C,COUTX         ;TEST FOR END\r
1474         JRST    COUTD2          ;NO, GET NEXT WORD\r
1475 \r
1476 COUTI:  SETOM   COUTX           ;INITIALIZE BUFFER INDEX\r
1477         SETZM   COUTRB          ;ZERO RELOCATION BITS\r
1478         MOVE    C,[POINT 2,COUTRB]\r
1479         MOVEM   C,COUTP         ;INITIALIZE BIT POINTER\r
1480         POPJ    PP,             ;EXIT\r
1481 \fSTOWZ: MOVEI   RC,0            ;USE STANDARD FORM\r
1482 STOW:   JUMP1   STOW20          ;SKIP TEST IF PASS ONE\r
1483         TRNE    RC,-2           ;RIGHT HALF ZERO OR 1?\r
1484         PUSHJ   PP,STOWT        ;NO, HANDLE EXTERNAL\r
1485         TLNN    RC,-2           ;LEFT HALF ZERO OR 1? WFW\r
1486         JRST    STOW10          ;YES, SKIP TEST\r
1487         MOVSS   RC              ;SWAP HALVES\r
1488         PUSHJ   PP,STOWT1       ;HANDLE EXTERNAL WFW\r
1489         MOVSS   RC              ;RESTORE VALUES\r
1490 \r
1491 STOW10: SKIPE   EXTPNT          ;ANY EXTERNALS REMAINING?\r
1492         TRO     ER,ERRE         ;YES, SET EXTERNAL ERROR FLAG\r
1493 \r
1494 STOW20: AOS     AC1,STPX        ;INCREMEMT POINTER\r
1495         MOVEM   AC0,STCODE(AC1) ;STOW CODE\r
1496         MOVEM   RC,STOWRC(AC1)  ;STOW RELOCATION BITS\r
1497         SKIPN   LITLVL          ;ARE WE IN LITERAL?\r
1498         AOS     LOCA            ;NO, INCREMENT ASSEMBLY LOCATION\r
1499         CAIGE   AC1,.STP-1      ;OVERFLOW\r
1500         POPJ    PP,             ;NO, EXIT\r
1501 \r
1502         SKIPE   LITLVL          ;ARE WE IN A LITERAL?\r
1503         TROA    ER,ERRL         ;YES, FLAG ERRRO BUT DON'T DUMP\r
1504         JRST    CHARL1          ;NO, SAVE REGISTERS AND DUMP THE BUFFER\r
1505         JRST    STOWI           ;INITIALIZE BUFFER\r
1506 \r
1507 DSTOW:  AOS     AC1,STPY        ;INCREMENT POINTER\r
1508         MOVE    AC0,STCODE(AC1) ;FETCH CODE\r
1509         MOVE    RC,STOWRC(AC1)  ;FETCH RELOCATION BITS\r
1510         CAMGE   AC1,STPX        ;IS THIS THE END?\r
1511         POPJ    PP,             ;NO, EXIT\r
1512 STOWI:  SETOM   STPX            ;INITIALIZE FOR INPUT\r
1513         SETOM   STPY            ;INITIALIZE FOR OUTPUT\r
1514         SETZM   EXTPNT\r
1515         POPJ    PP,             ;EXIT\r
1516 \r
1517 \fSVSTOW:        AOS     LITLVL          ;NESTED LITERALS\r
1518         PUSH    PP,STPX         ;MAKE ROOM FOR ANOTHER\r
1519         PUSH    PP,STPY\r
1520         MOVE    AC1,STPX\r
1521         MOVEM   AC1,STPY\r
1522         JRST    0(AC2)\r
1523 \r
1524 GTSTOW: POP     PP,STPY         ;BACK UP A LEVEL\r
1525         POP     PP,STPX\r
1526         SOS     LITLVL\r
1527         JRST    0(AC2)\r
1528 \r
1529         ;EXTERNAL RIGHT\r
1530 STOWT:  HRRZ    AC1,EXTPNT      ;GET RIGHT POINTER\r
1531         CAIN    AC1,0(RC)       ;DOES IT MATCH\r
1532         JRST    STOWT0          ;EXTERNAL OR RELOCATION ERROR\r
1533         HRRI    RC,0\r
1534         TRO     ER,ERRE\r
1535 STOWT0: HLLZS   EXTPNT\r
1536         POPJ    PP,             ;EXIT\r
1537 \r
1538         ;EXTERNAL LEFT\r
1539 STOWT1: HLRZ    AC1,EXTPNT      ;GET LEFT HALF\r
1540         CAIN    AC1,0(RC)       ;SEE ABOVE\r
1541         JRST    STOWT2\r
1542         HRRI    RC,0\r
1543         TRO     ER,ERRE\r
1544 STOWT2: HRRZS   EXTPNT\r
1545         POPJ    PP,             ;EXIT\r
1546 \fONC:   ILDB    C,TABP          ;ENTRY TO ADVANCE TAB POINTER\r
1547         PUSHJ   PP,OUTL         ;OUTPUT A TAB\r
1548                                 ;OUTPUT 6 OCT NUMBERS FROM CS LEFT\r
1549 ONC1:   MOVEI   C,6             ;CONVERT TO ASCII\r
1550         LSHC    C,3             ;SHIFT IN OCTAL\r
1551         PUSHJ   PP,OUTL         ;OUTPUT ASCII FROM C\r
1552         TRNE    CS,-1           ;ARE WE THROUGH?\r
1553         JRST    ONC1            ;NO, GET ANOTHER\r
1554         MOVEI   C,"'"\r
1555         TLNN    CS,1            ;RELOCATABLE?\r
1556         PUSHJ   PP,OUTC         ;OUTPUT IF EXTERN OR RELOCATABLE\r
1557         POPJ    PP,             ;EXIT\r
1558 \r
1559 DNC:    IDIVI   C,^D10\r
1560         HRLM    CS,0(PP)\r
1561         SKIPE   C\r
1562         PUSHJ   PP,DNC          ;RECURSE IF NON-ZERO\r
1563         HLRZ    C,0(PP)\r
1564         ADDI    C,"0"           ;FORM ASCII\r
1565         JRST    PRINT           ;DUMP AND TEST FOR END\r
1566 \r
1567 OUTAS0: HRLI    CS,(POINT 7,,)  ;ENTRY TO SET POINTER\r
1568 OUTASC: ILDB    C,CS            ;GET NEXT BYTE\r
1569         JUMPE   C,POPOUT        ;EXIT ON ZERO DELIMITER\r
1570         PUSHJ   PP,PRINT\r
1571         JRST    OUTASC\r
1572 \r
1573 OUTSIX: HRLI    CS,(POINT 6,,)  ;OUTPUT SIXBIT\r
1574         ILDB    C,CS            ;GET SIXBIT\r
1575         CAIN    C,40            ;"@" DELIMITER?\r
1576         POPJ    PP,             ;YES, EXIT\r
1577         ADDI    C,40            ;NO, FORM ASCII\r
1578         PUSHJ   PP,OUTL         ;OUTPUTASCII CHAR FROM C\r
1579         JRST    OUTSIX+1\r
1580 \r
1581 OUTSYM: MOVE    CS,AC0          ;PLACE NAME IN CS\r
1582 OUTSY1: MOVEI   C,0             ;CLEAR C\r
1583         LSHC    C,6             ;MOVE NEXT SIXBIT CHARACTER IN\r
1584         JUMPE   C,OUTTAB        ;TEST FOR END\r
1585         ADDI    C,40            ;CONVERT TO ASCII\r
1586         PUSHJ   PP,OUTL         ;OUTPUT\r
1587         JRST    OUTSY1          ;LOOP\r
1588 \fOUTSET:        AOS     SX,0(PP)        ;GET RETURN LOCATION\r
1589         MOVE    SX,-1(SX)       ;GET XWD CODE\r
1590         HLRM    SX,BLKTYP       ;SET BLOCK TYPE\r
1591         SETZB   ARG,RC          \r
1592         PUSHJ   PP,0(SX)        ;GO TO PRESCRIBED ROUTINE\r
1593         JRST    COUTD           ;TERMINATE BLOCK AND EXIT\r
1594 \r
1595         ;LOOKUP SCANS ALL THE SYMBOLS IN THE SYMBOL TABLE\r
1596 \r
1597 LOOKUP: POP     PP,LOOKX        ;INTERCEPT RETURN POP\r
1598         MOVE    SX,SYMBOL\r
1599         MOVE    SDEL,0(SX)      ;SET FOR TABLE SCAN\r
1600 LOOKL:  SOJL    SDEL,POPOUT     ;TEST FOR END\r
1601         ADDI    SX,2\r
1602         MOVE    AC0,-1(SX)\r
1603         PUSHJ   PP,SRCH7        ;LOAD REGISTERS\r
1604         HLRZS   ARG\r
1605         PUSHJ   PP,@LOOKX       ;RETURN TO CALLING ROUTINE\r
1606         JRST    LOOKL           ;TRY AGAIN\r
1607 \fEND0:  AOS     LITLVL\r
1608         PUSHJ   PP,STMNT\r
1609         SOS     LITLVL\r
1610         SKIPL   STPX\r
1611         PUSHJ   PP,DSTOW\r
1612         TLZN    RC,-2\r
1613         TRZE    RC,-2\r
1614         TRO     ER,ERRE\r
1615         MOVEM   AC0,VECTOR\r
1616         MOVEM   RC,VECREL\r
1617         PUSHJ   PP,VARA\r
1618         PUSHJ   PP,LIT1\r
1619         JUMP2   ENDP2\r
1620         PUSHJ   PP,UOUT\r
1621         PUSHJ   PP,REC2\r
1622         PUSHJ   PP,INZ\r
1623 \r
1624 PASS20: SETZM   CTLSAV\r
1625         PUSHJ   PP,COUTI\r
1626         PUSHJ   PP,EOUT         ;OUTPUT THE ENTRIES\r
1627         PUSHJ   PP,OUTSET\r
1628         XWD      6,NOUT         ;OUTPUT THE HISEG BLOCK\r
1629 PASS21: MOVEI   1\r
1630         HRRM    BLKTYP          ;SET FOR TYPE 1 BLOCK\r
1631         TLZ     FR,P1!MWLFLG    ;SET FOR PASS 2 AND TURN OFF FLAG\r
1632         TLO     IO,IOPALL       ;PUT THESE BACK\r
1633         TLZ     IO,IOPROG!IOCREF!DEFCRS ;SO LISTINGS WILL BE THE WAY THEY SHOULD\r
1634         TLNN    FR,R1BSW\r
1635         JRST    STOWI\r
1636         MOVE    CS,[XWD $ST-1-$CKSM,R1BLDR]\r
1637         MOVE    C,0(CS)\r
1638         PUSHJ   PP,PTPBIN\r
1639         AOBJN   CS,.-2\r
1640         PUSHJ   PP,R1BI\r
1641         JRST    STOWI\r
1642 \f\r
1643 R1BLDR:\r
1644         PHASE 0\r
1645         IOWD $ADR,$ST\r
1646 $ST:    CONO PTR,60\r
1647         HRRI $A,$RD+1\r
1648 $RD:    CONSO PTR,10\r
1649         JRST .-1\r
1650         DATAI PTR,@$TBL1-$RD+1($A)\r
1651         XCT $TBL1-$RD+1($A)\r
1652         XCT $TBL2-$RD+1($A)\r
1653 $A:     SOJA $A,\r
1654 $TBL1:  CAME $CKSM,$ADR\r
1655         ADD $CKSM,1($ADR)\r
1656         SKIPL $CKSM,$ADR\r
1657 $TBL2:  JRST 4,$ST\r
1658         AOBJN $ADR,$RD\r
1659 $ADR:   JRST $ST+1\r
1660 $CKSM:\r
1661         DEPHASE\r
1662 \r
1663 IF2,<   PURGE $ST,$RD,$A,$TBL1,$TBL2,$ADR,$CKSM>\r
1664 \fENDP2: PUSHJ   PP,COUTD        ;DUMP THE BUFFER\r
1665 IFN RENTSW,<\r
1666         MOVE    AC0,HHIGH\r
1667         CAMN    AC0,LOCO\r
1668         HRRZM   AC2,HHIGH\r
1669 >\r
1670         TLNN    FR,CREFSW\r
1671         TLNN    IO,IOCREF       ;CLOSE CREF IF NECESSARY\r
1672         SKIPA\r
1673         PUSHJ   PP,CLSCR2       ;CLOSE IT UP\r
1674         HRR     ER,OUTSW        ;SET OUTPUT SWITCH\r
1675         SKIPN   TYPERR\r
1676         TRO     ER,TTYSW\r
1677         PUSHJ   PP,UOUT         ;OUTPUT UNDEFINEDS\r
1678         TRO     ER,TTYSW\r
1679         SKIPG   C,ERRCNT        ;GET ERROR COUNT AND CHECK FOR POSITIVE\r
1680         JRST    NOERW\r
1681 IFN CCLSW,<ADDM C,JOBERR                ;REMEMBER ERROR COUNT FOR EXECUTION DELETION>\r
1682         PUSHJ PP,OUTCR\r
1683         MOVE C,ERRCNT\r
1684         CAIN C,1                ;1 IS A SPECIAL CASE\r
1685         JRST ONERW              ;PRINT MESSAGE\r
1686         MOVEI C,"?"             ;? FOR BATCH\r
1687         PUSHJ PP,OUTL           ;...\r
1688         MOVE C,ERRCNT           ;PRINT NUMBER OF ERRORS\r
1689         PUSHJ PP,DNC\r
1690         SKIPA CS,[EXP ERRMS3]   ;LOAD TO PRINT\r
1691 ONERW:  MOVEI CS,ERRMS2         ;ONE ERROR DECTECTED\r
1692 ONERW1: PUSHJ PP,OUTSIX         ;PRINT\r
1693         JRST ENDP2D\r
1694 NOERW:  MOVEI CS,ERRMS1\r
1695         TLNE IO,CRPGSW          ;IF RPG, DON'T PRINT MESSAGE\r
1696         TRZ     IO,TTYSW        ;NO TTY OUTPUT\r
1697         IOR     IO,OUTSW        ;UNLESS NEEDED FOR LISTING\r
1698         PUSHJ PP,OUTCR\r
1699         JRST ONERW1\r
1700 ENDP2D: PUSHJ   PP,OUTCR\r
1701 IFN     CCLSW,<TLNE IO,CRPGSW   ;IF RPG, DON'T PRINT PGM BREAK\r
1702         TRZ     IO,TTYSW        ;...>\r
1703 IFE     CCLSW,< SKIPA   ;SO PRGEND CODE CAN WORK>\r
1704         IOR     IO,OUTSW        ;...\r
1705         PUSHJ   PP,OUTCR\r
1706         MOVEI   CS,[SIXBIT /PROGRAM BREAK IS @/]\r
1707         PUSHJ   PP,OUTSIX\r
1708 IFN RENTSW,<\r
1709         HRLO    CS,HHIGH        ;GET PROGRAM BREAK\r
1710         PUSHJ   PP,UOUT1>\r
1711         PUSHJ   PP,OUTCR\r
1712         TLNE    FR,RIMSW!R1BSW  ;RIM MODE?\r
1713         PUSHJ   PP,RIMFIN       ;YES, FINISH IT\r
1714         HRR     IO,OUTSW\r
1715         PUSHJ   PP,OUTSET\r
1716         XWD     2,SOUT          ;OUTPUT THE SYMBOLS (BLKTYP-2)\r
1717         PUSHJ   PP,OUTSET\r
1718         XWD     7,VOUT          ;OUTPUT TRANSFER VECTOR (..-7)\r
1719 IFN RENTSW,<\r
1720         PUSHJ   PP,OUTSET\r
1721         XWD     5,HOUT          ;OUTPUT HIGHEST RELOCATABLE (..-5)>\r
1722         PUSHJ   PP,COUTD\r
1723         JRST    FINIS\r
1724 RIMFIN: TLNE FR,R1BSW\r
1725         PUSHJ PP,R1BDMP\r
1726         SKIPN   C,VECTOR\r
1727         MOVSI   C,(JRST 4,)\r
1728         TLNN    C,777000\r
1729         TLO     C,(JRST)\r
1730         PUSHJ   PP,PTPBIN\r
1731         MOVEI   C,0\r
1732         JRST    PTPBIN\r
1733 \fSUBTTL PASS    INITIALIZE\r
1734 INZ:    AOS     MODA\r
1735         AOS     MODO\r
1736         PUSHJ   PP,OUTFF\r
1737         SETZM   SEQNO\r
1738         SETZM   TAG\r
1739         HRRI    RX,^D8\r
1740         MOVEI   VARHD\r
1741         MOVEM   VARHDX\r
1742         MOVEI   LITHD\r
1743         MOVEM   LITHDX\r
1744         PUSHJ   PP,LITI\r
1745         PUSHJ   PP,STOWI\r
1746         JRST    OUTLI\r
1747 RCPNTR: POINT   1,ARG,^L<RELF>-18       ;POINT 1,ARG,22\r
1748 \fSUBTTL PSEUDO-OP       HANDLERS\r
1749 \r
1750 TAPE0:  PUSHJ   PP,STOUTS\r
1751         JRST    GOTEND\r
1752 \r
1753 RADIX0: PUSHJ   PP,EVAL10       ;EVALUATE RADIX D10\r
1754         CAIG    AC0,^D10        ;IF GREATER THAN 10\r
1755         CAIG    AC0,1           ;OR LESS THAN 2.\r
1756 ERRAX:  TROA    ER,ERRA         ;FLAG ERROR AND SKIP\r
1757         HRR     RX,AC0          ;SET NEW RADIX\r
1758         POPJ    PP,\r
1759 \r
1760 IOSET:  JUMP1   POPOUT          ;NOSYM (IONSYM), XALL (IOPALL), XLIST (IOPROG)\r
1761         HLRZ    SX,AC0          ;STORE FLAGS\r
1762         PUSHJ   PP,STOUTS       ;POLISH OFF LINE\r
1763         TLOA    IO,0(SX)        ;NOW SUPPRESS PRINTING\r
1764 IORSET: TDZ     IO,AC0          ;RESET  FLAG IOPALL/IOPROG\r
1765         POPJ    PP,\r
1766 \r
1767 BLOCK0: PUSHJ   PP,HIGHQ        \r
1768         PUSHJ   PP,EVALEX       ;EVALUATE\r
1769         TRZE    RC,-1           ;EXTERNAL OR RELOCATABLE?\r
1770         PUSHJ   PP,QEXT         ;UPDATE ASSEMBLY LOCATION\r
1771         ADDM    AC0,LOCO        ;SAVE START OF BLOCK\r
1772 BLOCK1: EXCH    AC0,LOCA        ;UPDATE OUTPUT LOCATION\r
1773         ADDM    AC0,LOCA\r
1774 BLOCK2: HRLOM   AC0,LOCBLK\r
1775         JUMP2   POPOUT\r
1776         TRNE    ER,ERRU\r
1777         TRO     ER,ERRV\r
1778         POPJ    PP,\r
1779 \f\r
1780 PRINT0: MOVNI   AC0,5\r
1781         ADDM    AC0,ERRCNT\r
1782         TRO     ER,400000\r
1783         POPJ    PP,\r
1784 \r
1785 REMAR0: PUSHJ   PP,GETCHR\r
1786         CAIE    C,EOL\r
1787         JRST    REMAR0\r
1788         POPJ    PP,\r
1789 \fLIT0:  PUSHJ   PP,BLOCK1\r
1790 LIT1:   JUMP2   LIT20\r
1791 \r
1792 ;ON PASS ONE, WE JUST STEP THE LOCATION COUNTER AND CLEAR\r
1793 \r
1794         PUSHJ   PP,STOUTS\r
1795         MOVE    AC0,LITCNT\r
1796         MOVE    SX,LITHDX\r
1797         HRLM    AC0,0(SX)\r
1798         MOVE    V,LOCA\r
1799         HRL     V,MODA\r
1800         MOVEM   V,-1(SX)\r
1801         JRST    LIT24\r
1802 \r
1803 LIT20:  PUSH    PP,LOCA\r
1804         PUSH    PP,LOCO\r
1805         SKIPN   LITNUM\r
1806         JRST    LIT20A\r
1807         MOVE    SX,LITHDX\r
1808         HRRZ    AC0,-1(SX)\r
1809         CAME    AC0,LOCA\r
1810         TRO     ER,ERRP\r
1811 LIT20A: PUSHJ   PP,STOUTS\r
1812         MOVE    SX,LITAB\r
1813 LIT21:  SOSGE   LITNUM\r
1814         JRST    LIT22\r
1815         MOVE    AC0,-2(SX)      ;WFW\r
1816         MOVE    RC,-1(SX)       ;WFW\r
1817         MOVE SX,0(SX)           ;WFW POINTER TO THE NEXT LIT\r
1818         PUSHJ   PP,STOW20       ;STOW CODE\r
1819         MOVEI   C,12            ;SET LINE FEED\r
1820         IDPB    C,LBUFP\r
1821         PUSHJ   PP,OUTLIN       ;OUTPUT THE LINE\r
1822         JRST    LIT21\r
1823 \fLIT22: HRRZ    AC2,LOCO\r
1824         POP     PP,LOCO\r
1825         POP     PP,LOCA\r
1826         MOVE    SX,LITHDX\r
1827         HLRZ    AC0,0(SX)\r
1828         SUB AC2,LOCO    ;COMPUTE LENGTH USED\r
1829         CAMGE AC0,AC2   ;USE LARGER\r
1830         MOVE AC0,AC2\r
1831         ADD AC2,LOCO\r
1832 LIT24:  ADDM    AC0,LOCA\r
1833         ADDM    AC0,LOCO\r
1834         PUSHJ   PP,GETTOP\r
1835         HRRM    SX,LITHDX\r
1836 LITI:   SETZM   LITCNT\r
1837         SETZM   LITNUM\r
1838         MOVEI   LITAB\r
1839         MOVEM   LITABX\r
1840         JRST    HIGHQ\r
1841 GETTOP: HRRZ    AC1,SX          ;VARHD\r
1842         HRRZ    SX,0(SX)\r
1843         JUMPN   SX,POPOUT\r
1844         MOVEI   SX,3            ;WFW\r
1845         ADDB    SX,FREE\r
1846         CAML    SX,SYMBOL\r
1847         PUSHJ   PP,XCEED\r
1848         SETZM   0(SX)           ;CLEAR FORWARE LINK\r
1849         HRRM    SX,0(AC1)       ;STORE ADDRESS IN LAST LINK\r
1850         POPJ    PP,\r
1851 \fVAR0:  PUSHJ   PP,BLOCK1               ;PRINT LOCATION\r
1852         PUSHJ   PP,VARA\r
1853         JRST    STOUTS\r
1854 \r
1855 VARA:   MOVE    SX,VARHDX\r
1856         MOVE AC0,LOCA           ;GET LOCATION FOR CHECK\r
1857         JUMP1 VARB              ;DO NOT CHECK START ON PASS 1\r
1858         CAME AC0,-1(SX)         ;CHECK START OF VAR AREA\r
1859         TRO ER,ERRP             ;AND GIVE ERROR\r
1860 VARB:   MOVEM AC0,-1(SX)        ;SAVE START FOR PASS 2\r
1861         HLRZ    AC0,0(SX)\r
1862         ADDM    AC0,LOCA\r
1863         ADDM    AC0,LOCO\r
1864         PUSHJ   PP,GETTOP\r
1865         HRRM    SX,VARHDX\r
1866         JUMP2   POPOUT\r
1867 \r
1868         PUSHJ   PP,LOOKUP       ;SET FOR TABLE SCAN\r
1869         TRZN    ARG,VARF\r
1870         POPJ    PP,             ;NO, EXIT\r
1871         TRZ     ARG,UNDF        ;TURN OFF FLAG NOW\r
1872         MOVSI   V,1             ;NUMBER TO ADD TO\r
1873         ADDM    V,0(AC1)        ;UPDATE COUNT\r
1874 VARA1:  IOR     ARG,MODA        ;SET TO ASSEMBLY MODE\r
1875         HRL     ARG,LOCA\r
1876 \r
1877         MOVSM   ARG,0(SX)       ;UPDATE 2ND WRD OF SYM TAB ENTRY\r
1878         AOS     LOCA\r
1879         AOS     LOCO\r
1880         JRST    HIGHQ1\r
1881 \fIF:    PUSH    PP,AC0          ;SAVE AC0\r
1882         PUSH    PP,IO\r
1883         PUSHJ   PP,EVALXQ       ;EVALUATE AND TEST EXTERNAL\r
1884         POP     PP,AC1\r
1885         SKIPL   AC1\r
1886         TLZ     IO,FLDSW\r
1887 IFPOP:  POP     PP,AC1          ;RETRIEVE SKIP INSTRUCTION\r
1888 IFSET:  TLO IO,IORPTC           ;REPEAT CHARACTER\r
1889 IFXCT:  XCT     AC1             ;EXECUTE INSTRUCTION\r
1890         TDZA    AC0,AC0         ;FALSE\r
1891         MOVEI   AC0,1           ;TRUE\r
1892 IFEXIT: JUMPOC REPEA1           ;BRANCH IF IN OP-CODE FIELD\r
1893 IFEX1:  PUSHJ PP,GETCHR         ;SEARCH FOR "<"\r
1894         CAIN C,EOL              ;ERROR IF END OF LINE\r
1895         JRST ERRAX\r
1896         CAIE C,34\r
1897         JRST IFEX1\r
1898         JUMPE AC0,IFEX2         ;TEST FOR 0\r
1899         TLO IO,IORPTC           ;NO, PROCESS AS CELL\r
1900         PUSHJ PP,CELL\r
1901         JRST STOW               ;STOW CODE AND EXIT\r
1902 \r
1903 IFPASS: TLZ 14,4\r
1904         HRRI    AC0,P1          ;MAKE IT TLNX IO,P1\r
1905         MOVE    AC1,AC0         ;PLACE IT IN AC1\r
1906         JRST    IFSET           ;EXECUTE INSTRUCTION\r
1907 \r
1908 IFB0:   HLLO    AC1,AC0         ;FORM AND STORE TEST INSTRUCTION\r
1909 IFB2:   PUSHJ   PP,CHARAC       ;GET FIRST NON-BLANK\r
1910         CAIN    C,74\r
1911         AOJA    RC,IFB2\r
1912         CAIN    C,76\r
1913         SOJLE   RC,IFXCT\r
1914         CAIE    C," "           ;BLANK\r
1915         TRO     AC0,0(RC)\r
1916         JRST    IFB2\r
1917 \fIFDEF0:        HRRI    AC0,UNDF        ;MAKE IT TLNX ARG,UNDF\r
1918         PUSH    PP,AC0          ;STACK IT\r
1919         PUSHJ   PP,GETSYM       ;TAKES SKIP RETURN IF SYM NAME IS LEGAL\r
1920         TROA    ER,ERRA         ;ILLEGAL!\r
1921         PUSHJ   PP,SEARCH\r
1922         JRST    [PUSHJ  PP,OPTSCH\r
1923                 TLO     ARG,UNDF\r
1924                 JRST    .+1]\r
1925         PUSHJ   PP,SSRCH3       ;EMIT TO CREF ANYWAY\r
1926         JRST    IFPOP\r
1927 \r
1928 \fIFIDN0:        HLRZS   AC0\r
1929         MOVEI   V,2*.IFBLK-1\r
1930         SETZM   IFBLK(V)        ;CLEAR COMPARISON BLOCK\r
1931         SOJGE   V,.-1\r
1932         MOVEI   RC,IFBLK        ;SET FOR FIRST BLOCK\r
1933         PUSHJ   PP,IFCL         ;GET FIRST STRING\r
1934         MOVEI   RC,IFBLKA\r
1935         PUSHJ   PP,IFCL         ;GET SECOND STRING\r
1936         MOVEI   V,.IFBLK-1\r
1937         MOVE    SX,IFBLK(V)     ;GET WORD FROM FIRST STRING\r
1938         CAMN    SX,IFBLKA(V)    ;COMPARE WITH SECOND STRING\r
1939         SOJGE   V,.-2           ;EQUAL, TRY NEXT WORD\r
1940         SKIPL   V               ;DID WE FINISH STRING\r
1941         XORI    AC0,1           ;NO, TOGGLE REQUEST\r
1942         JRST    IFEXIT          ;DO NOT TURN ON IORPTC WFW\r
1943 \r
1944 IFCL:   HRLI    RC,(POINT 7,,)\r
1945 IFCL1:  PUSHJ   PP,CHARAC       ;GET AND LIST CHARACTERS\r
1946         CAIE    C,74            ;SKIP SPACES\r
1947         JRST    IFCL1\r
1948         MOVEI   SX,30\r
1949 IFCL2:  PUSHJ   PP,CHARAC\r
1950         CAIN    C,76\r
1951         POPJ    PP,\r
1952         IDPB    C,RC\r
1953         SOJLE   SX,POPOUT\r
1954         JRST    IFCL2\r
1955 \f\r
1956 IFEX2:  PUSHJ   PP,GETCHR\r
1957         CAIN    C,EOL           ;EXIT WITH ERROR IF END OF LINE\r
1958         JRST    ERRAX\r
1959         CAIN    C,34            ;"<"?\r
1960         AOJA    IFEX2           ;YES, INCREMENT COUNT\r
1961         CAIE    C,36            ;">"?\r
1962         JRST    IFEX2           ;NO, TRY AGAIN\r
1963         SOJGE   IFEX2           ;YES, TEST FOR MATCH\r
1964         PUSHJ   PP,BYPAS1       ;YES, MOVE TO NEXT DELIMITER\r
1965         AOJA    AC0,STOWZ       ;STOW ZERO\r
1966 \r
1967 \r
1968 INTER0: HLLZM   AC0,INTENT      ;AC0 CONTAINS INTF/ENTF FLAGS\r
1969 \r
1970 INTER1: PUSHJ   PP,GETSYM       ;GET A SYMBOL\r
1971         JRST    INTER3          ;INVALID, SKIP\r
1972         PUSHJ   PP,SSRCH        ;SEARCH THE TABLE\r
1973         MOVSI   ARG,SYMF!INTF!UNDF\r
1974         TLNE    ARG,UNDF        ;ALLOW FORWARD REFERENCE\r
1975         TRO     ER,ERRA\r
1976         TLNN    ARG,SYNF!EXTF\r
1977         TDOA    ARG,INTENT      ;SET APPROPRIATE FLAGS\r
1978 INTER3: TROA    ER,ERRA         ;FLAG ARG EROR AND SKIP\r
1979         PUSHJ   PP,INSERQ       ;INSERT/UPDATE\r
1980         JUMPCM  INTER1\r
1981         POPJ    PP,             ;NO, EXIT\r
1982 \fEXTER0:        PUSHJ   PP,GETSYM       ;GET A SYMBOL\r
1983         JRST    EXTER3          ;INVALID, ERROR\r
1984         PUSHJ   PP,SSRCH        ;OK, SEARCH SYMBOL TABLE\r
1985         JRST    EXTER2          ;NOT THER, INSERT IT\r
1986         TLNN    ARG,EXTF!VARF!UNDF\r
1987         TROA    ER,ERRE         ;FLAG ERROR AND BYPASS\r
1988         TLNE    ARG,EXTF        ;VALID, ALREADY DEFINED\r
1989         JRST    EXTER3\r
1990 EXTER2: MOVEI   V,2             ;NO, GET 2 CELLS FROM THE TREE\r
1991         ADDB    V,FREE\r
1992         CAML    V,SYMBOL        ;HAVE WE RUN OUT OF CORE?\r
1993         PUSHJ   PP,XCEEDS       ;YES, TRY TO BORROW SOME MORE\r
1994         SUBI    V,1             ;GET RIGHT CELL FOR POINTER\r
1995         SETZB   RC,0(V)         ;ALL SET, ZERO VALUES\r
1996         MOVSI   ARG,SYMF!EXTF\r
1997         PUSHJ   PP,INSERT       ;INSERT/UPDATE IT\r
1998         MOVSI   ARG,PNTF\r
1999         IORM    ARG,0(SX)\r
2000         MOVE    ARG,-1(SX)      ;GET THE SIXBIT FOR THE NAME\r
2001         MOVEM   ARG,1(V)        ;AND STORE IT FOR ADDITIVE GLOBAL FIXUPS\r
2002 EXTER3: JUMPCM  EXTER0\r
2003         POPJ    PP,             ;NO EXIT\r
2004 \fEVAL10:        PUSH    PP,RX\r
2005         HRRI    RX,^D10\r
2006         PUSHJ   PP,EVALEX       ;EVALUATE\r
2007         POP     PP,RX           ;RESET RADIX\r
2008         JUMPE   RC,POPOUT       ;EXIT IF ABSOLUTE\r
2009 \r
2010 QEXT:   SKIPE   EXTPNT          ;ANY POSSIBILITIES?\r
2011         TROA    ER,ERRE         ;YES, FLAG EXTERNAL ERROR\r
2012         TRO     ER,ERRR         ;NO, FLAG RELOCATION ERROR\r
2013         HLLZS   RC              ;CLEAR RELOCATION/EXTERNAL\r
2014         POPJ    PP,\r
2015 \r
2016 EVALXQ: PUSHJ   PP,EVALEX       ;EVALUTE EXPRESSION\r
2017         TLZN    RC,-2           ;WAS AN EXTERNAL FOUND?\r
2018         TRZE    RC,-2\r
2019         TRO     ER,ERRE         ;YES, FLAG ERROR\r
2020         POPJ    PP,             ;RETURN\r
2021 \fOPDEF0:        PUSHJ   PP,GETSYM               ;GET THE FIRST SYMBOL\r
2022         POPJ    PP,             ;ERROR IF INVALID SYMBOL\r
2023         CAIE    C,73            ;"["?\r
2024         JRST    ERRAX           ;NO, ERROR\r
2025         PUSH    PP,AC0          ;STACK MNEMONIC\r
2026         AOS     LITLVL          ;SHORT OUT LOCATION INCREMENT\r
2027         PUSHJ   PP,STMNT        ;EVALUATE STATEMENT\r
2028         PUSHJ   PP,DSTOW        ;GET AND DECODE VALUE\r
2029         SOS     LITLVL\r
2030         EXCH    AC0,0(PP)       ;EXCHANGE VALUE FOR MNEMONIC\r
2031         PUSH    PP,RC           ;STACK RELOCATION\r
2032         TLO     IO,DEFCRS       ;SAY WE ARE DEFINING IT\r
2033         PUSHJ   PP,MSRCH        ;SEARCH SYMBOL TABLE\r
2034         MOVSI   ARG,OPDF        ;NOT FOUND\r
2035         POP     PP,RC           ;RESTORE VALUES\r
2036         POP     PP,V\r
2037         TLNE    ARG,SYNF!MACF\r
2038         JRST    ERRAX           ;YES "A" ERROR\r
2039         PUSHJ   PP,INSERT       ;NO, INSERT/UPDATE\r
2040         TLZ     IO,DEFCRS       ;JUST IN CASE\r
2041         PUSHJ   PP,BYPAS1\r
2042         JRST    STOWI           ;BE SURE STOW IS RESET\r
2043 \r
2044 \r
2045 DEPHA0: MOVE    AC0,LOCO\r
2046         SKIPA   RC,MODO         ;SET TO OUTPUT VALUES AND SKIP\r
2047 PHASE0: PUSHJ   PP,EVALXQ       ;EVALUATE AND CHECK FOR EXTERNAL\r
2048         MOVEM   AC0,LOCA        ;SET ASSEMBLY LOCATION COUNTER\r
2049         MOVEM   RC,MODA\r
2050         JRST    BLOCK2\r
2051 \fASSIGN:        JUMPAD  ERRAX           ;NO, ERROR\r
2052         PUSHJ   PP,ASSIG1\r
2053         HRROM   RC,ASGBLK\r
2054         MOVEM   V,LOCBLK\r
2055         POPJ    PP,\r
2056 \r
2057 ASSIG1: PUSH    PP,AC0\r
2058         MOVEI   AC0,0\r
2059         PUSHJ   PP,GETCHR\r
2060         CAIN    C,35            ;EQUALS?\r
2061         TLOA    AC0,NOOUTF      ;YES, NOT OUT TO DDT WFW\r
2062         TLO     IO,IORPTC\r
2063         MOVEM   AC0,HDAS        ;STORE THESE BITS WFW\r
2064         SETZM   EXTPNT\r
2065         PUSHJ   PP,EVALEX       ;EVALUATE EXPRESSION\r
2066         EXCH    AC0,0(PP)       ;SWAP VALUE FOR SYMBOL\r
2067         PUSH    PP,RC\r
2068         TRNN    RC,-2           ;CHECK EXTERNAL AGREEMENT\r
2069         JRST    ASSIG2\r
2070         HRRZS   RC\r
2071         HRRZ    ARG,EXTPNT\r
2072         CAME    RC,ARG\r
2073         JRST    ASSIG4\r
2074 ASSIG2: HLRZ    RC,0(PP)\r
2075         TRNN    RC,-2\r
2076         JRST    ASSIG3\r
2077         HLRZ    ARG,EXTPNT\r
2078         CAME    RC,ARG\r
2079         JRST    ASSIG4\r
2080 ASSIG3: TLO     IO,DEFCRS\r
2081         PUSHJ   PP,SSRCH\r
2082         MOVSI   ARG,400000\r
2083         IOR     ARG,HDAS\r
2084         TLZA    ARG,UNDF!VARF!40        ;CANCEL UNDEFINED AND VARIABLE FLAGS\r
2085 ASSIG4: TRO     ER,ERRE\r
2086         SETZM   EXTPNT          ;FOR REST OF WORLD\r
2087         TRNE    ER,ERRORS-ERRQ\r
2088         TLO     ARG,UNDF        ;YES,SO TURN UNDF ON\r
2089         POP     PP,RC\r
2090         POP     PP,V\r
2091         TLNE    ARG,TAGF!EXTF\r
2092         JRST    ERRAX\r
2093         JRST    INSERT\r
2094 \fLOC0: PUSHJ    PP,HIGHQ        ;AC0=0,0\r
2095         HRR     AC0,LOCO\r
2096         EXCH    AC0,RELLOC\r
2097         PUSHJ   PP,BYPAS1\r
2098         TLO     IO,IORPTC\r
2099         CAIE    C,EOL\r
2100         PUSHJ   PP,EVALXQ\r
2101         HLL     AC0,RELLOC\r
2102         HRRZM   AC0,LOCA        ;SET ASSEMBLY LOCATION\r
2103         HRRZM   AC0,LOCO        ;AND OUTPUT LOCATION\r
2104         HLRZM   AC0,MODA        ;SET MODE\r
2105         HLRZM   AC0,MODO\r
2106         JRST    BLOCK2\r
2107 \f\r
2108 IFN RENTSW,<\r
2109 HISEG0: PUSHJ   PP,HIGHQ        ;SET CURRENT PROGRAM BREAK\r
2110         PUSHJ   PP,COUTD        ;DUMP CURRENT TYPE OF BLOCK\r
2111         PUSH    PP,BLKTYP\r
2112         MOVEI   AC0,3\r
2113         MOVEM   AC0,BLKTYP\r
2114         PUSHJ   PP,BYPAS1       ;GO GET EXPRESSION\r
2115         TLO     IO,IORPTC\r
2116         PUSHJ   PP,EVALXQ       ;CHECK FOR EXTERNAL\r
2117         HRRZM   AC0,LOCA        ;SET LOC COUNTERS\r
2118         HRRZM   AC0,LOCO\r
2119         MOVEI   RC,1            ;ASSUME RELOCATABLE\r
2120         PUSHJ   PP,COUT\r
2121         MOVEM   RC,MODA         ;SET MODES\r
2122         MOVEM   RC,MODO\r
2123         PUSHJ   PP,COUTD\r
2124         POP     PP,BLKTYP\r
2125         JRST    BLOCK2\r
2126 \fHIGHQ: JUMP1   POPOUT\r
2127 HIGHQ1: SKIPN   MODO\r
2128         POPJ    PP,\r
2129         MOVE    V,LOCO          ;GET ASSEMBLY LOCATION\r
2130         CAMLE   V,HHIGH         ;IS IT GREATER THAN "HIGH"?\r
2131         MOVEM   V,HHIGH         ;YES, REPLACE WITH LARGER VALUE\r
2132         POPJ    PP,>\r
2133 IFE RENTSW,<\r
2134 HIGHQ:  JUMP1   POPOUT\r
2135 HIGHQ1: MOVE    V,LOCO\r
2136         POPJ    PP,\r
2137 >\r
2138 ONML:   TLOA    FR,MWLFLG       ;MULTI-WORD LITERALS OK\r
2139 OFFML:  TLZ     FR,MWLFLG\r
2140         POPJ    PP,\r
2141 SUPRE0: PUSHJ PP,GETSYM         ;GET A SYMBOL TO SUPRES\r
2142         JRST SUPRE1             ;ERROR\r
2143         PUSHJ PP,SSRCH          ;SYMBOL ONLY\r
2144         JRST SUPRE1             ;GIVE ERROR MESSAGE\r
2145         TLOA ARG,SUPRBT         ;SET THE SUPRESS BIT\r
2146 SUPRE1: TROA ER,ERRA\r
2147         IORM ARG,(SX)           ;PUT BACK\r
2148         JUMPCM SUPRE0\r
2149 SUPRS1: SETZM EXTPNT\r
2150         POPJ PP,\r
2151 \r
2152 SUPRSA: PUSHJ PP,LOOKUP         ;SUPRESS ALL\r
2153         MOVSI ARG,SUPRBT\r
2154         IORM ARG,(SX)\r
2155         SETZM EXTPNT            ;JUST IN CASE\r
2156         POPJ PP,\r
2157 \r
2158 \fTITLE0:        JUMP2 REMAR0\r
2159         MOVEI SX,.TBUF-1\r
2160         HRRI AC0,TBUF\r
2161         PUSHJ PP,SUBTT1         ;GO READ IT\r
2162         TLOE IO,IOTLSN          ;HAVE WE SEEN ONE\r
2163 IFE CCLSW,<TRO  ER,ERRM         ;YES, COMPLAIN>\r
2164 IFN CCLSW,<TROA ER,ERRM         ;YES, MESSAGE\r
2165         JRST PRNAM              ;PRINT NAME IF FIRST ONE>\r
2166         POPJ PP,                ;EXIT OTHERWISE\r
2167 \r
2168 SUBTT0: JUMP1 REMAR0            ;OTHERWISE EXIT IF PASS ONE\r
2169         MOVEI SX,.SBUF-1\r
2170         HRRI SBUF\r
2171 SUBTT1: PUSHJ PP,BYPAS1         ;BYPASS LEADING BLANKS\r
2172         TLO IO,IORPTC\r
2173 SUBTT3: PUSHJ PP,CHARAC         ;GET ASCII CHARACTER\r
2174         IDPB C,AC0              ;STORE IN BLOCK\r
2175         CAIGE C,40              ;TEST FOR TERMINATOR\r
2176         CAIN C,HT\r
2177         SOJGE SX,SUBTT3         ;TEST FOR BUFFER FULL\r
2178         DPB RC,AC0              ;END, STORE TERMINATOR\r
2179         POPJ PP,\r
2180 IFN CCLSW,<\r
2181 PRNAM:  TLNN IO,CRPGSW          ;NOT IF NOT RPG\r
2182         POPJ PP,\r
2183         MOVE AC0,[POINT 7,TBUF]\r
2184         MOVE SX,[POINT 7,OTBUF]\r
2185         MOVEI RC,6              ;MAX OF SIX CHRS\r
2186 PN1:    ILDB C,AC0\r
2187         CAILE C," "             ;CHECK FOR LEGAL\r
2188         CAILE C,"Z"+40          ;CHECK AGAINST LOWER CASE Z\r
2189         JRST PN2\r
2190         IDPB C,SX               ;PUT IN OUTPUT BUFFER\r
2191         SOJG RC,PN1             ;GET MORE\r
2192 PN2:    MOVEI C,0\r
2193         IDPB C,SX               ;TERMINATOR\r
2194         MOVEI C,OTBUF\r
2195         DDTOUT C,\r
2196         MOVEI C,[ASCIZ /\r
2197 /]\r
2198         DDTOUT C,\r
2199         POPJ PP,\r
2200 >\r
2201 \fSYN0:  PUSHJ   PP,GETSYM       ;GET THE FIRST SYMBOL\r
2202         JRST    ERRAX           ;ERROR, EXIT\r
2203         PUSHJ   PP,MSRCH        ;TRY FOR MACRO/OPDEF\r
2204         JRST    SYN3            ;NO,0THRY FOR OPERAND\r
2205 SYN1:   MOVEI   SX,MSRCH        ;YES, SET FLAG\r
2206 SYN2:   PUSHJ   PP,SAVEXS       ;SAVE REGISTERS\r
2207         JUMPNC  ERRAX           ;ERROR IF NO COMMA\r
2208         PUSHJ   PP,GETSYM       ;GET THE SECOND SYMBOL\r
2209         POPJ    PP,\r
2210         PUSHJ   PP,@SAVBLK+SX   ;SEARCH FOR SECOND SYMBOL\r
2211         JFCL\r
2212         MOVE    ARG,SAVBLK+ARG  ;GET VALUES\r
2213         MOVE    RC,SAVERC\r
2214         MOVE    V,SAVBLK+V\r
2215         TLNE    ARG,MACF        ;MACRO?\r
2216         PUSHJ   PP,REFINC       ;YES, INCREMENT REFERENCE\r
2217         JRST    INSERT          ;INSERT AND EXIT\r
2218 \r
2219 SYN3:   PUSHJ   PP,SSRCH        ;SEARCH FOR OPERAND\r
2220         JRST    SYN4            ;NOT FOUND, EXIT WITH ERROR\r
2221         TLO     ARG,SYNF        ;FLAG AS SYNONYM\r
2222         TLNE    ARG,EXTF        ;EXTERNAL?\r
2223         HRRZ    V,ARG           ;YES, RELPACE WITH POINTER\r
2224         MOVEI   SX,SSRCH        ;SET FLAG\r
2225         JRST    SYN2\r
2226 \r
2227 SYN4:   PUSHJ   PP,OPTSCH       ;SEARCH FOR OP-CODE\r
2228         JRST    ERRAX           ;NOT FOUND, EXIT WITH ERROR\r
2229         MOVSI   ARG,SYNF        ;FLAG AS SYNONYM\r
2230         JRST    SYN1\r
2231 \fPURGE0:        PUSHJ   PP,GETSYM       ;GET A MNEMONIC\r
2232         JRST    PURGE5\r
2233         PUSHJ   PP,MSRCH        ;SEARCH MACRO SYMBOL TABLE\r
2234         JRST    PURGE2          ;NOT FOUND, TRY SYMBOLS\r
2235         TLNE    ARG,MACF        ;MACRO?\r
2236         PUSHJ   PP,REFDEC       ;YES, DECREMENT THE REFERENCE\r
2237         JRST    PURGE4          ;REMOVE SYMBOL FROM TABLE\r
2238 \r
2239 PURGE2: PUSHJ   PP,SSRCH        ;TRY OPERAND SYMBOL TABLE\r
2240         JRST    PURGE3          ;NOT FOUND GET NEXT SYMBOL\r
2241         TRNN    RC,-2           ;CHECK COMPLEX EXTERNAL\r
2242         TLNE    RC,-2\r
2243         TLNE    ARG,SYNF\r
2244         SKIPA\r
2245         JRST    PURGE3\r
2246         TLNE    ARG,EXTF!UNDF   ;ERROR IF EXTERNAL OR UNDEFINED\r
2247         TLNE    ARG,SYNF        ;BUT NOT A SYNONYM      \r
2248         JRST    PURGE4\r
2249 PURGE3: TROA    ER,ERRA         ;NOT FOUND, ERROR\r
2250 PURGE4: PUSHJ   PP,REMOVE       ;REMOVE FROM THE SYMBOL TABLE\r
2251 PURGE5: JUMPCM  PURGE0\r
2252         POPJ    PP,             ;EXIT\r
2253 \fOPD1:  MOVE    AC0,V           ;PUT VALUE IN AC0\r
2254 OP:\r
2255 OPD:    SKIPA   2,[POINT 4,0(PP),12]\r
2256 IOP:    MOVSI   AC2,(POINT 9,0(PP),11)\r
2257         PUSH    PP,RC\r
2258         PUSH    PP,AC0          ;STACK CODE\r
2259         PUSH    PP,AC2\r
2260         PUSHJ   PP,EVALEX       ;EVALUATE FIRST EXPRESSION\r
2261         POP     PP,AC2\r
2262         JUMPNC  OP2\r
2263         LDB     AC1,AC2\r
2264         ADD     AC1,AC0\r
2265         DPB     AC1,AC2\r
2266         SKIPE   RC              ;EXTERNAL OR RELOCATABLE?\r
2267         PUSHJ   PP,QEXT         ;YES, DETERMINE WHICH AND FLAG AN ERROR\r
2268 OP1A:   PUSHJ   PP,EVALEX       ;GET ADDRESS PART\r
2269 OP2:    PUSHJ   PP,EVADR        ;EVALUATE STANDARD ADDRESS\r
2270 OP3:    POP     PP,AC0          ;PUT IN AC0\r
2271         POP     PP,RC\r
2272         JRST    STOW            ;NO,STOW CODE AND EXIT\r
2273 \fEVADR: TLCE    AC0,-1          ;OK IF ALL 0'S\r
2274         TLNN    AC0,-1\r
2275         SKIPA\r
2276         TRO     ER,ERRQ         ;NO,FLAG Q ERROR\r
2277         ADD     AC0,-1(PP)      ;ADD ADDRESS PORTIONS\r
2278         HLL     AC0,-1(PP)      ;GET LEFT HALF\r
2279         TLZE    FR,INDSW        ;INDIRECT BIT?\r
2280         TLO     AC0,20\r
2281         MOVEM   AC0,-1(PP)      ;RE-STACK CODE\r
2282         ADD     RC,-2(PP)       ;UPDATE RELOCATION\r
2283         HRRM    RC,-2(PP)       ;USE HALF WORD ADD\r
2284         CAIE    C,10            ;"("?\r
2285         POPJ    PP,             ;NO, EXIT\r
2286         MOVSS   EXTPNT          ;WFW\r
2287         PUSHJ   PP,EVALEX               ;EVALUATE\r
2288         MOVSS   EXTPNT          ;WFW\r
2289         MOVSS   V,AC0           ;SWAP HALVES\r
2290         MOVSS   SX,RC\r
2291         IOR     SX,V            ;MERGE RELOCATION\r
2292         TRNN    SX,-1           ;RIGHT HALF ZERO?\r
2293         JRST    OP2A            ;YES, DO SIMPLE ADD\r
2294         MOVE    ARG,RC          ;NO, SWAP RC INTO ARG\r
2295         ADD     V,-1(PP)        ;ADD RIGHT HALVES\r
2296         ADD     ARG,-2(PP)\r
2297         HRRM    V,-1(PP)        ;UPDATE WITHOUT CARRY\r
2298         HRRM    ARG,-2(PP)\r
2299         HLLZS   AC0             ;PREPARE LEFT HALVES\r
2300         HLLZS   RC\r
2301         TLNE    SX,-1           ;IS LEFT HALF ZERO?\r
2302         TRO     ER,ERRQ         ;NO FLAG FORMAT ERROR\r
2303 OP2A:   ADDM    AC0,-1(PP)      ;MERGE WITH PREVIOUS VALUE\r
2304         ADDM    RC,-2(PP)\r
2305         CAIE    C,11            ;")"?\r
2306         JRST    ERRAX           ;NO, FLAG ERROR\r
2307         JRST    BYPAS1          ;YES, BYPASS PARENTHESIS\r
2308 \r
2309 EXPRES: HRLZ    AC0,RX          ;FUDGE FOR OCT0\r
2310 \r
2311 OCT0:   PUSH    PP,RX\r
2312         HLR     RX,AC0\r
2313 OCT1:   PUSHJ   PP,EVALEX       ;EVALUATE\r
2314         PUSHJ   PP,STOW         ;STOW CODE\r
2315         JUMPCM  OCT1\r
2316         POP     PP,RX           ;YES, RESTORE RADIX\r
2317         POPJ    PP,             ;EXIT\r
2318 \fSIXB10:        MOVSI   RC,(POINT 6,AC0);SET UP POINTER\r
2319         MOVEI   AC0,0           ;CLEAR WORD\r
2320 \r
2321 SIXB20: PUSHJ   PP,CHARL        ;GET NEXT CHARACTER\r
2322         CAMN    C,SX            ;IS THIS PRESET DELIMITER?\r
2323         JRST    ASC60           ;YES\r
2324         CAIL    C,"A"+40\r
2325         CAILE   C,"Z"+40\r
2326         SKIPA   \r
2327         SUBI    C,40            ;CONVERT LOWER CASE TO SIXBIT\r
2328         SUBI    C,40            ;CONVERT TO SIXBIT\r
2329         JUMPL   C,ASC55         ;TEST FOR INVALID CHARACTER\r
2330         IDPB    C,RC            ;NO, DEPOSIT THE BYTE\r
2331         TLNE    RC,770000       ;IS THE WORD FULL?\r
2332         JRST    SIXB20          ;NO, GET NEXT CHARACTER\r
2333         PUSHJ   PP,STOWZ        ;YES, STORE\r
2334         JRST    SIXB10          ;GET NEXT WORD\r
2335 \fASCII0:        HLLZ    SDEL,AC0        ;STORE ASCII/ASCIZ FLAG\r
2336 ASC10:  PUSHJ   PP,CHARL        ;GET FIRST NON-BLANK\r
2337         CAIE    C," "\r
2338         CAIN    C,HT\r
2339         JRST    ASC10\r
2340         CAIG    C,CR            ;CHECK FOR CRRET AS DELIM\r
2341         CAIGE   C,LF\r
2342         SKIPA\r
2343         JRST    ERRAX\r
2344         MOVE    SX,SEQNO2\r
2345         MOVEM   SX,TXTSEQ\r
2346         MOVE    SX,PAGENO\r
2347         MOVEM   SX,TXTPG\r
2348         SETOM   INTXT\r
2349         MOVE    SX,C            ;SAVE FOR COMPARISON\r
2350         JUMPG   SDEL,SIXB10     ;BRANCH IF SIXBIT\r
2351 \r
2352 ASC20:  MOVSI   RC,(POINT 7,AC0)        ;SET UP POINTER\r
2353         MOVEI   AC0,0           ;CLEAR WORD\r
2354 ASC30:  PUSHJ   PP,CHARL        ;GET ASCII CHARACTER AND LIST\r
2355         CAMN    C,SX            ;TEST FOR DELIMITER\r
2356         JRST    ASC50           ;FOUND\r
2357         IDPB    C,RC            ;DEPOSIT BYTE\r
2358         TLNE    RC,760000       ;HAVE WE FINISHED WORD?\r
2359         JRST    ASC30           ;NO,GET NEXT CHARACTER\r
2360         PUSHJ   PP,STOWZ        ;YES, STOW IT\r
2361         JRST    ASC20           ;GET NEXT WORD\r
2362 \r
2363 ASC50:  TDZA    RC,SDEL         ;TEST FOR ASCIIZ\r
2364 ASC55:  TROA    ER,ERRA         ;SIXBIT FOUND EXIT\r
2365 ASC60:  PUSHJ   PP,BYPAS1       ;POLISH OFF TERMINATE\r
2366         SETZM   INTXT           ;WE ARE OUT OF IT\r
2367         ANDCM   RC,STPX         ;STORE AT LEAST ONE WORD\r
2368         JUMPGE  RC,STOWZ        ;STOW\r
2369         POPJ    PP,             ;ASCII, NO BYTES STORED, SO EXIT\r
2370 \fPOINT0:        PUSH    PP,RC           ;STACK REGISTERS\r
2371         PUSH    PP,AC0\r
2372         PUSHJ   PP,EVAL10       ;EVALUATE RADIX 10\r
2373         DPB     AC0,[POINT 6,0(PP),11]  ;STORE BYTE SIZE\r
2374         JUMPNC  POINT2\r
2375         PUSHJ   PP,EVALEX       ;NO, GET ADDRESS\r
2376         PUSHJ   PP,EVADR        ;EVALUATE STANDARD ADDRESS\r
2377         JUMPNC  POINT2\r
2378         PUSHJ   PP,EVAL10       ;EVALUATE RADIX 10\r
2379         TLNE    IO,NUMSW        ;IF NUMERIC\r
2380         TDCA    AC0,[-1]        ;POSITION=D35-RHB\r
2381 POINT2: MOVEI   AC0,0           ;OTHERWISE SET TO D36\r
2382         ADDI    AC0,^D36\r
2383         LSH     AC0,^D30\r
2384         ADDM    AC0,0(PP)       ;UPDATE VALUE\r
2385         JRST    OP3\r
2386 \fXWD0:  PUSH    PP,RC\r
2387         PUSH    PP,AC0          ;STORE ZERO ON STACK\r
2388         PUSHJ   PP,EVALEX       ;EVALUATE EXPRESSION\r
2389         JUMPNC  OP2\r
2390         HRLM    AC0,0(PP)       ;SET LEFT HALF\r
2391         HRLM    RC,-1(PP)\r
2392         MOVSS   EXTPNT          ;WFW\r
2393         JRST    OP1A            ;EXIT THROUGH OP\r
2394 \r
2395 IOWD0:  PUSHJ   PP,EVALXQ       ;EVALUATE AND TEST FOR EXTERNAL\r
2396         CAIE    C,14            ;","?\r
2397         SOJA    AC0,STOW        ;NO, TREAT AS RIGHT HALF\r
2398         PUSH    PP,AC0          ;YES, STACK LEFT HALF\r
2399         PUSHJ   PP,EVALEX       ;WFW\r
2400         SUBI    AC0,1\r
2401         POP     PP,AC1          ;RETRIEVE LEFT HALF\r
2402         MOVNS   AC1\r
2403         HRL     AC0,AC1\r
2404         JRST    STOW            ;STOW CODE AND EXIT\r
2405 \fBYTE0: PUSHJ   PP,BYPAS1       ;GET FIRST NON-BLANK\r
2406         CAIE    C,10            ;"("?\r
2407         JRST    ERRAX           ;NO, FLAG ERROR AND EXIT\r
2408         PUSH    PP,RC\r
2409         PUSH    PP,AC0          ;INITIALIZE STACK TO ZERO\r
2410         MOVSI   ARG,(POINT -1,(PP))\r
2411 \r
2412 BYTE1:  PUSH    PP,ARG\r
2413         PUSHJ   PP,EVAL10       ;EVALUATE RADIX 10\r
2414         POP     PP,ARG\r
2415         CAIG    AC0,^D36        ;TEST SIZE\r
2416         CAIGE   AC0,0\r
2417         TRO     ER,ERRA\r
2418         DPB     AC0,[POINT 6,ARG,11]    ;STORE BYTE SIZE\r
2419 \r
2420 BYTE2:  IBP     ARG             ;INCREMENT BYTE\r
2421         TRZN    ARG,-1          ;OVERFLOW?\r
2422         JRST    BYTE3           ;NO\r
2423         SETZB   AC0,RC          ;YES\r
2424         EXCH    AC0,0(PP)       ;GET CURRENT VALUES\r
2425         EXCH    RC,-1(PP)       ;AND STACK ZEROS\r
2426         PUSHJ   PP,STOW         ;STOW FULL WORD\r
2427 \r
2428 BYTE3:  PUSH    PP,ARG\r
2429         PUSHJ   PP,EVALEX       ;COMPUTE NEXT BYTE\r
2430         POP     PP,ARG\r
2431         DPB     AC0,ARG         ;STORE BYTE\r
2432         HLLO    AC0,ARG\r
2433         DPB     RC,AC0\r
2434 \r
2435         JUMPCM  BYTE2\r
2436         CAIN    C,10            ;"("?\r
2437         JRST    BYTE1           ;YES, GET NEW BYTE SIZE\r
2438         JRST    OP3             ;NO, EXIT\r
2439 \fRADX50:        PUSHJ   PP,EVALEX       ;EVALUATE CODE\r
2440         JUMPN   RC,ERRAX        ;ERROR IF NOT ABSOLUTE\r
2441         MOVE    ARG,AC0\r
2442         JUMPNC  ERRAX\r
2443         PUSHJ   PP,GETSYM       ;YET, GET SYMBOL\r
2444         POPJ    PP,\r
2445         PUSHJ   PP,SQOZE        ;SQUOZE SIXBIT AND ADD CODE\r
2446         JRST    STOW            ;STOW CODE AND EXIT\r
2447 \r
2448 \r
2449 SQOZE:  MOVE    AC1+1,AC0       ;PUT SIXBIT IN AC1+1\r
2450         MOVEI   AC0,0           ;CLEAR RESULT\r
2451 SQOZ1:  MOVEI   AC1,0\r
2452         LSHC    AC1,6           ;PUT 6-BIT CHARACTER IN AC1\r
2453         LDB     AC1,[POINT 6,CSTAT(AC1),23]     ;CONVERT TO RADIX50\r
2454         IMULI   AC0,50          ;MULTIPLY PREVIOUS RESULT\r
2455         ADD     AC0,AC1         ;ADD NEW CHARACTER\r
2456         JUMPN   AC1+1,SQOZ1     ;TEST FOR END\r
2457         LSH     ARG,^D30        ;LEFT-JUSTIFY CODE\r
2458         IOR     AC0,ARG         ;MERGE WITH RESULT\r
2459         POPJ    PP,\r
2460 \fSUBTTL MACRO/REPEAT HANDLERS\r
2461 \r
2462 REPEA0: PUSHJ   PP,EVALXQ               ;EVALUATE REPEAT EXP, EXTERNS ARE ILL\r
2463         JUMPNC  ERRAX\r
2464 \r
2465 REPEA1: JUMPLE  AC0,REPZ        ;PASS THE EXP., DONT PROCESS\r
2466         SOJE    AC0,REPO        ;REPEAT ONCE\r
2467 REPEA2: PUSHJ   PP,GCHARQ       ;GET STARTING "<"\r
2468         CAIE    C,"<"\r
2469         JRST    REPEA2\r
2470         PUSHJ   PP,SKELI1       ;INITIALZE SKELETON\r
2471         PUSH    MP,REPEXP\r
2472         MOVEM   AC0,REPEXP\r
2473         PUSH    MP,REPPNT       ;STACK PREVIOUS REPEAT POINTER\r
2474         MOVEM   ARG,REPPNT      ;STORE NEW POINTER\r
2475         TDZA    SDEL,SDEL       ;YES, INITIALIZE BRACKET COUNT AND SKIP\r
2476 \r
2477 REPEA4: PUSHJ   PP,WCHARQ       ;WRITE A CHARACTER\r
2478         PUSHJ   PP,GCHARQ       ;GET A CHARACTER\r
2479         CAIN    C,"<"           ;"<"?\r
2480         AOJA    SDEL,REPEA4     ;YES, INCREMENT AND WRITE\r
2481         CAIE    C,">"           ;">"?\r
2482         JRST    REPEA4          ;NO, WRITE THE CHARACTER\r
2483         SOJGE   SDEL,REPEA4     ;YES, WRITE IF NON-NEGATIVE COUNT\r
2484         MOVSI   CS,(BYTE (7) 177,3)     ;SET "REPEAT" END\r
2485         PUSHJ   PP,WWRXE                ;WRITE END\r
2486         PUSH    MP,MRP          ;STACK PREVIOUS READ POINTER\r
2487 REPEA5: HLRZ    MRP,@REPPNT\r
2488 REPEA8: MOVEI   C,LF\r
2489         JRST    RSW1\r
2490 \r
2491 REPEND: SOSL    REPEXP\r
2492         JRST    REPEA5\r
2493         HRRZ    V,REPPNT        ;GET START OF TREE\r
2494         PUSHJ   PP,REFDEC       ;DECREMENT REFERENCE\r
2495         POP     MP,MRP\r
2496         POP     MP,REPPNT\r
2497         POP     MP,REPEXP\r
2498         JRST    RSW0\r
2499 \fREPZ:  MOVE    SDEL,SEQNO2\r
2500         MOVEM   SDEL,REPSEQ\r
2501         MOVE    SDEL,PAGENO\r
2502         MOVEM   SDEL,REPPG\r
2503         SETOM INREP\r
2504         MOVEI SDEL,0    ;SET COUNT\r
2505 REPZ1:  PUSHJ   PP,GCHAR        ;GET NEXT CHARACTER\r
2506         CAIN    C,"<"           ;"<"?\r
2507         AOJA    SDEL,REPZ1      ;YES, INCREMENT COUNT\r
2508         CAIN    C,">"           ;">"?\r
2509         SOJLE   SDEL,REPZ2      ;YES, EXIT IF MATCHING\r
2510         JRST    REPZ1           ;NO, RECYCLE\r
2511 REPZ2:  SETZM   INREP\r
2512         JRST    GETCHR\r
2513 \r
2514 REPO:   PUSHJ   PP,GCHAR        ;GET "<"\r
2515         CAIE    C,"<"\r
2516         JRST    REPO\r
2517         SKIPE   RPOLVL          ;ARE WE NESTED?\r
2518         AOS     RPOLVL          ;YES, DECREMENT CURRENT\r
2519         PUSH    MP,RPOLVL\r
2520         SETOM   RPOLVL\r
2521         JRST    STMNT\r
2522 \r
2523 REPO1:  CAIN    C,"<"\r
2524         SOS     RPOLVL\r
2525         CAIN    C,">"\r
2526         AOSE    RPOLVL\r
2527         JRST    RSW2\r
2528         POP     MP,RPOLVL\r
2529         PUSHJ   PP,RSW2\r
2530         JRST    RSW0\r
2531 \fDEFIN0:        PUSHJ   PP,GETSYM               ;GET MACRO NAME\r
2532         JRST    ERRAX           ;EXIT ON ERROR\r
2533         MOVEM   PP,PPTMP1       ;SAVE POINTER\r
2534         MOVEM   AC0,PPTMP2      ;SAVE NAME\r
2535         TLO     IO,IORPTC\r
2536         MOVE    SX,SEQNO2\r
2537         MOVEM   SX,DEFSEQ\r
2538         MOVE    SX,PAGENO\r
2539         MOVEM   SX,DEFPG\r
2540         SETOM INDEF\r
2541         MOVEI   SX,0\r
2542 DEF02:  PUSHJ   PP,GCHAR\r
2543         CAIN    C,74\r
2544         JRST    DEF20\r
2545         CAIE    C,50\r
2546         JRST    DEF02\r
2547 DEF10:  PUSHJ   PP,GETSYM               ;YES, GET DUMMY SYMBOL\r
2548         TRO     ER,ERRA         ;FLAG ERROR\r
2549         ADDI    SX,1000         ;INCREMENT ARG COUNT\r
2550         PUSH    PP,AC0          ;STACK IT\r
2551         CAIE    C,11            ;")"?\r
2552         JRST    DEF10           ;NO, GET NEXT DUMMY SYMBOL\r
2553 DEF12:  PUSHJ   PP,GCHAR\r
2554         CAIE    C,"<"           ;"<"?\r
2555         JRST    DEF12           ;NO\r
2556 DEF20:  PUSH    PP,[0]          ;YES, MARK THE LIST\r
2557         AOS     ARG,SX\r
2558         PUSHJ   PP,SKELI        ;INITIALIZE MACRO SKELETON\r
2559         MOVE    AC0,PPTMP2      ;GET NAME\r
2560         MOVEM   PP,PPTMP2\r
2561         TLO     IO,DEFCRS\r
2562         PUSHJ   PP,MSRCH        ;SEARCH THE TABLE\r
2563         JRST    DEF24           ;NOT FOUND\r
2564         TLNN    ARG,MACF        ;FOUND, IS IT A MACRO?\r
2565         TROA    ER,ERRX         ;NO, FLAG ERROR AND SKIP\r
2566         PUSHJ   PP,REFDEC       ;YES, DECREMENT THE REFERENCE\r
2567 DEF24:  HRRZ    V,WWRXX         ;GET START OF TREE\r
2568         MOVSI   ARG,MACF\r
2569         PUSHJ   PP,INSERT       ;INSERT/UPDATE\r
2570         TLZ     IO,DEFCRS       ;JUST IN CASE\r
2571         TDZA    SDEL,SDEL       ;CLEAR BRACKET COUNT\r
2572 \fDEF30: PUSHJ   PP,WCHAR        ;WRITE CHARACTER\r
2573 DEF31:  PUSHJ   PP,GCHAR        ;GET A CHARACTER\r
2574 DEF32:  MOVE    CS,C            ;GET A COPY\r
2575         CAIG    CS,"Z"+40       ;CONVERT LOWER CASE\r
2576         CAIGE   CS,"A"+40\r
2577         SKIPA   \r
2578         SUBI    CS,40\r
2579         CAIL    CS,40\r
2580         CAILE   CS,77+40\r
2581         JRST    DEF30           ;TEST FOR SPECIAL\r
2582         MOVE    CS,CSTAT-40(CS) ;GET STATUS BITS\r
2583         TLNE    CS,6            ;ALPHA-NUMERIC?\r
2584         JRST    DEF40           ;YES\r
2585         CAIN    C,74\r
2586         AOJA    SDEL,DEF30\r
2587         CAIN    C,76\r
2588         SOJL    SDEL,DEF70\r
2589         CAIE    C,47            ;IS THIS A '?\r
2590         JRST    DEF30\r
2591         SKIPE   SDEL\r
2592 CPEEK1: PUSHJ   PP,WCHAR\r
2593         PUSHJ   PP,GCHAR\r
2594         CAIE    C,47\r
2595         JRST    DEF32\r
2596         JRST    CPEEK1\r
2597 \fDEF40: MOVEI   AC0,0           ;CLEAR ATOM\r
2598         MOVSI   AC1,(POINT 6,AC0)       ;SET POINTER\r
2599 DEF42:  PUSH    PP,C\r
2600         TLNE    AC1,770000\r
2601         IDPB    CS,1\r
2602         PUSHJ   PP,GCHAR        ;GET NEXT CHARACTER\r
2603         MOVE    CS,C\r
2604         CAIG    CS,"Z"+40\r
2605         CAIGE   CS,"A"+40\r
2606         SKIPA   \r
2607         SUBI    CS,40           ;CONVERT LOWER TO UPPER\r
2608         CAIL    CS,40\r
2609         CAILE   CS,77+40\r
2610         JRST    DEF44           ;TEST SPECIAL\r
2611         MOVE    CS,CSTAT-40(CS) ;GET STATUS\r
2612         TLNE    CS,6            ;ALPHA-NUMERIC?\r
2613         JRST    DEF42           ;YES, GET ANOTHER\r
2614 DEF44:  PUSH    PP,[0]          ;NO, MARK THE LIST\r
2615         MOVE    SX,PPTMP1       ;GET POINTER TO TP\r
2616 \r
2617 DEF46:  SKIPN   1(SX)           ;END OF LIST?\r
2618         JRST    DEF51           ;YES\r
2619         CAME    AC0,1(SX)       ;NO, DO THEY COMPARE\r
2620         AOJA    SX,DEF46        ;NO, TRY AGAIN\r
2621         SUB     SX,PPTMP1       ;YES, GET DUMMY SYMBOL NUMBER\r
2622         LSH     SX,4\r
2623         MOVSI   CS,0776020(SX)  ;(<BYTE (7) 177,101>)(SX) ;SET ESCAPE CODE MACEND\r
2624         LSH     AC0,-^D30\r
2625         CAIN    AC0,5           ;"%"?\r
2626         TLO     CS,1000         ;YES, SET CRESYM FLAG\r
2627         PUSHJ   PP,WWORD                ;WRITE THE WORD\r
2628 DEF48:  MOVE    PP,PPTMP2               ;RESET PUSHDOWN POINTER\r
2629         TLO     IO,IORPTC               ;ECHO LAST CHARACTER\r
2630         JRST    DEF31\r
2631 \r
2632 DEF51:  MOVE    C,2(SX)         ;GET CHARACTER\r
2633         JUMPE   C,DEF48         ;CLEAN UP IF END\r
2634         PUSHJ   PP,WCHAR                ;WRITE THE CHARACTER\r
2635         AOJA    SX,DEF51                ;GET NEXT\r
2636 \r
2637 DEF70:  MOVE    PP,PPTMP1               ;RESTORE PUSHDOWN POINTER\r
2638         MOVSI   CS,(BYTE (7) 177,1)\r
2639         PUSHJ   PP,WWRXE                ;WRITE END\r
2640         SETZM   INDEF           ;OUT OF IT\r
2641         JRST    BYPAS1\r
2642 \fSUBTTL MACRO CALL PROCESSOR\r
2643 CALLM:  SKIPGE  MACENL          ;ARE WE TRYING TO RE-ENTER?\r
2644         JRST    ERRAX           ;YES, BOMB OUT WITH ERROR\r
2645         HRROS   MACENL          ;FLAG "CALLM IN PROGRESS"\r
2646         EXCH    MP,RP\r
2647         PUSH    MP,V            ;STACK FOR REFDEC\r
2648         EXCH    MP,RP\r
2649         MOVE    SDEL,SEQNO2\r
2650         MOVEM   SDEL,CALSEQ\r
2651         MOVE    SDEL,PAGENO\r
2652         MOVEM   SDEL,CALPG\r
2653         HLRZ    V,0(V)\r
2654         AOS     SDEL,0(V)       ;INCREMENT ARG COUNT\r
2655         LSHC    SDEL,-^D<9+36>  ;ZERO SDEL, GET ARG COUNT IN SX\r
2656         ANDI    SX,777          ;MASK\r
2657         PUSH    PP,V            ;STORE COUNT OF ARGS\r
2658         PUSH    PP,RP           ;STACK FOR MACPNT\r
2659         JUMPE   SX,MAC20        ;TEST FOR NO ARGS\r
2660         PUSHJ   PP,CHARAC\r
2661         CAIE    C,"("           ;"("\r
2662         TROA    SDEL,-1         ;YES, END OF ARGUMENT STRING\r
2663 \r
2664 MAC10:  PUSHJ   PP,GCHAR\r
2665         CAIG    C,CR\r
2666         CAIGE   C,LF\r
2667         SKIPA\r
2668         JRST    MAC21\r
2669         CAIN    C,";"           ;";"?\r
2670         JRST    MAC21           ;YES, END OF ARGUMENT STRING\r
2671         PUSHJ   PP,SKELI1       ;NO, INITIALIZE SKELETON\r
2672         CAIN    C,"<"           ;"<"?\r
2673         JRST    MAC30           ;YES, PROCESS AS SPECIAL\r
2674         CAIE    C,176\r
2675         CAIN    C,134           ;"\"\r
2676         JRST    MAC40\r
2677 MAC14:  CAIN    C,","           ;","?\r
2678         JRST    MAC16           ;YES, NULL SYMBOL\r
2679         CAIN    C,"("           ;"("?\r
2680         ADDI    SDEL,1          ;YES, INCREMENT COUNT\r
2681         CAIN    C,")"           ;")"?\r
2682         SOJL    SDEL,MAC16      ;YES, TEST FOR END\r
2683         PUSHJ   PP,WCHAR        ;WRITE INTO SKELETON\r
2684 MAC14A: PUSHJ   PP,CHARAC       ;GET NEXT CHARACTER\r
2685         CAIG    C,CR\r
2686         CAIGE   C,LF\r
2687         SKIPA\r
2688         JRST    MAC15           ;TEST FOR END OF LINE\r
2689         CAIE    C,";"           ;";"?\r
2690         JRST    MAC14           ;YES, END OF LINE\r
2691 \r
2692 MAC15:  TLO     IO,IORPTC\r
2693 MAC16:  MOVSI   CS,(BYTE (7) 177,2)\r
2694         PUSHJ   PP,WWRXE        ;WRITE END\r
2695         EXCH    MP,RP\r
2696         PUSH    MP,WWRXX\r
2697         EXCH    MP,RP\r
2698         SOJG    SX,MAC10        ;BRANCH IF NO MORE ARGS\r
2699 \fMAC20: TLZN    IO,IORPTC\r
2700         PUSHJ   PP,CHARAC\r
2701 MAC21:  EXCH    MP,RP\r
2702 MAC21A: PUSH    MP,[-1]         ;NO MISSING ARGS\r
2703         SOJGE   SX,MAC21A\r
2704         SETZM   0(MP)\r
2705         LDB     C,LBUFP\r
2706         MOVEI   SX,"^"\r
2707         JUMPAD  MAC24\r
2708         CAIN    C,";"\r
2709         SKIPE   MRP\r
2710         JRST    MAC24\r
2711         PUSHJ   PP,STOUT        ;LIST COMMOENT OR CR-LF\r
2712         TLNE    IO,IOPALL       ;MACRO EXPANSION SUPPRESSION?\r
2713         TLO     IO,IOMAC        ;  NO, SET TEMP BIT\r
2714         TDOA    C,[-1]          ;FLAG LAST CHARACTER\r
2715 MAC24:  DPB     SX,LBUFP\r
2716         PUSH    MP,MACPNT\r
2717         POP     PP,MACPNT\r
2718         PUSH    MP,C\r
2719         PUSH    MP,MRP          ;STACK WORD COUNT\r
2720         POP     PP,MRP          ;STACK MACRO POINTER\r
2721         EXCH    MP,RP\r
2722         AOS     MACLVL\r
2723         HRRZS   MACENL          ;RESET "CALLM IN PROGRESS"\r
2724         JUMPOC  STMNT2          ;OP-CODE FIELD\r
2725         JRST    EVATOM          ;ADDRESS FIELD\r
2726 \r
2727 \fMAC30: MOVEI   AC0,0           ;INITIALIZE BRACKET COUNTER\r
2728 MAC31:  PUSHJ   PP,GCHAR        ;GET A CHARACTER\r
2729         CAIN    C,"<"           ;"<"?\r
2730         ADDI    AC0,1           ;YES, INCREMENT COUNT\r
2731         CAIN    C,">"           ;">"?\r
2732         SOJL    MAC14A          ;YES, EXIT IF MATCHING\r
2733         PUSHJ   PP,WCHAR        ;WRITE INTO SKELETON\r
2734         JRST    MAC31           ;GO BACK FOR ANOTHER\r
2735 \r
2736 MAC40:  PUSH    PP,SX           ;STACK REGISTERS\r
2737         PUSH    PP,SDEL\r
2738         HLLM    IO,TAGINC       ;SAVE IO FLAGS\r
2739         PUSHJ   PP,CELL         ;GET AN ATOM\r
2740         MOVE    V,AC0           ;ASSUME NUMERIC\r
2741         TLNE    IO,NUMSW        ;GOOD GUESS?\r
2742         JRST    MAC41           ;YES\r
2743         PUSHJ   PP,SSRCH        ;SEARCH THE SYMBOL TABLE\r
2744         TROA    ER,ERRX         ;NOT FOUND, ERROR\r
2745 MAC41:  PUSHJ   PP,MAC42        ;FORM ASCII STRING\r
2746         HLL     IO,TAGINC       ;RESTORE IO FLAGS\r
2747         POP     PP,SDEL\r
2748         POP     PP,SX\r
2749         TLO     IO,IORPTC       ;REPEAT LAST CHARACTER\r
2750         JRST    MAC14A          ;RETURN TO MAIN SCAN\r
2751 \r
2752 MAC42:  MOVE    C,V\r
2753 MAC44:  LSHC    C,-^D35\r
2754         LSH     CS,-1\r
2755         DIVI    C,0(RX)         ;DIVIDE BY CURRENT RADIX\r
2756         HRLM    CS,0(PP)\r
2757         SKIPE   C               ;TEST FOR END\r
2758         PUSHJ   PP,MAC44\r
2759         HLRZ    C,0(PP)\r
2760         ADDI    C,"0"           ;FORM TEXT\r
2761         JRST    WCHAR           ;WRITE INTO SKELETON\r
2762 \fMACEN0:        SOS     MACENL\r
2763 MACEND: SKIPGE  C,MACENL        ;TEST "CALLM IN PROGRESS"\r
2764         AOS     MACENL          ;INCREMENT END LEVEL AND EXIT\r
2765         JUMPL   C,REPEA8\r
2766         EXCH    MP,RP\r
2767         POP     MP,MRP          ;RETRIEVE READ POINTER\r
2768         MOVEI   C,"^"\r
2769         SKIPL   0(MP)           ;TEST FLAG\r
2770         PUSHJ   PP,RSW2         ;MARK END OF SUBSTITUTION\r
2771         POP     MP,C\r
2772         POP     MP,ARG\r
2773         SKIPA   MP,MACPNT       ;RESET MP AND SKIP\r
2774 MACEN1: PUSHJ   PP,REFDEC       ;DECREMENT REFERENCE\r
2775 MACEN2: AOS     V,MACPNT        ;GET POINTER\r
2776         MOVE    V,0(V)\r
2777         JUMPG   V,MACEN1        ;IF >0, DECREMENT REFERENCE\r
2778         JUMPL   V,MACEN2        ;IF <0, BYPASS\r
2779         POP     MP,V            ;IF=0, RETRIEVE POINTER\r
2780         PUSHJ   PP,REFDEC       ;DECREMENT REFERENCE\r
2781         MOVEM   ARG,MACPNT\r
2782         EXCH    MP,RP\r
2783         SOS     MACLVL\r
2784         HLRZ    CS,0(MRP)\r
2785         SKIPE   MACENL          ;CHECK UPROCESSED END LEVEL\r
2786         JUMPE   CS,MACEN0       ;THEN POP THE MACRO STACK NOW\r
2787         JUMPL   C,REPEA8        ;IF FLAG SET SUBSTITUTE\r
2788         JRST    RSW1\r
2789 \fIRP0:  SKIPN   MACLVL          ;ARE WE IN A MACRO\r
2790         JRST    ERRAX           ;NO, BOMB OUT\r
2791 IRP10:  PUSHJ   PP,MREADS       ;YES, GET DATA SPEC\r
2792         CAIE    C,40            ;SKIP LEADING BLANKS\r
2793         CAIN    C,"("           ;"("?\r
2794         JRST    IRP10           ;YES, BYPASS\r
2795         CAIN    C,11\r
2796         JRST    IRP10\r
2797         CAIE    C,177           ;NO, IS IT SPECIAL?\r
2798         JRST    ERRAX           ;NO, ERROR\r
2799         PUSHJ   PP,MREADS       ;YES\r
2800         TRZN    C,100           ;CREATED?\r
2801         JRST    ERRAX\r
2802         CAIL    C,40            ;TOO BIG?\r
2803         JRST    ERRAX\r
2804         ADD     C,MACPNT        ;NO, FORM POINTER TO STACK\r
2805         PUSH    MP,IRPCF        ;STACK PREVIOUS POINTERS\r
2806         PUSH    MP,IRPSW\r
2807         PUSH    MP,IRPARP\r
2808         PUSH    MP,IRPARG\r
2809         PUSH    MP,0(C)\r
2810         PUSH    MP,IRPPOI\r
2811 \r
2812         HRRZM   C,IRPARP\r
2813         MOVEM   AC0,IRPCF       ;IRPC FLAG FOUND IN AC0\r
2814         SETOM   AC0,IRPSW       ;RESET IRP SWITCH\r
2815         MOVE    CS,0(C)\r
2816         MOVEM   CS,IRPARG\r
2817         PUSHJ   PP,MREADS\r
2818         CAIE    C,"<"           ;"<">\r
2819         JRST    .-2             ;NO, SEARCH UNTIL FOUND\r
2820         PUSHJ   PP,SKELI1       ;INITIALIZE NEW STRING\r
2821         MOVEM   ARG,IRPPOI      ;SET NEW POINTER\r
2822 \r
2823         TDZA    SDEL,SDEL       ;ZERO BRACKET COUNT AND SKIP\r
2824 IRP20:  PUSHJ   PP,WCHAR\r
2825         PUSHJ   PP,MREADS\r
2826         CAIN    C,"<"           ;"<"?\r
2827         AOJA    SDEL,IRP20      ;YES, INCREMENT COUNT AND WRITE\r
2828         CAIE    C,">"           ;">"?\r
2829         JRST    IRP20           ;NO, JUST WRITE IT\r
2830         SOJGE   SDEL,IRP20      ;YES, WRITE IF NOT MATCHING\r
2831         MOVE    CS,[BYTE (7) 15,177,4]\r
2832         PUSHJ   PP,WWRXE        ;WRITE END\r
2833         PUSH    MP,MRP          ;STACK PREVIOUS READ POINTER\r
2834         SKIPG   CS,IRPARG\r
2835         JRST    IRPPOP          ;EXIT IF NOT VALID ARGUMENT\r
2836         HLRZ    C,0(CS)         ;INITIALIZE POINTER\r
2837         MOVEM   C,IRPARG\r
2838 \fIRPSET:        EXCH    MRP,IRPARG              ;SWAP READ POINTERS\r
2839         PUSHJ   PP,SKELI1       ;INITIALIZE SKELETON FOR DATA\r
2840         HRRZM   ARG,@IRPARP     ;STORE NEW DS POINTER\r
2841         SETZB   SX,SDEL         ;ZERO FOUND FLAG AND BRACKET COUNT\r
2842 IRPSE1: PUSHJ   PP,MREADS\r
2843         CAIE    C,177           ;SPECIAL?\r
2844         AOJA    SX,IRPSE2       ;NO, FLAG AS FOUND\r
2845         MOVEM   MRP,V\r
2846         PUSHJ   PP,MREADS       ;LOOK AT NEXT CHARACTER\r
2847         MOVE    MRP,V\r
2848         SETZM   IRPSW           ;SET IRP SWITCH\r
2849         JUMPG   SX,IRPSE4       ;IF ARG FOUND, PROCESS IT\r
2850         JRST    IRPPOP          ;NO, CLEAN UP AND EXIT\r
2851 \r
2852 IRPSE2: SKIPE   IRPCF           ;IRPC?\r
2853         JRST    IRPSE3          ;YES, WRITE IT\r
2854         CAIN    C,","           ;NO, IS IT A COMMA?\r
2855         JUMPE   SDEL,IRPSE4     ;YES, EXIT IF NOT NESTED\r
2856         CAIN    C,"<"           ;"<"?\r
2857         ADDI    SDEL,1          ;YES, INCREMENT COUNT\r
2858         CAIN    C,">"           ;">"?\r
2859         SUBI    SDEL,1          ;YES, DECREMENT COUNT\r
2860 \r
2861 IRPSE3: PUSHJ   PP,WCHAR\r
2862         SKIPN   IRPCF           ;IRPC?\r
2863         JRST    IRPSE1          ;NO, GET NEXT CHARACTER\r
2864 \r
2865 IRPSE4: MOVSI   CS,(BYTE (7) 177,2)\r
2866         PUSHJ   PP,WWRXE        ;WRITE END\r
2867         MOVEM   MRP,IRPARG      ;SAVE POINTER\r
2868         HLRZ    MRP,@IRPPOI     ;SET FOR NEW SCAN\r
2869         JRST    REPEA8          ;ON ARG COUNT\r
2870 \fSTOPI0:        SKIPN   IRPARP          ;IRP IN PROGRESS?\r
2871         JRST    ERRAX           ;NO, ERROR\r
2872         SETZM   IRPSW           ;YES, SET SWITCH\r
2873         POPJ    PP,\r
2874 \r
2875 IRPEND: MOVE    V,@IRPARP\r
2876         PUSHJ   PP,REFDEC\r
2877         SKIPE   IRPSW           ;MORE TO COME?\r
2878         JRST    IRPSET          ;YES\r
2879 \r
2880 IRPPOP: MOVE    V,IRPPOI\r
2881         PUSHJ   PP,REFDEC       ;DECREMENT REFERENCE\r
2882         POP     MP,MRP          ;RESTORE CELLS\r
2883         POP     MP,IRPPOI\r
2884         POP     MP,@IRPARP\r
2885         POP     MP,IRPARG\r
2886         POP     MP,IRPARP\r
2887         POP     MP,IRPSW\r
2888         POP     MP,IRPCF\r
2889         JRST    REPEA8\r
2890 \fGETDS: MOVE    CS,C            ;USE CS FOR WORK REGISTER\r
2891         ANDI    CS,37           ;MASK\r
2892         ADD     CS,MACPNT       ;ADD BASE ADDRESS\r
2893         MOVE    V,0(CS)         ;GET POINTER FLAG\r
2894         JUMPG   V,GETDS1        ;BRANCH IF POINTER\r
2895         TRNN    C,40            ;NOT POINTER, SHOULD WE CREATE?\r
2896         JRST    RSW0            ;NO, FORGET THIS ARG\r
2897         PUSH    PP,WWRXX\r
2898         PUSH    PP,MWP          ;STACK MACRO WRITE POINTER\r
2899         PUSHJ   PP,SKELI1       ;INITIALIZE SKELETON\r
2900         MOVEM   ARG,0(CS)       ;STORE POINTER\r
2901         MOVE    CS,[BYTE (7) 0,170,170,170,171] ;CREATE A SYMBOL\r
2902         ADD     CS,LSTSYM       ;LSTSYM= # OF LAST CREATED\r
2903         TDZ     CS,[BYTE (7) 0,170,170,170,170]\r
2904         MOVEM   CS,LSTSYM\r
2905         IOR     CS,[ASCII /.0000/]\r
2906         MOVEI   C,"."\r
2907         PUSHJ   PP,WCHAR        ;WRITE INTO SKELETON\r
2908         PUSHJ   PP,WWORD\r
2909         MOVSI   CS,(BYTE (7) 177,2)\r
2910         PUSHJ   PP,WWRXE        ;WRITE END CODE\r
2911         POP     PP,MWP          ;RESTORE MACRO WRITE POINTER\r
2912         POP     PP,WWRXX\r
2913         MOVE    V,ARG           ;SET UP FOR REFINC\r
2914 \r
2915 GETDS1: PUSHJ PP,REFINC         ;INCREMENT REFERENCE\r
2916         PUSH MP,V               ;STACK V FOR DECREMENT\r
2917         PUSH MP,MRP             ;STACK READ POINTER\r
2918         HLRZ MRP,0(V)           ;FORM READ POINTER\r
2919         JRST RSW0               ;EXIT\r
2920 \r
2921 DSEND:  POP MP,MRP\r
2922         POP MP,V\r
2923         PUSHJ PP,REFDEC         ;DECREMENT REFERENCE\r
2924         JRST RSW0               ;EXIT\r
2925 \fSKELI1:        MOVEI   ARG,1   ;ENTRY FOR SINGLE ARG\r
2926 SKELI:  MOVE    MWP,LADR\r
2927         PUSHJ   PP,SKELWL       ;GET POINTER WORD\r
2928         HRRZM   MWP,WWRXX       ;SAVE FIRST ADDRESS\r
2929         PUSHJ   PP,SKELWL\r
2930         HRRM    ARG,0(MWP)      ;STORE COUNT\r
2931         HRRZ    ARG,WWRXX       ;SET FIRST ADDRESS\r
2932         ;SKEW RETURNS WITH ADR OF NEXT FREE LOC IN V (RIGHT)\r
2933 \r
2934 SKELWL: SKIPE   V,NEXT          ;GET FIRST FREE ADDRESS\r
2935         JRST    SKELW1          ;IF NON-ZERO, UPDATE FREE\r
2936         AOS     V,FREE          ;INCREMENT BY LEAF SIZE\r
2937         CAML    V,SYMBOL        ;OVERFLOW?\r
2938         PUSHJ   PP,XCEED        ;YES, BOMB OUT\r
2939         SETZM   (V)             ;CLEAR LINK\r
2940 \r
2941 SKELW1: HLL     V,0(V)          ;GET ADDRESS\r
2942         HLRM    V,NEXT          ;UPDATE NEXT\r
2943         HRLM    V,0(MWP)        ;STORE LINK IN FIRST WORD OF LEAF\r
2944         HRRZ    MWP,V\r
2945         TLO     MWP,(POINT 7,,21)       ;2 ASCII CHARS\r
2946         POPJ    PP,\r
2947 \r
2948         ;WWRXX  POINTS TO END OF TREE\r
2949         ;MWP    IDPB POINTER TO NEXT HOLE\r
2950         ;NEXT   FIRST OF A LINKED PORTION THAT IS NOT BEING USED (LEAVES)\r
2951         ;FREE   POINTS TO FREE CORE BETWEEN TREE AND SYM-TABLE\r
2952         ;LADR   POINTS TO BEG OF LINKED PORTION.\r
2953 \fGCHARQ:        SKIPE   MACLVL\r
2954         JRST    MREADS          ;IF GETTING CHAR. FROM TREE\r
2955 GCHAR:  PUSHJ   PP,CHARAC       ;GET ASCII CHARACTER\r
2956         CAIE    C,LF            ;TEST FOR LF, VT OR FF\r
2957         CAIN    C,FF\r
2958         PUSHJ   PP,OUTIM1       ;YES, LIST IT\r
2959         POPJ    PP,\r
2960 \r
2961 WCHARQ: SKIPE   MACLVL\r
2962         JRST    WCHAR\r
2963 WCHAR:  TLNN    MWP,770000      ;END OF WORD?\r
2964         PUSHJ   PP,SKELWL       ;YES, GET ANOTHER\r
2965         IDPB    C,MWP\r
2966         POPJ    PP,\r
2967 \r
2968 WWORD:  LSHC    C,7             ;MOVE ASCII INTO C\r
2969         PUSHJ   PP,WCHAR        ;STORE IT\r
2970         JUMPN   CS,WWORD        ;TEST FOR END\r
2971         POPJ    PP,             ;YES, EXIT\r
2972 \r
2973 WWRXE:  PUSHJ   PP,WWORD        ;WRITE LAST WORD\r
2974         HRRZS   (MWP)           ;ZERO LEFT HALF OF LAST LEAF\r
2975         HRRM    MWP,@WWRXX      ;SET POINTER TO END\r
2976         POPJ    PP,\r
2977 \fMREAD: PUSHJ   PP,MREADS       ;READ ON CHARACTER\r
2978         CAIE    C,177           ;SPECIAL?\r
2979         JRST    RSW1            ;NO, EXIT\r
2980         PUSHJ   PP,MREADS       ;YES, GET CODE WORD\r
2981         TRZE C,100              ;SYMBOL?\r
2982         JRST GETDS              ;YES\r
2983         CAILE C,4               ;POSSIBLY ILLEGAL\r
2984         JRST ERRAX              ;YES\r
2985         JRST    .+1(C)\r
2986         PUSHJ   PP,XCEED\r
2987         JRST    MACEND          ;1; END OF MACRO\r
2988         JRST    DSEND           ;2; END OF DUMMY SYMBOL\r
2989         JRST    REPEND          ;3; END OF REPEAT\r
2990         JRST    IRPEND          ;4; END OF IRP\r
2991 \r
2992 MREADS: TLNE    MRP,770000      ;HAVE WE FINISHED WORD?\r
2993         JRST    MREADC          ;STILL CHAR. IN LEAF\r
2994         HLRZ    MRP,0(MRP)      ;YES, GET LINK\r
2995         HRLI    MRP,(POINT 7,,21)       ;SET POINTER\r
2996 MREADC: ILDB    C,MRP           ;GET CHARACTER\r
2997         POPJ    PP,\r
2998 \r
2999 \fREFINC:        HLRZ    CS,0(V)         ;GET POINTER TO FREE\r
3000         AOS     0(CS)           ;INCREMENT REFERENCE\r
3001         POPJ    PP,\r
3002 REFDEC: HLRZ    CS,0(V)         ;GET POINTER TO TREE\r
3003         SOS     CS,0(CS)        ;DECREMENT REFERENCE\r
3004         TRNE    CS,000777       ;IS IT ZERO?\r
3005         POPJ    PP,             ;NO, EXIT\r
3006         HRRZ    CS,0(V)         ;YES, GET POINTER TO END\r
3007         HRL     CS,NEXT         ;GET POINTER TO NEXT RE-USABLE\r
3008         HLLM    CS,0(CS)        ;SET LINK\r
3009         HRRM    V,NEXT          ;RESET NEXT\r
3010         POPJ    PP,\r
3011 \r
3012 \fA==   0                       ;ASCII MODE\r
3013 AL==    1                       ;ASCII LINE MODE\r
3014 IB==    13                      ;IMAGE BINARY MODE\r
3015 B==     14                      ;BINARY MODE\r
3016 \r
3017 CTL==   0                       ;CONTROL DEVICE NUMBER\r
3018 IFN CCLSW,<CTL2==4              ;INPUT DEV FOR CCL FILE>\r
3019 BIN==   1                       ;BINARY DEVICE NUMBER\r
3020 CHAR==  2                       ;INPUT DEVICE NUMBER\r
3021 LST==   3                       ;LISTING DEVICE NUMBER\r
3022 \r
3023 ;       COMMAND STRING ACCUMULATORS\r
3024 \r
3025 ACDEV== 1                       ;DEVICE\r
3026 ACFILE==2                       ;FILE\r
3027 ACEXT== 3                       ;EXTENSION\r
3028 ACPPN== 4                       ;PPN\r
3029 ACDEL== 4                       ;DELIMITER\r
3030 ACPNTR==5                       ;BYTE POINTER\r
3031 \r
3032 TIO==   6\r
3033 \r
3034 TIORW== 1000\r
3035 TIOLE== 2000\r
3036 TIOCLD==20000\r
3037 \r
3038 DIRBIT==4               ;DIRECTORY DEVICE\r
3039 TTYBIT==10              ;TTY\r
3040 MTABIT==20              ;MTA\r
3041 DTABIT==100             ;DTA\r
3042 DISBIT==2000            ;DISPLAY\r
3043 CONBIT==20000           ;CONTROLING TTY\r
3044 LPTBIT==40000           ;LPT\r
3045 DSKBIT==200000          ;DSK\r
3046 \r
3047 ;GETSTS ERROR BITS\r
3048 \r
3049 IOIMPM==400000          ;IMPROPER MODE (WRITE LOCK)\r
3050 IODERR==200000          ;DEVICE DATA ERROR\r
3051 IODTER==100000          ;CHECKSUM OR PARITY ERROR\r
3052 IOBKTL== 40000          ;BLOCK TOO LARGE\r
3053 ERRBIT==IOIMPM!IODERR!IODTER!IOBKTL\r
3054 \fSUBTTL I/O ROUTINES\r
3055 BEG:\r
3056 IFN CCLSW,<TLZA IO,ARPGSW       ;DON'T ALLOW RAPID PROGRAM GENERATION\r
3057         TLO     IO,ARPGSW       ;ALLOW RAPID PROGRAM GENERATION\r
3058         TLZA    IO,CRPGSW       ;SET TO INITI NEW COMMAND FILE\r
3059 M:      TLNN    IO,CRPGSW       ;CURRENTLY DOING RPG?>\r
3060 IFE CCLSW,<M:>\r
3061         RESET                   ;INITIALIZE PROGRAM\r
3062         SETZB   MRP,PASS1I\r
3063         MOVE    [XWD PASS1I,PASS1I+1]\r
3064         BLT     PASS2X-1        ;ZERO THE PASS1 AND PASS2 VARIABLE\r
3065         MOVEI   PP,JOBFFI       ;SET TEMP PUSH-DOWN POINTER\r
3066         MOVE    CS,[POINT 7,DBUF]       ;INITIALIZE FOR DATA\r
3067         MSTIME  2,              ;GET TIME FROM MONITOR\r
3068         IDIVI   2,^D60*^D1000\r
3069         IDIVI   2,^D60\r
3070         PUSH    PP,3            ;SAVE MINUTES\r
3071         PUSHJ   PP,OTOD1\r
3072         POP     PP,2\r
3073         PUSHJ   PP,OTOD1\r
3074         DATE    1,\r
3075         IDIVI   1,^D31          ;GET DAY\r
3076         ADDI    2,1\r
3077         CAIG    2,^D9           ;TWO DIGITS?\r
3078         ADDI    2,7760*^D10     ;NO, PUT IN SPACE\r
3079         PUSHJ   PP,OTOD1        ;STORE DAY\r
3080         IDIVI   1,^D12          ;GET MONTH\r
3081         MOVE    2,DTAB(2)       ;GET MNEMONIC\r
3082         ADDI    CS,1\r
3083         MOVEM   2,0(CS)\r
3084         MOVEI   2,^D64(1)       ;GET YEAR\r
3085         PUSHJ   PP,OTOD         ;STORE IT\r
3086         MOVSI   FR,P1!CREFSW\r
3087 IFN CCLSW,<TLNE IO,CRPGSW       ;RPG IN PROGRESS?\r
3088         JRST    GOSET           ;YES, GO READ NEXT COMMAND\r
3089         TLNE    IO,ARPGSW       ;NO, RPG ALLOWED?\r
3090         JRST    RPGSET          ;YES, GO TRY\r
3091 CTLSET: RELEAS  CTL2,           ;IN CASE OF LOOKUP FAILURE>\r
3092 IFE CCLSW,<CTLSET:>\r
3093         MOVSI   IO,IOPALL       ;ZERO FLAGS\r
3094         INIT    CTL,AL          ;INITIALIZE USER CONSOLE\r
3095         SIXBIT  /TTY/\r
3096         XWD     CTOBUF,CTIBUF\r
3097         EXIT                    ;NO TTY, NO ASSEMBLY\r
3098         INBUF   CTL,1           ;INITIALIZE SINGLE CONTROL\r
3099         OUTBUF  CTL,1           ;BUFFERS\r
3100         PUSHJ   PP,CRLF         ;OUTPUT CARRIAGE RETURN - LINE FEED\r
3101         MOVEI   C,"*"\r
3102         IDPB    C,CTOBUF+1\r
3103         OUTPUT  CTL,0\r
3104         INPUT   CTL,0\r
3105 \fIFN CCLSW,<JRST BINSET         ;BEGIN WITH BINARY FILE\r
3106 RPGSET:\r
3107 IFN TEMP,<HRRZ 3,JOBFF          ;GET START OF BUFFER AREA\r
3108         HRRM 3,TMPFIL+1 ;STORE IN TMPCOR UUO IOWD\r
3109         SOS TMPFIL+1            ;MAKE IT THE PROPER IOWD FORMAT\r
3110         HRRM 3,CTLBLK+1         ;DUMMY UP BUFFER HEADER\r
3111         MOVE 0,[XWD 2,TMPFIL]   ;SET UP FOR TEMP CORE READ\r
3112         TMPCOR                  ;READ AND DELETE FILE "MAC"\r
3113         JRST RPGTMP             ;NO SUCH FILE IN CORE TRY DISK\r
3114         ADD 3,0                 ;CALCULATE END OF BUFFER\r
3115         MOVEM 3,JOBFF           ;FIX JOBFF SO FILE WONT BE KILLED\r
3116         IMULI 0,5               ;CALCULATE CHARACTER COUNT\r
3117         MOVEM 0,CTLBLK+2        ;SET UP CHAR CNT IN BUFFER HEADER\r
3118         MOVEI 0,440700          ;SET UP BYTE POINTER IN HEADER\r
3119         HRLM 0,CTLBLK+1         ;BUUFER HEADER NOW SET UP\r
3120         SETOM TMPFLG            ;MARK THAT A TMPCOR UUO WAS DONE\r
3121         JRST RPGS2A             ;CONTINUE IN MAIN STREAM\r
3122 RPGTMP:>\r
3123         INIT CTL2,AL            ;LOOK FOR DISK\r
3124         SIXBIT /DSK/            ;...\r
3125         XWD   0,CTLBLK          ;...\r
3126         JRST CTLSET             ;DSK NOT THERE\r
3127 \r
3128         HRLZI   3,(SIXBIT /MAC/)        ;###MAC\r
3129         MOVEI   3                       ;COUNT\r
3130         PJOB    AC1,                    ;RETURNS JOB NO. TO AC1\r
3131 RPGLUP: IDIVI   AC1,12                  ;CONVERT\r
3132         ADDI    AC2,"0"-40              ;SIXBITIZE IT\r
3133         LSHC    AC2,-6                  ;\r
3134         SOJG    RPGLUP                  ;3 TIMES\r
3135         MOVEM   3,CTLBUF                ;###MAC\r
3136         HRLZI   (SIXBIT /TMP/)          ;\r
3137         MOVEM   CTLBUF+1                ;TMP\r
3138         SETZM   CTLBUF+3                ;PROG-PRO\r
3139         LOOKUP  CTL2,CTLBUF             ;COMMAND FILE\r
3140         JRST    CTLSET                  ;NOT THERE\r
3141         HLRM    EXTMP                   ;SAVE THE EXTENSION\r
3142 RPGS2:  INBUF   CTL2,1                  ;SINGLE BUFFERED\r
3143 RPGS2A: INIT    CTL,AL                  ;TTY FOR CONSOLE MESSAGES\r
3144         SIXBIT  /TTY/                   ;...\r
3145         XWD     CTOBUF,0                ;...\r
3146         EXIT                            ;NO TTY, NO ASSEMBLY\r
3147         OUTBUF  CTL,1                   ;SINGLE BUFFERED\r
3148         MOVE    JOBFF                   ;REMEMBER WHERE BINARY BUFFERS BEGIN\r
3149         MOVEM   SAVFF                   ;...\r
3150         TLNE    IO,CRPGSW               ;ARE WE ALREAD IN RPG MODE?\r
3151         JRST    M                       ;MUST HAVE COME FROM @ COMMAND, RESET\r
3152 \r
3153 \fGOSET: MOVSI   IO,IOPALL!CRPGSW                ;SET INITIAL FLAGS\r
3154         MOVEI   CS,CTLSIZ               ;MAXIMUM CHARS IN A LINE\r
3155         MOVE    AC1,[POINT 7,CTLBUF]    ;WHERE TO STASH CHARS\r
3156         MOVEM   AC1,CTIBUF+1    ;...\r
3157 GOSET1: SOSG    CTLBLK+2                ;ANY MORE CHARS?\r
3158         PUSHJ   PP,[IFN TEMP,<SKIPE TMPFLG      ;TMPCOR UUO IN PROGRESS?\r
3159                   EXIT          ;YES EXIT>\r
3160                  IN CTL2,               ;READ ANOTHER BUFFERFUL\r
3161                  POPJ PP,               ;EVERYTHING OK, RETURN\r
3162                  STATO CTL2,20000       ;EOF?\r
3163                  JRST [HRROI RC,[SIXBIT /ERROR READING COMMAND FILE@/]\r
3164                         JRST ERRNE0]    ;GO COMPLAIN\r
3165                   PUSHJ PP,DELETE       ;CMD FILE\r
3166                   EXIT]                 ;EOF AND FINISHED\r
3167         ILDB    C,CTLBLK+1              ;GET NEXT CHAR\r
3168         MOVE    RC,@CTLBLK+1    ;CHECK FOR SEQUENCE NUMBERS\r
3169         TRNE    RC,1            ;...\r
3170         JRST    [AOS CTLBLK+1           ;SKIP OVER ANOTHER 5 CHARS\r
3171                 MOVNI RC,5              ;...\r
3172                 ADDM RC,CTLBLK+2        ;...\r
3173                 JRST GOSET1]            ;GO READ ANOTHER CHAR\r
3174         JUMPE   C,GOSET1        ;IGNORE NULLS\r
3175         IDPB    C,CTIBUF+1      ;GET NEXT CHAR\r
3176         CAIE    C,12            ;LINE FEED OR\r
3177         CAIN    C,175           ;ALTMODE?\r
3178         JRST    GOSET2          ;YES, FINISHED WITH COMMAND\r
3179         CAIE    C,176\r
3180         CAIN    C,33\r
3181         JRST    GOSET2          ;ALTMODE.\r
3182         SOJG    CS,GOSET1       ;GO READ ANOTHER\r
3183         HRROI   RC,[SIXBIT /COMMAND LINE TOO LONG@/]\r
3184         JRST    ERRNE0          ;GO COMPLAIN\r
3185 GOSET2: MOVEI   C,12            ;MAKE SURE THERE'S A LF\r
3186         IDPB    C,CTIBUF+1      ;...\r
3187         MOVEM   AC1,CTIBUF+1    ;SET POINTER TO BEGINNING\r
3188         MOVE    AC0,SAVFF       ;RESET JOBFF FOR NEW BINARY\r
3189         MOVEM   AC0,JOBFF       ;...\r
3190         JRST BINSET\r
3191 \fRPGS1: PUSHJ   PP,DELETE               ;DELETE COMMAND FILE\r
3192         MOVEM   ACDEV,RPGDEV    ;GET SET TO INIT\r
3193         PUSHJ   PP,RPGINI\r
3194         MOVEM   ACFILE,INDIR    ;USE INPUT BLOCK\r
3195         MOVEM   ACEXT,INDIR+1\r
3196         LOOKUP  CTL2,INDIR\r
3197         JRST    RPGLOS\r
3198         HLRM    ACEXT,EXTMP     ;SAVE THE EXTENSION\r
3199         HLRZ    JOBSA           ;RESET JOBFF TO ORIGINAL\r
3200         MOVEM   JOBFF\r
3201         TLO     IO,CRPGSW       ;TURN ON SWITHC SO WE RESET WORLD\r
3202         JRST    RPGS2           ;AND GO\r
3203 RPGLOS: RELEAS  CTL2,0\r
3204         TLZ     IO,CRPGSW       ;STOPS IO TO UNASGD CHAN\r
3205         JRST    ERRCF           ;NO FILE FOUND\r
3206 >\r
3207 \fBINSET:        PUSHJ   PP,NAME1        ;GET FIRST NAME\r
3208 IFN     CCLSW,<CAIN C,"!"       ;CHECK FOR A NEW RPG FILE\r
3209         JRST    NUNSET\r
3210         CAIN    C,"@"   ;CHEK FOR A NEW RPG FILE\r
3211         JRST    RPGS1>\r
3212         TLNN    FR,CREFSW       ;CROSS REF REQUESTED?\r
3213         JRST    LSTSE1          ;YES, SKIP BINARY\r
3214         CAIN    C,","           ;COMMA?\r
3215         JUMPE   ACDEV,LSTSET    ;YES, SKIP BINARY IF NO DEVICE SPECIFIED\r
3216         CAIN    C,"_"           ;LEFT ARROW?\r
3217         JUMPE   ACDEV,LSTSE1    ;YES, SKIP BINARY IF NO DEVICE SPECIFIED\r
3218         JUMPE   ACDEV,ERRCM     ;IGNORE IF JUST <CR-LF>\r
3219         TLO     FR,PNCHSW       ;OK, SET SWITCH\r
3220         MOVEM   ACDEV,BINDEV    ;STORE DEVICE NAME\r
3221         MOVEM   ACFILE,INDIR    ;STORE FILE NAME IN DIRECTORY\r
3222         SKIPN   ACEXT           ;EXTENSION SPECIFIED?\r
3223         MOVSI   ACEXT,(SIXBIT /REL/)    ;NO, ASSUME RELOCATABLE BINARY\r
3224         MOVEM   ACEXT,INDIR+1   ;STORE IN DIRECTORY\r
3225         PUSHJ   PP,BININI       ;INITIALIZE BINARY\r
3226         TLZE TIO,TIOLE          ;SKIP TO EOT\r
3227         MTEOT. BIN,\r
3228         TLZE    TIO,TIORW       ;REWIND REQUESTED?\r
3229         MTREW.  BIN,            ;YES\r
3230         JUMPGE  CS,BINSE2       ;BRANCH IF NO BACK-SPACE\r
3231         MTBSF.  BIN,            ;BACK-SPACE A FILE\r
3232         AOJL    CS,.-1          ;TEST FOR END\r
3233         MTWAT.  BIN,\r
3234         STATO   BIN,1B24        ;LOAD POINT?\r
3235         MTSKF.  BIN,            ;NO, GO FORWARD ONE\r
3236 BINSE2: SOJG    CS,.-1          ;TEST FORWARD SPACING\r
3237 \r
3238         TLNE    TIO,TIOCLD      ;DIRECTORY CLEAR REQUESTED?\r
3239         UTPCLR  BIN,            ;YES, CLEAR IT\r
3240         OUTBUF  BIN,2           ;SET UP TWO RING BUFFER\r
3241         ENTER   BIN,INDIR\r
3242         JRST    ERREF\r
3243         CAIN    C,"_"\r
3244         JRST    GETSET          ;NO LISTING\r
3245 \fLSTSET:        PUSHJ   PP,NAME1                ;GET NEXT DEVICE\r
3246 LSTSE1: CAIE    C,"_"\r
3247         JRST    ERRCM\r
3248         TLNE    FR,CREFSW       ;CROSS-REF REQUESTED?\r
3249         JRST    LSTSE2          ;NO, BRANCH\r
3250         SKIPN   ACDEV           ;YES, WAS DEVICE SPECIFIED?\r
3251         MOVSI   ACDEV,(SIXBIT /DSK/)    ;NO, ASSUME DSK\r
3252         SKIPN   ACFILE\r
3253         MOVE    ACFILE,[SIXBIT /CREF/]\r
3254         SKIPN   ACEXT\r
3255         MOVSI   ACEXT,(SIXBIT /LST/)\r
3256 LSTSE2: JUMPE   ACDEV,GETSET    ;FORGET LISTING IF NO DEVICE SPECIFIED\r
3257         MOVEM   ACDEV,LSTDEV\r
3258         MOVE    AC0,1\r
3259         DEVCHR  AC0,\r
3260         TLNN    AC0,2\r
3261         TLNE    FR,CREFSW       ; WAS CROSS-REF REQUESTED?\r
3262         AOSA    OUTSW           ;NO, ASSUME TTY\r
3263         JRST    ERRCM           ;YES, ERROR - CREF DEV MUST NO TBE LPT, DIS OR TTY\r
3264         TLNE    AC0,TTYBIT      ;CONTROLING TELETYPE LISTING?\r
3265         JRST    GETSET          ;YES, BUFFER ALREADY SET\r
3266         AOS     OUTSW           ;SET FOR LPT\r
3267         MOVEM   ACFILE,INDIR\r
3268         SKIPN   ACEXT\r
3269         MOVSI   ACEXT,(SIXBIT /LST/)\r
3270         MOVEM   ACEXT,INDIR+1\r
3271         PUSHJ   PP,LSTINI\r
3272         TLZE    TIO,TIOLE\r
3273         MTEOT.  LST,\r
3274         TLZE    TIO,TIORW\r
3275         MTREW.  LST,\r
3276         JUMPGE  CS,LSTSE3\r
3277         MTBSF.  LST,\r
3278         AOJL    CS,.-1\r
3279         MTWAT.  LST,\r
3280         STATO   LST,1B24\r
3281         MTSKF.  LST,\r
3282 LSTSE3: SOJG    CS,.-1\r
3283         TLNE    TIO,TIOCLD      ;DIRECTORY CLEAR REQUESTED?\r
3284         UTPCLR  LST,            ;YES, CLEAR IT\r
3285         OUTBUF  LST,2           ;SET UP A TWO RING BUFFER\r
3286         ENTER   LST,INDIR\r
3287         JRST    ERREF\r
3288 \fGETSET:        MOVEI   3,PDPERR\r
3289         HRRM    3,JOBAPR        ;SET TRAP LOCATION\r
3290         MOVEI   3,1B19          ;SET FOR PUSH-DOWN OVERFLOW\r
3291         APRENB  3,\r
3292         SOS     3,PDP           ;GET PDP REQUEST MINUS 1\r
3293         IMULI   3,.PDP          ;COMPUTE SIZE (50*<NUMBER OF /P'S +1>)\r
3294         HRLZ    MP,3\r
3295         HRR     MP,JOBFF        ;SET BASIC POINTER\r
3296         MOVE    PP,MP\r
3297         SUB     PP,3\r
3298         MOVEM   PP,RP           ;SET RP\r
3299         SUB     PP,3\r
3300         ASH     3,1             ;DOUBLE SIZE OF BASIC POINTER\r
3301         HRL     PP,3\r
3302         SUBM    PP,3            ;COMPUTE TOP LOCATION\r
3303         HRRZM   3,LADR          ;SET START OF MACRO TREE\r
3304         HRRZM   3,FREE\r
3305 \r
3306 GETSE1: HRRZ    JOBREL\r
3307         SKIPE   JOBDDT\r
3308         HRRZ    JOBSYM\r
3309         SUBI    1\r
3310         MOVEM   SYMTOP\r
3311         SUBI    LENGTH\r
3312         CAMLE   LADR\r
3313         JRST    GETSE2\r
3314 \r
3315         HRRZ    2,JOBREL        ;NO, TRY FOR MORE CORE\r
3316         ADDI    2,2000\r
3317         CORE    2,\r
3318         JRST    XCEED2          ;NO MORE, INFORM USER\r
3319         JRST    GETSE1          ;TRY AGAIN\r
3320 \r
3321 GETSE2: MOVEM   SYMBOL          ;SET START OF SYMBOL TABLE\r
3322         HRLI    SYMNUM\r
3323         BLT     @SYMTOP         ;STORE SYMBOLS\r
3324         PUSHJ   PP,SRCHI\r
3325         MOVE    AC0,CTIBUF+1\r
3326         MOVEM   AC0,CTLSAV\r
3327         MOVSI   AC0,(SIXBIT 'DSK')\r
3328         MOVEM   AC0,ACDEVX\r
3329         PUSHJ   PP,INSET\r
3330 \r
3331         MOVEI   CS,[ASCIZ /MACRO: /]    ;PUBLISH COMPILER NAME\r
3332         TLNE    IO,CRPGSW       ;PUNCH REQUESTED?\r
3333         DDTOUT  CS,\r
3334         JRST    ASSEMB\r
3335 \r
3336 \fFINIS: CLOSE   BIN,            ;DUMP BUFFER\r
3337         TLNE    FR,PNCHSW       ;PUNCH REQUESTED?\r
3338         PUSHJ   PP,TSTBIN       ;YES, TEST FOR ERRORS\r
3339         RELEAS  BIN,\r
3340         CLOSE   LST,\r
3341         SOSLE   OUTSW           ;LPT TYPE OUTPUT?\r
3342         PUSHJ   PP,TSTLST       ;YES, TEST FOR ERRORS\r
3343         RELEAS  LST,\r
3344         CLOSE   CHAR,\r
3345         RELEAS  CHAR,\r
3346         OUTPUT  CTL,0           ;FLUSH TTY OUTPUT\r
3347         JRST    M\r
3348 \fINSET: MOVEI   JOBFFI          ;POINTER TO INPUT BUFFER\r
3349         HRRM    JOBFF           ;INFORM SYSTEM OF BUFFER AREA\r
3350         PUSHJ   PP,NAME2        ;GET NEXT COMMAND NAME\r
3351         JUMPE   ACDEV,ERRNE     ;ERROR IF NONE LEFT\r
3352         MOVEM   ACDEV,INDEV     ;STORE DEVICE\r
3353         MOVEM   ACFILE,INDIR    ;STORE FILE IN DIRECTORY\r
3354         PUSHJ   PP,INDEVI\r
3355         DEVCHR  ACDEV,          ;TEST CHARACTERISTICS\r
3356         TLNN    ACDEV,MTABIT    ;MAG TAPE?\r
3357         JRST    INSET3          ;NO\r
3358         TLZN    FR,MTAPSW       ;FIRST MAG TAPE IS PASS 2?\r
3359         JRST    INSET1          ;NO\r
3360         TLNN    TIO,TIORW       ;YES, REWIND REQUESTED?\r
3361         SUB     CS,RECCNT       ;NO, PREPARE TO BACK-SPACE TAPE\r
3362 INSET1: AOS     RECCNT          ;INCREMENT FILE COUNTER\r
3363         ADDM    CS,RECCNT       ;UPDATE  COUNT\r
3364         TLZE    TIO,TIOLE\r
3365         MTEOT.  CHAR,\r
3366         TLZE    TIO,TIORW       ;REWIND?\r
3367         MTREW.  CHAR,           ;YES\r
3368         JUMPGE  CS,INSET2\r
3369         MTBSF.  CHAR,\r
3370         MTBSF.  CHAR,\r
3371         AOJL    CS,.-1\r
3372         MTWAT.  CHAR,\r
3373         STATO   CHAR,1B24\r
3374         MTSKF.  CHAR,\r
3375 INSET2: SOJGE   CS,.-1\r
3376 \r
3377 INSET3: INBUF   CHAR,1\r
3378         MOVEI   ACPNTR,JOBFFI\r
3379         EXCH    ACPNTR,JOBFF\r
3380         SUBI    ACPNTR,JOBFFI\r
3381         MOVEI   ACDEL,NUMBUF*203+1\r
3382         IDIV    ACDEL,ACPNTR\r
3383         INBUF   CHAR,(ACDEL)\r
3384         JUMPN   SDEL,INSET4     ;TAKE USER'S EXTENSION IF NON-BLANK\r
3385         MOVSI   SDEL,(SIXBIT /MAC/)     ;BLANK, TRY .MAC FIRST\r
3386         PUSHJ   PP,INSETI\r
3387 INSET4: PUSHJ   PP,INSETI\r
3388         JUMPE   ACEXT,ERRCF     ;ERROR IF ZERO\r
3389         TLNE    ACDEV,TTYBIT    ;TELETYPE?\r
3390         SETSTS  CHAR,AL         ;YES, CHANGE TO ASCII LINE\r
3391         POPJ    PP,\r
3392 \r
3393 INSETI: HLLM    ACEXT,INDIR+1   ;STORE EXTENSION\r
3394         LOOKUP  CHAR,INDIR\r
3395         TDZA    ACEXT,ACEXT\r
3396         AOS     0(PP)\r
3397         POPJ    PP,\r
3398 \fREC2:  MOVE    CTLSAV\r
3399         MOVEM   CTIBUF+1\r
3400         MOVEI   "_"\r
3401         HRLM    BLKTYP\r
3402         SETZM   ACDEVX\r
3403         MOVE    [XWD PASS2I,PASS2I+1]\r
3404         BLT     PASS2X-1                ;ZERO PASS2 VARIABLES\r
3405         TLOA    FR,MTAPSW!LOADSW        ;SET FLAGS\r
3406         INPUT   CHAR,\r
3407 \r
3408 GOTEND: STATO   CHAR,1B22               ;TEST FOR EOF\r
3409         JRST    .-2\r
3410 \r
3411 EOT:    PUSHJ   PP,SAVEXS               ;SAVE REGISTERS\r
3412         RELEAS  CHAR,\r
3413         PUSHJ   PP,INSET                ;GET THE NEXT INPUT DEVICE\r
3414         HRROI   RC,[SIXBIT /END OF PASS 1@/]    ;ASSUME END OF PASS\r
3415         TLZN    FR,LOADSW               ;ZERO ONLY ON END OF PASS 1\r
3416         HRROI   RC,[SIXBIT /LOAD THE NEXT FILE@/]       ;NOT END OF PASS\r
3417         TLNN    ACDEV,(1B13!1B15)       ;WAS ALL THAT WORK NECESSARY?\r
3418         PUSHJ   PP,TYPMSG               ;YES\r
3419 \r
3420 RSTRXS: MOVSI   RC,SAVBLK               ;SET POINTER\r
3421         BLT     RC,RC-1\r
3422         MOVE    RC,SAVERC               ;RESTORE RC\r
3423         POPJ    PP,\r
3424 \r
3425 SAVEXS: MOVEM RC,SAVERC         ;SAVE RC\r
3426         MOVEI   RC,SAVBLK               ;SET POINTER\r
3427         BLT     RC,SAVBLK+RC-1  ;BLT ALL REGISTERS BELOW EC\r
3428         POPJ    PP,             ;EXIT\r
3429 \r
3430 \fNAME2: SKIPA   ACDEV,ACDEVX\r
3431 NAME1:  SETZB   ACDEV,INDIR+2\r
3432         MOVEI   ACFILE,0                ;CLEAR FILE\r
3433         HLRZ    ACDEL,ACDELX    ;GET PREVIOUS DELIMITER\r
3434         SETZB   TIO,CS\r
3435         SETZB   ACEXT,INDIR+3   ;RESET EXTENSION AND PROGRAM-NUMBER PAIR\r
3436 NAME3:  MOVSI   ACPNTR,(POINT 6,AC0)    ;SET POINTER\r
3437         TDZA    AC0,AC0         ;CLEAR SYMBOL\r
3438 \r
3439 SLASH:  PUSHJ   PP,SW0\r
3440 GETIOC: PUSHJ   PP,TTYIN        ;GET INPUT CHARACTER\r
3441         CAIN    C,"/"\r
3442         JRST    SLASH\r
3443         CAIN    C,"("\r
3444         JRST    SWITCH\r
3445         CAIN    C,":"\r
3446         JRST    DEVICE\r
3447         CAIN    C,"."\r
3448         JRST    NAME\r
3449 IFN CCLSW,<CAIE C,"!"           ;IS CHAR AN IMPARTIVE?\r
3450         CAIN    C,"@"\r
3451         JRST    TERM            ;YES, GO DO IT>\r
3452         CAIE    C,33            ;CHECK FOR THREE FLAVORS OF ALT-MODE\r
3453         CAIN    C,176           ;...\r
3454         JRST    TERM            ;...\r
3455         CAIE    C,175           ;OR 3RD ALTMOD\r
3456         CAIN    C,CR            ;CR?\r
3457         JRST    TERM\r
3458         CAIN    C,"["\r
3459         JRST    PROGNP\r
3460         CAIE    C,","\r
3461         CAIN    C,"_"\r
3462         JRST    TERM\r
3463         SUBI    C,40            ;CONVERT TO 6-BIT\r
3464         TLNE    ACPNTR,770000   ;HAVE WE STORED SIX BYTES?\r
3465         IDPB    C,ACPNTR        ;NO, STORE IT\r
3466         JRST    GETIOC          ;GET NEXT CHARACTER\r
3467 \r
3468 DEVICE: SKIPA   ACDEV,0         ;ERROR IF ALREADY SET\r
3469 \r
3470 NAME:   MOVE    ACFILE,AC0      ;FILE NAME\r
3471         MOVE    ACDEL,C         ;SET DELIMITER\r
3472         JRST    NAME3\r
3473 \r
3474 TERM:   JUMPE   ACDEL,TERM1     ;IF NO PREVIOUS TERMINATOR, THEN FILENAME\r
3475         CAIN    ACDEL,"_"       ;...\r
3476         JRST    TERM1           ;...\r
3477         CAIE    ACDEL,":"       ;IF PREVIOUS DELIMITER\r
3478         CAIN    ACDEL,","       ;WAS COLON OR COMMA\r
3479 TERM1:  MOVE    ACFILE,AC0      ;SET FILE\r
3480         CAIN    ACDEL,"."       ;IF PERIOD\r
3481         HLLZ    ACEXT,AC0       ;SET EXTENSION\r
3482         HRLM    C,ACDELX        ;SAVE PREVIOUS DELIMITER\r
3483         MOVEM   ACDEV,ACDEVX    ;USE LAST DEVICE\r
3484         CAIN    C,"!"           ;IMPERATIVE?\r
3485         POPJ    PP,             ;YES, DON'T ASSUME DEV\r
3486         JUMPE   ACFILE,POPOUT   ;IF THERE IS A FILE,\r
3487         SKIPN   ACDEV           ;BUT NO DEVICE\r
3488         MOVSI   ACDEV,(SIXBIT /DSK/)    ;THEN ASSUME DISK\r
3489         POPJ    PP,             ;EXIT\r
3490 \r
3491 \fPROGNP:        JUMPL   PP,PROGN2\r
3492 \r
3493 ERRCM:  HRROI   RC,[SIXBIT /COMMAND ERROR@/]\r
3494         JRST    ERRNE0\r
3495 \r
3496 PROGN1: HRLZM   RC,INDIR+3\r
3497 PROGN2: MOVEI   RC,0            ;CLEAR AC\r
3498 PROGN3: PUSHJ   PP,TTYIN\r
3499         CAIN    C,","\r
3500         JRST    PROGN1          ;STORE LEFT HALF\r
3501         HRRM    RC,INDIR+3\r
3502         CAIN    C,135\r
3503         JRST    GETIOC\r
3504         LSH     RC,3            ;SHIFT PREVIOUS RESULT\r
3505         ADDI    RC,-"0"(C)      ;ADD IN NEW NUMBER\r
3506         JRST    PROGN3\r
3507 \fSWITC0:        PUSHJ   PP,SW1\r
3508 SWITCH: PUSHJ   PP,TTYIN        ;GET NEXT CHARACTER\r
3509         CAIE    C,")"           ;END OF STRING?\r
3510         JRST    SWITC0          ;NO\r
3511         JRST    GETIOC          ;YES\r
3512 \r
3513 SW0:    PUSHJ   PP,TTYIN\r
3514 SW1:    MOVEI   C,-"A"(C)       ;CONVERT FROM ASCII TO NUMERIC\r
3515         CAILE   C,"Z"-"A"       ;WITHIN BOUNDS? (IS IT ALPHA?)\r
3516         JRST    ERRCM           ;NO, ERROR\r
3517         MOVE    RC,[POINT 4,BYTAB]\r
3518         IBP     RC\r
3519         SOJGE   C,.-1           ;MOVE TO PROPER BYTE\r
3520         LDB     C,RC            ;PICK UP BYTE\r
3521         JUMPE   C,ERRCM         ;TEST FOR VALID SWITCH\r
3522         CAIG    C,SWTABT-SWTAB  ;LEGAL ON SOURCE?\r
3523         JUMPL   PP,ERRCM        ;NO, TEST FOR SOURCE\r
3524         LDB     RC,[POINT 4,SWTAB-1(C),12]\r
3525         CAIN    RC,IO\r
3526         SKIPN   CTLSAV          ;IF PASS2 OR IO SWITCH\r
3527         XCT     SWTAB-1(C)      ;EXECUTE INSTRUCTION\r
3528         POPJ    PP,\r
3529 \r
3530 \f       DEFINE  SETSW   (LETTER,INSTRUCTION)    < INSTRUCTION\r
3531 J=      <"LETTER"-"A">-9*<I=<"LETTER"-"A">/9>\r
3532         SETCOD  \I,J>\r
3533 \r
3534         DEFINE  SETCOD          (I,J)\r
3535         <BYTAB'I=BYTAB'I!<.-SWTAB>B<4*J+3>>\r
3536 \r
3537 BYTAB0= 0                       ;INITIALIZE TABLE\r
3538 BYTAB1= 0\r
3539 BYTAB2= 0\r
3540 \r
3541 SWTAB:\r
3542         SETSW   Z,<TLO  TIO,TIOCLD      >\r
3543         SETSW   C,<TLZ  FR,CREFSW       >\r
3544         SETSW   P,<SOS  PDP             >\r
3545 SWTABT:                         ;THE ABOVE SW'S ARE LEGAL ON OUTPUT ONLY\r
3546         SETSW   A,<ADDI CS,1            >\r
3547         SETSW   B,<SUBI CS,1            >\r
3548         SETSW   E,<TLZ  IO,IOPALL       >\r
3549         SETSW   L,<TLZ  IO,IOMSTR       >\r
3550         SETSW   N,<HLLOS        TYPERR          >\r
3551         SETSW   Q,<TLO  FR,ERRQSW       >\r
3552         SETSW   S,<TLO  IO,IOMSTR       >\r
3553         SETSW   T,<TLO  TIO,TIOLE       >\r
3554         SETSW   W,<TLO  TIO,TIORW       >\r
3555         SETSW   X,<TLO  IO,IOPALL       >\r
3556 IFG .-SWTAB-17,<PRINTX SWITCH TABLE TOO LONG, CHANGE BYTE SIZE>\r
3557 \r
3558 BYTAB:                          ;BYTAB CONTAINS AN INDEX TO SWTAB\r
3559                                 ;IT CONSIST OF 9 4BIT BYTES/WORD\r
3560                                 ;OR ONE BYTE FOR EACH LETTER\r
3561 \r
3562         +BYTAB0                 ;A-G    BYTE = 1 THROUGH 17 = INDEX\r
3563         +BYTAB1                 ;H-N    BYTE = 0 = COMMAND ERROR\r
3564         +BYTAB2                 ;O-U\r
3565 \r
3566 \fTTYIN: ILDB    C,CTIBUF+1              ;GET CHARACTER\r
3567         CAIE    C," "           ;SKIP BLANKS\r
3568         CAIN    C,HT            ;AND TABS\r
3569         JRST    TTYIN\r
3570         CAIE    C,LF\r
3571         POPJ    PP,\r
3572 \r
3573 ERRNE:  HRROI RC,[SIXBIT /?NO END STATEMENT ENCOUNTERED ON INPUT FILE@/]\r
3574         PUSHJ PP,TYPMSG\r
3575         SKIPN LITLVL            ;SET IF IN LITERAL\r
3576         JRST ERRNE1             ;NO, TRY OTHERS\r
3577         MOVE V,[XWD [SIXBIT /LITERAL@/],LITPG]\r
3578         PUSHJ PP,PRNUM\r
3579 ERRNE1: MOVEI V,0               ;CHECK FOR OTHER PLACES\r
3580         SKIPE INDEF\r
3581         MOVE V,[XWD [SIXBIT /DEFINE@/],DEFPG]\r
3582         SKIPE INTXT\r
3583         MOVE V,[XWD [SIXBIT /TEXT@/],TXTPG]\r
3584         SKIPE INREP\r
3585         MOVE V,[XWD [SIXBIT /CONDITIONAL OR REPEAT@/],REPPG]\r
3586         SKIPGE MACENL\r
3587         MOVE V,[XWD [SIXBIT /MACRO CALL@/],CALPG]\r
3588         SKIPE V\r
3589         PUSHJ PP,PRNUM          ;GO PRINT INFORMATION\r
3590         HRROI RC,[SIXBIT /@/]   ;WILL GET A RETURN\r
3591         JRST ERRNE0\r
3592 \r
3593 ERRMS3: SIXBIT / ERRORS DETECTED@/\r
3594 ERRMS2: SIXBIT /?1 ERROR DETECTED@/\r
3595 ERRMS1: SIXBIT /NO ERRORS DETECTED@/\r
3596 EINIT:  MOVE    RC,[XWD ACDEV,[SIXBIT /NOT AVAILABLE@/]]\r
3597         JRST    ERRNE0\r
3598 \fERREF: SKIPA   RC,[XWD [SIXBIT /CANNOT ENTER FILE@/],ACFILE]\r
3599 ERRCF:  MOVE    RC,[XWD [SIXBIT /CANNOT FIND@/],ACFILE]\r
3600 ERRNE0: PUSHJ   PP,CRLF\r
3601         MOVEI   C,77\r
3602         PUSHJ   PP,TYO\r
3603         PUSHJ   PP,TYPMS1\r
3604         JRST    M\r
3605 \fTYPMSG:        PUSHJ   PP,CRLF         ;MOVE TO NEXT LINE\r
3606 TYPMS1: HLRZ    CS,RC           ;GET FIRST MESSAGE\r
3607         CAIE    CS,-1           ;SKIP IF MINUS ONE\r
3608         PUSHJ   PP,TYPM2        ;TYPE MESSAGE\r
3609         HRRZ    CS,RC           ;GET SECOND HALF\r
3610         PUSHJ   PP,TYPM2\r
3611 \r
3612 CRLF:   MOVEI   C,CR            ;OUTPUT CARRIAGE RETURN\r
3613         PUSHJ   PP,TYO\r
3614         MOVEI   C,LF            ;AND LINE FEED\r
3615 \r
3616 TYO:    SOSG    CTOBUF+2        ;BUFFER FULL?\r
3617         OUTPUT  CTL,0           ;YES, DUMP IT\r
3618         IDPB    C,CTOBUF+1      ;STORE BYTE\r
3619         CAIE    C,FF            ;FORM FEED?\r
3620         CAIN    C,LF            ;V TAB OR LINE FEED?\r
3621         OUTPUT  CTL,0           ;YES\r
3622         POPJ    PP,             ;AND EXIT\r
3623 \r
3624 TYPM2:  MOVSI   C,(1B0)         ;ANTICIPATE REGISTER WORD\r
3625         CAIG    CS,17           ;IS IT?\r
3626         MOVEM   C,1(CS)\r
3627         HRLI    CS,(POINT 6,,)  ;FORM BYTE POINTER\r
3628 \r
3629 TYPM3:  ILDB    C,CS            ;GET A SIXBIT BYTE\r
3630         CAIN    C,40            ;"@"?\r
3631         JRST    TYO             ;YES, TYPE SPACE AND EXIT\r
3632         ADDI    C,40            ;NO, FORM 7-BIT ASCII\r
3633         PUSHJ   PP,TYO          ;OUTPUT CHARACTER\r
3634         JRST    TYPM3\r
3635 \r
3636 \fXCEEDS:        ADDI    SX,2000 ;ADJUST SYMBOL POINTER\r
3637 XCEED:  PUSHJ   PP,SAVEXS       ;SAVE THE REGISTERS\r
3638         HRRZ    1,JOBREL        ;GET CURRENT TOP\r
3639         MOVEI   0,2000(1)\r
3640 XCEED2: HRROI   RC,[SIXBIT /INSUFFICIENT CORE@/]\r
3641         CORE    0               ;REQUEST MORE CORE\r
3642         JRST    ERRNE0          ;ERROR, BOMB OUT\r
3643         HRRZ    2,JOBREL        ;GET NEW TOP\r
3644 \r
3645 XCEED1: MOVE    0,0(1)          ;GET ORIGIONAL\r
3646         MOVEM   0,0(2)          ;STORE IN NEW LOCATION\r
3647         SUBI    2,1             ;DECREMENT UPPER\r
3648         CAMLE   1,SYMBOL        ;HAVE WE ARRIVED?\r
3649         SOJA    1,XCEED1        ;NO, GET ANOTHER\r
3650         MOVEI   1,2000\r
3651         ADDM    1,SYMBOL\r
3652         ADDM    1,116\r
3653         ADDM    1,SYMTOP\r
3654         PUSHJ   PP,SRCHI        ;RE-INITIALIZE SYMBOL TABLE\r
3655         JRST    RSTRXS  ;RESTORE REGISTERS AND EXIT\r
3656 \r
3657 PDPERR: HRROI   RC,[SIXBIT .PDP OVERFLOW, TRY /P@.]\r
3658         JRST    ERRNE0\r
3659 \r
3660 PRNUM:  HLRZ CS,V       ;GET MESSAGE\r
3661         PUSHJ PP,TYPM2\r
3662         MOVE AC0,(V)    ;GET PAGE\r
3663         PUSHJ PP,DP1    ;PRINT NUMBER\r
3664         MOVEI C,40\r
3665         PUSHJ PP,TYO\r
3666         SKIPN AC1,1(V)  ;GET SEQ NUM IF THERE\r
3667         POPJ PP,\r
3668         MOVEM AC1,OUTSQ\r
3669         MOVEI AC0,OUTSQ\r
3670         OUTPUT CTL,0    ;TO MAKE THINGS PRINT IN RIGHT ORDER\r
3671         DDTOUT AC0,\r
3672         MOVEI C,40\r
3673         JRST TYO        ;AND RETURN\r
3674 \r
3675 DP1:    IDIVI AC0,^D10\r
3676         HRLM AC1,(PP)\r
3677         SKIPE AC0\r
3678         PUSHJ PP,DP1\r
3679         HLRZ C,(PP)\r
3680         ADDI C,"0"\r
3681         JRST TYO\r
3682 \fRIM0:  TDO     FR,AC0          ;SET RIM/RIM10 FLAG\r
3683         TLNE    FR,PNCHSW       ;FORGET IT IF PUNCH RESET\r
3684         SETSTS  BIN,IB          ;SET TO IMAGE BINARY MODE\r
3685         POPJ    PP,\r
3686 \r
3687 ROUT:   EXCH    CS,RIMLOC\r
3688         SUB     PP,[XWD 1,1]    ;CLEAR OUT STACK WFW\r
3689         TLNE    FR,R1BSW\r
3690         JRST    ROUT6\r
3691         TLNN    FR,RIM1SW\r
3692         JRST    ROUT1\r
3693         JUMPE   CS,ROUT1\r
3694         SUB     CS,RIMLOC\r
3695         JUMPE   CS,ROUT1\r
3696         JUMPG   CS,ERRAX\r
3697         MOVEI   C,0\r
3698         PUSHJ   PP,PTPBIN\r
3699         AOJL    CS,.-1\r
3700 ROUT1:  MOVSI   C,(DATAI PTR,)  ;RIM OUTPUT\r
3701         HRR     C,LOCO          ;GET ADDRESS\r
3702         TLNE    FR,RIM1SW       ;NO DATAI IF RIM10      \r
3703         AOSA    RIMLOC\r
3704         PUSHJ   PP,PTPBIN       ;OUTPUT\r
3705         MOVE    C,AC0           ;CODE\r
3706         AOSA    LOCO            ;INCREMENT CURRENT LOCATION\r
3707 \r
3708 OUTBIN: TLNN    FR,RIMSW!RIM1SW!R1BSW   ;EXIT IF RIM MODE\r
3709 PTPBIN: TLNN    FR,PNCHSW       ;EXIT IF PUNCH NOT REQUESTED\r
3710         POPJ    PP,\r
3711         SOSG    BINBUF+2        ;TEST FOR BUFFER FULL\r
3712         PUSHJ   PP,DMPBIN       ;YES, DUMP IT\r
3713         IDPB    C,BINBUF+1      ;DEPOSIT BYTE\r
3714         POPJ    PP,             ;EXIT\r
3715 \fDMPBIN:        OUTPUT  BIN,0           ;DUMP THE BUFFER\r
3716 TSTBIN: STATO   BIN,740000      ;GET STATUS BITS\r
3717         POPJ    PP,             ;NO, EXIT\r
3718         MOVE    AC0,BINDEV      ;YES, GET TAG\r
3719         JRST    ERRLST\r
3720 \f\r
3721 R1BDMP: SETCM CS,R1BCNT\r
3722         JUMPE CS,R1BI\r
3723         HRLZS C,CS\r
3724         HRR C,R1BLOC\r
3725         HRRI C,-1(C)\r
3726         MOVEM C,R1BCHK\r
3727         PUSHJ PP,PTPBIN\r
3728         HRRI CS,R1BBLK\r
3729 R1BDM1: MOVE C,0(CS)\r
3730         ADDM C,R1BCHK\r
3731         PUSHJ PP,PTPBIN\r
3732         AOBJN CS,R1BDM1\r
3733         MOVE C,R1BCHK\r
3734         PUSHJ PP,PTPBIN\r
3735 R1BI:   SETOM R1BCNT\r
3736         PUSH PP,LOCO\r
3737         POP PP,R1BLOC\r
3738         POPJ PP,\r
3739 \r
3740 ROUT6:  CAME CS,RIMLOC\r
3741         PUSHJ PP,R1BDMP\r
3742         AOS C,R1BCNT\r
3743         MOVEM 0,R1BBLK(C)\r
3744         AOS LOCO\r
3745         CAIN C,21\r
3746         PUSHJ PP,R1BDMP\r
3747         AOS RIMLOC\r
3748         POPJ PP,\r
3749 \fREAD0: PUSHJ   PP,EOT\r
3750 READ:   SOSG    IBUF+2  ;BUFFER EMPTY?\r
3751         JRST    READ3           ;YES\r
3752 READ1:  ILDB    C,IBUF+1        ;PLACE CHARACTER IN C\r
3753         MOVE CS,@IBUF+1         ;CHECK FOR SEQUENCE NUMBER\r
3754         TRNN CS,1\r
3755         JRST READ1A\r
3756         CAIN CS,1               ;CHECK FOR SPECIAL\r
3757         MOVE CS,[<ASCII/     />+1]\r
3758         MOVEM CS,SEQNO\r
3759         MOVEM CS,SEQNO2\r
3760         MOVNI CS,4\r
3761         ADDM CS,IBUF+2          ;ADJUST WORD COUNT\r
3762 REPEAT 4,<      IBP IBUF+1>     ;SKIP SEQ NU\r
3763         PUSHJ PP,READ   ;AND THE TAB\r
3764         JRST    READ            ;GET NEXT CHARACTER\r
3765 \r
3766 READ1A: JUMPE   C,READ          ;IGNORE NULL\r
3767         JUMP2   READ1B\r
3768         CAIN    C,14\r
3769         AOS     PAGENO\r
3770 READ1B: CAIN    C,32            ;IF IT'S A "^Z"\r
3771         MOVEI   C,LF            ;TREAT IT AS A "LF"\r
3772         CAIE    C,37            ;CONTROL _\r
3773         POPJ    PP,\r
3774 READ2:  PUSHJ   PP,READ         ;YES, TEST FOR LINE FEED\r
3775         PUSHJ   PP,RSW2         ;LIST IN ANY EVENT\r
3776         CAIE    C,LF            ;IS IT LF\r
3777         JRST    READ2           ;NO\r
3778         PUSHJ   PP,OUTIM1               ;YES, DUMP THE LINE\r
3779         JRST    READ            ;RETURN NEXT CHARACTER\r
3780 \r
3781 READ3:  INPUT   CHAR,0          ;GET NEXT BUFFER\r
3782         STATO   CHAR,762000     ;NO ERRORS\r
3783         JRST    READ1\r
3784         STATO   CHAR,742000     ;ERRORS?\r
3785         JRST    READ0           ;EOF\r
3786         MOVE    AC0,INDEV\r
3787         MOVSI   RC,[SIXBIT /INPUT ERROR ON DEVICE@/]\r
3788         JRST    ERRNE0\r
3789 \fOUTAB2:        PUSHJ   PP,OUTTAB       ;PRINT TWO TABS\r
3790 OUTTAB: MOVEI   C,HT\r
3791 PRINT:  CAIN    C,LF            ;IS THIS A LF?\r
3792         JRST    OUTCR           ;YES, GO PROCESS\r
3793         CAIN    C,CR            ;OR CR?\r
3794         POPJ    PP,\r
3795         CAIN    C,FF            ;FORM FEED?\r
3796         JRST    OUTFF           ;YES FORCE NEW PAGE\r
3797         JRST    OUTL\r
3798 \r
3799 OUTCR:  TRNN    ER,ERRORS!LPTSW!TTYSW\r
3800         POPJ    PP,\r
3801         MOVEI   C,CR            ;CARRIAGE RETURN, LINE FEED\r
3802         PUSHJ   PP,OUTL\r
3803         SOSGE   LPP             ;END OF PAGE?\r
3804         TLO     IO,IOPAGE       ;YES, SET FLAG\r
3805         TRCA    C,7             ;FORM LINE FEED AND SKIP\r
3806 \r
3807 OUTL:   TLZN    IO,IOPAGE       ;NEW PAGE REQUESTED?\r
3808         JRST    OUTC            ;NO\r
3809         JUMP1    OUTC           ;YES, BYPASS IF PASS ONE\r
3810         PUSH    PP,C            ;SAVE C AND CS\r
3811         PUSH    PP,CS\r
3812         PUSH    PP,ER\r
3813         TLNN    IO,IOMSTR!IOPROG\r
3814         HRR     ER,OUTSW\r
3815         MOVEI   C,.LPP  \r
3816         MOVEM   C,LPP           ;SET NEW COUNTER\r
3817         MOVEI   C,CR\r
3818         PUSHJ   PP,OUTC\r
3819         MOVEI   C,FF\r
3820         PUSHJ   PP,OUTC         ;OUTPUT FORM FEED\r
3821         MOVEI   CS,TBUF\r
3822         PUSHJ   PP,OUTAS0       ;OUTPUT TITLE\r
3823         MOVEI   CS,VBUF\r
3824         PUSHJ   PP,OUTAS0       ;OUTPUT VERSION\r
3825         MOVE    C,PAGENO\r
3826         PUSHJ   PP,DNC          ;OUTPUT PAGE NUMBER\r
3827         AOSG    PAGEN.          ;FIRST PAGE OF THIS NUMBER?\r
3828         JRST    OUTL1\r
3829         MOVEI   C,"-"           ;NO, PUT OUT MODIFIER\r
3830         PUSHJ   PP,OUTC\r
3831         MOVE    C,PAGEN.\r
3832         PUSHJ   PP,DNC\r
3833 OUTL1:  PUSHJ   PP,OUTCR\r
3834         HRRZ    CS,SUBTTX       ;SWITCH FOR SUB-TITLE\r
3835         SKIPE   0(CS)           ;IS THERE A SUB-TITLE?\r
3836         PUSHJ   PP,OUTTAB       ;YES, OUTPUT A TAB\r
3837         PUSHJ   PP,SOUT20       ;OUTPUT ASCII WITH CARRIAGE RETURN\r
3838         PUSHJ   PP,OUTCR\r
3839         POP     PP,ER\r
3840         POP     PP,CS\r
3841         POP     PP,C\r
3842 \r
3843 OUTC:   TRNE    ER,ERRORS!TTYSW\r
3844         PUSHJ   PP,TYO\r
3845         TRNN    ER,LPTSW\r
3846         POPJ    PP,\r
3847 OUTLST: SOSG    LSTBUF+2        ;BUFFER FULL?\r
3848         PUSHJ   PP,DMPLST       ;YES, DUMP IT\r
3849         IDPB    C,LSTBUF+1      ;STORE BYTE\r
3850         POPJ    PP,\r
3851 DMPLST: OUTPUT  LST,0           ;OUTPUT BUFFER\r
3852 TSTLST: STATO   LST,740000\r
3853         POPJ    PP,\r
3854         MOVE    0,LSTDEV\r
3855 ERRLST: MOVSI   RC,[SIXBIT /DATA ERROR DEVICE@/]\r
3856         JRST    ERRNE0\r
3857 \fPAGE0:\r
3858 OUTFF:  AOS     PAGENO\r
3859         SETOM   PAGEN.\r
3860         TLO     IO,IOPAGE\r
3861         POPJ    PP,\r
3862 \r
3863 OTOD1:  IBP     CS\r
3864 OTOD:   IDIVI   2,^D10\r
3865         ADDI    2,60            ;FORM ASCII\r
3866         IDPB    2,CS\r
3867         ADDI    3,60\r
3868         IDPB    3,CS\r
3869         POPJ    PP,\r
3870 \r
3871 DTAB:   ASCII "JAN-"\r
3872         ASCII "FEB-"\r
3873         ASCII "MAR-"\r
3874         ASCII "APR-"\r
3875         ASCII "MAY-"\r
3876         ASCII "JUN-"\r
3877         ASCII "JUL-"\r
3878         ASCII "AUG-"\r
3879         ASCII "SEP-"\r
3880         ASCII "OCT-"\r
3881         ASCII "NOV-"\r
3882         ASCII "DEC-"\r
3883 \fSUBTTL MACHINE INSTRUCTION SEARCH ROUTINES\r
3884 OPTSCH: MOVEI   RC,0\r
3885         MOVEI   ARG,1B^L<OP1END-OP1TOP> ;SET UP INDEX\r
3886         MOVEI   V,1B^L<OP1END-OP1TOP>/2 ;SET UP INCREMENT\r
3887 OPT1A:  CAMN    AC0,OP1TOP(ARG)         ;ARE WE POINTING AT SYMBOL?\r
3888         JRST    OPT1D                   ;YES, GET THE CODE\r
3889         JUMPE   V,POPOUT                ;TEST FOR END\r
3890         CAML    AC0,OP1TOP(ARG)         ;NO, SHOULD WE MOVE DOWN?\r
3891         TDOA    ARG,V                   ;NO, INCREMENT\r
3892 OPT1B:  SUB     ARG,V                   ;YES, DECREMENT\r
3893         ASH     V,-1                    ;HALVE INCREMENT\r
3894         CAIG    ARG,OP1END-OP1TOP       ;ARE WE OUT OF BOUNDS?\r
3895         JRST    OPT1A                   ;NO, TRY AGAIN\r
3896         JRST    OPT1B                   ;YES, BRING IT DOWN A PEG\r
3897 OPT1D:  IDIVI   ARG,4                   ;ARG HAS INDEX USED IN OPTTAB\r
3898         LDB     V,OPTTAB(V)             ;V HAS INDEX TO OPTTAB\r
3899         CAIL    V,700                   ;PSEUDO-OP OR IO INSTRUCTION?\r
3900         JRST    OPT1G                   ;YES\r
3901         ROT     V,-^D9                  ;LEFT JUSTIFY\r
3902         HRRI    V,OPD                   ;POINT TO BASIC FORMAT\r
3903 OPT1F:  AOS     0(PP)                   ;SET FOR SKIP EXIT\r
3904         MOVEI   SDEL,%OP                ;SET OP-CODE CROSS-REF FLAG\r
3905         JRST    CREF                    ;TEST AND OUTPUT, AC0=SYMBOL, V=VALUE\r
3906 OPT1G:  TLNN    AC0,200000              ;PSEUDO-OP OR IO INST., TEST FOR PROPER TABLE\r
3907         SKIPA   V,OP2TAB-700(V)         ;2ND TABLE, FIRST LETTER IS "A" TO "O"\r
3908         MOVE    V,OP1TAB-700(V)         ;1ST TABLE, ..."P" TO "Z"\r
3909         JRST    OPT1F                   ;EXIT\r
3910 OPTTAB:\r
3911         POINT   9,OP1COD-1(ARG),35\r
3912         POINT   9,OP1COD(ARG),8\r
3913         POINT   9,OP1COD(ARG),17\r
3914         POINT   9,OP1COD(ARG),26\r
3915 \r
3916 \fIFDEF .XCREF,< .XCREF  ;DON'T CREF THIS MESS>\r
3917         RELOC   .-1\r
3918 OP1TOP:\r
3919         RELOC\r
3920 \r
3921         IF1,<N1=0\r
3922         DEFINE  X  <N1=N1+1 ;>>\r
3923 \r
3924         IF2, <\r
3925         N2=^D36\r
3926         CC=0\r
3927         RELOC   OP1COD\r
3928         RELOC\r
3929 DEFINE  X (SYMBOL,CODE) \r
3930 <SIXBIT /SYMBOL/\r
3931 CC=CC+CODE_<N2=N2-9>\r
3932 IFE N2, <OUTLIT>>\r
3933 \r
3934 DEFINE  OUTLIT  <\r
3935         RELOC\r
3936         +CC\r
3937         RELOC\r
3938 N2=^D36+<CC=0>>>\r
3939         SYN X,XX                ;JUST THE SAME MACRO\r
3940 \fX      ADD   , 270\r
3941 X       ADDB  , 273\r
3942 X       ADDI  , 271\r
3943 X       ADDM  , 272\r
3944 \r
3945 X       AND   , 404\r
3946 X       ANDB  , 407\r
3947 X       ANDCA , 410\r
3948 X       ANDCAB, 413\r
3949 X       ANDCAI, 411\r
3950 X       ANDCAM, 412\r
3951 X       ANDCB , 440\r
3952 X       ANDCBB, 443\r
3953 X       ANDCBI, 441\r
3954 X       ANDCBM, 442\r
3955 X       ANDCM , 420\r
3956 X       ANDCMB, 423\r
3957 X       ANDCMI, 421\r
3958 X       ANDCMM, 422\r
3959 X       ANDI  , 405\r
3960 X       ANDM  , 406\r
3961 \r
3962 X       AOBJN , 253\r
3963 X       AOBJP , 252\r
3964 \r
3965 X       AOJ   , 340\r
3966 X       AOJA  , 344\r
3967 X       AOJE  , 342\r
3968 X       AOJG  , 347\r
3969 X       AOJGE , 345\r
3970 X       AOJL  , 341\r
3971 X       AOJLE , 343\r
3972 X       AOJN  , 346\r
3973 \r
3974 XX      AOS   , 350\r
3975 X       AOSA  , 354\r
3976 X       AOSE  , 352\r
3977 X       AOSG  , 357\r
3978 X       AOSGE , 355\r
3979 X       AOSL  , 351\r
3980 X       AOSLE , 353\r
3981 X       AOSN  , 356\r
3982 X       ARG   , 320\r
3983 X       ASCII , 700\r
3984 XX      ASCIZ , 701\r
3985 \r
3986 X       ASH   , 240\r
3987 X       ASHC  , 244\r
3988 \r
3989 X       ASUPPR, 705\r
3990 X       BLKI  , 702\r
3991 X       BLKO  , 703\r
3992 X       BLOCK , 704\r
3993 \r
3994 X       BLT   , 251\r
3995 \r
3996 X       BYTE  , 707\r
3997 \r
3998 XX      CAI   , 300\r
3999 X       CAIA  , 304\r
4000 X       CAIE  , 302\r
4001 X       CAIG  , 307\r
4002 X       CAIGE , 305\r
4003 X       CAIL  , 301\r
4004 X       CAILE , 303\r
4005 X       CAIN  , 306\r
4006 \r
4007 X       CALL  , 040\r
4008 XX      CALLI , 047\r
4009 \r
4010 XX      CAM   , 310\r
4011 X       CAMA  , 314\r
4012 X       CAME  , 312\r
4013 X       CAMG  , 317\r
4014 X       CAMGE , 315\r
4015 X       CAML  , 311\r
4016 X       CAMLE , 313\r
4017 X       CAMN  , 316\r
4018 \r
4019 XX      CLEAR , 400\r
4020 XX      CLEARB, 403\r
4021 XX      CLEARI, 401\r
4022 XX      CLEARM, 402\r
4023 \r
4024 X       CLOSE , 070\r
4025 \r
4026 \r
4027 X       CONI  , 710\r
4028 X       CONO  , 711\r
4029 X       CONSO , 712\r
4030 X       CONSZ , 713\r
4031 \r
4032 XX      DATA. , 020\r
4033 \r
4034 X       DATAI , 714\r
4035 X       DATAO , 715\r
4036 X       DEC   , 716\r
4037 X       DEFINE, 717\r
4038 X       DEPHAS, 720\r
4039 \r
4040 X       DFN   , 131\r
4041 \r
4042 X       DIV   , 234\r
4043 X       DIVB  , 237\r
4044 X       DIVI  , 235\r
4045 X       DIVM  , 236\r
4046 \r
4047 X       DPB   , 137\r
4048 \r
4049 X       END   , 721\r
4050 \r
4051 X       ENTER , 077\r
4052 \r
4053 X       ENTRY , 722\r
4054 \r
4055 X       EQV   , 444\r
4056 X       EQVB  , 447\r
4057 X       EQVI  , 445\r
4058 X       EQVM  , 446\r
4059 \r
4060 X       EXCH  , 250\r
4061 \r
4062 X       EXP   , 723\r
4063 XX      EXTERN, 724\r
4064 \r
4065 X       FAD   , 140\r
4066 X       FADB  , 143\r
4067 X       FADL  , 141\r
4068 X       FADM  , 142\r
4069 \r
4070 X       FADR  , 144\r
4071 X       FADRB , 147\r
4072 X       FADRI , 145\r
4073 X       FADRM , 146\r
4074 \r
4075 X       FDV   , 170\r
4076 X       FDVB  , 173\r
4077 X       FDVL  , 171\r
4078 X       FDVM  , 172\r
4079 \r
4080 X       FDVR  , 174\r
4081 X       FDVRB , 177\r
4082 X       FDVRI , 175\r
4083 X       FDVRM , 176\r
4084 \r
4085 XX      FIN.  , 021\r
4086 \r
4087 \r
4088 X       FMP   , 160\r
4089 X       FMPB  , 163\r
4090 X       FMPL  , 161\r
4091 X       FMPM  , 162\r
4092 \r
4093 \fX      FMPR  , 164\r
4094 X       FMPRB , 167\r
4095 X       FMPRI , 165\r
4096 X       FMPRM , 166\r
4097 \r
4098 X       FSB   , 150\r
4099 X       FSBB  , 153\r
4100 X       FSBL  , 151\r
4101 X       FSBM  , 152\r
4102 \r
4103 X       FSBR  , 154\r
4104 X       FSBRB , 157\r
4105 X       FSBRI , 155\r
4106 X       FSBRM , 156\r
4107 \r
4108 X       FSC   , 132\r
4109 \r
4110 X       GETSTS, 062\r
4111 \r
4112 \fX      HALT  , 725\r
4113 IFN RENTSW, <X  HISEG , 706>\r
4114 \r
4115 X       HLL   , 500\r
4116 X       HLLE  , 530\r
4117 X       HLLEI , 531\r
4118 X       HLLEM , 532\r
4119 X       HLLES , 533\r
4120 X       HLLI  , 501\r
4121 X       HLLM  , 502\r
4122 X       HLLO  , 520\r
4123 X       HLLOI , 521\r
4124 X       HLLOM , 522\r
4125 X       HLLOS , 523\r
4126 X       HLLS  , 503\r
4127 X       HLLZ  , 510\r
4128 X       HLLZI , 511\r
4129 X       HLLZM , 512\r
4130 X       HLLZS , 513\r
4131 \r
4132 X       HLR   , 544\r
4133 X       HLRE  , 574\r
4134 X       HLREI , 575\r
4135 X       HLREM , 576\r
4136 X       HLRES , 577\r
4137 X       HLRI  , 545\r
4138 X       HLRM  , 546\r
4139 X       HLRO  , 564\r
4140 X       HLROI , 565\r
4141 X       HLROM , 566\r
4142 X       HLROS , 567\r
4143 X       HLRS  , 547\r
4144 X       HLRZ  , 554\r
4145 X       HLRZI , 555\r
4146 X       HLRZM , 556\r
4147 X       HLRZS , 557\r
4148 \r
4149 \fX      HRL   , 504\r
4150 X       HRLE  , 534\r
4151 X       HRLEI , 535\r
4152 X       HRLEM , 536\r
4153 X       HRLES , 537\r
4154 X       HRLI  , 505\r
4155 X       HRLM  , 506\r
4156 X       HRLO  , 524\r
4157 X       HRLOI , 525\r
4158 X       HRLOM , 526\r
4159 X       HRLOS , 527\r
4160 X       HRLS  , 507\r
4161 X       HRLZ  , 514\r
4162 X       HRLZI , 515\r
4163 X       HRLZM , 516\r
4164 X       HRLZS , 517\r
4165 \r
4166 X       HRR   , 540\r
4167 X       HRRE  , 570\r
4168 X       HRREI , 571\r
4169 X       HRREM , 572\r
4170 X       HRRES , 573\r
4171 X       HRRI  , 541\r
4172 X       HRRM  , 542\r
4173 X       HRRO  , 560\r
4174 X       HRROI , 561\r
4175 X       HRROM , 562\r
4176 X       HRROS , 563\r
4177 X       HRRS  , 543\r
4178 X       HRRZ  , 550\r
4179 X       HRRZI , 551\r
4180 X       HRRZM , 552\r
4181 X       HRRZS , 553\r
4182 \r
4183 X       IBP   , 133\r
4184 \r
4185 X       IDIV  , 230\r
4186 X       IDIVB , 233\r
4187 X       IDIVI , 231\r
4188 X       IDIVM , 232\r
4189 \r
4190 X       IDPB  , 136\r
4191 \r
4192 X       IF1   , 726\r
4193 X       IF2   , 727\r
4194 X       IFB   , 730\r
4195 X       IFDEF , 731\r
4196 X       IFDIF , 732\r
4197 X       IFE   , 733\r
4198 X       IFG   , 734\r
4199 X       IFGE  , 735\r
4200 X       IFIDN , 736\r
4201 X       IFL   , 737\r
4202 X       IFLE  , 740\r
4203 X       IFN   , 741\r
4204 X       IFNB  , 742\r
4205 X       IFNDEF, 743\r
4206 \r
4207 X       ILDB  , 134\r
4208 \r
4209 X       IMUL  , 220\r
4210 X       IMULB , 223\r
4211 X       IMULI , 221\r
4212 X       IMULM , 222\r
4213 \r
4214 X       IN    , 056\r
4215 XX      IN.   , 016\r
4216 X       INBUF , 064\r
4217 XX      INF.  , 026\r
4218 X       INIT  , 041\r
4219 X       INPUT , 066\r
4220 \r
4221 XX      INTERN, 744\r
4222 \r
4223 X       IOR   , 434\r
4224 X       IORB  , 437\r
4225 X       IORI  , 435\r
4226 X       IORM  , 436\r
4227 \r
4228 \r
4229 X       IOWD  , 745\r
4230 X       IRP   , 746\r
4231 X       IRPC  , 747\r
4232 X       JCRY  , 750\r
4233 X       JCRY0 , 751\r
4234 X       JCRY1 , 752\r
4235 X       JEN   , 753\r
4236 \r
4237 XX      JFCL  , 255\r
4238 \r
4239 X       JFFO  , 243\r
4240 X       JFOV  , 765\r
4241 X       JOV   , 754\r
4242 \r
4243 X       JRA   , 267\r
4244 XX      JRST  , 254\r
4245 \r
4246 X       JRSTF , 755\r
4247 \r
4248 X       JSA   , 266\r
4249 XX      JSP   , 265\r
4250 X       JSR   , 264\r
4251 \r
4252 XX      JUMP  , 320\r
4253 XX      JUMPA , 324\r
4254 X       JUMPE , 322\r
4255 X       JUMPG , 327\r
4256 X       JUMPGE, 325\r
4257 X       JUMPL , 321\r
4258 X       JUMPLE, 323\r
4259 X       JUMPN , 326\r
4260 \r
4261 X       LALL  , 756\r
4262 \r
4263 X       LDB   , 135\r
4264 \r
4265 X       LIST  , 757\r
4266 X       LIT   , 760\r
4267 X       LOC   , 761\r
4268 \r
4269 X       LOOKUP, 076\r
4270 \r
4271 X       LSH   , 242\r
4272 X       LSHC  , 246\r
4273 X       MLOFF , 767\r
4274 X       MLON  , 766\r
4275 XX      MOVE  , 200\r
4276 XX      MOVEI , 201\r
4277 XX      MOVEM , 202\r
4278 X       MOVES , 203\r
4279 X       MOVM  , 214\r
4280 X       MOVMI , 215\r
4281 X       MOVMM , 216\r
4282 X       MOVMS , 217\r
4283 X       MOVN  , 210\r
4284 X       MOVNI , 211\r
4285 X       MOVNM , 212\r
4286 X       MOVNS , 213\r
4287 X       MOVS  , 204\r
4288 X       MOVSI , 205\r
4289 X       MOVSM , 206\r
4290 X       MOVSS , 207\r
4291 \r
4292 \r
4293 X       MTAPE , 072\r
4294 XX      MTOP. , 024\r
4295 \r
4296 X       MUL   , 224\r
4297 X       MULB  , 227\r
4298 X       MULI  , 225\r
4299 X       MULM  , 226\r
4300 XX      NLI.  , 031\r
4301 XX      NLO.  , 032\r
4302 \r
4303 X       NOSYM , 762\r
4304 \r
4305 \fX      OCT   , 763\r
4306 X       OPDEF , 764\r
4307 \r
4308 X       OPEN  , 050\r
4309 \r
4310 X       OR    , 434\r
4311 X       ORB   , 437\r
4312 X       ORCA  , 454\r
4313 X       ORCAB , 457\r
4314 X       ORCAI , 455\r
4315 X       ORCAM , 456\r
4316 X       ORCB  , 470\r
4317 X       ORCBB , 473\r
4318 \r
4319 X       ORCBI , 471\r
4320 X       ORCBM , 472\r
4321 X       ORCM  , 464\r
4322 X       ORCMB , 467\r
4323 X       ORCMI , 465\r
4324 X       ORCMM , 466\r
4325 X       ORI   , 435\r
4326 X       ORM   , 436\r
4327 \r
4328 X       OUT   , 057\r
4329 XX      OUT.  , 017\r
4330 X       OUTBUF, 065\r
4331 XX      OUTF. , 027\r
4332 X       OUTPUT, 067\r
4333 \r
4334 \fX      PAGE  , 700\r
4335 X       PASS2 , 701\r
4336 X       PHASE , 702\r
4337 X       POINT , 703\r
4338 \r
4339 XX      POP   , 262\r
4340 XX      POPJ  , 263\r
4341 \r
4342 X       PRINTX, 704\r
4343 X       PURGE , 705\r
4344 \r
4345 XX      PUSH  , 261\r
4346 XX      PUSHJ , 260\r
4347 \r
4348 X       RADIX , 706\r
4349 X       RADIX5, 707\r
4350 \r
4351 X       RELEAS, 071\r
4352 \r
4353 X       RELOC , 710\r
4354 X       REMARK, 711\r
4355 \r
4356 X       RENAME, 055\r
4357 \r
4358 X       REPEAT, 712\r
4359 \r
4360 XX      RESET., 015\r
4361 X       RIM   , 715\r
4362 X       RIM10 , 735\r
4363 X       RIM10B, 736\r
4364 \r
4365 X       ROT   , 241\r
4366 X       ROTC  , 245\r
4367 \r
4368 X       RSW   , 716\r
4369 XX      RTB.  , 022\r
4370 \r
4371 X       SETA  , 424\r
4372 X       SETAB , 427\r
4373 X       SETAI , 425\r
4374 X       SETAM , 426\r
4375 X       SETCA , 450\r
4376 X       SETCAB, 453\r
4377 X       SETCAI, 451\r
4378 X       SETCAM, 452\r
4379 X       SETCM , 460\r
4380 X       SETCMB, 463\r
4381 X       SETCMI, 461\r
4382 X       SETCMM, 462\r
4383 X       SETM  , 414\r
4384 X       SETMB , 417\r
4385 X       SETMI , 415\r
4386 X       SETMM , 416\r
4387 X       SETO  , 474\r
4388 X       SETOB , 477\r
4389 X       SETOI , 475\r
4390 X       SETOM , 476\r
4391 X       SETSTS, 060\r
4392 X       SETZ  , 400\r
4393 X       SETZB , 403\r
4394 X       SETZI , 401\r
4395 XX      SETZM , 402\r
4396 \r
4397 XX      SIXBIT, 717\r
4398 \r
4399 XX      SKIP  , 330\r
4400 X       SKIPA , 334\r
4401 X       SKIPE , 332\r
4402 X       SKIPG , 337\r
4403 X       SKIPGE, 335\r
4404 X       SKIPL , 331\r
4405 X       SKIPLE, 333\r
4406 X       SKIPN , 336\r
4407 \r
4408 XX      SLIST., 025\r
4409 \r
4410 X       SOJ   , 360\r
4411 X       SOJA  , 364\r
4412 X       SOJE  , 362\r
4413 X       SOJG  , 367\r
4414 X       SOJGE , 365\r
4415 X       SOJL  , 361\r
4416 X       SOJLE , 363\r
4417 X       SOJN  , 366\r
4418 \r
4419 XX      SOS   , 370\r
4420 X       SOSA  , 374\r
4421 X       SOSE  , 372\r
4422 X       SOSG  , 377\r
4423 X       SOSGE , 375\r
4424 X       SOSL  , 371\r
4425 X       SOSLE , 373\r
4426 X       SOSN  , 376\r
4427 \r
4428 X       SQUOZE, 707\r
4429 \r
4430 X       STATO , 061\r
4431 X       STATUS, 062\r
4432 X       STATZ , 063\r
4433 \r
4434 X       STOPI , 722\r
4435 \r
4436 X       SUB   , 274\r
4437 X       SUBB  , 277\r
4438 X       SUBI  , 275\r
4439 X       SUBM  , 276\r
4440 \r
4441 IF2,<SUBTL:>\r
4442 X       SUBTTL, 723\r
4443 X       SUPPRE, 713\r
4444 X       SYN   , 724\r
4445 X       TAPE  , 725\r
4446 \r
4447 \fX      TDC   , 650\r
4448 X       TDCA  , 654\r
4449 X       TDCE  , 652\r
4450 X       TDCN  , 656\r
4451 X       TDN   , 610\r
4452 X       TDNA  , 614\r
4453 X       TDNE  , 612\r
4454 X       TDNN  , 616\r
4455 X       TDO   , 670\r
4456 X       TDOA  , 674\r
4457 X       TDOE  , 672\r
4458 X       TDON  , 676\r
4459 X       TDZ   , 630\r
4460 X       TDZA  , 634\r
4461 X       TDZE  , 632\r
4462 X       TDZN  , 636\r
4463 \r
4464 X       TITLE , 726\r
4465 \r
4466 X       TLC   , 641\r
4467 X       TLCA  , 645\r
4468 X       TLCE  , 643\r
4469 X       TLCN  , 647\r
4470 X       TLN   , 601\r
4471 X       TLNA  , 605\r
4472 XX      TLNE  , 603\r
4473 XX      TLNN  , 607\r
4474 XX      TLO   , 661\r
4475 X       TLOA  , 665\r
4476 X       TLOE  , 663\r
4477 X       TLON  , 667\r
4478 XX      TLZ   , 621\r
4479 XX      TLZA  , 625\r
4480 XX      TLZE  , 623\r
4481 XX      TLZN  , 627\r
4482 \r
4483 \fX      TRC   , 640\r
4484 X       TRCA  , 644\r
4485 X       TRCE  , 642\r
4486 X       TRCN  , 646\r
4487 X       TRN   , 600\r
4488 X       TRNA  , 604\r
4489 XX      TRNE  , 602\r
4490 XX      TRNN  , 606\r
4491 X       TRO   , 660\r
4492 X       TROA  , 664\r
4493 X       TROE  , 662\r
4494 X       TRON  , 666\r
4495 XX      TRZ   , 620\r
4496 X       TRZA  , 624\r
4497 X       TRZE  , 622\r
4498 X       TRZN  , 626\r
4499 \r
4500 X       TSC   , 651\r
4501 X       TSCA  , 655\r
4502 X       TSCE  , 653\r
4503 X       TSCN  , 657\r
4504 X       TSN   , 611\r
4505 X       TSNA  , 615\r
4506 X       TSNE  , 613\r
4507 \r
4508 X       TSNN  , 617\r
4509 X       TSO   , 671\r
4510 X       TSOA  , 675\r
4511 X       TSOE  , 673\r
4512 X       TSON  , 677\r
4513 X       TSZ   , 631\r
4514 X       TSZA  , 635\r
4515 X       TSZE  , 633\r
4516 X       TSZN  , 637\r
4517 X       TTCALL, 051\r
4518 X       UFA   , 130\r
4519 X       UGETF , 073\r
4520 X       USETI , 074\r
4521 X       USETO , 075\r
4522 \r
4523 X       VAR   , 727\r
4524 \r
4525 XX      WTB.  , 023\r
4526 \r
4527 X       XALL  , 732\r
4528 \r
4529 X       XCT   , 256\r
4530 \r
4531 X       XLIST , 733\r
4532 \r
4533 X       XOR   , 430\r
4534 X       XORB  , 433\r
4535 X       XORI  , 431\r
4536 X       XORM  , 432\r
4537 \r
4538 X       XWD   , 734\r
4539 \r
4540 X       Z     , 000\r
4541 \r
4542 \r
4543 \r
4544 \f\r
4545 IF1, <  BLOCK   N1>\r
4546 OP1END: -1B36\r
4547 OP1COD: BLOCK   N1/4\r
4548         CC\r
4549 \r
4550 \r
4551 IFDEF .CREF,<   .CREF   ;START CREFFING AGAIN\r
4552 >\r
4553 \fSUBTTL PERMANENT SYMBOLS\r
4554 SYMNUM: EXP     LENGTH/2        ;NUMBER OF PERMANENT SYMBOLS\r
4555 DEFINE  P       (A,B)<\r
4556         SIXBIT  /A/\r
4557         XWD     SYMF!40,B>\r
4558 \r
4559 P       @,      0\r
4560 PRMTBL:                 ;PERMANENT SYMBOLS\r
4561 P       APR,    0\r
4562 P       CCI,    14\r
4563 P       CDP,    110\r
4564 P       CDR,    114\r
4565 P       CPA,    0\r
4566 P       CR,     150\r
4567 P       DC,     200\r
4568 P       DCSA,   300\r
4569 P       DCSB,   304\r
4570 P       DF,     270\r
4571 P       DIS,    130\r
4572 P       DLS,    240\r
4573 P       DRUM,   400\r
4574 P       DSK,    170\r
4575 P       DTC,    210\r
4576 P       DTS,    214\r
4577 P       LPT,    124\r
4578 P       MDF,    260\r
4579 P       MTC,    220\r
4580 P       MTM,    230\r
4581 P       MTS,    224\r
4582 P       PI,     4\r
4583 P       PLT,    140\r
4584 P       PTP,    100\r
4585 P       PTR,    104\r
4586 P       TDC,    320\r
4587 P       TDS,    324\r
4588 P       TMC,    340\r
4589 P       TMS,    344\r
4590 P       TTY,    120\r
4591 P       UTC,    210\r
4592 P       UTS,    214\r
4593 P       ??????, 0\r
4594 PRMEND:                         ;END OF PERMANENT SYMBOLS\r
4595 \r
4596 LENGTH= .-SYMNUM                        ;LENGTH OF INITIAL SYMBOLS\r
4597 \r
4598 \f       OPDEF   ZL      [Z      LITF]   ;INVALID IN LITERALS\r
4599         OPDEF   ZA      [Z      ADDF]   ;INVALID IN ADDRESSES\r
4600         OPDEF   ZAL     [Z      ADDF!LITF]\r
4601 \r
4602 OP1TAB:\r
4603 \r
4604         ZL      PAGE0                   ;PAGE\r
4605         ZL      PASS20                  ;PASS2\r
4606         ZL      PHASE0                  ;PHASE\r
4607         Z       POINT0                  ;POINT\r
4608         ZL      PRINT0                  ;PRINTX\r
4609         ZL      PURGE0                  ;PURGE\r
4610         ZL      RADIX0                  ;RADIX\r
4611         Z       RADX50                  ;RADIX50,SQUOZE\r
4612         ZL      LOC0    (1)             ;RELOC\r
4613         ZL      REMAR0                  ;REMARK\r
4614         ZL      REPEA0                  ;REPEAT\r
4615         ZL      SUPRE0                  ;SUPRESS\r
4616         Z                               ;?\r
4617         ZL      RIM0    (RIMSW)         ;RIM\r
4618         DATAI   0,IOP                   ;RSW\r
4619         Z       ASCII0  (1)             ;SIXBIT\r
4620         Z\r
4621         Z\r
4622 ;       ZL      IOSET   (IOPALL!IOSALL) ;SALL\r
4623         ZL      STOPI0                  ;STOPI\r
4624         ZL      SUBTT0  (Z (POINT 7,,)) ;SUBTTL\r
4625         ZL      SYN0                    ;SYN\r
4626         ZL      TAPE0                   ;TAPE\r
4627         ZL      TITLE0  (Z (POINT 7,,)) ;TITLE\r
4628         ZL      VAR0                    ;VAR\r
4629 \r
4630         Z\r
4631         Z\r
4632         ZL      IOSET   (IOPALL)        ;XALL\r
4633         ZL      IOSET   (IOPROG)        ;XLIST\r
4634         Z       XWD0                    ;XWD\r
4635         ZL      RIM0    (RIM1SW)        ;RIM10\r
4636         ZL      RIM0    (R1BSW)         ;RIM10B\r
4637 \fOP2TAB:\r
4638 \r
4639         Z       ASCII0  (0)             ;ASCII\r
4640         Z       ASCII0  (1B18)          ;ASCIZ\r
4641         BLKI    IOP                     ;BLKI\r
4642         BLKO    IOP                     ;BLKO\r
4643         ZL      BLOCK0                  ;BLOCK\r
4644         ZL      SUPRSA                  ;ASUPPRESS\r
4645 IFN RENTSW,<    ZL      HISEG0                  ;HISEG>\r
4646 IFE RENTSW,<    Z                               ;HISEG>\r
4647         Z       BYTE0                   ;BYTE\r
4648         CONI    IOP                     ;CONI\r
4649         CONO    IOP                     ;CONO\r
4650         CONSO   IOP                     ;CONSO\r
4651         CONSZ   IOP                     ;CONSZ\r
4652         DATAI   IOP                     ;DATAI\r
4653         DATAO   IOP                     ;DATAO\r
4654         Z       OCT0    (^D10)          ;DEC\r
4655         ZL      DEFIN0                  ;DEFINE\r
4656 \r
4657         ZL      DEPHA0                  ;DEPHASE\r
4658         ZL      END0                    ;END\r
4659         ZL      INTER0  (INTF!ENTF)     ;ENTRY\r
4660         Z       EXPRES                  ;EXP\r
4661         ZL      EXTER0                  ;EXTERN\r
4662         JRST    4,OP                    ;HALT\r
4663         TLNN    FR,IFPASS               ;IF1\r
4664         TLNE    FR,IFPASS               ;IF2\r
4665 \r
4666         TRNE    AC0,IFB0                ;IFB\r
4667         TLNE    ARG,IFDEF0              ;IFDEF\r
4668         Z       IFIDN0  (0)             ;IFDIF\r
4669         SKIPE   IF                      ;IFE\r
4670         SKIPG   IF                      ;IFG\r
4671         SKIPGE  IF                      ;IFGE\r
4672         Z       IFIDN0  (1)             ;IFIDN\r
4673         SKIPL   IF                      ;IFL\r
4674 \r
4675         SKIPLE  IF                      ;IFLE\r
4676         SKIPN   IF                      ;IFN\r
4677         TRNN    AC0,IFB0                ;IFNB\r
4678         TLNN    ARG,IFDEF0              ;IFNDEF\r
4679         ZL      INTER0  (INTF)          ;INTERN\r
4680         Z       IOWD0                   ;IOWD\r
4681         ZL      IRP0    (0)             ;IRP\r
4682         ZL      IRP0    (400000)        ;IRPC\r
4683 \r
4684         JFCL    6,OP                    ;JCRY\r
4685         JFCL    4,OP                    ;JCRY0\r
4686         JFCL    2,OP                    ;JCRY1\r
4687         JRST    12,OP                   ;JEN\r
4688         JFCL    10,OP                   ;JOV\r
4689         JRST    2,OP                    ;JRSTF\r
4690         ZL      IORSET  (IOPALL)        ;LALL\r
4691         ZL      IORSET  (IOPROG)        ;LIST\r
4692         ZL      LIT0                    ;LIT\r
4693         ZL      LOC0    (0)             ;LOC\r
4694         ZL      IOSET   (IONCRF)        ;CREF\r
4695 ;       ZL      OFFSYM                  ;NOSYM\r
4696         Z       OCT0    (^D8)           ;OCT\r
4697         ZL      OPDEF0                  ;OPDEF\r
4698         JFCL    1,OP                    ;JFOV\r
4699         ZL      ONML                    ;MLON\r
4700         ZL      OFFML                   ;MLOFF\r
4701 ;       TRN     ASCII0  (3B19)          ;COMMENT\r
4702 \r
4703 \f       SUBTTL  USER-DEFINED SYMBOL SEARCH ROUTINES\r
4704 MSRCH:  PUSHJ   PP,SEARCH       ;PERFORM GENERAL SEARCH\r
4705         POPJ    PP,             ;NOT FOUND, EXIT\r
4706         JUMPG   ARG,MSRCH2      ;SKIP-EXIT AND CROSS-REF IF FOUND\r
4707         CAME    AC0,1(SX)       ;WE ARE LOOKING AT SYMBOL, TRY ONE ABOVE\r
4708         POPJ    PP,             ;NO, EXIT\r
4709         ADDI    SX,2            ;YES, POINT TO IT\r
4710         PUSHJ   PP,SRCH5        ;LOAD REGISTERS\r
4711 MSRCH2: AOSA    0(PP)           ;SET SKIP-EXIT\r
4712 QSRCH:  JUMPL   ARG,SSRCH3      ;BRANCH IF OPERAND\r
4713         MOVEI   SDEL,%MAC       ;SET OPERATOR FLAG\r
4714         TLZE    IO,DEFCRS       ;IS IT A DEFINITION?\r
4715         MOVEI   SDEL,%DMAC      ;YES\r
4716         JRST    CREF            ;CROSS-REF AND EXIT\r
4717 \r
4718 SSRCH:  PUSHJ   PP,SEARCH       ;PERFORM GENERAL SEARCH\r
4719         POPJ    PP,             ;NOT FOUND, EXIT\r
4720         JUMPL   ARG,SSRCH2      ;SKIP-EXIT AND CROSS-REF IF FOUND\r
4721 SSRCH1: CAME    AC0,-3(SX)      ;WE ARE LOOKING AT MACRO, LOOK ONE SLOT BELOW\r
4722         POPJ    PP,             ;NO DICE, EXIT\r
4723         SUBI    SX,2            ;YES, POINT TO IT\r
4724         PUSHJ   PP,SRCH5        ;LOAD REGISTERS\r
4725 SSRCH2: AOS     0(PP)           ;SET FOR SKIP-EXIT\r
4726 SSRCH3: MOVEI   SDEL,%SYM       ;SET OPERAND FLAG\r
4727 \r
4728 CREF:   TLNE    FR,P1!CREFSW    ;PASS ONE OR CROSS-REF SUPPRESSION?\r
4729         POPJ    PP,             ;YES, EXIT\r
4730         EXCH    SDEL,C          ;PUT FLAG IN C, SACE C\r
4731         PUSH    PP,CS\r
4732         TLOE    IO,IOCREF       ;HAVE WE PUT OUT THE 177,102\r
4733         JRST    CREF3           ;YES\r
4734         PUSH    PP,C            ;START OF CREF DATA\r
4735         MOVEI C,0\r
4736 REPEAT 0,<    ;NEEDS CHANGE TO CREF\r
4737         MOVEI C,177\r
4738         PUSHJ PP,OUTLST\r
4739         MOVEI C,102\r
4740         PUSHJ PP,OUTLST\r
4741         TLO IO,IOCREF   ;WE NOW ARE IN THAT STATE\r
4742         POP PP,C        ;WE HAVE NOW\r
4743 CREF3:  JUMPE C,NOFLG           ;JUST CLOSE IT\r
4744         PUSHJ   PP,OUTLST       ;TYPE OF SYMBOL (%MAC,%DMAC,%SYM)\r
4745         MOVSI CS,770000         ;COUNT CHRS\r
4746         TDZA C,C        ;STARTING AT 0\r
4747         LSH CS,-6       ;TRY NEXT\r
4748         TDNE AC0,CS     ;IS THAT ONE THERE?\r
4749         AOJA C,.-2      ;YES\r
4750         PUSHJ PP,OUTLST         ;PRINT NUMBER OF SYMBOL CONSTITUENTS\r
4751         MOVE    CS,AC0\r
4752 \r
4753 CREF2:  MOVEI   C,0\r
4754         LSHC    C,6\r
4755         ADDI    C,40\r
4756         PUSHJ   PP,OUTLST       ;THE ASCII SYMBOL\r
4757         JUMPN   CS,CREF2\r
4758         MOVEI   C,%DSYM\r
4759         TLZE    IO,DEFCRS\r
4760         PUSHJ   PP,OUTLST       ;MARK IT AS A DEFINING OCCURENCE\r
4761 NOFLG:  MOVE    C,SDEL\r
4762         POP     PP,CS\r
4763         POPJ    PP,\r
4764 \r
4765 CLSCRF: TRNN ER,LPTSW\r
4766         POPJ PP,        ;LEAVE IF WE SHOULD NOT BE PRINTING\r
4767 CLSCR2: MOVEI C,177\r
4768         PUSHJ PP,PRINT\r
4769         TLZE IO,IOCREF  ;WAS IT OPEN?\r
4770         JRST CLSCR1     ;YES, JUST CLOSE IT\r
4771         MOVEI C,102     ;NO, OPEN IT FIRST\r
4772         PUSHJ PP,OUTLST         ;MARK BEGINNING OF CREF DATA\r
4773         MOVEI C,177\r
4774         PUSHJ PP,OUTLST\r
4775 CLSCR1: MOVEI C,103\r
4776         JRST OUTLST             ;MARK END OF CREF DATA\r
4777 \r
4778 CLSC3:  TLZ IO,IOCREF\r
4779         MOVEI C,177\r
4780         PUSHJ PP,OUTLST\r
4781         MOVEI C,104\r
4782         JRST OUTLST     ;177,104 CLOSES IT FOR NOW\r
4783 >       ;END OF REPEAT 0\r
4784 REPEAT 1,<              ;WORKS WITH EXISTING CREF\r
4785         TLNE IO,IOPAGE\r
4786         PUSHJ PP,OUTL   ;GET CORRECT SUBTTL\r
4787         MOVEI C,177\r
4788         PUSHJ PP,OUTLST\r
4789         MOVEI C,102\r
4790         PUSHJ PP,OUTLST\r
4791         POP PP,C        ;WE HAVE NOW\r
4792 CREF3:  PUSHJ PP,OUTLST         ;TYPE OF SYMBOL (%MAC,%DMAC,%SYM)\r
4793         MOVSI CS,770000         ;COUNT CHRS\r
4794         TDZA C,C        ;STARTING AT 0\r
4795         LSH CS,-6       ;TRY NEXT\r
4796         TDNE AC0,CS     ;IS THAT ONE THERE?\r
4797         AOJA C,.-2      ;YES\r
4798         PUSHJ PP,OUTLST         ;PRINT NUMBER OF SYMBOL CONSTITUENTS\r
4799         MOVE CS,AC0\r
4800 \r
4801 CREF2:  MOVEI   C,0\r
4802         LSHC    C,6\r
4803         ADDI    C,40\r
4804         PUSHJ   PP,OUTLST       ;THE ASCII SYMBOL\r
4805         JUMPN   CS,CREF2\r
4806         MOVEI   C,%DSYM\r
4807         TLZE    IO,DEFCRS\r
4808         PUSHJ   PP,OUTLST       ;MARK IT AS A DEFINING OCCURENCE\r
4809         MOVE    C,SDEL\r
4810         POP     PP,CS\r
4811         POPJ    PP,\r
4812 \r
4813 CLSCRF: TRNN ER,LPTSW\r
4814         POPJ PP,                ;LEAVE IF WE SHOULD NOT BE PRINTING\r
4815 CLSCR2: TLZE IO,IOCREF  ;FINISH UP LINE\r
4816         JRST CLSCR1\r
4817         MOVEI C,177\r
4818         PUSHJ PP,PRINT\r
4819         MOVEI C,102\r
4820         PUSHJ PP,OUTLST ;MARK BEGINNING OF CREF DATA\r
4821 CLSCR1: MOVEI C,177\r
4822         PUSHJ PP,OUTLST\r
4823         MOVEI C,103\r
4824         JRST OUTLST             ;MARK END OF CREF DATA\r
4825 >       ;END OF REPEAT 1\r
4826 \fSEARCH:        HLRZ    SX,SRCHX\r
4827         HRRZ    SDEL,SRCHX\r
4828 \r
4829 SRCH1:  CAML    AC0,-1(SX)\r
4830         JRST    SRCH3\r
4831 SRCH2:  SUB     SX,SDEL\r
4832         LSH     SDEL,-1\r
4833         CAMG    SX,SYMTOP\r
4834         JUMPN   SDEL,SRCH1\r
4835         JUMPN   SDEL,SRCH2\r
4836         SOJA    SX,POPOUT       ;NOT FOUND\r
4837 \r
4838 SRCH3:  CAMN    AC0,-1(SX)\r
4839         JRST    SRCH4           ;NORMAL / FOUND EXIT\r
4840         ADD     SX,SDEL\r
4841         LSH     SDEL,-1\r
4842         CAMG    SX,SYMTOP\r
4843         JUMPN   SDEL,SRCH1\r
4844         JUMPN   SDEL,SRCH2\r
4845         SOJA    SX,POPOUT       ;NOT FOUND\r
4846 \r
4847 SRCH4:  AOS     0(PP)           ;SET FOR SKIP EXIT\r
4848 SRCH5:  MOVSI ARG,SUPRBT        ;HE IS USING IT, TURN OFF BIT\r
4849         ANDCAM ARG,0(SX) ; IN THE TABLE\r
4850 SRCH7:  MOVE ARG,0(SX)          ;FLAG AND VALUE TO ARG\r
4851         LDB     RC,RCPNTR               ;POINT 1,ARG,17\r
4852         TLNE ARG,LELF   ;CHECK LEFT RELOCATE\r
4853         TLO RC,1\r
4854         HRRZ    V,ARG\r
4855         TLNE ARG,SPTR   ;CHECK SPECIAL EXTESN POINTER\r
4856         JRST SRCH6\r
4857         TLNE    ARG,PNTF\r
4858         MOVE    V,0(ARG)                ;36BIT VALUE TO V\r
4859         POPJ    PP,\r
4860 \r
4861 SRCH6:  MOVE V,0(ARG)           ;VALUE\r
4862         MOVE RC,1(ARG)          ;AND RELOC\r
4863         TLNE RC,-2                      ;CHECK AND SET EXTPNT\r
4864         HLLM RC,EXTPNT\r
4865         TRNE RC,-2\r
4866         HRRM RC,EXTPNT\r
4867         POPJ PP,\r
4868 \fINSERQ:        TLNE    ARG,UNDF!VARF\r
4869 INSERZ: SETZB   RC,V\r
4870 INSERT: CAME    AC0,-1(SX)      ;ARE WE LOOKING AT MATCHING MNEMONIC?\r
4871         JRST    INSRT2          ;NO, JUST INSERT\r
4872         JUMPL   ARG,INSRT1      ;YES, BRANCH IF OPERAND\r
4873         SKIPL   0(SX)           ;OPERATOR, ARE WE LOOKING AT ONE?\r
4874         JRST    UPDATE          ;YES, UPDATE\r
4875         JRST    INSRT2          ;NO, INSERT\r
4876 \r
4877 INSRT1: SKIPG   0(SX)           ;OPERAND, ARE WE LOOKING AT ONE?\r
4878         JRST    UPDATE          ;YES, UPDATE\r
4879         SUBI    SX,2            ;NO, MOVE UNDER OPERATOR AND INSERT\r
4880 INSRT2: MOVE    SDEL,SYMBOL\r
4881         SUBI    SDEL,2\r
4882         CAMLE   SDEL,FREE\r
4883         JRST    INSRT3\r
4884         PUSHJ   PP,XCEED\r
4885         ADDI    SDEL,2000\r
4886         ADDI    SX,2000\r
4887 INSRT3: MOVEM   SDEL,SYMBOL     ;MAKE ROOM FOR A TWO WORD ENTRY\r
4888         HRLI    SDEL,2(SDEL)\r
4889         BLT     SDEL,-2(SX)     ;PUSH EVERYONE DOWN TWO LOACTIONS\r
4890         AOS     @SYMBOL         ;INCREMENT THE SYMBOL COUNT\r
4891         TLNN    RC,-2           ;SPECIAL LEFT OR RIGHT EXTERNAL?\r
4892         TRNE    RC,-2\r
4893         JRST    INSRT5          ;YES, JUMP\r
4894         TLNN    V,-1            ;SKIP IF V IS A 36BIT VALUE\r
4895         JRST    INSRT4          ;JUMP, ITS A 18BIT VALUE\r
4896         AOS     SDEL,FREE       ;36BIT, SO GET A CELL FROM FREE CORE\r
4897         CAML    SDEL,SYMBOL     ;MORE CORE NEEDED\r
4898         PUSHJ   PP,XCEEDS       ;YES\r
4899         HRR     ARG,SDEL        ;POINT TO ARG\r
4900         MOVEM   V,0(ARG)        ;36BIT VALUE TO FREE CORE\r
4901         TLOA    ARG,PNTF        ;NOTE THAT ARG IS APOINTER, NOT A 18BIT VALUE\r
4902 \r
4903 INSRT4: HRR     ARG,V           ;18BIT VALUE TO ARG\r
4904         DPB     RC,RCPNTR       ;FIX RIGHT RELOCATION\r
4905         TLNE RC,1\r
4906         TLO ARG,LELF    ;FIX LEFT RELOCATION\r
4907 INSRT6: MOVEM   ARG,0(SX)       ;INSERT FLAGS AND VALUE.\r
4908         MOVEM   AC0,-1(SX)      ;INSERT SYMBOL NAME.\r
4909         PUSHJ   PP,SRCHI        ;INITILIAZE SRCHX\r
4910         JRST    QSRCH           ;EXIT THROUGH CREF\r
4911 \r
4912 INSRT5: MOVEI SDEL,2    ;GET TWO CELLS FROM FREE CORE\r
4913         ADDB SDEL,FREE\r
4914         CAML SDEL,SYMBOL ;MORE CORE NEEDED?\r
4915         PUSHJ PP,XCEEDS ;YES\r
4916         MOVEM RC,0(SDEL)\r
4917         HRRI ARG,-1(SDEL)       ;POINT TO THE ARG\r
4918         MOVEM V,0(ARG)\r
4919         TLO ARG,SPTR    ;SET SPECIAL POINTER, POINTS TO TWO CELLS\r
4920         JRST INSRT6\r
4921 \fREMOVE:        SUBI    SX,2    ;MOVE EVERYONE UP TWO LOCATIONS\r
4922 REMOV1: MOVE    0,0(SX)\r
4923         MOVEM   0,2(SX)         ;OVERWRITE THE DELETED SYMBOL\r
4924         CAME    SX,SYMBOL       ;SKIP WHEN DONE\r
4925         SOJA    SX,REMOV1\r
4926         ADDI    SX,2\r
4927         MOVEM   SX,SYMBOL\r
4928         SOS     0,0(SX)         ;DECREMENT THE SYMBOL COUNT\r
4929 \r
4930 SRCHI:  MOVEI   AC2,0           ;THIS CODE SETS UP SRCHX\r
4931         FAD     AC2,@SYMBOL\r
4932         LSH     AC2,-^D27\r
4933         MOVEI   AC1,1000\r
4934         LSH     AC1,-357(AC2)\r
4935         HRRM    AC1,SRCHX\r
4936         LSH     AC1,1\r
4937         ADD     AC1,SYMBOL\r
4938         HRLM    AC1,SRCHX\r
4939         POPJ    PP,\r
4940 \fUPDATE:        DPB     RC,RCPNTR       ;FIX RIGHT RELOCATION\r
4941         TLNE ARG,SPTR   ;SKIP IF THERE IS NO SPECIAL POINTER\r
4942         JRST UPDAT4     ;YES, USE THE TWO CELLS\r
4943         TLNN RC,-2      ;NEED TO CHANGE ANY CURRENT EXTERNS\r
4944         TRNE RC,-2\r
4945         JRST UPDAT5     ;YES, JUMP\r
4946         TLZ ARG,LELF    ;CLEAR LELF\r
4947         TLNE RC,1       ;LEFT RELOCATABLE?\r
4948         TLO ARG,LELF    ;YES, SET THE FLAG\r
4949         TLNE    ARG,PNTF        ;WAS THERE A 36BIT VALUE?\r
4950         JRST    UPDAT2          ;YES, USE IT.\r
4951         TLNE    V,-1            ;NO,IS THERE A 36BIT VALUE?\r
4952         JRST    UPDAT1          ;YES, GET A CELL\r
4953         HRR     ARG,V           ;NO, USE RH OF ARG\r
4954 UPDAT3: MOVEM   ARG,0(SX)       ;OVERWRITE THE ONE IN THE TABLE\r
4955         POPJ    PP,             ;AND EXIT\r
4956 \r
4957 UPDAT1: AOS     SDEL,FREE       ;GET ONE CELL\r
4958         CAML    SDEL,SYMBOL     ;NEED MORE CORE?\r
4959         PUSHJ   PP,XCEEDS       ;YES\r
4960         HRR     ARG,SDEL        ;POINT TO ARG\r
4961         TLO     ARG,PNTF        ;AND NOTE IT.\r
4962 UPDAT2: TLNE ARG,EXTF   ;IS THERE A EXTERNAL?\r
4963         JRST UPDAT3             ;YES, - JUST SAVE A LOCATION\r
4964         MOVEM   ARG,0(SX)       ;NO, OVERWRITE THE POINTER IN THE TABLE\r
4965         MOVEM   V,0(ARG)        ;STORE VALUE AS A 36BIT VALUES\r
4966         POPJ    PP,             ;AND EXIT\r
4967 \r
4968 UPDAT4: MOVEM ARG,0(SX) ;WE HAVE TWO CELLS, WE USE THEM\r
4969         MOVEM V,0(ARG)  ;SAVE AS 36BIT VALUE\r
4970         MOVEM RC,1(ARG) ;SAVE RELCATION BITS\r
4971         POPJ PP,                ;AND EXIT\r
4972 \r
4973 UPDAT5: MOVEI SDEL,2            ;THERE IS A EXTERNAL\r
4974         ADDB SDEL,FREE          ;SO WE NEED TWO LOCATIONS\r
4975         CAML SDEL,SYMBOL        ;NEED MORE CORE?\r
4976         PUSHJ PP,XCEEDS         ;YES\r
4977         MOVEM RC,0(SDEL)        ;SAVE RELOCATION BITS\r
4978         HRRI ARG,-1(SDEL)       ;SAVE THE POINTER IN ARG\r
4979         MOVEM V,0(ARG)          ;SAVE A 36BIT VALUE\r
4980         TLO ARG,SPTR            ;SET SPECIAL PNTR FLAG\r
4981         TLZ ARG,PNTF            ;CLEAR POINTER FLAG\r
4982         JRST UPDAT3             ;SAVE THE POINTER AND EXIT\r
4983 \r
4984 \fSUBTTL STORAGE CELLS\r
4985 \r
4986 IFN PURESW,<\r
4987         LOC     140\r
4988 >\r
4989 PASS1I:\r
4990 \r
4991 RP:     BLOCK   1\r
4992 IFE CCLSW,<CTIBUF:      BLOCK   3\r
4993 CTOBUF: BLOCK   3\r
4994 >\r
4995 \r
4996 IFN CCLSW,<CTLBUF:      BLOCK   <CTLSIZ+5>/5\r
4997 IFN RUNSW,<RUNDEV:      BLOCK   1\r
4998 RUNFIL: BLOCK   3\r
4999 RUNPP:  BLOCK   2>>\r
5000 LSTBUF: BLOCK   3\r
5001 BINBUF: BLOCK   3\r
5002 IBUF:   BLOCK   3\r
5003 IFN CCLSW,<IFE RUNSW,<NUNDIR:>>\r
5004 INDIR:  BLOCK   4\r
5005 \r
5006 ACDELX:                 ;LEFT HALF\r
5007 BLKTYP: BLOCK   1       ;RIGHT HALF\r
5008 \r
5009 COUTX:  BLOCK   1\r
5010 COUTY:  BLOCK   1\r
5011 COUTP:  BLOCK   1\r
5012 COUTRB: BLOCK   1\r
5013 COUTDB: BLOCK   ^D18\r
5014 \r
5015 ERRCNT: BLOCK   1\r
5016 FREE:   BLOCK   1\r
5017 IFN RENTSW,<HHIGH: BLOCK 1      ;SAVE BREAK OF HIGH SEG. IN TWO SEG PROG.>\r
5018 IFBLK:  BLOCK   .IFBLK\r
5019 IFBLKA: BLOCK   .IFBLK\r
5020 LADR:   BLOCK   1\r
5021 LBUFP:  BLOCK   1\r
5022 LBUF:   BLOCK   <.CPL+5>/5\r
5023         BLOCK 1\r
5024 VARHD:  BLOCK   1\r
5025 VARHDX: BLOCK   1\r
5026 \r
5027 LITAB:  BLOCK   1\r
5028 LITABX: BLOCK   1\r
5029         BLOCK   1\r
5030 LITHD:  BLOCK   1\r
5031 LITHDX: BLOCK   1\r
5032 LITCNT: BLOCK   1\r
5033 LITNUM: BLOCK   1\r
5034 \r
5035 LOOKX:  BLOCK   1\r
5036 NEXT:   BLOCK   1\r
5037 OUTSW:  BLOCK   1\r
5038 PDP:    BLOCK   1\r
5039 RECCNT: BLOCK   1\r
5040 SAVBLK: BLOCK   RC\r
5041 SAVERC: BLOCK   1\r
5042 SBUF:   BLOCK   .SBUF/5\r
5043 SRCHX:  BLOCK   1\r
5044 SUBTTX: BLOCK   1\r
5045 SVSYM:  BLOCK   1\r
5046 SYMBOL: BLOCK   1\r
5047 SYMTOP: BLOCK   1\r
5048 SYMCNT: BLOCK 1 \r
5049 \r
5050 STPX:   BLOCK   1\r
5051 STPY:   BLOCK   1\r
5052 STCODE: BLOCK   .STP\r
5053 STOWRC: BLOCK   .STP\r
5054 \r
5055 TABP:   BLOCK   1\r
5056 TBUF:   BLOCK   .TBUF/5\r
5057 TYPERR: BLOCK   1\r
5058 \r
5059 \fPASS2I:\r
5060 \r
5061 ACDEVX: BLOCK   1\r
5062 CPL:    BLOCK   1\r
5063 CTLSAV: BLOCK   1\r
5064 EXTPNT: BLOCK   1\r
5065 INTENT: BLOCK   1\r
5066 INREP:  BLOCK 1  \r
5067 INDEF:  BLOCK 1  \r
5068 INTXT:  BLOCK 1  \r
5069 CALPG:  BLOCK 1  \r
5070 CALSEQ: BLOCK 1  \r
5071 DEFPG:  BLOCK 1  \r
5072 DEFSEQ: BLOCK 1  \r
5073 LITPG:  BLOCK 1  \r
5074 LITSEQ: BLOCK 1  \r
5075 REPPG:  BLOCK 1  \r
5076 REPSEQ: BLOCK 1  \r
5077 TXTPG:  BLOCK 1  \r
5078 TXTSEQ: BLOCK 1  \r
5079 IRPARG: BLOCK   1\r
5080 IRPARP: BLOCK   1\r
5081 IRPCF:  BLOCK   1\r
5082 IRPPOI: BLOCK   1\r
5083 IRPSW:  BLOCK   1\r
5084 LITLVL: BLOCK   1\r
5085 \r
5086 ASGBLK: BLOCK   1\r
5087 LOCBLK: BLOCK   1\r
5088 \r
5089 LOCA:   BLOCK   1\r
5090 LOCO:   BLOCK   1\r
5091 RELLOC: BLOCK   1\r
5092 LPP:    BLOCK   1\r
5093 LSTSYM: BLOCK   1\r
5094 MACENL: BLOCK   1\r
5095 MACLVL: BLOCK   1\r
5096 MACPNT: BLOCK   1\r
5097 MODA:   BLOCK   1\r
5098 MODLOC: BLOCK   1\r
5099 MODO:   BLOCK   1\r
5100 IFN CCLSW,<OTBUF:       BLOCK 2 >\r
5101 OUTSQ:  BLOCK 2\r
5102 PAGENO: BLOCK   1\r
5103 PAGEN.: BLOCK   1\r
5104 PPTEMP: BLOCK   1\r
5105 PPTMP1: BLOCK   1\r
5106 PPTMP2: BLOCK   1\r
5107 \r
5108 REPCNT: BLOCK   1\r
5109 REPEXP: BLOCK   1\r
5110 REPPNT: BLOCK   1\r
5111 RPOLVL: BLOCK   1\r
5112 R1BCNT: BLOCK 1  \r
5113 R1BCHK: BLOCK 1  \r
5114 R1BBLK: BLOCK .R1B\r
5115 R1BLOC: BLOCK 1  \r
5116 RIMLOC: BLOCK   1\r
5117 SEQNO2: BLOCK 1  \r
5118 TAGINC: BLOCK   1\r
5119 VECREL: BLOCK   1\r
5120 VECTOR: BLOCK   1\r
5121 WWRXX:  BLOCK   1\r
5122 PASS2X:          \r
5123 \fSUBTTL MULTI-ASSEMBLY STORAGE CELLS\r
5124 \r
5125 HDAS:   BLOCK 1\r
5126 IFN CCLSW,<EXTMP:       BLOCK 1 ;HOLDS EXT OF COMMAND FILE (RH)\r
5127 SAVFF:  BLOCK   1\r
5128 CTLBLK: BLOCK   3\r
5129 CTIBUF: BLOCK   3\r
5130 CTOBUF: BLOCK   3       >\r
5131 IFN TEMP,<TMPFLG:       BLOCK 1>\r
5132         VAR                     ;CLEAR VARIABLES\r
5133 \r
5134 \f       SUBTTL  CONSTANTS\r
5135 \r
5136 IFN TEMP,<TMPFIL: SIXBIT /MAC/\r
5137         XWD     -200,0>\r
5138 TAG:    BLOCK   1\r
5139         SIXBIT  / + @/\r
5140 TABI:\r
5141         BYTE    (7) 0, 11, 11, 11, 11\r
5142 SEQNO:  BLOCK   1\r
5143         ASCIZ   /       /\r
5144 BININI: INIT    1,B\r
5145 BINDEV: BLOCK   1\r
5146         XWD     BINBUF,0\r
5147         JRST    EINIT\r
5148         POPJ    PP,\r
5149 LSTINI: INIT    3,AL\r
5150 LSTDEV: BLOCK   1\r
5151         XWD     LSTBUF,0\r
5152         JRST    EINIT\r
5153         POPJ    PP,\r
5154         INIT    1,16\r
5155         BLOCK 2\r
5156         JRST    EINIT\r
5157         POPJ    PP,\r
5158 IFN CCLSW,<\r
5159 RPGINI: INIT    4,1\r
5160 RPGDEV: BLOCK 1\r
5161         XWD 0,CTLBLK\r
5162         JRST    EINIT\r
5163         POPJ    PP,\r
5164 >\r
5165 INDEVI: INIT    2,0\r
5166 INDEV:  BLOCK   1\r
5167         XWD     0,IBUF\r
5168         JRST    EINIT\r
5169         POPJ    PP,\r
5170 VBUF:   ASCII   /       MACRO.V36/      ;MUST BE LAST LOCATIONS IN BLOCK\r
5171 DBUF:   ASCIZ   / TI:ME DY-MON-YR PAGE /\r
5172 JOBFFI: BLOCK   203*NUMBUF+1            ;INPUT BUFFER PLUS ONES\r
5173 IFN PURESW,<LOWEND==.-1\r
5174         Z\r
5175         RELOC>\r
5176 \r
5177         END     BEG\r
5178 \f\r