src/macro.30

   1 TITLE   MACRO V.30(52)  \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         VMACRO==30              ;VERSION NUMBER\r
   6         VUPDATE==0              ;DEC UPDATE LEVEL\r
   7         VEDIT==30               ;EDIT NUMBER\r
   8         VCUSTOM==0              ;NON-DEC UPDATE LEVEL\r
   9 \r
  10 \r
  11         LOC     <JOBVER==137>\r
  12         <VCUSTOM>B2+<VMACRO>B11+<VUPDATE>B17+VEDIT\r
  13         RELOC\r
  14         MLON\r
  15 \r
  16 COMMENT *       ASSEMBLY FEATURE SWITCHES (ACTION WHEN NON-ZERO)\r
  17 \r
  18         SWITCHES ON (NON-ZERO) IN DEC VERSION\r
  19 FTDISK          GIVES DISK FEATURES\r
  20 RUNSW           USE RUN UUO FOR "DEV:NAME!"\r
  21 FORMSW          USE MORE READABLE FORMATS FOR LISTING (ICCSW)\r
  22 DFRMSW          DEFAULT CONDITION OF FORMAT PRINTING (MULTI-FORM IF ON)\r
  23 \r
  24         SWITCHES OFF (ZERO) IN DEC VERSION\r
  25 IIISW           GIVES III FEATURES\r
  26 OPHSH           GIVES HASH SEARCH OF OPCODES\r
  27 *\r
  28 \fSUBTTL DEFAULT ASSEMBLY SWITCH SETTINGS\r
  29 \r
  30 IFNDEF RUNSW,<RUNSW==1>\r
  31 IFNDEF FTDISK,<FTDISK==0>\r
  32 IFNDEF DFRMSW,<DFRMSW==0>\r
  33 IFN DFRMSW,<FORMSW==1>\r
  34 IFDEF ICCSW,<FORMSW==ICCSW>     ;SAME SWITCH\r
  35 IFNDEF FORMSW,<FORMSW==0>\r
  36 \r
  37 IFNDEF IIISW,<IIISW==0>\r
  38 \r
  39 IFNDEF OPHSH,<OPHSH==0>\r
  40 \r
  41 \fSUBTTL OTHER PARAMETERS\r
  42 \r
  43 .PDP==  ?D50            ;BASIC PUSH-DOWN POINTER\r
  44 IFNDEF LPTWID,<LPTWID==?D132>   ;DEFAULT WIDTH OF PRINTER\r
  45 .LPTWD==8*<LPTWID/8>            ;USEFUL WIDTH IN MAIN LISTING\r
  46 .CPL==  .LPTWD-?D32             ;WIDTH AVAIABLE FOR TEXT WHEN\r
  47                                 ;BINARY IS IN HALFWORD FORMAT\r
  48 .LPP==?D55      ;LINES/PAGE\r
  49 .STP==  ?D40            ;STOW SIZE\r
  50 .TBUF== ?D80            ;TITLE BUFFER\r
  51 .SBUF== ?D80            ;SUB-TITLE BUFFER\r
  52 .IFBLK==?D20            ;IFIDN COMPARISON BLOCK SIZE\r
  53 .R1B==?D18\r
  54 .UNIV==?D10             ;NUMBER OF UNIVERSAL DEFINITIONS\r
  55 .LEAF==4                ;SIZE OF BLOCKS IN MACRO TREE\r
  56 \r
  57 NCOLS==LPTWID/?D32              ;NUMBER OF COLUMNS IN SYMBOL TABLE\r
  58 IFN OPHSH,<IFNDEF PRIME,<PRIME==?D701>>\r
  59 IFNDEF NUMBUF,<\r
  60 NUMBUF==2       ;NUMBER OF INPUT BUFFERS\r
  61 \r
  62 EXTERN  JOBREL,JOBSYM,JOBDDT,JOBFF,JOBAPR,JOBSA\r
  63 \r
  64         SALL            ;SUPPRESS ALL MACROS\r
  65 \r
  66 ;SOME ASCII CHARACTERS\r
  67 \r
  68 HT==11\r
  69 LF==12\r
  70 VT==13\r
  71 FF==14\r
  72 CR==15\r
  73 EOL==33\r
  74 \f                       ;ACCUMULATORS\r
  75 AC0==   0\r
  76 AC1=    AC0+1\r
  77 AC2=    AC1+1\r
  78 SDEL=   3               ;SEARCH INCREMENT\r
  79 SX=     SDEL+1          ;SEARCH INDEX\r
  80 ARG=    5               ;ARGUMENT\r
  81 V=      6               ;VALUE\r
  82 C=      7               ;CURRENT CHARACTER\r
  83 CS=     C+1             ;CHARACTER STATUS BITS\r
  84 RC=     11              ;RELOCATION BITS\r
  85 MWP=    12              ;MACRO WRITE POINTER\r
  86 MRP=    13              ;MACRO READ POINTER\r
  87 IO=     14              ;IO REGISTER (LEFT)\r
  88 ER==    IO              ;ERROR REGISTER (RIGHT)\r
  89 FR=     15              ;FLAG REGISTER (LEFT)\r
  90 RX==    FR              ;CURRENT RADIX (RIGHT)\r
  91 MP=     16              ;MACRO PUSHDOWN POINTER\r
  92 PP=     17              ;BASIC PUSHDOWN POINTER\r
  93 \r
  94 %OP==   3\r
  95 %MAC==  5\r
  96 %DSYM== 2\r
  97 %SYM==  1\r
  98 %DMAC== %MAC+1\r
  99 \r
 100 OPDEF   RESET   [CALLI   0]\r
 101 OPDEF   SETDDT  [CALLI   2]\r
 102 OPDEF   DDTOUT  [CALLI   3]\r
 103 OPDEF   DEVCHR  [CALLI   4]\r
 104 OPDEF   WAIT    [MTAPE   0]\r
 105 OPDEF   CORE    [CALLI  11]\r
 106 OPDEF   EXIT    [CALLI  12]\r
 107 OPDEF   UTPCLR  [CALLI  13]\r
 108 OPDEF   DATE    [CALLI  14]\r
 109 OPDEF   APRENB  [CALLI  16]\r
 110 OPDEF   MSTIME  [CALLI  23]\r
 111 OPDEF   PJOB    [CALLI  30]\r
 112 OPDEF   RUN     [CALLI  35]\r
 113 \r
 114 \f                       ;FR  FLAG REGISTER (FR/RX)\r
 115 IOSCR== 000001          ;NO CR AFTER LINE\r
 116 MTAPSW==000004          ;MAG TAPE\r
 117 ERRQSW==000010          ;IGNORE Q ERRORS\r
 118 LOADSW==000020          ;END OF PASS1 & NO EOF YET\r
 119 DCFSW== 000040          ;DECIMAL FRACTION\r
 120 RIM1SW==000100          ;RIM10 MODE\r
 121 NEGSW== 000200          ;NEGATIVE ATOM\r
 122 RIMSW== 000400          ;RIM OUTPUT\r
 123 PNCHSW==001000          ;RIM/BIN OUTPUT WANTED\r
 124 CREFSW==002000\r
 125 R1BSW== 004000          ;RIM10 BINARY OUTPUT\r
 126 TMPSW== 010000          ;EVALUATE CURRENT ATOM\r
 127 INDSW== 020000          ;INDIRECT ADDRESSING WANTED\r
 128 RADXSW==040000          ;RADIX ERROR SWITCH\r
 129 FSNSW== 100000          ;NON BLANK FIELD SEEN\r
 130 MWLFLG==200000          ;ON FOR DON'T ALLOW MULTI-WORD LITERALS\r
 131 P1==    400000          ;PASS1\r
 132 \r
 133                         ;IO FLAG REGISTER (IO/ER)\r
 134 FLDSW== 400000          ;ADDRESS FIELD\r
 135 IOMSTR==200000\r
 136 ARPGSW==100000          ;ALLOW RAPID PROGRAM GENERATION\r
 137 IOPROG==040000          ;SUPRESS LISTING (LIST/XLIST PSEUDO OP)\r
 138 NUMSW== 020000\r
 139 IOMAC== 010000          ;MACRO EXPANSION IN PROGRESS\r
 140 IOPALL==004000          ;SUPRESS LISTING OF MACRO EXPANSIONS\r
 141 IONCRF==002000          ;SUPRESS OUTPUT OF CREF INFORMATION\r
 142 CRPGSW==001000          ;CURRENTLY IN PROGRESS ON RPG\r
 143 IOCREF==000400          ;WE ARE NOW OUTPUTTING CREF INFO\r
 144 IOENDL==000200          ;BEEN TO STOUT\r
 145 IOPAGE==000100\r
 146 DEFCRS==000040          ;THIS IS A DEFINING OCCURANCE (MACROS)\r
 147 IOIOPF==000020          ;IOP INSTRUCTION SEEN\r
 148 MFLSW== 000010          ;MULTI-FILE MODE,PRGEND SEEN\r
 149 IORPTC==000004          ;REPEAT CURRENT CHARACTER\r
 150 IOTLSN==000002          ;TITLE SEEN\r
 151 IOSALL==000001          ;SUPPRESS MACRO LISTING EVEN IF BINARY IS GENERATED\r
 152 \r
 153 OPDEF   JUMP1   [JUMPL  FR,  ]  ;JUMP IF PASS 1\r
 154 OPDEF   JUMP2   [JUMPGE FR,  ]  ;JUMP IF PASS 2\r
 155 \r
 156 OPDEF   JUMPOC  [JUMPGE IO,  ]  ;JUMP IF IN OP-CODE FIELD\r
 157 OPDEF   JUMPAD  [JUMPL  IO,  ]  ;JUMP IF IN ADDRESS FIELD\r
 158 \r
 159 OPDEF   JUMPCM  [JUMPL  CS,  ]  ;JUMP IF CURRENT CHAR IS COMMA\r
 160 OPDEF   JUMPNC  [JUMPGE CS,  ]  ;JUMP IF CURRENT CHAR IS NON-COMMA\r
 161 \r
 162 \f                       ;ER ERROR REGISTERS (IO/ER)\r
 163 ERRM==  000020          ;MULTIPLY DEFINED SYMBOL\r
 164 ERRE==  000040          ;ILLEGAL USE OF EXTERNAL\r
 165 ERRP==  000100          ;PHASE DISCREPANCY\r
 166 ERRO==  000200          ;UNDEFINED OP CODE\r
 167 ERRN==  000400          ;NUMBER ERROR\r
 168 ERRV==  001000          ;VALUE PREVIOUSLY UNDEFINED\r
 169 ERRU==  002000          ;UNDEFINED SYMBOL\r
 170 ERRR==  004000          ;RELOCATION ERROR\r
 171 ERRL==  010000          ;LITERAL ERROR\r
 172 ERRD==  020000          ;REFERENCE TO MULTIPLY DEFINED SYMBOL\r
 173 ERRA==  040000          ;PECULIAR ARGUMENT\r
 174 ERRX==  100000          ;MACRO DEFINITION ERROR\r
 175 ERRQ==  200000          ;QUESTIONABLE, NON-FATAL ERROR\r
 176 ERRORS==777760\r
 177 LPTSW== 000002\r
 178 TTYSW== 000001\r
 179 \r
 180                         ;SYMBOL TABLE FLAGS\r
 181 SYMF==  400000          ;SYMBOL\r
 182 TAGF==  200000          ;TAG\r
 183 NOOUTF==100000          ;NO DDT OUTPUT WFW\r
 184 SYNF==  040000          ;SYNONYM\r
 185 MACF==  SYNF?-1         ;MACRO\r
 186 OPDF==  SYNF?-2         ;OPDEF\r
 187 PNTF==  004000          ;"VALUE" IN SYMBOL TBL IS PNTR TO 36BIT VALUE\r
 188 UNDF==  002000          ;UNDEFINED\r
 189 EXTF==  001000          ;EXTERNAL\r
 190 INTF==  000400          ;INTERNAL\r
 191 ENTF==  000200          ;ENTRY\r
 192 VARF==  000100          ;VARIABLE\r
 193 MDFF==  000020          ;MULTIPLY DEFINED\r
 194 SPTR==  000010          ;SPECIAL EXTERNAL POINTER\r
 195 SUPRBT==000004          ;SUPRESS OUTPUT TO DDT\r
 196 LELF==  000002          ;LEFT HAND RELOCATABLE\r
 197 RELF==  000001          ;RIGHT HAND RELOCATABLE\r
 198 \r
 199 LITF==  200000          ;FLAG FOR PSEUDO-OPS INVALID IN LIT'S\r
 200 ADDF==  100000          ;FLAG FOR PSEUDO-OPS INVALID IN ADDRESSES\r
 201 \r
 202 TNODE== 200000          ;TERMINAL NODE FOR EVALEX\r
 203 \fSUBTTL RUN UUO\r
 204 \r
 205 \r
 206         LIST\r
 207 \r
 208 \fIFN RUNSW,<    ;ASSEMBLE IF RUN UUO IMPLEMENTED\r
 209 NUNSET: JUMPN   ACDEV,.+2\r
 210         MOVSI   ACDEV,(SIXBIT /SYS/)    ;USE SYS IF NONE SPECIFIED\r
 211         MOVEM ACDEV,RUNDEV\r
 212 \r
 213         MOVEM ACFILE,RUNFIL     ;STORE FILE NAME\r
 214         PUSHJ PP,DELETE         ;COMMAND FILE\r
 215         SETZM RUNPP\r
 216         MOVEI 16,RUNDEV ;XWD 0,RUNDEV\r
 217         TLNE IO,CRPGSW  ;WAS RPG IN PROGRESS?\r
 218         HRLI 16,1       ;YES. START NEXT AT C(JOBSA)+1\r
 219         RUN 16,         ;DO "RUN DEV:NAME"\r
 220         HALT            ;SHOULDN'T RETURN. HALT IF IT DOES\r
 221 >\r
 222 \r
 223 DELETE: HRRZ    EXTMP           ;IF THE EXTENSION\r
 224         CAIE    (SIXBIT/TMP/)   ;IS  .TMP\r
 225         POPJ    PP,             ;RETURN.\r
 226         CLOSE   CTL2,           ;DELETE\r
 227         SETZB   4,5             ;THE COMMAND FILE.\r
 228         SETZB   6,7\r
 229         RENAME  CTL2,4          ;\r
 230         JFCL\r
 231         POPJ    PP,\r
 232 >\r
 233 \fSUBTTL START ASSEMBLING\r
 234 \r
 235 ASSEMB: PUSHJ   PP,INZ          ;INITIALIZE FOR PASS\r
 236         MOVE    [ASCII /.MAIN/]\r
 237         MOVEM   TBUF\r
 238         MOVEI   SBUF\r
 239         HRRM    SUBTTX\r
 240 \r
 241 ASSEM1: PUSHJ   PP,CHARAC       ;TEST FOR FORM FEED\r
 242         SKIPGE  LIMBO           ;CRLF FLAG?\r
 243         JRST    ASSEM1          ;YES ,IGNORE LF\r
 244         CAIN    C,14\r
 245         SKIPE   SEQNO\r
 246         JRST    ASSEM2\r
 247         PUSHJ   PP,OUTFF1\r
 248         PUSHJ   PP,OUTLI\r
 249         JRST    ASSEM1\r
 250 \r
 251 ASSEM2: AOS     TAGINC\r
 252         CAIN    C,"\"           ;BACK-SLASH?\r
 253         TLZA    IO,IOMAC        ;YES, LIST IF IN MACRO\r
 254         TLO     IO,IORPTC\r
 255         PUSHJ   PP,STMNT        ;OFF WE GO\r
 256         TLZN    IO,IOENDL       ;WAS STOUT PRE-EMPTED?\r
 257         PUSHJ   PP,STOUT        ;NO, POLISH OFF LINE\r
 258         JRST    ASSEM1\r
 259 \r
 260 \fSUBTTL STATEMENT PROCESSOR\r
 261 \r
 262 STMNT:  TLZ     FR,INDSW!FSNSW\r
 263         TLZA    IO,FLDSW\r
 264 STMNT1: PUSHJ   PP,LABEL\r
 265 STMNT2: PUSHJ   PP,ATOM         ;GET THE FIRST ATOM\r
 266         CAIN    C,35            ;"="?\r
 267         JRST    ASSIGN          ;YES\r
 268         CAIN    C,32            ;":"?\r
 269         JRST    STMNT1          ;YES\r
 270         JUMPAD  STMNT7          ;NUMERIC EXPRESSION\r
 271         JUMPN   AC0,STMN2A      ;JUMP IF NON NULL FIELD\r
 272         SKIPN   LITLVL          ;ALLOW COMMA IN LITERALS\r
 273         CAIE    C,14            ;NULL, COMMA?\r
 274         CAIN    C,EOL           ;OR END OF LINE?\r
 275         POPJ    PP,             ;YES,EXIT\r
 276         CAIN    C,"]"           ;CLOSING LITERAL?\r
 277         POPJ    PP,             ;YES\r
 278         JRST    STMNT9          ;NO,AT LEAST SKIP ALL THIS NONSENSE\r
 279 \r
 280 STMN2A: JUMPE   C,.+2\r
 281         TLO     IO,IORPTC\r
 282         PUSHJ   PP,MSRCH        ;SEARCH FOR MACRO/OPDEF/SYN\r
 283         JRST    STMNT3          ;NOT FOUND, TRY OP CODE\r
 284         LDB     SDEL,[POINT 3,ARG,5]\r
 285         JUMPE   SDEL,ERRAX      ;ERROR IF NO FLAGS\r
 286         SOJE    SDEL,OPD1       ;OPDEF IF 1\r
 287         SOJE    SDEL,CALLM      ;MACRO IF 2\r
 288         JRST    STMNT4          ;SYNONYM, PROCESS WITH OP-CODES\r
 289 \r
 290 STMNT3: PUSHJ   PP,OPTSCH       ;SEARCH OP CODE TABLE\r
 291         JRST    STMNT5          ;NOT FOUND\r
 292 STMNT4: HLLZ    AC0,V           ;PUT CODE IN AC0\r
 293         TRZ     V,ADDF          ;CLEAR ADDRESS NON-VALID FLAG\r
 294         TRZE    V,LITF          ;VALID IN LITERAL?\r
 295         SKIPN   LITLVL          ;NO, ARE WE IN A LITERAL?\r
 296         JRST    0(V)            ;NO, GO TO APPROPRIATE PROCESSOR\r
 297         POPJ    PP,             ;YES,EXIT\r
 298 \r
 299 STMNT5: PUSHJ   PP,SSRCH        ;TRY SYMBOLS\r
 300         JRST    STMNT8          ;NOT FOUND\r
 301         TLNE    ARG,EXTF!UNDF   ;EXTERNAL OR UNDEFINED?\r
 302         JRST    STMNT7          ;YES, PROCESS IN EVALEX\r
 303         TLNN RC,-2              ;CHECK FOR EXTERNAL\r
 304         TRNE RC,-2\r
 305         JRST STMNT7\r
 306         MOVE    AC0,V           ;FOUND, PUT VALUE IN AC0\r
 307         TLO     IO,NUMSW        ;FLAG AS NUMERIC\r
 308 STMNT7: TLZ     IO,IORPTC\r
 309 STMNT9: PUSHJ   PP,EVALHA       ;EVALUATE EXPRESSION\r
 310 IFN FORMSW,<    MOVE    AC1,HWFORM      ;USE STANDARD FORM>\r
 311         TLNE    FR,FSNSW        ;FIELD SEEN?\r
 312         JRST    STOW            ;YES,STOW THE CODE AND EXIT\r
 313         CAIE    C,"]"-40        ;CLOSING LITERAL?\r
 314         TRO     ER,ERRQ         ;NO, GIVE "Q" ERROR\r
 315         POPJ    PP,             ;EXIT\r
 316 \r
 317 \fSTMNT8:        MOVEI   V,0             ;ALWAYS START SCAN WITH 0\r
 318         CAIL    V,CALNTH        ;END OF TABLE?\r
 319         JRST    STMN8C          ;YES, TRY TTCALLS\r
 320         CAME    AC0,CALTBL(V)   ;FOUND IT?\r
 321         AOJA    V,.-3           ;NO,TRY AGAIN\r
 322         SUBI    V,NEGCAL        ;CALLI'S START AT -1\r
 323         HRLI    V,(CALLI)       ;PUT IN UUO\r
 324 STMN8D: MOVSI   ARG,OPDF        ;SET FLAG FOR OPDEF\r
 325 STMN8B: PUSHJ   PP,INSERT       ;PUT OPDEF IN TABLE\r
 326         JRST    OPD             ;AND TREAT AS OPDEF\r
 327 \r
 328 STMN8C: SETZ    V,              ;START WITH ZERO\r
 329         CAIL    V,TTCLTH        ;END OF TABLE?\r
 330         JRST    STMN8A          ;YES, ERROR\r
 331         CAME    AC0,TTCTBL(V)   ;MATCH?\r
 332         AOJA    V,.-3           ;NO, KEEP TRYING\r
 333         LSH     V,5             ;PUT IN AC FIELD (RIGHT HALF)\r
 334         HRLZI   V,<(TTCALL)>(V) ;PUT UUO IN LEFT HALF\r
 335         JRST    STMN8D          ;SET OPDEF FLAG\r
 336 \r
 337 STMN8A: SETZB   V,RC            ;CLEAR VALUE AND RELOCATION\r
 338         TRO     ER,ERRO         ;FLAG AS UNDEFINED OP-CODE\r
 339         JUMP1   OPD             ;TREAT AS STANDARD OP ON PASS1\r
 340         MOVSI   ARG,OPDF!UNDF!EXTF      ;SET A FEW FLAGS\r
 341         JRST    STMN8B          ;TO FORCE OUT A MESSAGE\r
 342 \r
 343                 ;STATEMENT OUT PASSES REMAINDER OF LINE (CMNT)\r
 344                         ;UNTIL A LINE TERMINATOR IS SEEN.\r
 345 STOUTS: TLOA    IO,IOENDL!IORPTC\r
 346 STOUT:  TLO     IO,IORPTC\r
 347         PUSHJ   PP,BYPAS1\r
 348         CAIN    C,14            ;COMMA?\r
 349         SKIPL   STPX            ;YES, ERROR IF CODE STORED\r
 350         CAIN    C,EOL\r
 351         TLOA    IO,IORPTC\r
 352         TRO     ER,ERRQ\r
 353 STOUT1: PUSHJ   PP,CHARAC\r
 354         CAIG    C,CR\r
 355         CAIG    C,HT\r
 356         JRST    STOUT1\r
 357         JRST    OUTLIN          ;OUTPUT THE LINE (BIN AND LST)\r
 358 \f       SUBTTL  LABEL PROCESSOR\r
 359         \r
 360 LABEL:  JUMPAD  LABEL4          ;COMPARE IF NON-SYMBOLIC\r
 361         JUMPE   AC0,LABEL5      ;ERROR IF BLANK\r
 362         TLO IO,DEFCRS           ;THIS IS A DEFINITION\r
 363         PUSHJ   PP,SSRCH        ;SEARCH FOR OPERAND\r
 364         MOVSI   ARG,SYMF!UNDF!TAGF      ;NOT FOUND\r
 365         TLNN    ARG,EXTF        ;OPERAND FOUND (SKIP EXIT)\r
 366         JRST    LABEL0\r
 367         JUMP1   LABEL3          ;ERROR ON PASS1\r
 368         TLNN    ARG,UNDF        ;UNDEFINED ON PASS1\r
 369         JRST    LABEL3          ;NO, FLAG ERROR\r
 370         TLZ     ARG,EXTF!PNTF   ;TURN OFF EXT FLAG NOW\r
 371 LABEL0: TLZN    ARG,UNDF!VARF   ;WAS IT PREVIOUSLY DEFINED?\r
 372         JRST    LABEL2          ;YES, CHECK EQUALITY\r
 373         MOVE    V,LOCA  ;WFW\r
 374         MOVE    RC,MODA\r
 375         TLO     ARG,TAGF\r
 376         PUSHJ   PP,PEEK         ;GET NEXT CHAR.\r
 377         CAIE    C,":"           ;SPECIAL CHECK FOR  ::\r
 378         JRST    LABEL1          ;NO MATCH\r
 379         TLO     ARG,INTF        ;MAKE IT INTERNAL\r
 380         PUSHJ   PP,GETCHR       ;PROCESS NEXT CHAR.\r
 381         PUSHJ   PP,PEEK         ;PREVIEW NEXT CHAR.\r
 382 LABEL1: CAIE    C,"!"           ;HALF-KILL SIGN\r
 383         JRST    LABEL6          ;NO\r
 384         TLO     ARG,NOOUTF      ;YES, SUPPRESS IT\r
 385         PUSHJ   PP,GETCHR       ;AND GET RID OF IT\r
 386 LABEL6: MOVEM   AC0,TAG         ;SAVE FOR PASS 1 ERRORS\r
 387         HLLZS   TAGINC          ;ZERO INCREMENT\r
 388         JRST    INSERT          ;INSERT/UPDATE AND EXIT\r
 389 \r
 390 LABEL2: HRLOM   V,LOCBLK        ;SAVE LIST LOCATION\r
 391         CAMN    V,LOCA          ;DOES IT COMPARE WITH PREVIOUS? WFW\r
 392         CAME    RC,MODA\r
 393 LABEL3: TLOA    ARG,MDFF        ;NO, FLAG MULTIPLY DEFINED AND SKIP\r
 394         JRST    LABEL7          ;YES, GET RID OF EXTRA CHARS.\r
 395         TRO     ER,ERRM         ;FLAG MULTIPLY DEFINED ERROR \r
 396         JRST    UPDATE          ;UPDATE AND EXIT\r
 397 \r
 398 LABEL4: CAMN    AC0,LOCA        ;DO THEY COMPARE?\r
 399         CAME    RC,MODA\r
 400 LABEL5: TRO     ER,ERRP         ;NO, FLAG PHASE ERROR\r
 401         POPJ    PP,\r
 402 \r
 403 LABEL7: SKIPE   LITLVL          ;LABEL IN A LITERAL?\r
 404         MOVEM   AC0,LITLBL      ;YES, SAVE LABEL NAME FOR LATER\r
 405         PUSHJ   PP,PEEK         ;INSPECT A CHAR.\r
 406         CAIN    C,":"           ;COLON?\r
 407         PUSHJ   PP,GETCHR       ;YES, DISPOSE OF IT\r
 408         PUSHJ   PP,PEEK         ;EXAMINE ONE MORE CHAR.\r
 409         CAIN    C,"!"           ;EXCLAMATION?\r
 410         JRST    GETCHR          ;YES, INDEED\r
 411 \f       POPJ    PP,\r
 412 \fSUBTTL ATOM PROCESSOR\r
 413 ATOM:   PUSHJ   PP,CELL         ;GET FIRST CELL\r
 414         TLNE    IO,NUMSW        ;IF NON-NUMERIC\r
 415 ATOM1:  CAIE    C,42            ;OR NOT A BINARY SHIFT,\r
 416         POPJ    PP,             ;EXIT\r
 417 \r
 418         PUSH    PP,AC0          ;STACK REGISTERS, ITS A BINARY SHIFT\r
 419         PUSH    PP,AC1\r
 420         PUSH    PP,RC\r
 421         PUSH    PP,RX\r
 422         HRRI    RX,?D10         ;COMPUTE SHIFT RADIX 10\r
 423         PUSHJ   PP,CELLSF       ;GET SHIFT\r
 424         MOVE    ARG,RC          ;SAVE RELOCATION\r
 425         POP     PP,RX           ;RESTORE REGISTERS\r
 426         POP     PP,RC\r
 427         POP     PP,AC1\r
 428         MOVN    SX,AC0          ;USE NEGATIVE OF SHIFT\r
 429         POP     PP,AC0\r
 430         JUMPN   ARG,NUMER2      ;IF NOT ABSOLUTE\r
 431         TLNN    IO,NUMSW        ;AND NUMERIC,\r
 432         JRST    NUMER2          ;FLAG ERROR\r
 433         LSHC    AC0,?D35(SX)\r
 434         LSH     RC,?D35(SX)\r
 435         JRST    ATOM1           ;TEST FOR ANOTHER\r
 436 \fCELLSF:        TLO     IO,FLDSW\r
 437 CELL:   SETZB   AC0,RC          ;CLEAR RESULT AND RELOCATION\r
 438         SETZB   AC1,AC2         ;CLEAR WORK REGISTERS\r
 439         MOVEM   PP,PPTEMP       ;SAVE PUSHDOWN POINTER\r
 440         TLZ     IO,NUMSW\r
 441         TLZA    FR,NEGSW!DCFSW!RADXSW\r
 442 \r
 443 CELL1:  TLO     IO,FLDSW\r
 444         PUSHJ   PP,BYPASS\r
 445         LDB     V,[POINT 4,CSTAT(C),14] ;GET CODE\r
 446         XCT     .+1(V)          ;EXECUTE, INDEX VIA BITS 11,12,13,14 OF CSTAT TABLE\r
 447         JRST    CELL1           ;0; BLANK, (TAB OR "+")\r
 448         JRST    LETTER          ;1; LETTER  ] $ % ( ) , ; >\r
 449         TLC     FR,NEGSW        ;2; "-"\r
 450         TLO     FR,INDSW        ;3; "@"\r
 451         JRST    NUM1            ;4; NUMERIC   0 - 9\r
 452         JRST    ANGLB           ;5; "<"\r
 453         JRST    SQBRK           ;6; "["\r
 454         JRST    QUOTES          ;7; ""","'" \r
 455         JRST    QUAL            ;10; "?"\r
 456         JRST    PERIOD          ;11; "."\r
 457         TROA    ER,ERRQ         ;12; ERROR, FLAG AND TREAT AS DELIMITER\r
 458                                 ;12;    ! # & * / : = ? \ ?\r
 459 \fLETTER:        TLOA    AC2,(POINT 6,AC0,)      ;SET BYTE POINTER\r
 460 LETTE1: PUSHJ   PP,GETCHR       ;GET CHARACTER\r
 461         TLNN    CS,6            ;ALPHA-NUMERIC?\r
 462         JRST    LETTE3          ;NO,TEST FOR VARIABLE\r
 463         TLNE    AC2,770000      ;STORE ONLY SIX BYTES\r
 464 LETTE2: IDPB    C,AC2           ;RETURN FROM PERIOD\r
 465         JRST    LETTE1\r
 466 \r
 467 LETTE3: CAIE    C,03            ;"#"?\r
 468         POPJ    PP,\r
 469         JUMPE   AC0,POPOUT      ;TEST FOR NULL\r
 470         PUSHJ   PP,PEEK         ;PEEK AT NEXT CHAR.\r
 471         CAIN    C,"#"           ;IS IT 2ND #?\r
 472         JRST    LETTE4          ;YES, THEN IT'S AN EXTERN\r
 473         TLO     IO,DEFCRS\r
 474         PUSHJ   PP,SSRCH        ;YES, SEARCH FOR SYMBOL (OPERAND)\r
 475         MOVSI   ARG,SYMF!UNDF   ;NOT FOUND, FLAGAS UNDEFINED SYM.\r
 476         TLNN    ARG,UNDF        ;UNDEFINED?\r
 477         JRST    GETCHR          ;NO, GET NEXT CHAR AND RETURN\r
 478         TLO     ARG,VARF        ;YES, FLAG AS A VARIABLE\r
 479         TRO     ER,ERRU         ;SET UNDEFINED ERROR FLAG\r
 480         PUSHJ   PP,INSERZ       ;INSERT IT WITH A ZERO VALUE\r
 481         JRST    GETDEL\r
 482 \r
 483 LETTE4: PUSHJ   PP,GETCHR       ;AND SCAN PAST IT\r
 484         PUSHJ   PP,GETCHR       ;GET RID OF #\r
 485         JRST    EXTER1          ;PUT IN SYMBOL TABLE\r
 486 \r
 487 NUMER1: SETZB   AC0,RC          ;RETURN ZERO\r
 488 NUMER2: TRO     ER,ERRN         ;FLAG ERROR\r
 489 \r
 490 GETDEL: PUSHJ   PP,BYPASS\r
 491 GETDE1: JUMPE   C,.-1\r
 492         MOVEI   AC1,0\r
 493 GETDE3: TLO     IO,NUMSW!FLDSW  ;FLAG NUMERIC\r
 494         TLNN    FR,NEGSW        ;IS ATOM NEGATIVE?\r
 495         POPJ    PP,             ;NO, EXIT\r
 496         JUMPE   AC1,GETDE2\r
 497         MOVNS   AC1\r
 498         TDCA    AC0,[-1]\r
 499 GETDE2: MOVNS   AC0             ;YES, NEGATE VALUE\r
 500         MOVNS   RC              ;AND RELOCATION\r
 501 POPOUT: POPJ    PP,             ;EXIT\r
 502 \fQUOTES:        CAIE    C,"'"-40        ;IS IT  "'"\r
 503         JRST    QUOTE           ;NO MUST BE """\r
 504         JRST    SQUOTE          ;YES\r
 505 \r
 506 QUOTE0: TLNE    AC0,376000      ;5 CHARACTERS STORED ALREADY?\r
 507         TRO     ER,ERRQ         ;YES, GIVE WARNING\r
 508         ASH     AC0,7\r
 509         IOR     AC0,C\r
 510 QUOTE:  PUSHJ   PP,CHARAC       ;GET 7-BIT ASCII\r
 511         CAIG    C,15            ;TEST FOR LF, VT, FF OR CR\r
 512         CAIGE   C,12\r
 513         JRST    .+2             ;NO, SO ALL IS WELL\r
 514         JRST    QUOTE2          ;ESCAPE WITH Q ERROR\r
 515         CAIE    C,42\r
 516         JRST    QUOTE0\r
 517         PUSHJ   PP,PEEK         ;LOOK AT NEXT CHAR.\r
 518         CAIE    C,42\r
 519         JRST    QUOTE1          ;RESTORE REPEAT LEVEL AND QUIT\r
 520         PUSHJ   PP,CHARAC       ;GET NEXT CHAR.\r
 521         JRST    QUOTE0          ;USE IT\r
 522 \r
 523 QUOTE2: TRO     ER,ERRQ         ;SET Q ERROR\r
 524 QUOTE1: JRST    GETDEL\r
 525 \r
 526 SQUOT0: TLNE    AC0,770000      ;SIX CHARS. STORED ALREADY ?\r
 527         TRO     ER,ERRQ         ;YES\r
 528         LSH     AC0,6\r
 529         IORI    AC0,-40(C)      ;OR IN SIXBIT CHAR.\r
 530 \r
 531 SQUOTE: PUSHJ   PP,CHARAC\r
 532         CAIG    C,CR\r
 533         CAIGE   C,LF\r
 534         JRST    .+2\r
 535         JRST    QUOTE1\r
 536         CAIE    C,"'"\r
 537         JRST    SQUOT0\r
 538         PUSHJ   PP,PEEK\r
 539         CAIE    C,"'"\r
 540         JRST    QUOTE1\r
 541         PUSHJ   PP,CHARAC\r
 542         JRST    SQUOT0\r
 543 \r
 544 \fQUAL:  PUSHJ   PP,BYPAS1       ;SKIP BLANKS, GET NEXT CHARACTER\r
 545         CAIN    C,42            ;"B"?\r
 546         JRST    QUAL2           ;YES, RADIX=D2\r
 547         CAIN    C,57            ;"O"?\r
 548         JRST    QUAL8           ;YES, RADIX=D8\r
 549         CAIN    C,46            ;"F"?\r
 550         JRST    NUMDF           ;YES, PROCESS DECIMAL FRACTION\r
 551         CAIN    C,54            ;"L"?\r
 552         JRST    QUALL           ;YES\r
 553         CAIE    C,44            ;"D"?\r
 554         JRST    NUMER1          ;NO, FLAG NUMERIC ERROR\r
 555         ADDI    AC2,2\r
 556 QUAL8:  ADDI    AC2,6\r
 557 QUAL2:  ADDI    AC2,2\r
 558         PUSH    PP,RX\r
 559         HRR     RX,AC2\r
 560         PUSHJ   PP,CELLSF\r
 561 QUAL2A: POP     PP,RX\r
 562         TLNN    IO,NUMSW\r
 563         JRST    NUMER1\r
 564         JRST    GETDE1\r
 565 \r
 566 QUALL:  PUSH    PP,FR\r
 567         PUSHJ   PP,CELLSF\r
 568         MOVE    AC2,AC0\r
 569         MOVEI   AC0,?D36\r
 570         JUMPE   AC2,QUAL2A\r
 571         LSH     AC2,-1\r
 572         SOJA    AC0,.-2\r
 573 \fSUBTTL LITERAL PROCESSOR\r
 574 \r
 575 SQBRK:  PUSH    PP,FR\r
 576         PUSH    PP,EXTPNT       ;ALLOW EXTERN TO PRECEDE LIT IN XWD\r
 577         SETZM   EXTPNT\r
 578         SKIPE LITLVL    ;SAVE SEQNO AND PAGE IF NOT IN LIT ALREADY\r
 579         JRST SQB5\r
 580         MOVE C,SEQNO2\r
 581         MOVEM C,LITSEQ\r
 582         MOVE C,PAGENO\r
 583         MOVEM C,LITPG\r
 584 SQB5:   JSP     AC2,SVSTOW\r
 585 SQB3:   PUSHJ   PP,STMNT\r
 586         CAIN C,75       ;CHECK FOR ]\r
 587         JRST SQB1\r
 588         TLO IO,IORPTC\r
 589         TLNE    FR,MWLFLG       ;CALL IT ] IF NOT MULTI-WORD FLAG\r
 590         JRST    SQB2            ;BUT REPEAT LAST CHARACTER\r
 591         PUSHJ PP,BYPAS1\r
 592         CAIN C,EOL\r
 593         TLOA IO,IORPTC\r
 594         TRO ER,ERRQ\r
 595 SQB4:   PUSHJ PP,CHARAC\r
 596         CAIN    C,";"           ;COMMENT?\r
 597         JRST    SQB6            ;YES, IGNORE SQUARE BRACKETS\r
 598         CAIN    C,"]"           ;LOOK FOR TERMINAL SQB\r
 599         TRNN    ER,ERRORS       ;IN CASE OF ERROR IN LITERAL\r
 600         JRST    .+2             ;NO ALL IS WELL\r
 601         JRST    SQB1            ;FINISH THE LITERAL NOW!!\r
 602         CAIG    C,CR            ;LOOK FOR END OF LINE\r
 603         CAIN    C,HT\r
 604         JRST    SQB4\r
 605 SQB4A:  PUSHJ   PP,OUTIML       ;DUMP\r
 606         PUSHJ   PP,CHARAC       ;GET ANOTHER CHAR.\r
 607         SKIPL   LIMBO           ;CRLF FLAG\r
 608         TLO     IO,IORPTC       ;NO REPEAT\r
 609         JRST    SQB3\r
 610 \r
 611 SQB6:   PUSHJ   PP,CHARAC       ;GET A CHARACTER\r
 612         CAIG    C,CR\r
 613         CAIN    C,HT            ;LOOK FOR END OF LINE CHAR.\r
 614         JRST    SQB6            ;NOT YET\r
 615         JRST    SQB4A           ;GOT IT\r
 616 \r
 617 SQB1:   TLZ     IO,IORPTC\r
 618 SQB2:   PUSHJ   PP,STOLIT\r
 619         JSP     AC2,GTSTOW\r
 620         SKIPE   LITLBL          ;NEED TO FIXUP A LABEL?\r
 621         PUSHJ   PP,RELBLE       ;YES, USE LOC OF LITERAL\r
 622         POP     PP,EXTPNT\r
 623         POP     PP,FR\r
 624         SKIPE   LITLVL          ;WERE WE NESTED?\r
 625         JUMP1   NUMER2          ;YES, FORCE ERROR IF PASS 1\r
 626         JRST    GETDEL\r
 627 \r
 628 RELBLE: PUSH    PP,AC0          ;SAVE LOCATION COUNTER\r
 629         PUSH    PP,RC           ;AND RELOCATION\r
 630         MOVE    AC0,LITLBL      ;SYMBOL WE NEED\r
 631         SETZM   LITLBL          ;ZERO INDICATOR\r
 632         PUSHJ   PP,SSRCH        ;SEARCH FOR OPERAND\r
 633         JRST    RELBL1          ;SHOULD NEVER HAPPEN\r
 634         TLNN    ARG,TAGF        ;IT BETTER BE A LABEL\r
 635         JRST    RELBL1          ;IT WASN'T , GIVE UP BEFORE SOME HARM IS DONE\r
 636         TLZ     ARG,UNDF!EXTF!PNTF      ;CLEAR FLAGS NOW\r
 637         POP     PP,RC           ;GET LITERAL RELOCATION\r
 638         MOVE    V,(PP)          ;GET VALUE (LOC COUNTER)\r
 639         PUSHJ   PP,UPDATE       ;UPDATE VALUE\r
 640         POP     PP,AC0          ;RESTORE LITERAL COUNT\r
 641         POPJ    PP,             ;RETURN\r
 642         \r
 643 RELBL1: POP     PP,RC           ;RESTORE RC\r
 644         POP     PP,AC0  ;AND AC0\r
 645         POPJ    PP,             ;JUST RETURN\r
 646 \fANGLB: PUSH    PP,FR\r
 647         TLZ     FR,INDSW\r
 648         PUSHJ   PP,ATOM\r
 649         TLNN    IO,NUMSW\r
 650         CAIE    C,35\r
 651         JRST    ANGLB1\r
 652         PUSHJ   PP,ASSIG1\r
 653         MOVE    AC0,V\r
 654         JRST    ANGLB2\r
 655 \r
 656 ANGLB1: PUSHJ   PP,EVALHA\r
 657 ANGLB2: POP     PP,FR\r
 658         CAIE    C,36\r
 659         TRO     ER,ERRN\r
 660         JRST    GETDEL\r
 661 \r
 662 PERIOD: PUSHJ   PP,GETCHR       ;LOOK AT NEXT CHARACTER\r
 663         TLNN    CS,2            ;ALPHABETIC?\r
 664         JRST    PERNUM          ;NO, TEST NUMERIC\r
 665         MOVSI   AC0,(SIXBIT /./)        ;YES, PUT PERIOD IN AC0\r
 666         MOVSI   AC2,(POINT 6,AC0,5)     ;SET BYTE POINTER\r
 667         JRST    LETTE2          ;AND TREAT AS SYMBOL\r
 668 \r
 669 PERNUM: TLNE    CS,4            ;IS IT A NUMBER\r
 670         JRST    NUM32           ;YES\r
 671         MOVE    AC0,LOCA        ;NO. CURRENT LOC SYMBOL (.)\r
 672         MOVE    RC,MODA         ;SET TO CURRENT ASSEMBLY MODE\r
 673         JRST    GETDE1          ;GET DELIMITER\r
 674 NUMDF:  TLO     FR,DCFSW        ;SET DECIMAL FRACTION FLAG\r
 675 NUM:    PUSHJ   PP,GETCHR       ;GET A CHARACTER\r
 676         TLNN    CS,4            ;NUMERIC?\r
 677         JRST    NUM10           ;NO\r
 678 NUM1:   SUBI    C,20            ;CONVERT TO OCTAL\r
 679         PUSH    PP,C            ;STACK FOR FLOATING POINT\r
 680         MOVE    AC0,AC1\r
 681         MULI    AC0,0(RX)\r
 682         ADD     AC1,C           ;ADD IN LAST VALUE\r
 683         CAIL    C,0(RX)         ;IS NUMBER LESS THAN CURRENT RADIX?\r
 684         TLO     FR,RADXSW       ;NO, SET FLAG\r
 685         AOJA    AC2,NUM         ;YES, AC2=NO. OF DECIMAL PLACES\r
 686 \r
 687 \fNUM10: CAIE    C,16            ;PERIOD?\r
 688         TLNE    FR,DCFSW        ;OR DECIMAL FRACTION?\r
 689         JRST    NUM30           ;YES, PROCESS FLOATING POINT\r
 690         LSH     AC1,1           ;NO, CLEAR THE SIGN BIT\r
 691         LSHC    AC0,?D35        ;AND SHIFT INTO AC0\r
 692         MOVE    PP,PPTEMP       ;RESTORE PP\r
 693         SOJE    AC2,GETDE1      ;NO RADIX ERROR TEST IF ONE DIGIT\r
 694         TLNE    FR,RADXSW       ;WAS ILLEGAL NUMBER ENCOUNTERED?\r
 695         TRO     ER,ERRN         ;YES, FLAG N ERROR\r
 696         JRST    GETDE1\r
 697 \r
 698 NUM30:  CAIE    C,"B"-40        ;IF "B" THEN MISSING  "."\r
 699 NUM31:  PUSHJ   PP,GETCHR\r
 700         TLNN    CS,4            ;NUMERIC?\r
 701         JRST    NUM40           ;NO\r
 702 NUM32:  SUBI    C,20\r
 703         PUSH    PP,C\r
 704         JRST    NUM31\r
 705 \r
 706 NUM40:  PUSH    PP,FR           ;STACK VALUES\r
 707         HRRI    RX,?D10\r
 708         PUSH    PP,AC2\r
 709         PUSH    PP,PPTEMP\r
 710         CAIN    C,45            ;"E"?\r
 711         JRST    [PUSHJ PP,PEEK  ;GET NEXT CHAR\r
 712                 PUSH PP,C       ;SAVE NEXT CHAR\r
 713                 PUSHJ PP,CELL   ;YES, GET EXPONENT\r
 714                 POP PP,C        ;GET FIRST CHAR. AFTER E\r
 715                 CAIN V,4        ;MUST HAVE NUMERICAL STATUS\r
 716                 JRST    .+2     ;SKIP RETURN\r
 717                 CAIN C,"<"      ;ALLOW <EXP>\r
 718                 JRST    .+2     ;SKIP RETURN\r
 719                 SKIPN   AC0     ;ERROR IF NON-ZERO EXPRESSION\r
 720                 TROA ER,ERRQ    ;ALLOW E+,E-\r
 721                 SETOM   RC      ;FORCE NUMERICAL ERROR\r
 722                 JRST    .+2]    ;SKIP RETURN\r
 723         MOVEI   AC0,0           ;NO, ZERO EXPONENT\r
 724         POP     PP,PPTEMP\r
 725         POP     PP,SX\r
 726         POP     PP,FR\r
 727         HRRZ    V,PP\r
 728         MOVE    PP,PPTEMP\r
 729         JUMPN   RC,NUMER1       ;EXPONENT MUST BE ABSOLUTE\r
 730         ADD     SX,AC0\r
 731         HRRZ    ARG,PP\r
 732         ADD     SX,ARG\r
 733         SETZB   AC0,AC2\r
 734         TLNE    FR,DCFSW\r
 735         JRST    NUM60\r
 736         JOV     NUM50           ;CLEAR OVERFLOW FLAG\r
 737 \f\r
 738 NUM50:  JSP     SDEL,NUMUP      ;FLOATING POINT\r
 739         JRST    NUM52           ;END OF WHOLE NUMBERS\r
 740         FMPR    AC0,[10.0]      ;MULTIPLY BY 10\r
 741         TLO     AC1,233000      ;CONVERT TO FLOATING POINT\r
 742         FADR    AC0,AC1         ;ADD IT IN\r
 743         JRST    NUM50\r
 744 \r
 745 NUM52:  JSP     SDEL,NUMDN      ;PROCESS FRACTION\r
 746         FADR    AC0,AC2\r
 747         JOV     NUMER1          ;TEST FOR OVERFLOW\r
 748         JRST    GETDE1\r
 749 \r
 750         TLO     AC1,233000\r
 751         TRNE    AC1,-1\r
 752         FADR    AC2,AC1         ;ACCUMULATE FRACTION\r
 753         FDVR    AC2,[10.0]\r
 754         JRST    NUM52\r
 755 \r
 756 NUM60:  JSP     SDEL,NUMUP\r
 757         JRST    NUM62\r
 758         IMULI   AC0,?D10\r
 759         ADD     AC0,AC1\r
 760         JRST    NUM60\r
 761 \r
 762 NUM62:  LSHC    AC1,-?D36\r
 763         JSP     SDEL,NUMDN\r
 764         LSHC    AC1,?D37\r
 765         PUSHJ   PP,BYPAS2\r
 766         JRST    GETDE3\r
 767 \r
 768         DIVI    AC1,?D10\r
 769         JRST    NUM62\r
 770 \r
 771 NUMUP:  MOVEI   AC1,0\r
 772         CAML    ARG,SX\r
 773         JRST    0(SDEL)\r
 774         CAMGE   ARG,V\r
 775         MOVE    AC1,1(ARG)\r
 776         AOJA    ARG,1(SDEL)\r
 777 \r
 778 NUMDN:  MOVEI   AC1,0\r
 779         CAMG    V,SX\r
 780         JRST    0(SDEL)\r
 781         CAMLE   V,ARG\r
 782         MOVE    AC1,0(V)\r
 783         SOJA    V,3(SDEL)\r
 784 \fSUBTTL GETSYM\r
 785 GETSYM: MOVEI   AC0,0           ;CLEAR AC0\r
 786         MOVSI   AC1,(POINT 6,AC0)       ;PUT POINTER IN AC1\r
 787         PUSHJ   PP,BYPASS       ;SKIP LEADING BLANKS\r
 788         TLNN    CS,2            ;ALPHABETIC?\r
 789         JRST    GETSY1          ;NO, ERROR\r
 790         CAIE    C,16            ;PERIOD?\r
 791         JRST    GETSY2          ;NO, A VALID SYMBOL\r
 792         IDPB    C,AC1           ;STORE THE CHARACTER\r
 793         PUSHJ   PP,GETCHR       ;YES, TEST NEXT CHARACTER\r
 794         TLNN    CS,2            ;ALPHABETIC?\r
 795 GETSY1: TROA    ER,ERRA\r
 796 GETSY2: AOS     0(PP)           ;YES, SET SKIP EXIT\r
 797 GETSY3: TLNN    CS,6            ;ALPHA-NUMERIC?\r
 798         JRST    BYPAS2          ;NO, GET DELIMITER\r
 799         TLNE    AC1,770000      ;YES, HAVE WE STORED SIX?\r
 800         IDPB    C,AC1           ;NO, STORE IT\r
 801         PUSHJ   PP,GETCHR\r
 802         JRST    GETSY3\r
 803 \r
 804 \fSUBTTL EXPRESSION EVALUATOR\r
 805 CV==    AC0                     ;CURRENT VALUE\r
 806 PV==    AC1                     ;PREVIOUS VALUE\r
 807 RC==    RC                      ;CURRENT RELOCATABILITY\r
 808 PR==    AC2                     ;PREVIOUS RELOCATABILITY\r
 809 CS=     CS                      ;CURRENT STATUS\r
 810 PS==    SDEL                    ;PREVIOUS STATUS\r
 811 \r
 812 EVALHA: TLO     FR,TMPSW\r
 813 EVALCM: PUSHJ   PP,EVALEX       ;EVALUATE FIRST EXPRESSION\r
 814         PUSH    PP,[0]          ;MARK PDL\r
 815         JUMPCM  EVALC3          ;JUMP IF COMMA\r
 816         TLO     IO,IORPTC       ;IT'S NOT,SO REPEAT\r
 817         JRST    OP              ;PROCESS IN OP\r
 818 EVALC3:\r
 819 IFN FORMSW,<PUSH PP,INFORM      ;PUT FORM WORD ON STACK>\r
 820         PUSH    PP,[0]          ;STORE ZERO'S ON PDL\r
 821         PUSH    PP,[0]          ;.......\r
 822         MOVSI   AC2,(POINT 4,(PP),12)\r
 823         JRST    OP1B            ;PROCESS IN OP\r
 824 \r
 825 EVALEX: TLO     IO,FLDSW\r
 826         PUSH    PP,[XWD TNODE,0]        ;MARK THE LIST 200000,,0\r
 827         TLZN    FR,TMPSW\r
 828 EVATOM: PUSHJ   PP,ATOM         ;GET THE NEXT ATOM\r
 829         JUMPE   AC0,EVGETD      ;TEST FOR NULL/ZERO\r
 830         TLOE    IO,NUMSW        ;SET NUMERIC, WAS IT PREVIOUSLY?\r
 831         JRST    EVGETD+1        ;YES, TREAT ACCORDINGLY\r
 832         PUSHJ   PP,SEARCH       ;SEARCH FOR MACRO OR SYMBOL\r
 833         JRST    EVOP            ;NOT FOUND, TRY FOR OP-CODE\r
 834         JUMPL   ARG,.+2         ;SKIP IF OPERAND\r
 835         PUSHJ   PP,SSRCH1       ;OPERATOR, TRY FOR SYMBOL (OPERAND)\r
 836         PUSHJ   PP,QSRCH        ;PERFORM CROSS-REFERENCE\r
 837         JUMPG   ARG,EVMAC       ;BRANCH IF OPERATOR\r
 838         MOVE    AC0,V           ;SYMBOL, SET VALUE\r
 839         JRST    EVTSTS          ;TEST STATUS\r
 840 \r
 841 EVMAC:  TLNE    FR,NEGSW        ;UNARY MINUS?\r
 842         JRST    EVERRZ          ;YES, INVALID BEFORE OPERATOR\r
 843         LDB     SDEL,[POINT 3,ARG,5]    ;GET MACF/OPDF/SYNF\r
 844         SOJL    SDEL,EVERRZ     ;ERROR IF NO FLAGS\r
 845 \r
 846         JUMPE   C,.+2           ;NON-BLANK?\r
 847         TLO     IO,IORPTC       ;YES, REPEAT CHARACTER\r
 848         SOJE    SDEL,CALLM      ;MACRO IF 2\r
 849         JUMPG   SDEL,EVOPS      ;SYNONYM IF 4\r
 850 \r
 851         MOVE    AC0,V           ;OPDEF\r
 852         MOVEI   V,OP            ;SET TRANSFER VECTOR\r
 853         JRST    EVOPD\r
 854 \fEVOP:  TLNE    FR,NEGSW        ;OPCODE, UNARY MINUS?\r
 855         JRST    EVERRZ          ;YES, ERROR\r
 856 \r
 857         PUSHJ   PP,OPTSCH       ;SEARCH SYMBOL TABLE\r
 858         JRST    EVOPX           ;NOT FOUND\r
 859 EVOPS:  TRZ     V,LITF          ;CLEAR LIT INVALID FLAG\r
 860         TRZE    V,ADDF          ;SYNONYM\r
 861         JRST    EVOPX           ;PSEUDO-OP THAT GENERATES NO DATA JUMPS\r
 862         HLLZ    AC0,V\r
 863 EVOPD:  JUMPE   C,.+2           ;OPDEF, NON-BLANK DELIMITER?\r
 864         TLO     IO,IORPTC       ;YES, REPEAT CHARACTER\r
 865         JSP     AC2,SVSTOW\r
 866         PUSHJ   PP,0(V)\r
 867         PUSHJ   PP,DSTOW\r
 868         JSP     AC2,GTSTOW\r
 869         TRNE    RC,-2\r
 870         HRRM    RC,EXTPNT\r
 871         TLNE RC,-2\r
 872         HLLM RC,EXTPNT\r
 873         JRST    EVNUM\r
 874 \r
 875 EVOPX:  MOVSI   ARG,SYMF!UNDF\r
 876         PUSHJ   PP,INSERZ\r
 877 EVERRZ: SETZB   AC0,RC          ;CLEAR CODE AND RELOCATION\r
 878 EVERRU: TRO     ER,ERRU\r
 879         JRST    EVGETD\r
 880 \fEVTSTS:        TLNE    ARG,UNDF\r
 881         JRST    [TRO    ER,ERRU ;SET UNDEF ERROR\r
 882                 JUMP1   EVGETD  ;TREAT AS UNDF ON PASS1\r
 883                 JRST    .+1]    ;TREAT AS EXTERNAL ON PASS2\r
 884         TLNN    ARG,EXTF\r
 885         JRST    EVTSTR\r
 886         HRRZ RC,ARG     ;GET ADRES WFW\r
 887         HRRZ ARG,EXTPNT ;SAVE IT WFW\r
 888         HRRM RC,EXTPNT  ;WFW\r
 889         TRNE ARG,-1     ;WFW\r
 890         TRO     ER,ERRE\r
 891         SETZB   AC0,ARG\r
 892 \r
 893 EVTSTR: TLNE    ARG,MDFF        ;MULTIPLY DEFINED?\r
 894         TRO     ER,ERRD         ;YES, FLAG IT\r
 895         TLNE    FR,NEGSW        ;NEGATIVE ATOM?\r
 896         PUSHJ   PP,GETDE2       ;YES, NEGATE AC0 AND RC\r
 897 \r
 898 EVGETD: TLNE    IO,NUMSW        ;NON BLANK FIELD\r
 899         TLO     FR,FSNSW        ;YES,SET FLAG\r
 900         PUSHJ   PP,BYPAS2\r
 901         TLNE    CS,6            ;ALPHA-NUMERIC?\r
 902         TLO     IO,IORPTC       ;YES, REPEAT IT\r
 903 EVNUM:  POP     PP,PS           ;POP THE PREVIOUS DELIMITER/TNODE\r
 904         TLO     PS,4000\r
 905         CAMGE   PS,CS           ;OPERATION REQUIRED?\r
 906         JRST    EVPUSH          ;NO, PUT VALUES BACK ON STACK\r
 907         TLNN    PS,TNODE        ;YES, HAVE WE REACHED TERMINAL NODE?\r
 908         JRST    EVXCT           ;NO, EXECUTION REQUIRED\r
 909         TLNN    CS,170000       ;YES, ARE WE POINTING AT DEL? (& ! * / + - ?)\r
 910         POPJ    PP,             ;YES, EXIT\r
 911                                 ;NO,FALL INTO EVPUSH\r
 912 \r
 913 \fEVPUSH:        PUSH    PP,PS           ;STACK VALUES\r
 914         PUSH    PP,CV\r
 915         PUSH    PP,RC\r
 916         PUSH    PP,CS\r
 917         JRST    EVATOM          ;GET NEXT ATOM\r
 918 \r
 919 EVXCT:  POP     PP,PR           ;POP PREVIOUS RELOCATABILITY\r
 920         POP     PP,PV           ;AND PREVIOUS VALUE\r
 921         LDB     PS,[POINT 3,PS,29]      ;TYPE OF OPERATION TO PS\r
 922         JRST    .+1(PS)         ;PERFORM PROPER OPERATION\r
 923         JRST    ASSEM1          ;0; SHOULD NEVER GET HERE ;DMN\r
 924         JRST    XMUL            ;1;\r
 925         JRST    XDIV            ;2;\r
 926         JRST    XADD            ;3;\r
 927         JRST    XSUB            ;4;\r
 928         JRST    XLRW            ;5; "?"\r
 929         TDOA    CV,PV           ;6; MERGE PV INTO CV\r
 930         AND     CV,PV           ;7; AND PV INTO CV\r
 931         JUMPN   RC,.+2          ;COMMON RELOCATION TEST\r
 932 EVXCT1: JUMPE   PR,EVNUM\r
 933         TRO     ER,ERRR         ;BOTH MUST BE FIXED\r
 934         JRST    EVNUM           ;GO TRY AGAIN\r
 935 \r
 936 XSUB:   SUBM    PV,CV\r
 937         SUBM    PR,RC\r
 938         JRST    EVNUM\r
 939 \r
 940 XADD:   ADDM    PV,CV\r
 941         ADDM    PR,RC\r
 942         JRST    EVNUM\r
 943 \r
 944 XDIV:   IDIV    PR,CV           ;CORRECT RELOCATABILITY\r
 945         IDIVM   PV,CV\r
 946 XDIV1:  EXCH    PR,RC           ;TAKE RELOCATION OF NUMERATOR\r
 947         JRST    EVXCT1\r
 948 \r
 949 XMUL:   JUMPE   PR,XMUL1        ;AT LEAST ONE OPERAND\r
 950         JUMPE   RC,XMUL1        ;MUST BE FIXED\r
 951         TRO     ER,ERRR\r
 952 XMUL1:  IORM    PR,RC           ;GET RELOCATION TO RC\r
 953         CAMGE   PV,CV           ;FIND THE GREATER\r
 954         EXCH    PV,CV           ;FIX IN CASE CV=0,OR 1\r
 955         IMULM   PV,RC\r
 956         IMULM   PV,CV\r
 957         JRST    EVNUM\r
 958 XLRW:   EXCH    PV,CV\r
 959         LSH     CV,0(PV)\r
 960         LSH     PR,0(PV)\r
 961         JRST    XDIV1\r
 962 \f       SUBTTL  LITERAL STORAGE HANDLER\r
 963         \r
 964 STOLER:\r
 965 IFE FORMSW,<    SETZB   AC0,RC  ;ERROR, NO CODE STORED\r
 966         PUSHJ   PP,STOW         ;STOW ZERO>\r
 967 IFN FORMSW,<    MOVEI   AC0,0\r
 968         PUSHJ   PP,STOWZ1>\r
 969         TRO     ER,ERRL         ;AND FLAG THE ERROR\r
 970 \r
 971 STOLIT: MOVE    SDEL,STPX\r
 972         SUB     SDEL,STPY       ;COMPUTE NUMBER OF WORDS\r
 973         JUMPE   SDEL,STOLER     ;ERROR IF NONE STORED\r
 974         TRNN    ER,ERRORS       ;ANY ERRORS?\r
 975         JRST    STOL06          ;NO\r
 976         JUMP2   STOL22          ;YES, NO SEARCH.  BRANCH IF PASS2\r
 977         ADDM    SDEL,LITCNT     ;PASS ONE, UPDATE COUNT\r
 978         JRST    STOWI           ;INITIALIZE STOW\r
 979 \r
 980 STOL06: MOVEI   SX,LITAB        ;PREPARE FOR SEARCH\r
 981         MOVE    ARG,STPX        ;SAVE IN THE EVENT OF MULTIPLE-WORD\r
 982         HRL     ARG,STPY\r
 983         MOVE    AC2,LITNUM\r
 984         MOVEI   SDEL,0\r
 985 STOL08: PUSHJ   PP,DSTOW        ;GET VALUE WFW\r
 986 \r
 987 STOL10: SOJL    AC2,STOL24      ;TEST FOR END\r
 988         MOVE    SX,0(SX)        ;NO, GET NEXT STORAGE CELL\r
 989         MOVE    V,-1(SX)                ;GET RELOCATION BITS WFW\r
 990         CAMN    AC0,-2(SX)      ;DO CODES COMPARE? WFW\r
 991         CAME    RC,V            ;YES, HOW ABOUT RELOCATION?\r
 992         AOJA    SDEL,STOL10     ;NO, TRY AGAIN\r
 993         SKIPGE  STPX            ;YES, MULTI-WORD?\r
 994         JRST    STOL26          ;NO, JUST RETURN LOCATION\r
 995         MOVEM   AC2,SAVBLK+AC2  ;YES, SAVE STARTING INFO\r
 996         MOVEM   SX,SAVBLK+SX\r
 997 \r
 998 STOL12: SOJL    AC2,STOL23      ;TEST FOR END\r
 999         PUSHJ   PP,DSTOW        ;GET NEXT WORD WFW\r
1000         MOVE    SX,0(SX)        ;UPDATE POINTER\r
1001         MOVE    V,-1(SX)                ;GET RELOCATION WFW\r
1002         CAMN    AC0,-2(SX)      ;COMPARE VALUE WFW\r
1003         CAME    RC,V            ;AND RELOCATION\r
1004         JRST    STOL14          ;NO MATCH, TRY AGAIN\r
1005         SKIPL   STPX            ;MATCH, HAVE WE FINISHED SEARCH?\r
1006         JRST    STOL12          ;NO, TRY NEXT WORD\r
1007         JRST    STOL26          ;YES, RETURN LOCATION\r
1008 \r
1009 STOL14: MOVE    AC2,SAVBLK+AC2  ;RESTORE STOW POINTERS\r
1010         MOVE    SX,SAVBLK+SX\r
1011         HRREM   ARG,STPX\r
1012         HLREM   ARG,STPY\r
1013         AOJA    SDEL,STOL08     ;BETTER LUCK NEXT TIME\r
1014 \f\r
1015 STOL22: MOVE    SDEL,LITNUM\r
1016 STOL23: PUSHJ   PP,DSTOW        ;DSTOW AND CONVERT\r
1017 STOL24: MOVE    SX,LITABX       ;GET CURRENT STORAGE\r
1018         PUSHJ   PP,GETTOP       ;GET NEXT CELL\r
1019         MOVEM   AC0,-2(SX)      ;STORE CODE WFW\r
1020         MOVEM   RC,-1(SX)       ;WFW\r
1021 IFN FORMSW,<\r
1022         MOVE    AC0,FORM\r
1023         MOVEM   AC0,-3(SX)>\r
1024         MOVEM   SX,LITABX       ;SET POINTER TO CURRENT CELL\r
1025         AOS     LITNUM          ;INCREMENT NUMBER STORED\r
1026         AOS     LITCNT          ;INCREMENT NUMBER RESERVED\r
1027         SKIPL   STPX            ;ANY MORE CODE?\r
1028         JRST    STOL23          ;YES\r
1029 STOL26: JUMP1   POPOUT          ;EXIT IF PASS ONE\r
1030         MOVE    SX,LITHDX       ;GET HEADER BLOCK\r
1031         HLRZ    RC,-1(SX)       ;GET BLOCK RELOCATION\r
1032         HRRZ    AC0,-1(SX)\r
1033         ADDI    AC0,0(SDEL)     ;COMPUTE ACTUAL LOCATION\r
1034         POPJ    PP,             ;EXIT\r
1035 \r
1036 \fSUBTTL INPUT ROUTINES\r
1037 GETCHR: PUSHJ   PP,CHARAC       ;GET ASCII CHARACTER\r
1038         CAIL    C,"A"+40        ;CHECK FOR LOWER CASE\r
1039         CAILE   C,"Z"+40\r
1040         JRST    .+2             ;NOT LOWER CASE\r
1041         MOVEI C,100             ;@>\r
1042         TRZA    C,100           ;CONVERT LOWER CASE TO SIXBIT\r
1043         SUBI    C,40            ;CONVERT TO SIXBIT\r
1044         CAIG    C,77            ;CHAR GREATER THAN SIXBIT?\r
1045         JUMPGE  C,GETCS         ;TEST FOR VALID SIXBIT\r
1046         ADDI    C,40            ;BACK TO ASCII\r
1047         CAIN    C,HT            ;CHECK FOR TAB\r
1048         JRST    GETCS2          ;MAKE IT LOOK LIKE SPACE\r
1049         CAIG    C,CR            ;GREATER THAN CR\r
1050         CAIG    C,HT            ;GREATER THAN TAB\r
1051         JRST    GETCS1          ;IS NOT FF,VT,LF OR CR\r
1052         MOVEI   C,EOL           ;LINE OR FORM FEED OR V TAB\r
1053         TLOA    IO,IORPTC       ;REPEAT CHARACTER\r
1054 GETCS2: MOVEI   C,0             ;BUT TREAT AS BLANK\r
1055 GETCS:  MOVE    CS,CSTAT(C)     ;GET STATUS BITS\r
1056         POPJ    PP,             ;EXIT\r
1057 \r
1058 GETCS1: JUMPE   C,GETCS         ;IGNORE NULS\r
1059         TRC     C,100           ;MAKE CHAR. VISIBLE\r
1060         MOVEI   CS,"?"\r
1061         DPB     CS,LBUFP        ;PUT ? IN OUTPUT\r
1062         PUSHJ   PP,RSW2         ;ALSO MODIFIED CHAR.\r
1063         TRO     ER,ERRQ         ;FLAG Q ERROR\r
1064         JRST    GETCHR          ;BUT IGNORE CHAR.\r
1065 \f\r
1066 CHARAC: TLZE    IO,IORPTC       ;REPEAT REQUESTED?\r
1067         JRST    CHARAX          ;YES\r
1068 RSW0:   JUMPN   MRP,MREAD       ;BRANCH IF TREE POINTER SET\r
1069         PUSHJ   PP,READ\r
1070 RSW1:   SKIPE   RPOLVL          ;ARE WE IN "REPEAT ONCE"?\r
1071         JRST    REPO1           ;YES\r
1072 RSW2:   MOVE    CS,LIMBO        ;GET LAST CHAR.\r
1073         MOVEM   C,LIMBO ;STORE THIS CHAR. FOR RPTC\r
1074         CAIN    C,LF            ;LF?\r
1075         CAIE    CS,CR           ;YES,LAST CHAR. A CR?\r
1076         JRST    RSW3            ;NO\r
1077         HRROS   LIMBO           ;YES,FLAG\r
1078         POPJ    PP,             ;AND EXIT\r
1079 \r
1080 RSW3:   TLNE    IO,IOSALL       ;MACRO SUPPRESS ALL?\r
1081         JUMPN   MRP,CPOPJ       ;YES,DON'T LIST IN MACRO\r
1082         SOSG    CPL             ;ANY ROOM IN THE IMAGE BUFFER?\r
1083         PUSHJ   PP,OUTPL        ;NO, OUTPUT THE PARTIAL LINE\r
1084         IDPB    C,LBUFP         ;YES, STORE IN PRINT AREA\r
1085         CAIE    C,HT            ;TAB?\r
1086         POPJ    PP,             ;NO, EXIT\r
1087         MOVEI   C,7\r
1088         ANDCAM  C,CPL           ;MASK\r
1089 CHARAX: HRRZ    C,LIMBO         ;GET LAST CHARACTER\r
1090         POPJ    PP,             ;EXIT\r
1091 \r
1092 CHARL:  PUSHJ   PP,CHARAC       ;GET AND TEST 7-BIT ASCII\r
1093         CAIG    C,FF            ;LINE OR FORM FEED OR VT?\r
1094         CAIGE   C,LF\r
1095         POPJ    PP,             ;NO,EXIT\r
1096         SKIPE   LITLVL          ;IN LITERAL?\r
1097         JRST    OUTIML          ;YES\r
1098 CHARL1: PUSHJ   PP,SAVEXS       ;SAVE REGISTERS\r
1099         PUSHJ   PP,OUTLIN       ;DUMP THE LINE\r
1100         JRST    RSTRXS          ;RESTORE REGISTERS AND EXIT\r
1101 \fSUBTTL CHARACTER STATUS TABLE\r
1102 \r
1103         DEFINE  GENCS   (OPLVL,ATOM,AN,SQUOZ,OPTYPE,SEQNO)\r
1104 <BYTE (6)OPLVL (9)ATOM (3)AN (6)SQUOZ,OPTYPE,SEQNO>\r
1105 \r
1106         ;OPLVL  PRIORITY OF BINARY OPERATORS\r
1107         ;ATOM   INDEX TO JUMP TABLE AT CELL1\r
1108         ;AN     TYPE OF CHARACTER\r
1109         ;       1=OTHER, 2=ALPHA, 4=NUMERIC\r
1110         ;SQUOZ  VALUE IN RADIX 50\r
1111         ;OPTYPE INDEX TO JUMP TABLE AT EVXCT\r
1112         ;SEQNO  VALUE IN SIXBIT\r
1113 CSTAT:\r
1114         GENCS   00,00,1,00,00,00        ; ' '\r
1115         GENCS   04,12,1,00,06,01        ; '!'\r
1116         GENCS   00,07,1,00,00,02        ; '"'\r
1117         GENCS   00,12,1,00,00,03        ; '#'\r
1118         GENCS   00,01,2,46,00,04        ; '$'\r
1119         GENCS   00,01,2,47,00,05        ; '%'\r
1120         GENCS   04,12,1,00,07,06        ; '&'\r
1121         GENCS   00,07,1,00,00,07        ; '''\r
1122 \r
1123         GENCS   00,01,1,00,00,10        ; '('\r
1124         GENCS   00,01,1,00,00,11        ; ')'\r
1125         GENCS   02,12,1,00,01,12        ; '*'\r
1126         GENCS   01,00,1,00,03,13        ; '+'\r
1127         GENCS   40,01,1,00,00,14        ; ','\r
1128         GENCS   01,02,1,00,04,15        ; '-'\r
1129         GENCS   00,11,2,45,00,16        ; '.'\r
1130         GENCS   02,12,1,00,02,17        ; '/'\r
1131 \r
1132         GENCS   00,04,4,01,00,20        ; '0'\r
1133         GENCS   00,04,4,02,00,21        ; '1'\r
1134         GENCS   00,04,4,03,00,22        ; '2'\r
1135         GENCS   00,04,4,04,00,23        ; '3'\r
1136         GENCS   00,04,4,05,00,24        ; '4'\r
1137         GENCS   00,04,4,06,00,25        ; '5'\r
1138         GENCS   00,04,4,07,00,26        ; '6'\r
1139         GENCS   00,04,4,10,00,27        ; '7'\r
1140 \r
1141         GENCS   00,04,4,11,00,30        ; '8'\r
1142         GENCS   00,04,4,12,00,31        ; '9'\r
1143         GENCS   00,12,1,00,00,32        ; ':'\r
1144         GENCS   00,01,1,00,00,33        ; ';'\r
1145         GENCS   00,05,1,00,00,34        ; '<'\r
1146         GENCS   00,12,1,00,00,35        ; '='\r
1147         GENCS   00,01,1,00,00,36        ; '>'\r
1148         GENCS   00,12,1,00,00,37        ; '?'\r
1149 \f       GENCS   00,03,1,00,00,40        ; '@'\r
1150         GENCS   00,01,2,13,00,41        ; 'A'\r
1151         GENCS   00,01,2,14,00,42        ; 'B'\r
1152         GENCS   00,01,2,15,00,43        ; 'C'\r
1153         GENCS   00,01,2,16,00,44        ; 'D'\r
1154         GENCS   00,01,2,17,00,45        ; 'E'\r
1155         GENCS   00,01,2,20,00,46        ; 'F'\r
1156         GENCS   00,01,2,21,00,47        ; 'G'\r
1157 \r
1158         GENCS   00,01,2,22,00,50        ; 'H'\r
1159         GENCS   00,01,2,23,00,51        ; 'I'\r
1160         GENCS   00,01,2,24,00,52        ; 'J'\r
1161         GENCS   00,01,2,25,00,53        ; 'K'\r
1162         GENCS   00,01,2,26,00,54        ; 'L'\r
1163         GENCS   00,01,2,27,00,55        ; 'M'\r
1164         GENCS   00,01,2,30,00,56        ; 'N'\r
1165         GENCS   00,01,2,31,00,57        ; 'O'\r
1166 \r
1167         GENCS   00,01,2,32,00,60        ; 'P'\r
1168         GENCS   00,01,2,33,00,61        ; 'Q'\r
1169         GENCS   00,01,2,34,00,62        ; 'R'\r
1170         GENCS   00,01,2,35,00,63        ; 'S'\r
1171         GENCS   00,01,2,36,00,64        ; 'T'\r
1172         GENCS   00,01,2,37,00,65        ; 'U'\r
1173         GENCS   00,01,2,40,00,66        ; 'V'\r
1174         GENCS   00,01,2,41,00,67        ; 'W'\r
1175 \r
1176         GENCS   00,01,2,42,00,70        ; 'X'\r
1177         GENCS   00,01,2,43,00,71        ; 'Y'\r
1178         GENCS   00,01,2,44,00,72        ; 'Z'\r
1179         GENCS   00,06,1,00,00,73        ; '['\r
1180         GENCS   00,12,1,00,00,74        ; '\'\r
1181         GENCS   00,01,1,00,00,75        ; ']'\r
1182         GENCS   00,10,1,00,00,76        ; '?'\r
1183         GENCS   10,12,1,00,05,77        ; '?'\r
1184 \fSUBTTL LISTING ROUTINES\r
1185 \r
1186 OUTLIN: TRNN    ER,ERRORS-ERRQ  ;ANY ERRORS?\r
1187         TLNE    FR,ERRQSW       ;NO, IGNORE Q ERRORS?\r
1188         TRZ     ER,ERRQ         ;YES, YES, ZERO THE Q ERROR\r
1189         HRLZ    AC0,ER          ;PUT ERROR FLAGS IN AC0 LEFT\r
1190         TDZ     ER,TYPERR\r
1191         JUMP1   OUTL30          ;BRANCH IF PASS ONE\r
1192         JUMPN   AC0,OUTL02      ;JUMP IF ANY ERRORS TO FORCE PRINTING\r
1193         SKIPL   STPX            ;SKIP IF NO CODE, OTHERWISE\r
1194         JRST    OUTL01          ;NO\r
1195         TLNN    IO,IOSALL       ;YES,SUPPRESS ALL?\r
1196         JRST    OUTL03          ;NO\r
1197         JUMPN   MRP,CPOPJ       ;YES,EXIT IF IN MACRO\r
1198         LDB     C,[XWD 350700,LBUF]\r
1199         CAIE    C,15            ;FIRST CHAR CR?\r
1200 OUTL01: TLZ     IO,IOMAC        ;FORCE MACRO PRINTING\r
1201 OUTL03: TLNN    IO,IOMSTR!IOPROG!IOMAC\r
1202 OUTL02: IOR     ER,OUTSW        ;FORCE IT.\r
1203         IDPB    AC0,LBUFP       ;STORE ZERO TERMINATOR AFTER ASCII SRC LINE\r
1204         TLNN    FR,CREFSW       ;CREF?\r
1205         PUSHJ   PP,CLSCRF       ;YES, WRITE END OF CREF DATA (177,003)\r
1206         JUMPE   AC0,OUTL20      ;BRANCH IF NO ERRORS\r
1207         TLZE    AC0,ERRM        ;M ERROR?\r
1208         TLO     AC0,ERRP        ;M ERROR SET - SET P ERROR.\r
1209         PUSHJ   PP,OUTLER       ;PROCESS ERRORS\r
1210 \r
1211 OUTL20: SKIPN   RC,ASGBLK\r
1212         SKIPE   CS,LOCBLK       ;\r
1213         SKIPL   STPX            ;ANY BINARY?\r
1214         JRST    OUTL23          ;YES, JUMP\r
1215         JUMPE   RC,OUTL22       ;SEQUENCE BREAK AND NO BINARY JUMPS\r
1216         ILDB    C,TABP          ;ASSIGNMENT FALLS THROUGH\r
1217         PUSHJ   PP,OUTL         ;OUTPUT A TAB.\r
1218         ILDB    C,TABP          ;OUTPUT 2ND TAB, LOCATION FIELD\r
1219         PUSHJ   PP,OUTC         ;NEXT IS BINARY LISTING FIELD\r
1220         HLLO    CS,LOCBLK       ;LEFT HALF OF A 36BIT VALUE\r
1221         JUMPL   RC,.+2          ;SKIP IF LEFT HALF IS NOT RELOC\r
1222         TRZA    CS,1            ;IT IS, SET THE FLAG\r
1223         TLNE    CS,-1           ;SKIP IF ITS A 18BIT VALUE, OTHERWISE\r
1224         PUSHJ PP,ONC1           ;PRINT LH OF A 36 BIT VALUE IN CS\r
1225         HRLO    CS,LOCBLK       ;PICK UP THE RIGHT HALF (18BIT VALUE)\r
1226         TRZ     CS,0(RC)        ;\r
1227         PUSHJ   PP,ONC          ;PRINT IT\r
1228         JRST    OUTL23          ;SKIP SINGLE QUOTE TEST\r
1229 \fOUTL22:        PUSHJ   PP,ONC          ;TAB TO RH AND PRINT IT\r
1230         MOVEI   C,"'"\r
1231         SKIPE   MODA\r
1232         PUSHJ   PP,OUTC\r
1233 OUTL23: SKIPL   STPX            ;ANY BINARY?\r
1234         PUSHJ   PP,BOUT         ;YES, DUMP IT\r
1235         MOVE    CS,@OUTLI2      ;[POINT 7,LBUF]\r
1236 OUTL24: ILDB    C,CS\r
1237         JUMPE   C,OUTL25\r
1238         CAIG    C," "\r
1239         JRST    OUTL24\r
1240         MOVE    CS,TABP\r
1241         PUSHJ   PP,OUTASC       ;OUTPUT TABS\r
1242 OUTL25: MOVEI   CS,LBUF\r
1243         PUSHJ   PP,OUTAS0       ;DUMP THE LINE\r
1244         TLNE    IO,IOSALL       ;SUPPRESSING ALL\r
1245         JUMPN   MRP,OUTL27      ;YES,EXTRA CR IF IN MACRO\r
1246 OUTL26: SKIPGE  STPX            ;ANY BINARY?\r
1247         JRST    OUTLI           ;NO, CLEAN UP AND EXIT\r
1248         PUSHJ   PP,OUTLI2       ;YES, INITIALIZE FOR NEXT LINE\r
1249         PUSHJ   PP,BOUT         ;YES, DUMP IT\r
1250 OUTL27: PUSHJ   PP,OUTCR        ;OUTPUT CARRIAGE RETURN\r
1251         JRST    OUTL26          ;TEST FOR MORE BINARY\r
1252 \r
1253 OUTPL:  SKIPN   LITLVL          ;IF IN LITERAL\r
1254         SKIPL   STPX            ;OR CODE GENERATED\r
1255         JRST    OUTIM           ;JUST OUTPUT THE IMAGE\r
1256         SKIPN   ASGBLK          ;SKIP IF AN ASSIGNMENT\r
1257         JRST    OUTIM           ;OTHERWISE OUTPUT IMAGE\r
1258         PUSH    PP,C            ;SAVE CHAR.\r
1259         MOVEI   C,CR\r
1260         IDPB    C,LBUFP\r
1261         MOVEI   C,LF\r
1262         IDPB    C,LBUFP         ;FINISH WITH CRLF\r
1263         PUSHJ   PP,OUTLIN       ;OUTPUT PARTIAL LINE\r
1264         POP     PP,C            ;RESTORE CHAR.\r
1265         JRST    OUTLI2          ;INITIALISE REST OF LINE\r
1266 \fOUTL30:        AOS     CS,STPX         ;PASS ONE\r
1267         ADDM    CS,LOCO         ;INCREMENT OUTPUT LOCATION\r
1268         PUSHJ   PP,STOWI        ;INITIALIZE STOW\r
1269         TLZ     AC0,ERRORS-ERRM-ERRP-ERRV\r
1270         JUMPN   AC0,OUTL32      ;JUMP IF ERRORS\r
1271         TLNE    IO,IOSALL       ;SUPPRESSING ALL/\r
1272         JUMPN   MRP,CPOPJ       ;YES,EXIT\r
1273         JRST    OUTLI1          ;NO,INIT LINE\r
1274 \r
1275 OUTL32: IDPB    AC0,LBUFP       ;ZERO TERNIMATOR\r
1276         IOR     ER,OUTSW        ;LIST ERRORS\r
1277         MOVEI   CS,TAG\r
1278         PUSHJ   PP,OUTSIX       ;OUTPUT TAG\r
1279         HRRZ    C,TAGINC\r
1280         PUSHJ   PP,DNC          ;CONVERT INCREMENT TO DECIMAL\r
1281         PUSHJ   PP,OUTTAB       ;OUTPUT TAB\r
1282         PUSHJ   PP,OUTLER       ;OUTPUT ERROR FLAGS\r
1283         PUSHJ   PP,OUTTAB\r
1284         MOVEI   CS,SEQNO        ;ADDRESS OF SEQUENCE NO.\r
1285         SKIPE   SEQNO           ;FILE NOT SEQUENCED\r
1286         PUSHJ   PP,OUTAS0       ;OUTPUT IT\r
1287         JRST    OUTL25          ;OUTPUT BASIC LINE\r
1288 \r
1289 OUTLER: PUSH PP,ER      ;SAVE LISTING SWITCHES FOR LATER\r
1290         TRNE ER,TTYSW   ;IF THIS IS ON, LISTING IS ON TTY\r
1291         TRZ ER,ERRORS   ;SO SUPPRESS ON TTY\r
1292         TDZ ER,OUTSW    ;BUT THIS SHOULD ONLY GO TO THE TTY\r
1293         MOVE CS,INDIR   ;GET FILE NAME\r
1294         CAME CS,LSTFIL  ;AND SEE IF SAME\r
1295         JRST    [MOVEM CS,LSTFIL        ;SAVE AS LAST ONE\r
1296                 MOVEI CS,LSTFIL\r
1297                 PUSHJ PP,OUTSIX ;LIST NAME\r
1298                 MOVEI C," "\r
1299                 PUSHJ PP,OUTL\r
1300                 MOVE CS,PAGENO  ;PRINT PAGE NUMBER TOO\r
1301                 JRST OUTLE8]\r
1302         MOVE CS,PAGENO  ;NOW CHECK PAGE NUMBER\r
1303         CAME CS,LSTPGN\r
1304 OUTLE8: JRST    [MOVEM CS,LSTPGN\r
1305                 MOVEI CS,[ASCIZ /PAGE /]\r
1306                 PUSHJ PP,OUTAS0\r
1307                 MOVE C,PAGENO\r
1308                 PUSHJ PP,DNC\r
1309                 PUSHJ PP,OUTCR  ;AND NOW FOR THE ERROR LINE\r
1310                 JRST .+1]\r
1311         HLLM ER,(PP)    ;RESTORE ER BUT NOT IO (LEFT HALF OF AC)\r
1312         POP PP,ER\r
1313         MOVE    CS,[POINT 7,[ASCII / QXADLRUVNOPEM/]]\r
1314 OUTLE2: ILDB    C,CS            ;GET ERROR MNEMONIC\r
1315         JUMPGE  AC0,OUTLE4      ;BRANCH IF NOT FLAGGED\r
1316         PUSHJ   PP,OUTL         ;OUTPUT THE CHARACTER\r
1317         AOS     ERRCNT          ;INCREMENT ERROR COUNT\r
1318 OUTLE4: LSH     AC0,1           ;SHIFT NEXT FLAG INTO SIGN BIT\r
1319 \f       JUMPN   AC0,OUTLE2      ;TEST FOR END\r
1320         POPJ    PP,             ;EXIT\r
1321 \fOUTIM1:        TLOA    FR,IOSCR        ;SUPPRESS CRLF AFTER LINE\r
1322 OUTIM:  TLZ     FR,IOSCR        ;DON'T FOR PARTIAL LINE\r
1323         TLNE    IO,IOSALL       ;SUPPRESSING ALL?\r
1324         JUMPN   MRP,CPOPJ       ;YES ,EXIT IF IN MACRO\r
1325         JUMP1   OUTLI1          ;BYPASS IF PASS ONE\r
1326         PUSH    PP,ER\r
1327         TDZ     ER,TYPERR\r
1328         TLNN    IO,IOMSTR!IOPROG!IOMAC\r
1329         IOR     ER,OUTSW\r
1330         PUSH    PP,C            ;OUTPUT IMAGE\r
1331         TLNN    FR,CREFSW\r
1332         PUSHJ   PP,CLSCRF\r
1333 OUTIM2: MOVE    CS,TABP\r
1334         PUSHJ   PP,OUTASC       ;OUTPUT TABS\r
1335         IDPB    C,LBUFP         ;STORE ZERO TERMINATOR\r
1336         MOVEI   CS,LBUF\r
1337         PUSHJ   PP,OUTAS0       ;OUTPUT THE IMAGE\r
1338         TLZN    FR,IOSCR        ;CRLF SUPPRESS?\r
1339         PUSHJ   PP,OUTCR        ;NO,OUTPUT\r
1340         POP     PP,C\r
1341         HLLM    ER,0(PP)\r
1342         POP     PP,ER\r
1343         JRST    OUTLI2\r
1344 \r
1345 OUTLI:  TLNE    IO,IOSALL       ;SUPPRESSING ALL\r
1346         JUMPN   MRP,OUTLI3      ;YES,SET FLAG IN REPEATS ALSO\r
1347         TLNE    IO,IOPALL       ;MACRO EXPANSION SUPRESS REQUESTED?\r
1348         SKIPN   MACLVL          ;YES, ARE WE IN MACRO?\r
1349         TLZA    IO,IOMAC        ;NO, CLEAR MAC FLAG\r
1350 OUTLI3: TLO     IO,IOMAC        ;YES, SET FLAG\r
1351 \r
1352 OUTLI1: TRZ     ER,ERRORS!LPTSW!TTYSW\r
1353 OUTLI2: MOVE    CS,[POINT 7,LBUF]       ;INITIALIZE BUFFERS\r
1354         MOVEM   CS,LBUFP\r
1355 IFN FORMSW,<MOVE CS,[POINT 7,TABI]\r
1356         MOVSS   HWFMT           ;PUT FLAG IN LEFT HALF\r
1357         SKIPGE  HWFMT           ;BUT IF ONLY HALF-WORD FORMAT>\r
1358         MOVE    CS,[POINT 7,TABI,6]\r
1359         MOVEM   CS,TABP\r
1360         MOVEI   CS,.CPL\r
1361 IFN FORMSW,<SKIPL HWFMT         ;IF MULTI-FORMAT\r
1362         SUBI    CS,8            ;LINE IS ONE TAB SHORTER\r
1363         MOVSS   HWFMT           ;BACK AS IT WAS>\r
1364         MOVEM   CS,CPL\r
1365         MOVSI   CS,(ASCII /     /)\r
1366         SKIPE   SEQNO           ;HAVE WE SEQUENCE NUMBERS?\r
1367         MOVEM   CS,SEQNO        ;YES, STORE TAB IN CASE OF MACRO\r
1368         MOVEM   CS,SEQNO+1      ;STORE TAB AND TERMINATOR\r
1369         SETZM   ASGBLK\r
1370         SETZM   LOCBLK\r
1371         POPJ    PP,\r
1372 \fOUTIML:        TLNE    IO,IOSALL       ;SUPPRESSING ALL?\r
1373         JUMPN   MRP,CPOPJ       ;YES,EXIT IF IN MACRO\r
1374         TRNN ER,ERRORS-ERRQ     ;FOR LITERALS (MULIT-LINE) OUTPUT ERRORS\r
1375         TLNE FR,ERRQSW\r
1376         TRZ ER,ERRQ\r
1377         HRLZ CS,ER\r
1378         JUMP1 OUTML1    ;CHECK PASS1 ERRORS\r
1379         TDZ ER,TYPERR\r
1380         JUMPE CS,OUTIM1\r
1381         PUSH PP,[0]     ;ERRORS SHOULD BE ZEROED\r
1382         PUSH PP,C\r
1383         PUSH    PP,AC0  ;SAVE AC0 IN CASE CALLED FROM ASCII\r
1384         MOVE    AC0,CS  ;ERROR ROUTINE WANTS FLAGS IN AC0\r
1385         IOR ER,OUTSW\r
1386         TLNN FR,CREFSW\r
1387         PUSHJ PP,CLSCRF ;FIX CREF\r
1388         TLZE AC0,ERRM\r
1389         TLO AC0,ERRP\r
1390         PUSHJ PP,OUTLER ;OUTPUT THEM\r
1391         POP     PP,AC0\r
1392         JRST OUTIM2     ;AND LINE\r
1393         \r
1394 OUTML1: TLZ CS,ERRORS-ERRM-ERRP-ERRV\r
1395         JUMPE CS,OUTLI2 ;NONE\r
1396         TRZ ER,ERRM!ERRP!ERRV\r
1397         TRO ER,ERRL\r
1398         PUSH PP,ER      ;SAVE\r
1399         PUSH PP,C       ;SAVE THIS\r
1400         PUSH    PP,AC0  ;AS ABOVE\r
1401         MOVE    AC0,CS          ;...\r
1402         TDZ ER,TYPERR\r
1403         IOR ER,OUTSW\r
1404         MOVEI CS,TAG\r
1405         PUSHJ PP,OUTSIX\r
1406         HRRZ C,TAGINC\r
1407         PUSHJ PP,DNC\r
1408         PUSHJ PP,OUTTAB\r
1409         PUSHJ PP,OUTLER ;DO NOT FORGET ERRORS\r
1410         PUSHJ PP,OUTTAB\r
1411         MOVEI CS,LBUF   ;PRINT REST OF LINE\r
1412         PUSHJ PP,SOUT20\r
1413         POP     PP,AC0\r
1414         POP PP,C\r
1415         POP PP,ER\r
1416         JRST OUTLI2\r
1417 \fSUBTTL OUTPUT ROUTINES\r
1418 UOUT:   PUSHJ   PP,LOOKUP       ;SET FOR TABLE SCAN\r
1419         TRNN ARG,PNTF   ;WFW\r
1420         TRNN    ARG,UNDF\r
1421         JRST    UOUT13          ;TEST FOR UNDF!EXTF!PNTF ON PASS2\r
1422         JUMP2   UOUT10\r
1423         TLNN    IO,IOIOPF       ;ANY IOP'S SEEN\r
1424         JRST    UOUT12          ;NO,MAKE EXTERNAL\r
1425         MOVSI   CS,PRMTBL-PRMEND;YES LOOKUP IN TABLE\r
1426 UOUT1:  CAME    AC0,PRMTBL(CS)  ;HAVE WE A MATCH?\r
1427         AOBJN   CS,UOUT2        ;NO,INCREMENT AND JUMP\r
1428         MOVE    ARG,PRMTBL+1(CS);YES,GET VALUE\r
1429         MOVEM   ARG,(SX)        ;UPDATE SYMBOL TABLE\r
1430         POPJ    PP,             ;EXIT\r
1431 UOUT2:  AOBJN   CS,UOUT1        ;TEST FOR END\r
1432 \r
1433 UOUT12: PUSHJ   PP,EXTER2       ;MAKE IT EXTERNAL\r
1434         MOVSI   ARG,UNDF        ;BUT PUT UNDF BACK ON\r
1435         IORM    ARG,(SX)        ;SO MESSAGE WILL COME OUT\r
1436         POPJ    PP,             ;GET NEXT SYMBOL\r
1437 \r
1438 UOUT13: JUMP1   CPOPJ   ;RECYCLE ON PASS1\r
1439         TRC ARG,UNDF!EXTF!PNTF  ;CHECK FOR ALL THREE ON\r
1440         TRCE ARG,UNDF!EXTF!PNTF ;ARE THEY?\r
1441         POPJ    PP,             ;NO, RECYCLE\r
1442 UOUT10: PUSHJ PP,OUTCR\r
1443         PUSHJ   PP,OUTSYM       ;OUTPUT THE SYMBOL\r
1444         MOVEI   CS,[SIXBIT /UNASSIGNED, DEFINED AS IF EXTERNAL @/]\r
1445         JRST    OUTSIX          ;POPJ FOR NEXT SYMBOL\r
1446 \r
1447 UOUT30: PUSHJ   PP,ONC1         ;OUTPUT THE LOCATION\r
1448         JRST    HIGHQ           ;EXIT THROUGH HIGHQ\r
1449 \f                               ;OUTPUT THE ENTRIES\r
1450 \r
1451 EOUT:   MOVEI   C,0             ;INITIALIZE THE COUNT\r
1452         MOVE    SX,SYMBOL\r
1453         MOVE    SDEL,0(SX)\r
1454 EOUT1:  SOJL    SDEL,EOUT2      ;TEST FOR END\r
1455         ADDI    SX,2\r
1456         HLRZ    ARG,0(SX)\r
1457         ANDCAI  ARG,SYMF!INTF!ENTF\r
1458         JUMPN   ARG,EOUT1       ;IF INVALID, DON'T COUNT\r
1459         AOJA    C,EOUT1         ;BUMP COUNT\r
1460 \r
1461 EOUT2:  HRLI    C,4             ;BLOCK TYPE 4\r
1462         PUSHJ   PP,OUTBIN\r
1463         SETZB   C,ARG\r
1464         PUSHJ   PP,OUTBIN\r
1465         MOVE    SX,SYMBOL\r
1466         MOVE    SDEL,0(SX)\r
1467         MOVEI   V,?D18\r
1468 \r
1469 EOUT3:  SOJL    SDEL,POPOUT\r
1470         ADDI    SX,2\r
1471         HLRZ    C,0(SX)\r
1472         ANDCAI  C,SYMF!INTF!ENTF\r
1473         JUMPN   C,EOUT3\r
1474         SOJGE   V,EOUT4         ;TEST END OF BLOCK\r
1475         PUSHJ   PP,OUTBIN\r
1476         MOVEI   V,?D17  ;WFW\r
1477 EOUT4:  MOVE    AC0,-1(SX)\r
1478         PUSHJ   PP,SQOZE\r
1479         MOVE    C,AC0\r
1480         PUSHJ   PP,OUTBIN\r
1481         JRST    EOUT3\r
1482 \f                               ;OUTPUT THE SYMBOLS\r
1483 \r
1484 SOUT:   SKIPN   IONSYM          ;SKIP IF NOSYM SEEN\r
1485         TRNN    ER,LPTSW!TTYSW  ;A LISTING REQUIRED?\r
1486         JRST    SOUT1           ;NO\r
1487         MOVEI   [ASCIZ /SYMBOL TABLE/]\r
1488         HRRM    SUBTTX          ;SET NEW SUB-TITLE\r
1489         PUSHJ   PP,OUTFF        ;FORCE NEW PAGE\r
1490         MOVEI   ARG,NCOLS       ;SET UP FOR NCOLS ACROSS SYMBOL TABLE\r
1491         TRNE    ER,TTYSW        ;IS TTY LISTING DEVICE?\r
1492         MOVEI   ARG,2           ;YES,ONLY 2 COLLUMNS\r
1493         MOVEM   ARG,NCOLLS      ;STORE ANSWER\r
1494         MOVEM ARG,SYMCNT\r
1495         PUSHJ PP,LOUT1          ;OUTPUT THEM\r
1496         MOVE ARG,SYMCNT         ;SEE IF WE ENDED EVEN\r
1497         CAME ARG,NCOLLS\r
1498         PUSHJ   PP,OUTCR        ;NO, NEED CR\r
1499         JRST    SOUT1           ;NOW FOR BLOCK TYPE 2\r
1500 \r
1501 LOUT1:  PUSHJ   PP,LLUKUP       ;SET FOR TABLE SCAN\r
1502         TRNN    ARG,SYMF\r
1503         TRNN    ARG,MACF!SYNF\r
1504         TDZA    MRP,MRP         ;SKIP AND CLEAR MRP\r
1505         POPJ    PP,             ;NO, TRY AGAIN\r
1506         TRNE    ARG,INTF\r
1507         MOVEI   MRP,1\r
1508         TRNE    ARG,EXTF\r
1509         MOVNI   MRP,1           ;MRP=-1 FOR EXTERNAL\r
1510         TRNE    ARG,SYNF        ;SYNONYM?\r
1511         JUMPL   MRP,POPOUT      ;YES, DON'T OUTPUT IF EXTERNAL\r
1512         TRNE ARG,SUPRBT         ;IF SUPRESSED\r
1513 ;       JUMPGE MRP,POPOUT       ;DO NOT OUTPUT UNLESS EXTERNAL\r
1514         POPJ    PP,             ;DO NOT OUTPUT\r
1515         AOS     (PP)            ;SET FOR SKIP RETURN IF SYMBOL IS PRINTED\r
1516         JUMPGE  MRP,LOUT10      ;BRANCH IF NOT EXTERNAL\r
1517         HLRZ    RC,V            ;PUT POINTER/FLAGS IN RC\r
1518         TRNE    RC,-2           ;POINTER?\r
1519         MOVS    RC,0(RC)        ;YES\r
1520         HLL     V,RC            ;STORE LEFT VALUE\r
1521 \r
1522 LOUT10: PUSH PP,RC      ;SAVE FOR LATER\r
1523         PUSHJ   PP,OUTSYM       ;OUTPUT THE NAME\r
1524         MOVE RC,(PP)    ;GET COPY\r
1525         MOVEI   AC1,0\r
1526         JUMPLE  MRP,LOUT15      ;SET DEFFERRED BITS IF EXTERNAL\r
1527         TLNE    RC,-2           ;CHECK FOR LEFT FIXUP\r
1528         IORI    AC1,40          ;AND SET BITS\r
1529         TRNE    RC,-2           ;CHECK FOR RIGHT FIXUP\r
1530         IORI    AC1,20          ;AND SET BITS\r
1531 LOUT15: TLNE RC,-2      ;FIX RELOC AS 0 IF EXTERNAL\r
1532         HRRZS RC\r
1533         TRNE RC,-2\r
1534         HLLZS RC\r
1535         TLZE RC,-1\r
1536         TRO RC,2\r
1537         HRL MRP,RC\r
1538         MOVEI RC,0\r
1539         TRNE    ARG,ENTF        ;ENTRY DMN\r
1540         HRRI    MRP,-5\r
1541         TRNE ARG,NOOUTF         ;SUPRESS OUTPUT? WFW\r
1542         ADDI MRP,3              ;YES WFW\r
1543         TRNE    ARG,UNDF        ;UNDEFINED IS EXTERNAL\r
1544         HRRI    MRP,2           ;SO FLAG AS UXT\r
1545         IOR     AC1,SOUTC(MRP)\r
1546         MOVE ARG,AC1\r
1547         MOVEM AC0,SVSYM         ;SAVE IT\r
1548         MOVE    AC0,V           ;GET THE VALUE\r
1549         HLRZ    RC,MRP          ;AND THE RELOCATION\r
1550         HLLO    CS,V\r
1551         TRNE    RC,2            ;LEFT HALF RELOCATABLE?\r
1552         TRZA    CS,1            ;NO, FLAG AND PRINT\r
1553         TLNE    CS,-1           ;IS THE LEFT HALF ZERO?\r
1554         PUSHJ   PP,ONC1         ;NO, OUTPUT IT\r
1555 LOUT11: PUSHJ   PP,OUTTAB\r
1556 LOUT30: HRLO    CS,V\r
1557         TDZ     CS,RC           ;SET RELOCATION\r
1558         PUSHJ   PP,ONC1\r
1559         PUSHJ   PP,OUTTAB\r
1560         POP PP,RC               ;GET BACK RELOC AND CHECK EXTERNAL\r
1561 LOUT60: MOVEI   CS,SOUTC(MRP)\r
1562         PUSHJ   PP,OUTAS0       ;EXT/INT\r
1563         SOSLE SYMCNT    ;SEE IF WE HAVE RUN OUT\r
1564         JRST    OUTTAB          ;NOT YET, PRINT ONE TAB\r
1565 LOUT64: MOVE CS,NCOLLS          ;YES, RESET\r
1566 \f       MOVEM CS,SYMCNT\r
1567         JRST    OUTCR           ;CARRIAGE RETURN AND TRY FOR ANOTHER\r
1568 \r
1569 \r
1570 \f       SYN IFBLK,SYMBLK        ;SOMEWHERE TO STORE THE POINTERS\r
1571 \r
1572 LLUKUP: POP     PP,LOOKX        ;INTERCEPT RETURN POP\r
1573         MOVE    SX,SYMBOL\r
1574         MOVE    SDEL,(SX)\r
1575         ADDI    SX,2            ;SKIP COUNT OF SYMBOLS\r
1576 LLUKP2: HRLI    SX,-<.LPP-1>    ;LENGTH OF PAGE\r
1577         MOVE    V,ARG           ;COPY OF ARG\r
1578         MOVEM   SX,SYMBLK(V)    ;STORE SYMBOL POINTER IN TABLE\r
1579         ADDI    SX,2*<.LPP-2>   ;SYMBOLS PER PAGE\r
1580         SOJG    V,.-2           ;FOR ALL COLUMNS\r
1581         MOVE    V,SYMCNT\r
1582         HRRZ    SX,SYMBLK(V)\r
1583         CAMGE   SX,SYMTOP\r
1584         SOJG    V,.-2\r
1585         ADDI    V,1\r
1586         MOVEM   V,SYMBLK\r
1587         JRST    LLUKP7          ;ENTER LOOP\r
1588 \r
1589 LLUKP1: MOVEM   SX,SYMBLK(ARG)  ;SAVE IT \r
1590         MOVE    AC0,-1(SX)\r
1591         PUSHJ   PP,SRCH7\r
1592         HLRZS   ARG\r
1593         PUSHJ   PP,@LOOKX\r
1594         JRST    [MOVE   ARG,SYMCNT\r
1595                 MOVEM SX,SYMBLK(ARG)\r
1596                 JRST    .+1]\r
1597 LLUKP7: SOJL    SDEL,POPOUT     ;TEST FOR END\r
1598 LLUKP3: MOVE    ARG,SYMCNT      ;GET PAGE POSITION\r
1599         MOVE    SX,SYMBLK(ARG)  ;GET NEXT POINTER\r
1600         AOBJP   SX,LLUKP4\r
1601         HRRZ    V,SX\r
1602         CAMG    V,SYMTOP\r
1603         AOJA    SX,LLUKP1\r
1604 LLUKP6: PUSHJ   PP,LOUT64       ;RESET SYMCNT\r
1605         JUMPE   SDEL,POPOUT     ;EXIT IF ALL DONE\r
1606         JRST    LLUKP3\r
1607 \r
1608 LLUKP4: AOJ     SX,\r
1609         MOVEM   SX,SYMBLK(ARG)\r
1610         MOVE    V,NCOLLS\r
1611         SKIPGE  SYMBLK(V)       ;TEST IF ALL FINISHED\r
1612         JRST    LLUKP5          ;NO\r
1613         SOJG    V,.-2           ;KEEP GOING\r
1614         MOVE    SX,SYMBLK\r
1615         MOVE    SX,SYMBLK(SX)\r
1616         HLRZ    V,SX            ;GET NUMBER ADVANCED\r
1617         LSH     V,1             ;2 WORDS PER SYMBOL\r
1618         SUBI    SX,2(V)         ;BACK UP ONE SYMBOL\r
1619         SKIPGE  LPP             ;IF PAGE FULL\r
1620         JRST    .+3             ;DON'T FINISH WITH EXTRA CR-LF\r
1621         SETZM   LPP             ;ENSURE END OF PAGE\r
1622         PUSHJ   PP,LOUT64\r
1623         MOVE    ARG,NCOLLS\r
1624         MOVEM   ARG,SYMCNT      ;JUST IN CASE\r
1625         JRST    LLUKP2\r
1626 \r
1627 LLUKP5: SOSG    SYMCNT  ;ON LAST COL?\r
1628         JRST    LLUKP6\r
1629         SKIPGE  LPP             ;IF PAGE FULL\r
1630         JRST    LLUKP3          ;NO MORE OUTPUT \r
1631 REPEAT 2,<PUSHJ PP,OUTAB2>      ;NO, TAB OUT TO NEXT COLUMN\r
1632         JRST    LLUKP3\r
1633 \fSOUT1: PUSHJ   PP,LOOKUP       ;SET FOR TABLE SCAN\r
1634         TRNN    ARG,SYMF\r
1635         TRNN    ARG,MACF!SYNF\r
1636         TDZA    MRP,MRP         ;SKIP AND CLEAR MRP\r
1637         POPJ    PP,             ;NO, TRY AGAIN\r
1638         TRNE    ARG,INTF\r
1639         MOVEI   MRP,1\r
1640         TRNE    ARG,EXTF\r
1641         MOVNI   MRP,1           ;MRP=-1 FOR EXTERNAL\r
1642         TRNE    ARG,SYNF        ;SYNONYM?\r
1643         JUMPL   MRP,POPOUT      ;YES, DON'T OUTPUT IF EXTERNAL\r
1644         TRNE ARG,SUPRBT         ;IF SUPRESSED\r
1645 ;       JUMPGE MRP,POPOUT       ;DO NOT OUTPUT UNLESS EXTERNAL\r
1646         POPJ    PP,             ;DO NOT OUTPUT\r
1647         JUMPGE  MRP,SOUT10      ;BRANCH IF NOT EXTERNAL\r
1648         HLRZ    RC,V            ;PUT POINTER/FLAGS IN RC\r
1649         TRNE    RC,-2           ;POINTER?\r
1650         MOVS    RC,0(RC)        ;YES\r
1651         HLL     V,RC            ;STORE LEFT VALUE\r
1652 \r
1653 SOUT10: PUSH PP,RC      ;SAVE FOR LATER\r
1654         MOVEI   AC1,0\r
1655         JUMPLE  MRP,SOUT15      ;SET DEFFERRED BITS IF EXTERNAL\r
1656         TLNE    RC,-2           ;CHECK FOR LEFT FIXUP\r
1657         IORI    AC1,40          ;AND SET BITS\r
1658         TRNE    RC,-2           ;CHECK FOR RIGHT FIXUP\r
1659         IORI    AC1,20          ;AND SET BITS\r
1660 SOUT15: TLNE RC,-2      ;FIX RELOC AS 0 IF EXTERNAL\r
1661         HRRZS RC\r
1662         TRNE RC,-2\r
1663         HLLZS RC\r
1664         TLZE RC,-1\r
1665         TRO RC,2\r
1666         HRL MRP,RC\r
1667         MOVEI RC,0\r
1668         TRNE    ARG,ENTF        ;ENTRY DMN\r
1669         HRRI    MRP,-5\r
1670         TRNE ARG,NOOUTF         ;SUPRESS OUTPUT? WFW\r
1671         ADDI MRP,3              ;YES WFW\r
1672         IOR     AC1,SOUTC(MRP)\r
1673         MOVE ARG,AC1\r
1674         PUSHJ   PP,NOUT2        ;SQUOZE AND DUMP THE SYMBOL\r
1675         MOVEM AC0,SVSYM         ;SAVE IT\r
1676         MOVE    AC0,V           ;GET THE VALUE\r
1677         HLRZ    RC,MRP          ;AND THE RELOCATION\r
1678         PUSHJ   PP,COUT\r
1679         POP PP,RC               ;GET BACK RELOC AND CHECK EXTERNAL\r
1680         TRNN RC,-2              ;IS IT?\r
1681         JRST SOUT50             ;NO\r
1682         MOVE AC0,1(RC)          ;GET NAME\r
1683         MOVEI ARG,60            ;EXTERNAL REQ\r
1684         PUSHJ PP,SQOZE\r
1685         HLLZS RC        ;NO RELOC\r
1686         PUSHJ PP,COUT   ;OUTPUT IT\r
1687         MOVE AC0,SVSYM  ;GET SYMBOL NAME\r
1688         TLO AC0,500000  ;SET AS ADDITIVE SYMBOL\r
1689         TLZ AC0,200000  ;BUT NOT LEFT HALF ETC\r
1690         PUSHJ PP,COUT\r
1691 SOUT50: MOVSS RC        ;CHECK LEFT HALF\r
1692         TRNN RC,-2\r
1693         JRST SOUT60\r
1694         MOVE AC0,1(RC)\r
1695         MOVEI ARG,60\r
1696         PUSHJ PP,SQOZE\r
1697         MOVEI RC,0\r
1698         PUSHJ PP,COUT\r
1699         MOVE AC0,SVSYM\r
1700         TLO AC0,700000\r
1701         PUSHJ PP,COUT\r
1702 SOUT60: POPJ    PP,\r
1703 \r
1704 SOUT20: PUSHJ PP,OUTAS0\r
1705         JRST OUTCR\r
1706 \r
1707         <ASCII /ENT/>!04        ;DMN\r
1708         Z\r
1709         Z\r
1710         <ASCII /SEN/>!44        ;SUPRESSED ENTRY\r
1711         <ASCII /EXT/>!60\r
1712 SOUTC:  EXP     10\r
1713         <ASCII /INT/>!04\r
1714         <ASCII /UXT/>!60        ;UNDEFINED EXTERNAL\r
1715         <ASCII /SPD/>!50\r
1716         <ASCII /SIN/>!44        ;DMN\r
1717 \f                               ;OUTPUT THE BINARY\r
1718 \r
1719 BOUT:   HRLO    CS,LOCO         ;PICKUP THE LOCATION\r
1720         PUSHJ   PP,ONC          ;OUTPUT IT TO THE LISTING FILE\r
1721         MOVEI   C,"'"\r
1722         SKIPE   MODO            ;IF MODE IS NOT ABSOLUTE\r
1723         PUSHJ   PP,OUTC         ;PRINT A SINGLE QUOTE\r
1724         PUSHJ   PP,DSTOW        ;GET THE CODE\r
1725         PUSH PP,RC      ;SAVE RELOC\r
1726         PUSH    PP,RC   ;AND AGAIN\r
1727         TLNE RC,-2      ;CHECK LEFT EXTERNAL\r
1728         HRRZS RC        ;MAKE LEFT NON-RELOC\r
1729         TRNN RC,-2      ;RIGHT EXT?\r
1730         JRST BOUT30     ;NO\r
1731         HRRZ AC1,AC0    ;YES\r
1732         JUMPE AC1,BOUT20        ;PROCESS IF ZERO CODE THERE\r
1733         HLLZS RC        ;MAKE NON-RELOC\r
1734         JRST BOUT30     ;PROCESS\r
1735 \r
1736 \fBOUT20:\r
1737         HRRM AC1,-1(PP) ;FIX RC IN STACK SO NO CONFUSION WFW (AC1 HAS 0)\r
1738         HRR     AC0,0(RC)       ;NO, SET ADDRESS LINK\r
1739         MOVE    AC1,LOCO        ;GET CURRENT LOCATION\r
1740         HRRM    AC1,0(RC)       ;SET NEW LINK\r
1741         HLRZ    AC1,0(RC)       ;GET FLAGS/POINTER\r
1742         TRNN    AC1,-2          ;POINTER?\r
1743         HRR     AC1,RC          ;NO, SET TO FLAGS\r
1744         HLR     RC,0(AC1)       ;PUT FLAGS IN RC\r
1745         HRL     AC1,MODO        ;GET CURRENT MODE\r
1746         TRZE    RC,-2           ;LEFT HALF RELOCATABLE+\r
1747         TLO     AC1,2           ;YES, SET FLAG\r
1748         HLLM    AC1,0(AC1)      ;STORE NEW FLAGS\r
1749 BOUT30: HLLO    CS,AC0\r
1750         TLZE    RC,1            ;PACK RELOCATION BITS\r
1751         TRO     RC,2\r
1752         TRNE    RC,2            ;LEFT HALF RELOCATABLE?\r
1753         TRZ     CS,1            ;YES, RESET BIT\r
1754         PUSH    PP,AC0          ;NEED AN AC\r
1755         HLRZ    AC0,-1(PP)      ;AC0 = LEFT RELOCATION\r
1756         CAILE   AC0,1           ;EXTERNAL?\r
1757         XORI    CS,EXTF!1       ;YES, SET SWITCH\r
1758 \fIFN FORMSW,<\r
1759         OR      AC0,HWFMT\r
1760         JUMPN   AC0,BOUT3H      ;EDIT IN HALF WORD FORMAT IF NOT 0\r
1761         MOVE    AC0,FORM        ;GET FORM WORD\r
1762         MOVEI   C,0             ;ZERO FIELD SIZE\r
1763 BOUT3A: JFFO    AC0,BOUT3B      ;AC1 = FIELD SIZE -1\r
1764         JRST    BOUT3C          ;NO FIELDS LEFT, JUMP\r
1765 BOUT3B: LSH     AC0,1(AC1)      ;SHIFT OFF FORM FIELD\r
1766         MOVEI   AC1,6(AC1)\r
1767         IDIVI   AC1,3           ;AC1 = COLUMNS USED + 1\r
1768         ADDI    C,(AC1)         ;INCREMENT FIELD SIZE\r
1769         CAIG    C,?D23          ;IS FIELD SIZE GTR 23?\r
1770         JRST    BOUT3A          ;NO.  CONTINUE\r
1771         MOVE    AC1,HWFORM      ;USE STANDARD FORM\r
1772         MOVEM   AC1,FORM\r
1773         MOVEI   C,?D13          ;SET FIELD SIZE TO 13\r
1774 BOUT3C: MOVEM   C,FLDSIZ        ;STORE FIELD SIZE\r
1775         MOVE    AC0,FORM        ;AC0 = FORM WORD\r
1776         TRNN    RC,2            ;IS LEFT HALF RELOCATED?\r
1777         CAMN    AC0,HWFORM      ;NO.  IS FORM HALF WORD?\r
1778         JRST    BOUT3H          ;YES.  EDIT IN OLD WAY\r
1779         CAMN    AC0,IOFORM      ;IS IT I/O WORD\r
1780         SETOM   IOSEEN          ;YES,NEED MORE WORK\r
1781         IBP     TABP\r
1782         CAIL    C,?D16\r
1783         IBP     TABP\r
1784         ILDB    C,TABP          ;GET A TAB\r
1785         PUSHJ   PP,OUTL         ;OUTPUT IT\r
1786         MOVE    AC2,(PP)        ;AC2 = INFO TO BE EDITED\r
1787         PUSH    PP,CS           ;SAVE CS = C+1\r
1788 BOUT3D: JFFO    AC0,BOUT3E      ;AC1 = FIELD LENGTH - 1\r
1789 BOUT3E: LSH     AC0,1(AC1)      ;SHIFT OFF FORM FIELD\r
1790         MOVEI   C,3(AC1)\r
1791         MOVEI   AC1,0\r
1792         LSHC    AC1,-2(C)       ;AC1 = FIELD INFO\r
1793         IDIVI   C,3             ;C = # OF OCTAL DIGITS\r
1794         MOVE    C+1,AC0         ;SAVE AC0\r
1795         SKIPE   IOSEEN          ;IS THIS A I/O INST.\r
1796         PUSHJ   PP,BOUT3J       ;YES,SET FIELDS CORRECTLY\r
1797         MOVNS   C\r
1798         ROT     AC1,(C)\r
1799         ROT     AC1,(C)\r
1800         ROT     AC1,(C)\r
1801         MOVNS   C\r
1802 \fBOUT3F:        MOVEI   AC0,6           ;EDIT A DIGIT\r
1803         LSHC    AC0,3\r
1804         EXCH    AC0,C\r
1805         PUSHJ   PP,OUTC         ;OUTPUT IT\r
1806         MOVE    C,AC0\r
1807         SOJG    C,BOUT3F        ;IF MORE DIGITS,  GO BACK\r
1808         JUMPE   C+1,BOUT3G      ;JUMP IF END OF WORD\r
1809         MOVE    AC0,C+1         ;RESTORE AC0\r
1810         MOVEI   C," "\r
1811         PUSHJ   PP,OUTC         ;OUTPUT A SPACE\r
1812         JRST    BOUT3D          ;PROCESS NEXT FIELD\r
1813 \r
1814 BOUT3G: POP     PP,CS           ;RESTORE CS = C+1\r
1815         MOVEI   C,0\r
1816         TRNE    RC,1            ;RELOCATABLE?\r
1817         MOVEI   C,"'"           ;YES\r
1818         HRRZ    AC0,-1(PP)      ;AC0 = RIGHT RELOCATION\r
1819         CAILE   AC0,1           ;EXTERNAL?\r
1820         MOVEI   C,"*"           ;YES\r
1821         PUSHJ   PP,ONC2         ;STORE POSSIBLE INDICATOR\r
1822         POP     PP,AC0\r
1823         JRST    BOUT3I          ;CONTINUE\r
1824 \r
1825 BOUT3H: MOVEI   C,?D15          ;SET SIZE TO 15\r
1826         MOVEM   C,FLDSIZ\r
1827 >\r
1828         POP     PP,AC0          ;RESTORE\r
1829         PUSHJ   PP,ONC\r
1830         HRLO    CS,AC0\r
1831         TDZ     CS,RC           ;SET RELOCATION\r
1832         HRRZ    C,(PP)          ;C = RIGHT RELOCATION\r
1833         CAILE   C,1             ;EXTERNAL\r
1834         XORI    CS,EXTF!1       ;YES, SET SWITCH\r
1835         PUSHJ   PP,ONC\r
1836 BOUT3I: POP     PP,CS           ;GET RID OF ENTRY ON STACK\r
1837         HRRZ    CS,LOCO\r
1838         TLNE    FR,RIMSW!RIM1SW!R1BSW   ;RIM OUTPUT?\r
1839         JRST    ROUT            ;YES, GO PROCESS\r
1840 \r
1841         HRL     CS,MODO\r
1842         CAME    CS,MODLOC       ;SEQUENCE OR RELOCATION BREAK?\r
1843         PUSHJ   PP,COUTD        ;YES, DUMP THE BUFFER\r
1844         SKIPL   COUTX           ;NEW BUFFER?\r
1845         JRST    BOUT40          ;NO, STORE CODE AND EXIT\r
1846         MOVEM   CS,MODLOC       ;YES, STORE NEW VALUES\r
1847         EXCH    AC0,LOCO\r
1848         EXCH    RC,MODO\r
1849         PUSHJ   PP,COUT         ;STORE BLOCK LOCATION AND MODE\r
1850         EXCH    RC,MODO         ;RESTORE CURRENT VALUES\r
1851         EXCH    AC0,LOCO\r
1852 \r
1853 \fBOUT40:        PUSHJ PP,COUT   ;EMIT CODE\r
1854         POP PP,RC       ;RETRIEVE EXTERNAL BITS\r
1855         TRNN RC,-2      ;RIGHT EXTERNAL?\r
1856         JRST BOUT50     ;TRY FOR LEFT\r
1857         PUSHJ PP,COUTD\r
1858         PUSH PP,BLKTYP  ;TERMINATE TYPE AND SAVE\r
1859         MOVEI AC0,2     ;BLOCK TYPE 2\r
1860         MOVEM AC0,BLKTYP\r
1861         MOVE AC0,1(RC)  ;GET SYMBOL\r
1862         MOVEI ARG,60    ;CODE BITS\r
1863         PUSHJ PP,SQOZE  ;CONVERT TO RADIX 50\r
1864         HLLZS RC        ;SYMBOL HAS NO RELOCATION\r
1865         PUSHJ PP,COUT   ;EMIT\r
1866         MOVE AC0,LOCO   ;GET CURRENT LOC\r
1867         HRLI AC0,400000 ;ADDITIVE REQ\r
1868         HRR RC,MODO     ;CURRENT MODE\r
1869         PUSHJ PP,COUT   ;EMIT\r
1870         MOVSS RC        ;NOW FOR LEFT\r
1871         TRNN RC,-2\r
1872         JRST BOUT60\r
1873         JRST BOUT70\r
1874 BOUT50: MOVSS RC        ;CHECK OTHER HALF\r
1875         TRNN RC,-2              ;LEFT HALF EXTERNAL?\r
1876         JRST BOUT80     ;NO, FALSE ALARM\r
1877         PUSHJ PP,COUTD  ;CHANGE MODE\r
1878         PUSH PP,BLKTYP\r
1879         MOVEI AC0,2\r
1880         MOVEM AC0,BLKTYP\r
1881 BOUT70: MOVE AC0,1(RC)\r
1882         MOVEI ARG,60\r
1883         PUSHJ PP,SQOZE\r
1884         HLLZS RC\r
1885         PUSHJ PP,COUT\r
1886         MOVE AC0,LOCO\r
1887         HRLI AC0,600000 ;LEFT HALF ADD\r
1888         HRR RC,MODO\r
1889         PUSHJ PP,COUT   ;EMIT\r
1890 BOUT60: PUSHJ PP,COUTD  ;CHANGE MODE\r
1891         POP PP,BLKTYP   ;TO OLD ONE\r
1892 BOUT80: AOS LOCO\r
1893         AOS MODLOC\r
1894         POPJ PP,\r
1895 \fIFN FORMSW,<\r
1896 BOUT3J: MOVSS   IOSEEN          ;SWAP\r
1897         SKIPGE  IOSEEN          ;SKIP IF NOT FIRST FIELD\r
1898         JRST    [HLLZS IOSEEN   ;CLEAR RIGHT HALF\r
1899                 POPJ    PP,]    ;AND RETURN\r
1900         MOVSS   IOSEEN          ;SWAP BACK\r
1901         LSH     AC1,2           ;CORRECT  MNEMONIC AND OP CODE\r
1902         CAIE    C,1             ;IS IT OP CODE?\r
1903         POPJ    PP,             ;NO,JUST RETURN\r
1904         MOVEI   C,2             ;TWO CHAR. WIDE NOW\r
1905         SETZM   IOSEEN          ;DON'T COME AGAIN\r
1906         POPJ    PP,             ;RETURN\r
1907 >\r
1908 \fNOUT:  MOVE    V,[POINT 7,TBUF]        ;POINTER TO ASCII LINE\r
1909         MOVSI   CS,(POINT 6,AC0)        ;POINTER TO SIXBIT AC0\r
1910         SETZB   ARG,AC0\r
1911 NOUT1:  ILDB    C,V             ;GET ASCII\r
1912         CAIL C,"A"+40\r
1913         CAILE C,"Z"+40\r
1914         JRST    .+2\r
1915         TRZA    C,100           ;LOWER CASE TO SIXBIT\r
1916         SUBI    C,40            ;CONVERT TO SIXBIT\r
1917         JUMPLE  C,NOUT3         ;TEST FORM NON-SIXBIT\r
1918         CAILE   C,77            ;AND NOT GREATER THAN SIXBIT\r
1919         JRST    NOUT3           ;...\r
1920         IDPB    C,CS            ;DEPOSIT IN AC0\r
1921         TLNE    CS,770000       ;TEST FOR SIX CHARACTERS\r
1922         JRST    NOUT1           ;NO, GET ANOTHER\r
1923 NOUT3:  SKIPGE  UNIVSN          ;IF A UNIVERSAL PROG\r
1924         POPJ    PP,             ;RETURN TO PUT IT IN THE TABLE\r
1925 \r
1926 \r
1927 NOUT2:  PUSHJ   PP,SQOZE        ;CONVERT TO SIXBIT\r
1928         JRST    COUT            ;DUMP AND EXIT\r
1929 \r
1930 HOUT:\r
1931         MOVEI   RC,1            ;RELOCATABLE\r
1932         MOVE    AC0,HIGH\r
1933         PUSHJ   PP,COUT         ;OUTPUT THE HIGHEST LOCATION\r
1934         MOVE AC0,ABSHI\r
1935                                 ;PUT OUT ABS PORTION OF PROGRAM BREAK\r
1936         SOJA    RC,COUT         ;OUTPUT A WORD OF ZERO AND EXIT\r
1937 \r
1938 VOUT:   SKIPN   RC,VECREL       ;IS VECTOR ABSOLUTE ZERO?\r
1939         SKIPE   VECTOR          ;ALSO CHECK RELOCATION\r
1940         JRST    .+2\r
1941         POPJ    PP,             ;YES, EXIT\r
1942         MOVE    AC0,VECTOR      ;AC0 SHOULD BE FLAGS\r
1943 \r
1944 COUT:   AOS     C,COUTX         ;INCREMENT INDEX\r
1945         MOVEM   AC0,COUTDB(C)   ;STORE CODE\r
1946         IDPB    RC,COUTP        ;STORE RELOCATION BITS\r
1947         CAIE    C,?D17          ;IS THE BUFFER FULL?\r
1948         POPJ    PP,             ;NO, EXIT\r
1949 \r
1950 COUTD:  AOSG    C,COUTX         ;DUMP THE BUFFER\r
1951         JRST    COUTI           ;BUFFER WAS EMPTY\r
1952         HRL     C,BLKTYP        ;SET BLOCK TYPE\r
1953         PUSHJ   PP,OUTBIN       ;OUTPUT COUNT AND TYPE\r
1954         SETOB   C,COUTY         ;INITIALIZE INDEX\r
1955 \r
1956 COUTD2: MOVE    C,COUTDB(C)     ;GET RELOCATION BITS/CODE\r
1957         PUSHJ   PP,OUTBIN       ;DUMP IT\r
1958         AOS     C,COUTY         ;INCREMENT INDEX\r
1959         CAMGE   C,COUTX         ;TEST FOR END\r
1960         JRST    COUTD2          ;NO, GET NEXT WORD\r
1961 \r
1962 COUTI:  SETOM   COUTX           ;INITIALIZE BUFFER INDEX\r
1963         SETZM   COUTRB          ;ZERO RELOCATION BITS\r
1964         MOVE    C,[POINT 2,COUTRB]\r
1965         MOVEM   C,COUTP         ;INITIALIZE BIT POINTER\r
1966         POPJ    PP,             ;EXIT\r
1967 \fSTOWZ1:\r
1968 IFN FORMSW,<    MOVE    AC1,HWFORM      ;USE STANDARD FORM>\r
1969 STOWZ:  MOVEI   RC,0\r
1970 STOW:\r
1971 IFN FORMSW,<    MOVEM   AC1,FORM        ;STORE FORM WORD>\r
1972         JUMP1   STOW20          ;SKIP TEST IF PASS ONE\r
1973         TRNE    RC,-2           ;RIGHT HALF ZERO OR 1?\r
1974         PUSHJ   PP,STOWT        ;NO, HANDLE EXTERNAL\r
1975         TLNN    RC,-2           ;LEFT HALF ZERO OR 1? WFW\r
1976         JRST    STOW10          ;YES, SKIP TEST\r
1977         MOVSS   RC              ;SWAP HALVES\r
1978         PUSHJ   PP,STOWT1       ;HANDLE EXTERNAL WFW\r
1979         MOVSS   RC              ;RESTORE VALUES\r
1980 \r
1981 STOW10: SKIPE   EXTPNT          ;ANY EXTERNALS REMAINING?\r
1982         TRO     ER,ERRE         ;YES, SET EXTERNAL ERROR FLAG\r
1983 \r
1984 STOW20: AOS     AC1,STPX        ;INCREMENT POINTER\r
1985         MOVEM   AC0,STCODE(AC1) ;STOW CODE\r
1986         MOVEM   RC,STOWRC(AC1)  ;STOW RELOCATION BITS\r
1987 IFN FORMSW,<\r
1988         PUSH    PP,FORM\r
1989         POP     PP,STFORM(AC1)  ;STORE FORM WORD\r
1990 >\r
1991         SKIPN   LITLVL          ;ARE WE IN LITERAL?\r
1992         AOS     LOCA            ;NO, INCREMENT ASSEMBLY LOCATION\r
1993         CAIGE   AC1,.STP-1      ;OVERFLOW?\r
1994         POPJ    PP,             ;NO, EXIT\r
1995 \r
1996         SKIPE   LITLVL          ;ARE WE IN A LITERAL?\r
1997         TROA    ER,ERRL         ;YES, FLAG ERROR BUT DON'T DUMP\r
1998         JRST    CHARL1          ;NO, SAVE REGISTERS AND DUMP THE BUFFER\r
1999         JRST    STOWI           ;INITIALIZE BUFFER\r
2000 \r
2001 DSTOW:  AOS     AC1,STPY        ;INCREMENT POINTER\r
2002         MOVE    AC0,STCODE(AC1) ;FETCH CODE\r
2003         MOVE    RC,STOWRC(AC1)  ;FETCH RELOCATION BITS\r
2004 IFN FORMSW,<\r
2005         PUSH    PP,STFORM(AC1)\r
2006         POP     PP,FORM         ;GET FORM WORD\r
2007 >\r
2008         CAMGE   AC1,STPX        ;IS THIS THE END?\r
2009         POPJ    PP,             ;NO, EXIT\r
2010 \r
2011 STOWI:  SETOM   STPX            ;INITIALIZE FOR INPUT\r
2012         SETOM   STPY            ;INITIALIZE FOR OUTPUT\r
2013         SETZM   EXTPNT\r
2014         POPJ    PP,             ;EXIT\r
2015 \fSVSTOW:        AOS     LITLVL          ;NESTED LITERALS\r
2016         PUSH    PP,STPX         ;MAKE ROOM FOR ANOTHER\r
2017         PUSH    PP,STPY\r
2018         MOVE    AC1,STPX\r
2019         MOVEM   AC1,STPY\r
2020         JRST    0(AC2)\r
2021 \r
2022 GTSTOW: POP     PP,STPY         ;BACK UP A LEVEL\r
2023         POP     PP,STPX\r
2024         SOS     LITLVL\r
2025         JRST    0(AC2)\r
2026 \r
2027         ;EXTERNAL RIGHT\r
2028 STOWT:  HRRZ    AC1,EXTPNT      ;GET RIGHT POINTER\r
2029         CAIE    AC1,(RC)        ;DOES IT MATCH \r
2030         PUSHJ   PP,QEXT         ;EXTERNAL OR RELOCATION ERROR\r
2031         HLLZS   EXTPNT\r
2032         POPJ    PP,             ;EXIT\r
2033 \r
2034         ;EXTERNAL LEFT\r
2035 STOWT1: HLRZ    AC1,EXTPNT      ;GET LEFT HALF\r
2036         CAIE    AC1,(RC)        ;SEE ABOVE\r
2037         PUSHJ   PP,QEXT\r
2038         HRRZS   EXTPNT\r
2039         POPJ    PP,             ;EXIT\r
2040 \fONC:   ILDB    C,TABP          ;ENTRY TO ADVANCE TAB POINTER\r
2041         PUSHJ   PP,OUTL         ;OUTPUT A TAB\r
2042                                 ;OUTPUT 6 OCT NUMBERS FROM CS LEFT\r
2043 ONC1:   MOVEI   C,6             ;CONVERT TO ASCII\r
2044         LSHC    C,3             ;SHIFT IN OCTAL\r
2045         PUSHJ   PP,OUTL         ;OUTPUT ASCII FROM C\r
2046         TRNE    CS,-1           ;ARE WE THROUGH?\r
2047         JRST    ONC1            ;NO, GET ANOTHER\r
2048         MOVEI   C,0             ;CLEAR C\r
2049         TLNN    CS,1            ;RELOCATABLE?\r
2050         MOVEI   C,"'"           ;YES\r
2051         TLNN    CS,EXTF         ;OR EXTERNAL\r
2052         MOVEI   C,"*"           ;YES\r
2053 ONC2:   JUMPN   C,OUTC          ;OUTPUT IF EXTERN OR RELOCATABLE\r
2054 IFN FORMSW,<    SOS     FLDSIZ  ;DECREMENT FIELD SIZE>\r
2055         POPJ    PP,             ;EXIT\r
2056 \r
2057 DNC:    IDIVI   C,?D10\r
2058         HRLM    CS,0(PP)\r
2059         JUMPE   C,.+2\r
2060         PUSHJ   PP,DNC          ;RECURSE IF NON-ZERO\r
2061         HLRZ    C,0(PP)\r
2062         ADDI    C,"0"           ;FORM ASCII\r
2063         JRST    PRINT           ;DUMP AND TEST FOR END\r
2064 \r
2065 OUTAS0: HRLI    CS,(POINT 7,,)  ;ENTRY TO SET POINTER\r
2066 OUTASC: ILDB    C,CS            ;GET NEXT BYTE\r
2067         JUMPE   C,POPOUT        ;EXIT ON ZERO DELIMITER\r
2068         PUSHJ   PP,PRINT\r
2069         JRST    OUTASC\r
2070 \r
2071 OUTSIX: HRLI    CS,(POINT 6,,)  ;OUTPUT SIXBIT\r
2072         ILDB    C,CS            ;GET SIXBIT\r
2073         CAIN    C,40            ;"@" DELIMITER?\r
2074         POPJ    PP,             ;YES, EXIT\r
2075         ADDI    C,40            ;NO, FORM ASCII\r
2076         PUSHJ   PP,OUTL         ;OUTPUT ASCII CHAR FROM C\r
2077         JRST    OUTSIX+1\r
2078 \r
2079 OUTSYM: MOVE    CS,AC0          ;PLACE NAME IN CS\r
2080 OUTSY1: MOVEI   C,0             ;CLEAR C\r
2081         LSHC    C,6             ;MOVE NEXT SIXBIT CHARACTER IN\r
2082         JUMPE   C,OUTTAB        ;TEST FOR END\r
2083         ADDI    C,40            ;CONVERT TO ASCII\r
2084         PUSHJ   PP,OUTL         ;OUTPUT\r
2085         JRST    OUTSY1          ;LOOP\r
2086 \fOUTSET:        AOS     SX,0(PP)        ;GET RETURN LOCATION\r
2087         MOVE    SX,-1(SX)       ;GET XWD CODE\r
2088         HLRM    SX,BLKTYP       ;SET BLOCK TYPE\r
2089         SETZB   ARG,RC\r
2090         PUSHJ   PP,0(SX)        ;GO TO PRESCRIBED ROUTINE\r
2091         JRST    COUTD           ;TERMINATE BLOCK AND EXIT\r
2092 \r
2093         ;LOOKUP SCANS ALL THE SYMBOLS IN THE SYMBOL TABLE\r
2094 \r
2095 LOOKUP: POP     PP,LOOKX        ;INTERCEPT RETURN POP\r
2096         MOVE    SX,SYMBOL\r
2097         MOVE    SDEL,0(SX)      ;SET FOR TABLE SCAN\r
2098 LOOKL:  SOJL    SDEL,POPOUT     ;TEST FOR END\r
2099         ADDI    SX,2\r
2100         MOVE    AC0,-1(SX)\r
2101         PUSHJ   PP,SRCH7        ;LOAD REGISTERS\r
2102         HLRZS   ARG\r
2103         PUSHJ   PP,@LOOKX       ;RETURN TO CALLING ROUTINE\r
2104         JRST    LOOKL           ;TRY AGAIN\r
2105 \fEND0:  PUSHJ   PP,EVALCM       ;GET A WORD\r
2106         SKIPE   EXTPNT          ;ANY EXTERNALS?\r
2107         TRO     ER,ERRE         ;YES, ERROR\r
2108         SKIPN   V,AC0           ;NON-ZERO?\r
2109         JUMPE   RC,.+2          ;OR RELOC?\r
2110         PUSHJ   PP,ASSIG7       ;YES, LIST THE VALUE\r
2111         MOVEM   AC0,VECTOR\r
2112         MOVEM   RC,VECREL\r
2113         PUSHJ   PP,VARA         ;FILL OUT SELF-DEFINED VARIABLES\r
2114         PUSHJ   PP,STOUTS       ;DUMP THE LINE\r
2115         PUSH    PP,IO           ;SAVE FLAGS\r
2116         TLO     IO,IOPROG       ;XLIST LITS\r
2117         PUSHJ   PP,LIT1\r
2118         POP     PP,IO           ;GET FLAG BACK\r
2119         JUMP2   ENDP2\r
2120 \r
2121         PUSHJ   PP,UOUT\r
2122         TLNN    IO,MFLSW        ;SKIP IF ONLY PSEND\r
2123         PUSHJ   PP,REC2\r
2124         MOVE    INDIR           ;SET UP FIRST AS LAST\r
2125         MOVEM   LSTFIL          ;PRINTED\r
2126         SETZM   LSTPGN\r
2127         PUSHJ   PP,INZ\r
2128         TLNE    IO,MFLSW        ;IF PSEND\r
2129         POPJ    PP,             ;BACK TO PSEND0\r
2130         SKIPE   PRGPTR          ;HAVE ANY PRGEND'S BEEN SEEN\r
2131         JRST    PSEND3          ;YES,GO SET UP AGAIN\r
2132 \r
2133 PASS20: SETZM   CTLSAV\r
2134         PUSHJ   PP,COUTI\r
2135         PUSHJ   PP,EOUT         ;OUTPUT THE ENTRIES\r
2136         PUSHJ   PP,OUTSET\r
2137         XWD     6,NOUT          ;OUTPUT THE NAME (BLKTYP-6)\r
2138         MOVEI   1\r
2139         HRRM    BLKTYP          ;SET FOR TYPE 1 BLOCK\r
2140         TLZ     FR,P1           ;SET FOR PASS 2 AND TURN OFF FLAG\r
2141         TLO     IO,IOPALL       ;PUT THESE BACK\r
2142         TLZ     IO,IOPROG!IOCREF!DEFCRS ;SO LISTINGS WILL BE THE WAY THEY SHOULD\r
2143         TLNN    FR,R1BSW\r
2144         JRST    STOWI\r
2145         \r
2146         MOVE CS,[XWD $ST-1-$CKSM,R1BLDR]\r
2147         MOVE C,0(CS)\r
2148         PUSHJ PP,PTPBIN\r
2149         AOBJN CS,.-2\r
2150         PUSHJ   PP,R1BI\r
2151         JRST    STOWI\r
2152 \f       \r
2153 R1BLDR:\r
2154         PHASE 0\r
2155         IOWD $ADR,$ST\r
2156 $ST:    CONO PTR,60\r
2157         HRRI $A,$RD+1\r
2158 $RD:    CONSO PTR,10\r
2159         JRST .-1\r
2160         DATAI PTR,@$TBL1-$RD+1($A)\r
2161         XCT $TBL1-$RD+1($A)\r
2162         XCT $TBL2-$RD+1($A)\r
2163 $A:     SOJA $A,\r
2164 $TBL1:  CAME $CKSM,$ADR\r
2165         ADD $CKSM,1($ADR)\r
2166         SKIPL $CKSM,$ADR\r
2167 $TBL2:  JRST 4,$ST\r
2168         AOBJN $ADR,$RD\r
2169 $ADR:   JRST $ST+1\r
2170 $CKSM:  \r
2171         DEPHASE\r
2172 \r
2173 IF2,<   PURGE $ST,$RD,$A,$TBL1,$TBL2,$ADR,$CKSM>\r
2174 \fENDP2: PUSHJ   PP,COUTD        ;DUMP THE BUFFER\r
2175         MOVE    AC0,LOCO        ;CHECK TO SEE IF LIT DIFFERED\r
2176         SKIPN   MODO            ;AND USE SMALLER SINCE AT END\r
2177         JRST    [CAMN   AC0,ABSHI\r
2178                 HRRZM   AC2,ABSHI\r
2179                 JRST    ENDP2W]\r
2180         CAMN    AC0,HIGH\r
2181         HRRZM   AC2,HIGH\r
2182 ENDP2W:\r
2183 REPEAT 1,<TLNE  IO,IOCREF       ;CLOSE CREF IF NECESSARY>\r
2184 REPEAT 0,<TLNE FR,CREFSW        ;IF CREFFING\r
2185         JRST ENDP2Q\r
2186         MOVEI SDEL,0\r
2187         PUSH PP,DBUF+3  ;SO NO PAGE INFO\r
2188         DPB SDEL,[POINT 7,DBUF+3,13]\r
2189         IOR ER,OUTSW    ;MAKE SURE OF OUTPUT\r
2190         PUSHJ PP,CREF\r
2191         MOVEI C,20      ;CODE FOR TITLE\r
2192         PUSHJ PP,OUTLST\r
2193         PUSH PP,IO      ;SAVE THIS\r
2194         TLZ IO,IOPAGE   ;AND PREVENT PAGE DURING TITLE\r
2195         MOVEI CS,TBUF\r
2196         PUSHJ PP,OUTAS0\r
2197         MOVEI CS,VBUF\r
2198         PUSHJ PP,OUTAS0\r
2199         POP PP,IO       ;RESTORE THE IO WORD\r
2200         POP PP,DBUF+3   >       ;NEEDS FIX TO CREF\r
2201         PUSHJ   PP,CLSCR2       ;CLOSE IT UP\r
2202 ENDP2Q: HRR     ER,OUTSW        ;SET OUTPUT SWITCH\r
2203         SKIPN   TYPERR\r
2204         TRO     ER,TTYSW\r
2205         PUSHJ   PP,UOUT         ;OUTPUT UNDEFINEDS\r
2206         TRO     ER,TTYSW\r
2207         SKPINC  C       ;SEE IF WE CAN INPUT A CHAR.\r
2208           JFCL          ;BUT ONLY TO DEFEAT ?O\r
2209         SKIPG C,ERRCNT  ;GET ERROR COUNT AND CHECK FOR POSITIVE\r
2210         JRST NOERW      ;PRINT NO ERROR MESSAGE\r
2211         PUSHJ PP,OUTCR\r
2212         MOVE C,ERRCNT\r
2213         CAIN C,1        ;1 IS A SPECIAL CASE\r
2214         JRST ONERW      ;PRINT MESSAGE\r
2215         MOVEI   C,"?"           ;? FOR BATCH\r
2216         PUSHJ   PP,OUTL         ;...\r
2217         MOVE C,ERRCNT   ;PRINT NUMBER OF ERRORS\r
2218         PUSHJ PP,DNC\r
2219         SKIPA CS,[EXP ERRMS1]   ;LOAD TO PRINT\r
2220 ONERW:  MOVEI CS,ERRMS2 ;ONE ERROR DETECTED\r
2221 ONERW1: PUSHJ PP,OUTSIX ;PRINT\r
2222         JRST ENDP2A\r
2223 NOERW:  MOVEI CS,ERRMS3\r
2224         TLNE    IO,MFLSW        ;NOR IF MULTI-FILE MODE\r
2225         TRZ     ER,TTYSW                ;NO TTY OUTPUT\r
2226         IOR     ER,OUTSW        ;UNLESS NEEDED FOR LISTING\r
2227         PUSHJ PP,OUTCR\r
2228         JRST ONERW1\r
2229 \r
2230 \fENDP2A:        PUSHJ PP,OUTCR\r
2231         TLNN    IO,MFLSW        ;IN A MULTI-PROG FILE?\r
2232         JRST    ENDP2D          ;NO\r
2233         SKIPE   ERRCNT          ;ANY ERROR?\r
2234         PUSHJ   PP,[MOVEI CS,[ASCIZ /PROGRAM    /]\r
2235                 PUSHJ PP,OUTAS0 ;YES,SO PRINT MESSAGE\r
2236                 MOVEI   CS,TBUF ;AND TITLE\r
2237                 PUSHJ PP,OUTAS0 ;FOR IDENTIFICATION\r
2238                 JRST    OUTCR]  ;AND A CR-LF\r
2239         TRZA    ER,TTYSW        ;NO MORE OUTPUT NOW\r
2240 ENDP2D:\r
2241         SKIPA           ;SO PRGEND CODE CAN WORK\r
2242         IOR     ER,OUTSW        ;...\r
2243         PUSHJ   PP,OUTCR\r
2244         MOVEI   CS,[SIXBIT /PROGRAM BREAK IS @/]\r
2245         PUSHJ   PP,OUTSIX       ;OUTPUT PROGRAM BREAK\r
2246         HRRZ    CS,ABSHI        ;GET ABS. BREAK\r
2247         CAIG    CS,140          ;ANY ABS. CODE\r
2248         JRST    [HRLO CS,HIGH   ;NO\r
2249                 JRST    ENDP2B] ;SO DON'T PRINT\r
2250         HRLO    CS,HIGH         ;GET PROGRAM BREAK\r
2251         PUSHJ   PP,ONC1\r
2252         PUSHJ   PP,OUTCR\r
2253         MOVEI   CS,[SIXBIT /ABSLUTE BREAK IS @/]\r
2254         PUSHJ   PP,OUTSIX\r
2255         HRLO    CS,ABSHI\r
2256 ENDP2B: PUSHJ   PP,ONC1\r
2257         PUSHJ PP,OUTCR\r
2258         TLNE    FR,RIMSW!R1BSW  ;RIM MODE?\r
2259         PUSHJ   PP,RIMFIN       ;YES, FINISH IT\r
2260         TLNN    IO,MFLSW        ;NOR IF IN MULTI-FILE MODE\r
2261         TRO     ER,TTYSW        ;PRINT SIZE\r
2262         PUSHJ   PP,OUTCR\r
2263         MOVE    C,JOBREL\r
2264         LSH     C,-?D10\r
2265         ADDI    C,1\r
2266         PUSHJ   PP,DNC\r
2267         MOVEI   CS,[SIXBIT /K CORE USED@/]\r
2268         PUSHJ   PP,OUTSIX\r
2269         PUSHJ   PP,OUTCR        \r
2270         HRR     ER,OUTSW\r
2271         PUSHJ   PP,OUTSET\r
2272         XWD     2,SOUT          ;OUTPUT THE SYMBOLS (BLKTYP-2)\r
2273         PUSHJ   PP,OUTSET\r
2274         XWD     7,VOUT          ;OUTPUT TRANSFER VECTOR (..-7)\r
2275         PUSHJ   PP,OUTSET\r
2276         XWD     5,HOUT          ;OUTPUT HIGHEST RELOCATABLE (..-5)\r
2277         PUSHJ   PP,COUTD\r
2278         TLNN    IO,MFLSW        ;IS IT PRGEND?\r
2279         JRST    FINIS           ;ALAS, FINISHED\r
2280         MOVEI   CS,SBUF         ;RESET SBUF POINTER\r
2281         HRRM    CS,SUBTTX       ;TO SUBTTL\r
2282         SETZM   PASS2I          ;CLEAR PASS2 VARIABLES\r
2283         MOVE    [XWD PASS2I,PASS2I+1]\r
2284         BLT     PASS2Z-1        ;BUT NOT ALL OF VARIABLES\r
2285         JRST    INZ             ;RE-INITIALIZE FOR NEXT PROG\r
2286 \r
2287 RIMFIN: TLNE FR,R1BSW\r
2288         PUSHJ PP,R1BDMP\r
2289         SKIPN   C,VECTOR\r
2290         MOVSI   C,(JRST 4,)\r
2291         TLNN    C,777000\r
2292         TLO     C,(JRST)\r
2293         PUSHJ   PP,PTPBIN\r
2294         MOVEI   C,0\r
2295         JRST    PTPBIN\r
2296 \fSUBTTL PASS INITIALIZE\r
2297 INZ:    AOS     MODA\r
2298         AOS     MODO\r
2299         SETZM   SEQNO\r
2300         SETZM   TAG\r
2301         HRRI    RX,?D8\r
2302         MOVEI   VARHD\r
2303         MOVEM   VARHDX\r
2304         MOVEI   LITHD\r
2305         MOVEM   LITHDX\r
2306         PUSHJ   PP,LITI\r
2307         PUSHJ   PP,STOWI\r
2308 IFN FORMSW,<\r
2309         HRRES   HWFMT           ;SET DEFAULT VALUE BACK>\r
2310         JRST    OUTLI\r
2311 \r
2312 RCPNTR: POINT   1,ARG,?L<RELF>-18       ;POINT 1,ARG,22\r
2313 \fSUBTTL PSEUDO-OP HANDLERS\r
2314 \r
2315 TAPE0:  PUSHJ   PP,STOUTS       ;FINISH THIS LINE\r
2316         JRST    GOTEND          ;AND IGNORE THE REST OF THIS FILE\r
2317 \r
2318 RADIX0: PUSHJ   PP,EVAL10       ;EVALUATE RADIX D10\r
2319         CAIG    AC0,?D10        ;IF GREATER THAN 10\r
2320         CAIG    AC0,1           ;OR LESS THAN 2,\r
2321 ERRAX:  TROA    ER,ERRA         ;FLAG ERROR AND SKIP\r
2322         HRR     RX,AC0          ;SET NEW RADIX\r
2323         POPJ    PP,\r
2324 \r
2325 \r
2326 XALL0:  TLZ     IO,IOSALL       ;TURN OFF MACRO SUPPRESS ALL\r
2327 IOSET:  JUMP1   POPOUT          ;NOSYM (IONSYM), XALL (IOPALL), XLIST (IOPROG)\r
2328         HLRZ    SX,AC0          ;STORE FLAGS\r
2329         PUSHJ   PP,STOUTS       ;POLISH OFF LINE\r
2330         TLO     IO,0(SX)        ;NOW SUPRESS PRINTING\r
2331         POPJ    PP,\r
2332 \r
2333 IORSET: TDZ     IO,AC0          ;RESET  FLAG IOPALL/IOPROG\r
2334         TLNE    AC0,IONCRF      ;RESTORING CREFFING?\r
2335         TLZ     IO,DEFCRS       ;YES, CLEAR ANY WAITING DEFINING OCCURENCES\r
2336         POPJ    PP,\r
2337 \r
2338 BLOCK0: PUSHJ   PP,HIGHQ\r
2339         PUSHJ   PP,EVALEX       ;EVALUATE\r
2340         TRZE    RC,-1           ;EXTERNAL OR RELOCATABLE?\r
2341         PUSHJ   PP,QEXT         ;YES, DETERMINE TYPE\r
2342         ADDM    AC0,LOCO        ;UPDATE ASSEMBLY LOCATION\r
2343 BLOCK1: EXCH    AC0,LOCA        ;SAVE START OF BLOCK\r
2344         ADDM    AC0,LOCA        ;UPDATE OUTPUT LOCATION\r
2345 BLOCK2: HRLOM   AC0,LOCBLK\r
2346         JUMP2   POPOUT\r
2347         TRNE    ER,ERRU\r
2348         TRO     ER,ERRV\r
2349         POPJ    PP,\r
2350 \f\r
2351 PRNTX0: TRO     ER,TTYSW        ;SET OUTPUT TO TTY\r
2352         JUMP2   PRNTX2          ;PASS1?\r
2353         TDOA    ER,OUTSW        ;YES,OUTPUT TO LSTDEV ALSO\r
2354 PRNTX2: ANDCM   ER,OUTSW        ;NO,DON'T OUTPUT TO TTY IF IT IS LSTDEV\r
2355         PUSHJ   PP,BYPASS       ;GET FIRST CHAR.\r
2356         TLOA    IO,IORPTC       ;REPEAT IT AND SKIP\r
2357 PRNTX4: PUSHJ   PP,PRINT        ;PRINT THE CHAR.\r
2358         PUSHJ   PP,CHARAC       ;GET ASCII CHAR.\r
2359         CAIG    C,CR            ;IF GREATER THAN CR\r
2360         CAIG    C,HT            ;OR LESS THAN LF\r
2361         JRST    PRNTX4          ;THEN CONTINUE\r
2362         PUSHJ   PP,OUTCR        ;OUTPUT A CRLF\r
2363         TRZA    ER,TTYSW!LPTSW  ;TURN OF OUTPUT\r
2364 CPOPJ1: AOS     (PP)            ;USEFUL TAG HAS TO GO SOMEWHERE\r
2365 CPOPJ:  POPJ    PP,             ;EXIT\r
2366 \r
2367 REMAR0: PUSHJ   PP,GETCHR       ;GET A CHARACTER\r
2368         CAIE    C,EOL\r
2369         JRST    REMAR0\r
2370         POPJ    PP,             ;EXIT\r
2371 \fLIT0:  PUSHJ   PP,BLOCK1\r
2372         PUSHJ   PP,STOUTS\r
2373 LIT1:   JUMP2   LIT20\r
2374 \r
2375 ;ON PASS ONE, WE JUST STEP THE LOCATION COUNTER AND CLEAR\r
2376 \r
2377         MOVE    AC0,LITCNT\r
2378         MOVE    SX,LITHDX\r
2379         HRLM    AC0,0(SX)\r
2380         MOVE    V,LOCA\r
2381         HRL     V,MODA\r
2382         MOVEM   V,-1(SX)\r
2383         JRST    LIT24\r
2384 \r
2385 LIT20:  PUSH    PP,LOCA\r
2386         PUSH    PP,LOCO\r
2387         SKIPN   LITNUM\r
2388         JRST    LIT20A\r
2389         MOVE    SX,LITHDX\r
2390         HRRZ    AC0,-1(SX)\r
2391         CAME    AC0,LOCA\r
2392         TRO     ER,ERRP\r
2393 LIT20A: MOVE    SX,LITAB\r
2394 LIT21:  SOSGE   LITNUM\r
2395         JRST    LIT22\r
2396 IFN FORMSW,<\r
2397         MOVE    AC0,-3(SX)\r
2398         MOVEM   AC0,FORM\r
2399 >\r
2400         MOVE    AC0,-2(SX)      ;WFW\r
2401         MOVE    RC,-1(SX)       ;WFW\r
2402         MOVE SX,(SX)    ;WFW POINTER TO THE NEXT LIT\r
2403         PUSHJ   PP,STOW20       ;STOW CODE\r
2404         MOVEI   C,12            ;SET LINE FEED\r
2405         IDPB    C,LBUFP\r
2406         PUSHJ   PP,OUTLIN       ;OUTPUT THE LINE\r
2407         JRST    LIT21\r
2408 \fLIT22: HRRZ    AC2,LOCO\r
2409         POP     PP,LOCO\r
2410         POP     PP,LOCA\r
2411         MOVE    SX,LITHDX\r
2412         HLRZ    AC0,0(SX)\r
2413         SUB AC2,LOCO    ;COMPUTE LENGTH USED\r
2414         CAMGE AC0,AC2   ;USE LARGER\r
2415         MOVE AC0,AC2\r
2416         ADD AC2,LOCO\r
2417 LIT24:  ADDM    AC0,LOCA\r
2418         ADDM    AC0,LOCO\r
2419         PUSHJ   PP,GETTOP\r
2420         HRRM    SX,LITHDX\r
2421 LITI:   SETZM   LITCNT\r
2422         SETZM   LITNUM\r
2423         MOVEI   LITAB\r
2424         MOVEM   LITABX\r
2425         JRST    HIGHQ\r
2426 \r
2427 GETTOP: HRRZ    AC1,SX          ;VARHD\r
2428         HRRZ    SX,0(SX)\r
2429         JUMPN   SX,POPOUT\r
2430 IFE FORMSW,<    MOVEI   SX,3    ;WFW>\r
2431 IFN FORMSW,<    MOVEI   SX,4    ;ICC>\r
2432         ADDB    SX,FREE\r
2433         CAML    SX,SYMBOL\r
2434         PUSHJ   PP,XCEED\r
2435         SUBI    SX,1            ;MAKE SX POINT TO LINK\r
2436         SETZM   0(SX)           ;CLEAR FORWARD LINK\r
2437         HRRM    SX,0(AC1)       ;STORE ADDRESS IN LAST LINK\r
2438         POPJ    PP,\r
2439 \fVAR0:  PUSHJ   PP,BLOCK1       ;PRINT LOCATION\r
2440         PUSHJ PP,VARA\r
2441         JRST STOUTS\r
2442 \r
2443 VARA:   MOVE    SX,VARHDX\r
2444         MOVE AC0,LOCA   ;GET LOCATION FOR CHECK\r
2445         JUMP1 VARB      ;DO NOT CHECK START ON PASS 1\r
2446         CAME AC0,-1(SX) ;CHECK START OF VAR AREA\r
2447         TRO ER,ERRP     ;AND GIVE ERROR\r
2448 VARB:   MOVEM AC0,-1(SX)        ;SAVE START FOR PASS 2\r
2449         HLRZ    AC0,0(SX)\r
2450         ADDM    AC0,LOCA\r
2451         ADDM    AC0,LOCO\r
2452         PUSHJ   PP,GETTOP\r
2453         HRRM    SX,VARHDX\r
2454         JUMP2   POPOUT\r
2455 \r
2456         PUSHJ   PP,LOOKUP       ;SET FOR TABLE SCAN\r
2457         TRZN    ARG,VARF\r
2458         POPJ    PP,             ;NO, EXIT\r
2459         TRZ ARG,UNDF            ;TURN OFF FLAG NOW\r
2460         MOVSI AC0,1             ;ADD 1\r
2461         ADDM    AC0,0(AC1)      ;UPDATE COUNT\r
2462 \r
2463         IOR     ARG,MODA        ;SET TO ASSEMBLY MODE\r
2464         HRL     ARG,LOCA\r
2465         MOVSM   ARG,0(SX)       ;UPDATE 2ND WRD OF SYM TAB ENTRY\r
2466         AOS     LOCA\r
2467         AOS     LOCO\r
2468         JRST    HIGHQ1\r
2469 \fIF:    PUSH    PP,AC0          ;SAVE AC0\r
2470         PUSH    PP,IO\r
2471         PUSHJ   PP,EVALXQ       ;EVALUATE AND TEST EXTERNAL\r
2472         POP     PP,AC1\r
2473         JUMPL   AC1,IFPOP\r
2474         TLZ     IO,FLDSW\r
2475 IFPOP:  POP     PP,AC1          ;RETRIEVE SKIP INSTRUCTION\r
2476 IFSET:  TLO IO,IORPTC           ;REPEAT CHARACTER\r
2477 IFXCT:  XCT     AC1             ;EXECUTE INSTRUCTION\r
2478         TDZA    AC0,AC0         ;FALSE\r
2479         MOVEI   AC0,1           ;TRUE\r
2480 IFEXIT: JUMPOC REPEA1           ;BRANCH IF IN OP-CODE FIELD\r
2481 IFEX1:  PUSHJ PP,GETCHR         ;SEARCH FOR "<"\r
2482         CAIN C,EOL              ;ERROR IF END OF LINE\r
2483         JRST ERRAX\r
2484         CAIE C,34\r
2485         JRST IFEX1\r
2486         JUMPE AC0,IFEX2         ;TEST FOR 0\r
2487         TLO IO,IORPTC           ;NO, PROCESS AS CELL\r
2488         PUSHJ PP,CELL\r
2489 IFN FORMSW,<    MOVE    AC1,HWFORM      ;USE STANDARD FORM>\r
2490         SETZM   INCND           ;NOT ANY MORE\r
2491         JRST STOW               ;STOW CODE AND EXIT\r
2492 \r
2493 IFPASS: HRRI    AC0,P1          ;MAKE IT TLNX IO,P1\r
2494         MOVE    AC1,AC0         ;PLACE IT IN AC1\r
2495         JRST    IFSET           ;EXECUTE INSTRUCTION\r
2496 \r
2497 IFB0:   HLLO    AC1,AC0         ;FORM AND STORE TEST INSTRUCTION\r
2498 IFB1:   PUSHJ   PP,CHARL        ;GET FIRST NON-BLANK\r
2499         CAIE    C," "\r
2500         CAIN    C,"     "\r
2501         JRST    IFB1            ;SKIP BLANKS AND TABS\r
2502         CAIG    C,CR            ;CHECK FOR CARRET AS DELIM.\r
2503         CAIGE   C,LF\r
2504         SKIPA   SX,SEQNO2\r
2505         JRST    ERRAX\r
2506         MOVEM   SX,CNDSEQ\r
2507         MOVE    SX,PAGENO\r
2508         MOVEM   SX,CNDPG\r
2509         SETOM   INCND           ;SAVE INFO. FOR PASS 1 ERRORS\r
2510         CAIN    C,"<"           ;LEFT BRACKET?\r
2511         SETZB   C,RC            ;YES, PREPARE FOR OLD FORMAT\r
2512         SKIPA   SX,C            ;SAVE FOR COMPARISON\r
2513 IFB3:   TRO     AC0,1           ;SET FLAG\r
2514 IFB2:   PUSHJ   PP,CHARL        ;GET ASCII CHARACTER AND LIST\r
2515         CAMN    C,SX            ;TEST FOR DELIMITER\r
2516         JRST    IFXCT           ;FOUND\r
2517         CAIE    C," "           ;BLANK?\r
2518         CAIN    C,"     "       ;OR TAB?\r
2519         JRST    IFB2            ;YES\r
2520         JUMPN   SX,IFB3         ;JUMP IF NEW FORMAT\r
2521         CAIN    C,"<"           ;<?\r
2522         AOJA    RC,IFB2         ;YES, INCREMENT COUNT\r
2523         CAIN    C,">"           ;>?\r
2524         SOJL    RC,IFXCT        ;YES, DECREMENT AND EXIT IF DONE\r
2525         JRST    IFB3            ;GET NEXT CHARACTER\r
2526 \r
2527 \fIFDEF0:        HRRI    AC0,UNDF        ;MAKE IT TLNX ARG,UNDF\r
2528         PUSH    PP,AC0          ;STACK IT\r
2529         PUSHJ   PP,GETSYM       ;TAKES SKIP RETURN IF SYM NAME IS LEGAL\r
2530         TROA    ER,ERRA         ;ILLEGAL!\r
2531         PUSHJ   PP,SEARCH\r
2532         JRST    [PUSHJ  PP,OPTSCH\r
2533                 TLO     ARG,UNDF\r
2534                 JRST    .+1]\r
2535         PUSHJ PP,SSRCH3         ;EMIT TO CREF ANYWAY\r
2536         JRST    IFPOP           ;POP AND EXECUTE INSTRUCTION\r
2537 \r
2538 \fIFIDN0:        HLRZS   AC0\r
2539         MOVEI   V,2*.IFBLK-1\r
2540         SETZM   IFBLK(V)        ;CLEAR COMPARISON BLOCK\r
2541         SOJGE   V,.-1\r
2542         SETZM   .TEMP           ;CLEAR STORED DELIMETER\r
2543         MOVEI   RC,IFBLK        ;SET FOR FIRST BLOCK\r
2544         PUSHJ   PP,IFCL         ;GET FIRST STRING\r
2545         MOVEI   RC,IFBLKA\r
2546         PUSHJ   PP,IFCL         ;GET SECOND STRING\r
2547         MOVEI   V,.IFBLK-1\r
2548         MOVE    SX,IFBLK(V)     ;GET WORD FROM FIRST STRING\r
2549         CAMN    SX,IFBLKA(V)    ;COMPARE WITH SECOND STRING\r
2550         SOJGE   V,.-2           ;EQUAL, TRY NEXT WORD\r
2551         JUMPL   V,IFEXIT        ;DID WE FINISH STRING\r
2552         XORI    AC0,1           ;NO, TOGGLE REQUEST\r
2553         JRST    IFEXIT  ;DO NOT TURN ON IORPTC WFW\r
2554 \r
2555 IFCL:   PUSHJ   PP,CHARAC       ;GET AND LIST CHARACTER\r
2556         CAIE    C," "           ;SKIP SPACES\r
2557         CAIG    C,CR            ;ALSO SKIP CR-LF\r
2558         CAIGE   C,HT            ;AND TAB\r
2559         JRST    .+2             ;NOT ONE OF THEM\r
2560         JRST    IFCL            ;SO LONG COMPARISONS WILL WORK\r
2561 ;*** A CROCK SO THAT IFIDN <X>,<X>,<INST.> WILL WORK    ***\r
2562         CAIE    C,","           ;IS IT A COMMA?\r
2563         JRST    .+3             ;NO\r
2564         SKIPN   .TEMP           ;YES, WAS PREVIOUS FIELD OLD METHOD?\r
2565         JRST    IFCL            ;YES, IGNORE COMMA AND SPACES\r
2566 ;       ***\r
2567         CAIN    C,"<"           ;WAS IT LEFT BRACKET?\r
2568         SETO    C,              ;SIGNAL OLD METHOD, LOOK FOR RIGHT BRACKET\r
2569         MOVEM   C,.TEMP         ;STORE TERMINATOR FOR COMPARISON\r
2570         MOVEI   SX,5*.IFBLK-1   ;LIMIT SEARCH\r
2571         HRLI    RC,(POINT 7,,)  ;SET UP BYTE IN RC\r
2572 IFCLR:  PUSHJ   PP,CHARAC\r
2573         SKIPLE  .TEMP           ;NEW METHOD?\r
2574         JRST    IFCLR1          ;YES, IGNORE ANGLE BRACKET COUNTING\r
2575         CAIN    C,"<"           ;ANOTHER LEFT ANGLE?\r
2576         SOS     .TEMP           ;YES, KEEP COUNT\r
2577         CAIN    C,">"           ;CLOSING ANGLE\r
2578         AOSGE   .TEMP           ;MATCHING COUNT?\r
2579 IFCLR1: CAMN    C,.TEMP         ;TEST FOR DELIMITER\r
2580         POPJ    PP,             ;EXIT ON RIGHT DELIMITER\r
2581         SOJG    SX,.+2          ;ANY ROOM IN COMPARISON BLOCK?\r
2582         TROA    ER,ERRA         ;NO, FLAG ERROR BUT KEEP ON GOING\r
2583         IDPB    C,RC            ;DEPOSIT BYTE\r
2584         JRST    IFCLR\r
2585 \r
2586 \f\r
2587 IFEX2:  PUSHJ   PP,GETCHR\r
2588         CAIN    C,EOL           ;EXIT WITH ERROR IF END OF LINE\r
2589         JRST    ERRAX\r
2590         CAIN    C,34            ;"<"?\r
2591         AOJA    AC0,IFEX2       ;YES, INCREMENT COUNT\r
2592         CAIE    C,36            ;">"?\r
2593         JRST    IFEX2           ;NO, TRY AGAIN\r
2594         SOJGE   AC0,IFEX2       ;YES, TEST FOR MATCH\r
2595         PUSHJ   PP,BYPASS       ;YES, MOVE TO NEXT DELIMITER\r
2596         SETZM   INCND           ;OUT OF CONDITIONAL NOW\r
2597         AOJA    AC0,STOWZ1      ;STOW ZERO\r
2598 \r
2599 \r
2600 INTER0: HLLZM   AC0,INTENT      ;AC0 CONTAINS INTF/ENTF FLAGS\r
2601 \r
2602 INTER1: PUSHJ   PP,GETSYM       ;GET A SYMBOL\r
2603         JRST    INTER3          ;INVALID, SKIP\r
2604         PUSHJ   PP,SSRCH        ;SEARCH THE TABLE\r
2605         MOVSI   ARG,SYMF!INTF!UNDF\r
2606         TLNE    ARG,UNDF        ;UNDEFINED?\r
2607         TRO     ER,ERRA         ;YES, FLAG ERROR\r
2608         TLNN    ARG,SYNF!EXTF\r
2609         TDOA    ARG,INTENT                      ;SET APPROPRIATE FLAGS\r
2610 INTER3: TROA    ER,ERRA         ;FLAG ARG EROR AND SKIP\r
2611         PUSHJ   PP,INSERQ       ;INSERT/UPDATE\r
2612         JUMPCM  INTER1\r
2613         SETZM EXTPNT    ;JUST IN CASE, SO AS NOT TO CONFUSE WORLD\r
2614         POPJ    PP,             ;NO, EXIT\r
2615 \fEXTER0:        PUSHJ   PP,GETSYM       ;GET A SYMBOL\r
2616         JRST    EXTER4          ;INVALID, ERROR\r
2617 EXTER1: TLO     IO,DEFCRS       ;FLAG THIS AS A DEFINITION\r
2618         PUSHJ   PP,SSRCH        ;OK, SEARCH SYMBOL TABLE\r
2619         JRST    EXTER2          ;NOT THERE, INSERT IT\r
2620         TLNN    ARG,EXTF!VARF!UNDF\r
2621         TROA    ER,ERRE         ;FLAG ERROR AND BYPASS\r
2622         TLNE    ARG,EXTF        ;VALID, ALREADY DEFINED?\r
2623         JRST    [JUMP1  EXTER3  ;YES, BYPASS\r
2624                 TLZN ARG,UNDF   ;SKIP IF UNDEFINED ALSO\r
2625                 JRST    EXTER3  ;CONTINUE\r
2626                 ANDM ARG,(SX)   ;CLEAR UNDF ON PASS 2\r
2627                 JRST    EXTER2] ;SET UP EXTERNAL NOW\r
2628 EXTER2: MOVEI V,2               ;NO, GET 2 CELLS FROM THE TREE\r
2629         ADDB V,FREE\r
2630         CAML    V,SYMBOL        ;HAVE WE RUN OUT OF CORE?\r
2631         PUSHJ   PP,XCEEDS       ;YES, TRY TO BORROW SOME MORE\r
2632         SUBI    V,2             ;GET RIGHT CELL FOR POINTER\r
2633         SETZB   RC,0(V)         ;ALL SET, ZERO VALUES\r
2634         MOVSI   ARG,SYMF!EXTF\r
2635         PUSHJ   PP,INSERT       ;INSERT/UPDATE IT\r
2636         MOVSI   ARG,PNTF\r
2637         IORM    ARG,0(SX)\r
2638         SKIPA ARG,-1(SX)                ;GET THE SIXBIT FOR THE NAME\r
2639 EXTER4: TROA ER,ERRA    ;FLAG AS ERROR\r
2640         MOVEM ARG,1(V)          ;AND STORE THAT IN CASE SYMBOL TABLE MOVES\r
2641 EXTER3: JUMPCM  EXTER0\r
2642         POPJ    PP,             ;NO, EXIT\r
2643 \fEVAL10:        PUSH    PP,RX\r
2644         HRRI    RX,?D10\r
2645         PUSHJ   PP,EVALEX       ;EVALUATE\r
2646         POP     PP,RX           ;RESET RADIX\r
2647         JUMPE   RC,POPOUT       ;EXIT IF ABSOLUTE\r
2648 \r
2649 QEXT:   SKIPE   EXTPNT          ;ANY POSSIBILITIES?\r
2650         TROA    ER,ERRE         ;YES, FLAG EXTERNAL ERROR\r
2651         TRO     ER,ERRR         ;NO, FLAG RELOCATION ERROR\r
2652         HLLZS   RC              ;CLEAR RELOCATION/EXTERNAL\r
2653         POPJ    PP,\r
2654 \r
2655 EVALXQ: PUSHJ   PP,EVALEX       ;EVALUATE EXPRESSION\r
2656         TLZN RC,-2              ;LEFT HALF EXTERNAL\r
2657         TRZE    RC,-2           ;WAS AN EXTERNAL FOUND?\r
2658         TRO     ER,ERRE         ;YES, FLAG ERROR\r
2659         POPJ    PP,             ;RETURN\r
2660 \fOPDEF0:        PUSHJ   PP,GETSYM       ;GET THE FIRST SYMBOL\r
2661         POPJ    PP,             ;ERROR IF INVALID SYMBOL\r
2662         CAIE    C,73            ;"["?\r
2663         JRST    ERRAX           ;NO, ERROR\r
2664         PUSH    PP,AC0          ;STACK MNEMONIC\r
2665         AOS     LITLVL          ;SHORT OUT LOCATION INCREMENT\r
2666         PUSHJ   PP,STMNT        ;EVALUATE STATEMENT\r
2667         SKIPGE  STPX            ;CODE STORED?\r
2668         TROA    ER,ERRA         ;NO,"A" ERROR\r
2669         PUSHJ   PP,DSTOW        ;GET AND DECODE VALUE\r
2670         SOS     LITLVL\r
2671         EXCH    AC0,0(PP)       ;EXCHANGE VALUE FOR MNEMONIC\r
2672         PUSH    PP,RC           ;STACK RELOCATION\r
2673         TLO     IO,DEFCRS       ;SAY WE ARE DEFINING IT\r
2674         PUSHJ   PP,MSRCH        ;SEARCH SYMBOL TABLE\r
2675         MOVSI   ARG,OPDF        ;NOT FOUND\r
2676         POP     PP,RC           ;RESTORE VALUES\r
2677         POP     PP,V\r
2678         TLNE    ARG,SYNF!MACF\r
2679         TRO     ER,ERRA         ;YES "A" ERROR\r
2680         TRNN    ER,ERRA         ;ERROR?\r
2681         PUSHJ   PP,INSERT       ;NO, INSERT/UPDATE\r
2682         TLZ IO,DEFCRS           ;JUST IN CASE\r
2683         PUSHJ   PP,BYPASS\r
2684         JRST    STOWI           ;BE SURE STOW IS RESET\r
2685 \r
2686 \r
2687 DEPHA0: MOVE    AC0,LOCO\r
2688         SKIPA   RC,MODO         ;SET TO OUTPUT VALUES AND SKIP\r
2689 PHASE0: PUSHJ   PP,EVALXQ       ;EVALUATE AND CHECK FOR EXTERNAL\r
2690         MOVEM   AC0,LOCA        ;SET ASSEMBLY LOCATION COUNTER\r
2691         MOVEM   RC,MODA\r
2692         JRST    BLOCK2\r
2693 \fASSIGN:        JUMPAD  ERRAX           ;NO, ERROR\r
2694         PUSHJ   PP,ASSIG1\r
2695         TLNE    IO,IOSALL       ;SUPPRESS ALL?\r
2696         JUMPN   MRP,CPOPJ       ;IF IN MACRO\r
2697 ASSIG7: MOVEM   RC,ASGBLK\r
2698         TRNE    RC,-2           ;EXTERNAL\r
2699         HLLZS   ASGBLK          ;YES,CLEAR RELOCATION\r
2700         TLNE    RC,1            ;LEFT HALF NOT RELOC?\r
2701         TLNE    RC,-2           ;...\r
2702         HRROS   ASGBLK          ;YES, SET FLAG\r
2703         MOVEM   V,LOCBLK\r
2704         POPJ    PP,\r
2705 \r
2706 ASSIG1: PUSH    PP,AC0          ;SAVE SYMBOL\r
2707         SETZB AC0,EXTPNT        ;SPECIAL CHECK FOR == WFW\r
2708         PUSHJ PP,PEEK           ;IS THE NEXT ON =\r
2709         CAIE    C,"="\r
2710         JRST    ASSIG5\r
2711         TLO     AC0,NOOUTF      ;YES, NOT OUT TO DDT WFW\r
2712         PUSHJ   PP,GETCHR       ;PROCESS THE CHAR.\r
2713         PUSHJ   PP,PEEK         ;CHECK FOR ==: DMN\r
2714 ASSIG5: CAIE    C,":"           ;IS IT\r
2715         JRST    ASSIG6          ;NO\r
2716         TLO     AC0,INTF        ;MAKE INTERNAL\r
2717         PUSHJ   PP,GETCHR       ;REPEAT IT\r
2718 ASSIG6: MOVEM AC0,HDAS          ;STORE THESE BITS WFW\r
2719         PUSHJ   PP,EVALCM       ;EVALUATE EXPRESSION\r
2720         EXCH    AC0,0(PP)       ;SWAP VALUE FOR SYMBOL\r
2721         PUSH    PP,RC\r
2722         TRNN RC,-2              ;CHECK EXTERNAL AGREEMENT\r
2723         JRST ASSIG2\r
2724         HRRZS RC\r
2725         HRRZ ARG,EXTPNT\r
2726         CAME RC,ARG\r
2727         PUSHJ   PP,QEXT         ;EXTERNAL OR RELOCATION ERROR\r
2728 ASSIG2: HLRZ RC,(PP)\r
2729         TRNN RC,-2\r
2730         JRST ASSIG3\r
2731         HLRZ ARG,EXTPNT\r
2732         CAME RC,ARG\r
2733         PUSHJ   PP,QEXT\r
2734 ASSIG3: TLO IO,DEFCRS\r
2735         PUSHJ   PP,SSRCH\r
2736         MOVSI   ARG,SYMF\r
2737         IOR ARG,HDAS    ;WFW\r
2738         TLNE    ARG,UNDF        ;WAS IT UNDEFINED\r
2739         TLZ     ARG,EXTF!PNTF   ;YES,CLEAR EXTF NOW\r
2740         TLZ     ARG,UNDF!VARF   ;CANCEL UNDEFINED AND VARIABLE FLAGS\r
2741         SETZM EXTPNT            ;FOR REST OF WORLD\r
2742         POP     PP,RC\r
2743         TRNE    ER,ERRORS-ERRQ\r
2744         SETZ    RC,             ;CLEAR RELOCATION\r
2745         POP     PP,V\r
2746         TRNE    ER,ERRU         ;WAS VALUE UNDEFINED?\r
2747         TLO     ARG,UNDF        ;YES,SO TURN UNDF ON\r
2748         TLNE    ARG,TAGF!EXTF\r
2749         JRST    ERRAX\r
2750         JRST    INSERT\r
2751 \r
2752 \fLOC0:  PUSHJ   PP,HIGHQ        ;AC0=0,0\r
2753         PUSH    PP,AC0          ;SAVE MODE REQUESTED\r
2754         HLRZS   AC0             ;PUT MODE IN RIGHT HALF\r
2755         JUMPN   AC0,RELOC0      ;RELOC PSEUDO-OP\r
2756         CAMN    AC0,MODO        ;SAME AS PRESENT MODE?\r
2757         JRST    [HRRZ AC0,LOCO  ;YES\r
2758                 EXCH AC0,ABSLOC ;EXCH VALUES\r
2759                 JRST    LOC01]\r
2760         HRRZ    AC0,LOCO        ;NO, GET CURRENT VALUE\r
2761         MOVEM   AC0,RELLOC      ;SAVE IT\r
2762         MOVE    AC0,ABSLOC      ;GET LAST RELOC VALUE\r
2763 LOC01:  PUSHJ   PP,BYPASS       ;SKIP BLANKS\r
2764         TLO     IO,IORPTC\r
2765         CAIE    C,EOL           ;USE PREVIOUS VALUE IF NULL ARGUMENT\r
2766         PUSHJ   PP,EVALXQ       ;GET EXPRESSION AND TEST EXTERNAL\r
2767         HRRM    AC0,(PP)        ;STORE NEW VALUE\r
2768         POP     PP,AC0          ;RETRIEVE STORED MODE AND VALUE\r
2769 LOC10:  HRRZM   AC0,LOCA        ;SET ASSEMBLY LOCATION\r
2770         HRRZM   AC0,LOCO        ;AND OUTPUT LOCATION\r
2771         HLRZM   AC0,MODA        ;SET MODE\r
2772         HLRZM   AC0,MODO\r
2773         JRST    BLOCK2\r
2774 \r
2775 RELOC0: CAMN    AC0,MODO\r
2776         JRST    [HRRZ   AC0,LOCO\r
2777                 EXCH    AC0,RELLOC\r
2778                 JRST    LOC01]\r
2779         HRRZ    AC0,LOCO\r
2780         MOVEM   AC0,ABSLOC\r
2781         MOVE    AC0,RELLOC\r
2782         JRST    LOC01\r
2783 \r
2784         SYN     CPOPJ,HISEG0\r
2785         SYN     CPOPJ,TWSEG0\r
2786 \r
2787 IFN FORMSW,<\r
2788 ONFORM: HRRES   HWFMT           ;ALLOW MULTI-FORMAT LISTING\r
2789         POPJ    PP,\r
2790 OFFORM: HRROS   HWFMT           ;HALF-WORD FORMAT ONLY\r
2791         POPJ    PP,     >\r
2792 \r
2793 IFE FORMSW,<\r
2794         SYN     CPOPJ,ONFORM\r
2795         SYN     CPOPJ,OFFORM>\r
2796 \fHIGHQ:\r
2797 HIGHQ1: MOVE    V,LOCO  ;GET ASSEMBLY LOCATION\r
2798         SKIPN   MODO            ;IF ASSEMBLY MODE IS ABSOLUTE\r
2799         JRST    [CAMLE V,ABSHI  ;RECORED ABS HIGHEST ALSO\r
2800                 MOVEM V,ABSHI\r
2801                 POPJ PP,]\r
2802         CAMLE   V,HIGH          ;IS IT GREATER THAN "HIGH"?\r
2803         MOVEM   V,HIGH          ;YES, REPLACE WITH LARGER VALUE\r
2804         POPJ    PP,\r
2805         \r
2806 ONML:   TLZA FR,MWLFLG          ;MULTI-WORD LITERALS OK\r
2807 OFFML:  TLO FR,MWLFLG           ;NO\r
2808         POPJ PP,\r
2809 \r
2810 OFFSYM: SETOM   IONSYM  ;SUPRESS SYMBOL TABLE LISTING\r
2811         POPJ    PP,\r
2812 \r
2813 SUPRE0: PUSHJ PP,GETSYM ;GET A SYMBOL TO SUPRES\r
2814         JRST SUPRE1     ;ERROR\r
2815         PUSHJ PP,SSRCH  ;SYMBOL ONLY\r
2816         JRST SUPRE1     ;GIVE ERROR MESSAGE\r
2817         TLOA ARG,SUPRBT ;SET THE SUPRESS BIT\r
2818 SUPRE1: TROA ER,ERRA\r
2819         IORM ARG,(SX)   ;PUT BACK\r
2820         JUMPCM SUPRE0   ;ANY MORE?\r
2821         JRST    SUPRS1\r
2822 \r
2823 SUPRSA: PUSHJ PP,LOOKUP ;SUPRESS ALL\r
2824         MOVSI ARG,SUPRBT\r
2825         IORM ARG,(SX)\r
2826 SUPRS1: SETZM EXTPNT    ;JUST IN CASE WE LOOKED ONE UP\r
2827         POPJ PP,\r
2828 \r
2829 XPUNG0: JUMP1   POPOUT\r
2830         PUSHJ   PP,LOOKUP\r
2831         MOVE    ARG,(SX)        ;GET SYMBOL FLAGS\r
2832         TLNN    ARG,INTF!ENTF!EXTF!SPTR\r
2833         TLOA    ARG,SUPRBT      ;LOCAL SYMBOL,SO SUPPRESS IT\r
2834         SETZM   EXTPNT\r
2835         MOVEM   ARG,(SX)        ;RESTORE FLAGS\r
2836         POPJ    PP,\r
2837 \fTITLE0:        JUMP2   REMAR0\r
2838         MOVEI   SX,.TBUF\r
2839         HRRI    AC0,TBUF\r
2840         PUSHJ PP,SUBTT1 ;GO READ IT\r
2841         MOVEM   SX,TCNT         ;SAVE COUNT OF CHARS. WRITTEN\r
2842         SKIPE   UNIVSN          ;WAS IT A UNIVERSAL?\r
2843         PUSHJ   PP,ADDUNV       ;YES  ADD TO TABLE\r
2844         TLOE IO,IOTLSN  ;HAVE WE SEEN ONE\r
2845         TRO     ER,ERRM         ;YES, COMPLAIN\r
2846         POPJ    PP,             ;EXIT OTHERWISE\r
2847 \r
2848 SUBTT0: SKIPE   SBUF            ;STORE FIRST SUBTTL ON PASS1\r
2849         JUMP1   REMAR0          ;OTHERWISE EXIT IF PASS ONE\r
2850         MOVEI   SX,.SBUF\r
2851         HRRI    AC0,SBUF\r
2852 \r
2853 SUBTT1: PUSHJ   PP,BYPASS       ;BYPASS LEADING BLANKS\r
2854         TLO     IO,IORPTC\r
2855 SUBTT3: PUSHJ   PP,CHARAC       ;GET ASCII CHARACTER\r
2856         IDPB    C,AC0           ;STORE IN BLOCK\r
2857         CAIGE   C,40            ;TEST FOR TERMINATOR\r
2858         CAIN    C,HT\r
2859         SOJG    SX,SUBTT3       ;TEST FOR BUFFER FULL\r
2860         DPB     RC,AC0          ;END, STORE TERMINATOR\r
2861         SOJA    SX,CPOPJ        ;COUNT NUL AND EXIT\r
2862 \r
2863 \r
2864 \fSYN0:  PUSHJ   PP,GETSYM       ;GET THE FIRST SYMBOL\r
2865         JRST    ERRAX           ;ERROR, EXIT\r
2866         PUSHJ   PP,MSRCH        ;TRY FOR MACRO/OPDEF\r
2867         JRST    SYN3            ;NO,0THRY FOR OPERAND\r
2868 SYN1:   MOVEI   SX,MSRCH        ;YES, SET FLAG\r
2869 SYN2:   PUSHJ   PP,SAVEXS       ;SAVE REGISTERS\r
2870         JUMPNC  ERRAX           ;ERROR IF NO COMMA\r
2871         PUSHJ   PP,GETSYM       ;GET THE SECOND SYMBOL\r
2872         POPJ    PP,\r
2873         PUSHJ   PP,@SAVBLK+SX   ;SEARCH FOR SECOND SYMBOL\r
2874         JFCL\r
2875         MOVE    ARG,SAVBLK+ARG  ;GET VALUES\r
2876         MOVE    RC,SAVBLK+RC\r
2877         MOVE    V,SAVBLK+V\r
2878         TLNE    ARG,MACF        ;MACRO?\r
2879         PUSHJ   PP,REFINC       ;YES, INCREMENT REFERENCE\r
2880         JRST    INSERT          ;INSERT AND EXIT\r
2881 \r
2882 SYN3:   PUSHJ   PP,SSRCH        ;SEARCH FOR OPERAND\r
2883         JRST    SYN4            ;NOT FOUND, TRY OP CODE\r
2884         TLO     ARG,SYNF        ;FLAG AS SYNONYM\r
2885         TLNE    ARG,EXTF        ;EXTERNAL?\r
2886         HRRZ    V,ARG           ;YES, RELPACE WITH POINTER\r
2887         MOVEI   SX,SSRCH        ;SET FLAG\r
2888         TLNN ARG,VARF   ;DO NOT LET HIM SYN A VARIABLE\r
2889         JRST    SYN2\r
2890         JRST ERRAX\r
2891 \r
2892 SYN4:   PUSHJ   PP,OPTSCH       ;SEARCH FOR OP-CODE\r
2893         JRST    ERRAX           ;NOT FOUND, EXIT WITH ERROR\r
2894         MOVSI   ARG,SYNF        ;FLAG AS SYNONYM\r
2895         JRST    SYN1\r
2896 \fPURGE0:        PUSHJ   PP,GETSYM       ;GET A MNEMONIC\r
2897         JRST    [TRZ ER,ERRA    ;CLEAR ERROR\r
2898                 POPJ    PP,]    ;AND RETURN\r
2899         PUSHJ   PP,MSRCH        ;SEARCH MACRO SYMBOL TABLE\r
2900         JRST    PURGE2          ;NOT FOUND, TRY SYMBOLS\r
2901         PUSH    PP,CS           ;SAVE CS AS IT MAY GET GARBAGED\r
2902         TLNE    ARG,MACF        ;MACRO?\r
2903         PUSHJ   PP,REFDEC       ;YES, DECREMENT THE REFERENCE\r
2904         POP     PP,CS\r
2905         JRST    PURGE4          ;REMOVE SYMBOL FROM TABLE\r
2906 \r
2907 PURGE2: PUSHJ   PP,SSRCH        ;TRY OPERAND SYMBOL TABLE\r
2908         JRST    PURGE5          ;NOT FOUND GET NEXT SYMBOL\r
2909         TRNN RC,-2              ;CHECK COMPLEX EXTERNAL\r
2910         TLNE RC,-2\r
2911         TLNE ARG,SYNF\r
2912         JRST    .+2\r
2913         JRST PURGE3\r
2914         TLNE    ARG,EXTF!UNDF   ;ERROR IF EXTERNAL OR UNDEFINED\r
2915         TLNE    ARG,SYNF        ;BUT NOT A SYNONYM\r
2916         JRST    PURGE4\r
2917 PURGE3: TROA    ER,ERRA         ;NOT FOUND, ERROR\r
2918 PURGE4: PUSHJ   PP,REMOVE       ;REMOVE FROM THE SYMBOL TABLE\r
2919 PURGE5: JUMPCM  PURGE0\r
2920         POPJ    PP,             ;EXIT\r
2921 \fOPD1:  TLNE    ARG,UNDF        ;IF OPDEF IS UNDEFINED\r
2922         TRO     ER,ERRO         ;GIVE "O" ERROR\r
2923 OPD:    MOVE    AC0,V           ;PUT VALUE IN AC0\r
2924         JRST    OP\r
2925 IOP:    MOVSI   AC2,(POINT 9,0(PP),11)\r
2926 IFE FORMSW,<    TLOA    IO,IOIOPF       ;SET "IOP SEEN" AND SKIP>\r
2927 IFN FORMSW,<    PUSH    PP,IOFORM       ;USE I/O FORM\r
2928         TLO     IO,IOIOPF       ;SET "IOP" SEEN\r
2929         JRST    OP+2>\r
2930 OP:     MOVSI   AC2,(POINT 4,0(PP),12)\r
2931 IFN FORMSW,<    PUSH    PP,INFORM       ;USE INST. FORM>\r
2932         PUSH    PP,RC\r
2933         PUSH    PP,AC0          ;STACK CODE \r
2934         PUSH    PP,AC2\r
2935         PUSHJ   PP,EVALEX       ;EVALUATE FIRST EXPRESSION\r
2936         POP     PP,AC2\r
2937         JUMPNC  OP2\r
2938 OP1B:   PUSHJ   PP,GETCHR       ;GET A CHARACTER\r
2939 IFE FORMSW,<JUMPCM XWD5         ;PROCESS COMMA COMMA IN XWD>\r
2940 IFN FORMSW,<JUMPNC .+4          ;JUMP IF NO COMMA\r
2941         MOVE    AC2,HWFORM      ;GET FORM WORD FOR XWD\r
2942         MOVEM   AC2,-2(PP)      ;REPLACE INSTRUCTION FORM\r
2943         JRST    XWD5            ;PROCESS COMMA COMMA IN XWD>\r
2944         TLO     IO,IORPTC       ;NOT A COMMA,REPEAT IT\r
2945         LDB     AC1,AC2\r
2946         ADD     AC1,AC0\r
2947         DPB     AC1,AC2\r
2948         JUMPE   RC,OP1A         ;EXTERNAL OR RELOCATABLE?\r
2949         PUSHJ   PP,QEXT         ;YES, DETERMINE WHICH AND FLAG AN ERROR\r
2950 \r
2951 OP1A:   PUSHJ   PP,EVALEX       ;GET ADDRESS PART\r
2952 OP2:    PUSHJ   PP,EVADR        ;EVALUATE STANDARD ADDRESS\r
2953 OP3:    POP     PP,AC0          ;PUT IN AC0\r
2954         POP     PP,RC\r
2955 IFN FORMSW,<    POP     PP,AC1  ;GET FORM WORD>\r
2956         SKIPE   (PP)            ;CAME FROM EVALCM?\r
2957         JRST    STOW            ;NO,STOW CODE AND EXIT\r
2958         POP     PP,AC1          ;YES,EXIT IMMEDIATELY\r
2959         POPJ    PP,\r
2960 \r
2961 \fEVADR:                         ;EVALUATE STANDARD ADDRESS\r
2962 IFE IIISW,<TLNN AC0,-1          ;OK IF ALL 0'S\r
2963         JRST    .+4             ;IT WAS\r
2964         TLC     AC0,-1          ;CHANGE ALL ONES TO ZEROS\r
2965         TLCE    AC0,-1          ;OK IF ALL 1'S\r
2966         TRO     ER,ERRQ         ;NO,FLAG Q ERROR>\r
2967         ADD     AC0,-1(PP)      ;ADD ADDRESS PORTIONS\r
2968         HLL     AC0,-1(PP)      ;GET LEFT HALF\r
2969         TLZE    FR,INDSW        ;INDIRECT BIT?\r
2970         TLO     AC0,(Z @)       ;YES, PUT IT IN\r
2971         MOVEM   AC0,-1(PP)      ;RE-STACK CODE\r
2972         ADD     RC,-2(PP)       ;UPDATE RELOCATION\r
2973         HRRM    RC,-2(PP)       ;USE HALF WORD ADD\r
2974         CAIE    C,10            ;"("?\r
2975         POPJ    PP,             ;NO, EXIT\r
2976 \r
2977         MOVSS   EXTPNT          ;WFW\r
2978         PUSHJ   PP,EVALCM       ;EVALUATE\r
2979         MOVSS   EXTPNT          ;WFW\r
2980         MOVSS   V,AC0           ;SWAP HALVES\r
2981 IFE IIISW,<MOVSS SX,RC\r
2982         IOR     SX,V            ;MERGE RELOCATION\r
2983         TRNN    SX,-1           ;RIGHT HALF ZERO?\r
2984         JRST    OP2A            ;YES, DO SIMPLE ADD\r
2985         MOVE    ARG,RC          ;NO, SWAP RC INTO ARG>\r
2986 IFN IIISW,<MOVSS ARG,RC>\r
2987         ADD     V,-1(PP)        ;ADD RIGHT HALVES\r
2988         ADD     ARG,-2(PP)\r
2989         HRRM    V,-1(PP)        ;UPDATE WITHOUT CARRY\r
2990         HRRM    ARG,-2(PP)\r
2991         HLLZS   AC0             ;PREPARE LEFT HALVES\r
2992         HLLZS   RC\r
2993 IFE IIISW,<TLNE SX,-1           ;IS LEFT HALF ZERO?\r
2994         TRO     ER,ERRQ         ;NO FLAG FORMAT ERROR\r
2995 OP2A:   TLNE    RC,-1           ;RELOCATION FOR LEFT HALF?\r
2996         PUSHJ   PP,OP2A1        ;YES,IS IT LEGAL?\r
2997         TLNE    AC0,777000      ;OP CODE FIELD USED?\r
2998         JRST    [EXCH AC0,-1(PP);YES, GET STORED CODE\r
2999                 TLNE AC0,777000 ;OP CODE FIELD BEEN SET?\r
3000                 TRO ER,ERRQ     ;YES, MOST LIKELY AN ERROR\r
3001                 EXCH AC0,-1(PP)\r
3002                 JRST    .+1]    ;RETURN TO ADD >\r
3003         ADDM    AC0,-1(PP)      ;MERGE WITH PREVIOUS VALUE\r
3004         ADDM    RC,-2(PP)\r
3005         CAIE    C,11            ;")"?\r
3006         JRST    ERRAX           ;NO, FLAG ERROR\r
3007                                 ;YES, BYPASS PARENTHESIS\r
3008 BYPASS:\r
3009 BYPAS1: PUSHJ   PP,GETCHR\r
3010 BYPAS2: JUMPE   C,.-1           ;SKIP TRAILING BLANKS\r
3011         POPJ    PP,             ;EXIT\r
3012 \r
3013 \fIFE IIISW,<\r
3014 OP2A1:  EXCH    RC,-2(PP)       ;GET STORED CODE\r
3015         TLNN    RC,-1           ;OK IF ALL ZERO\r
3016         JRST    OP2A2           ;OK SO RETURN\r
3017         TLC     RC,-1           ;CHANGE ALL ONES TO ZEROS\r
3018         TLCE    RC,-1           ;OK IF ALL ONES\r
3019         TRO     ER,ERRQ         ;OTHERWISE A "Q" ERROR\r
3020 OP2A2:  EXCH    RC,-2(PP)       ;GET RC,BACK\r
3021         POPJ    PP,             ;AND RETURN>\r
3022 \r
3023 \r
3024 EXPRES: HRLZ    AC0,RX          ;FUDGE FOR OCT0\r
3025 \r
3026 OCT0:   PUSH    PP,RX\r
3027         HLR     RX,AC0\r
3028 OCT1:   PUSHJ   PP,EVALEX       ;EVALUATE\r
3029 IFN FORMSW,<    MOVE    AC1,HWFORM>\r
3030         PUSHJ   PP,STOW         ;STOW CODE\r
3031         JUMPCM  OCT1\r
3032         POP     PP,RX           ;YES, RESTORE RADIX\r
3033         POPJ    PP,             ;EXIT\r
3034 \fSIXB10:        MOVSI   RC,(POINT 6,AC0)        ;SET UP POINTER\r
3035         MOVEI   AC0,0           ;CLEAR WORD\r
3036 \r
3037 SIXB20: PUSHJ   PP,CHARL        ;GET NEXT CHARACTER\r
3038         CAMN    C,SX            ;IS THIS PRESET DELIMITER?\r
3039 IFE FORMSW,<    JRST    ASC60           ;YES>\r
3040 IFN FORMSW,<\r
3041         JRST    [PUSHJ  PP,BYPAS1\r
3042                 ANDCM   RC,STPX\r
3043                 MOVE    AC1,SXFORM\r
3044                 JUMPGE  RC,STOWZ\r
3045                 POPJ    PP,]>\r
3046         CAIL C,"A"+40\r
3047         CAILE C,"Z"+40\r
3048         JRST    .+2\r
3049         TRZA    C,100           ;CONVERT LOWER CASE TO SIXBIT\r
3050         SUBI    C,40            ;CONVERT TO SIXBIT\r
3051         JUMPL   C,ASC55         ;TEST FOR INVALID CHARACTER\r
3052         IDPB    C,RC            ;NO, DEPOSIT THE BYTE\r
3053         TLNE    RC,770000       ;IS THE WORD FULL?\r
3054         JRST    SIXB20          ;NO, GET NEXT CHARACTER\r
3055 IFN FORMSW,<    MOVE    AC1,SXFORM      ;SIXBIT FORM>\r
3056         PUSHJ   PP,STOWZ        ;YES, STORE\r
3057         JRST    SIXB10          ;GET NEXT WORD\r
3058 \fASCII0:        HLLZ    SDEL,AC0        ;STORE ASCII/ASCIZ FLAG\r
3059 ASC10:  PUSHJ   PP,CHARL        ;GET FIRST NON-BLANK\r
3060         CAIE    C," "\r
3061         CAIN    C,HT\r
3062         JRST    ASC10\r
3063         CAIG C,CR               ;CHECK FOR CRRET AS DELIM\r
3064         CAIGE C,LF\r
3065         SKIPA   SX,SEQNO2\r
3066         JRST ERRAX\r
3067         MOVEM SX,TXTSEQ         ;SAVE SEQ AND PAGE\r
3068         MOVE SX,PAGENO\r
3069         MOVEM SX,TXTPG\r
3070         SETOM INTXT\r
3071         MOVE    SX,C            ;SAVE FOR COMPARISON\r
3072         JUMPG   SDEL,SIXB10     ;BRANCH IF SIXBIT\r
3073 \r
3074 ASC20:  MOVSI   RC,(POINT 7,AC0)        ;SET UP POINTER\r
3075         TLNE    SDEL,200000     ;THIS BIT (AND BIT0) IN FOR COMMENT\r
3076         MOVSI RC,440000         ;SO NOTHING WILL BE DEPOSITED\r
3077 IFE IIISW,<MOVEI AC0,0          ;CLEAR WORD>\r
3078 IFN IIISW,<TLNE SDEL,100000     ;ASCID?\r
3079         TLZA    SDEL,400000     ;YES, ZERO ASCIZ BIT\r
3080         TDZA    AC0,AC0         ;NO, ZERO WORD\r
3081         MOVE    AC0,[BYTE (7) 10,10,10,10,10 (1) 1]     ;YES, A WORD FULL OF BACKSPACES>\r
3082 ASC30:  PUSHJ   PP,CHARL        ;GET ASCII CHARACTER AND LIST\r
3083         CAMN    C,SX            ;TEST FOR DELIMITER\r
3084         JRST    ASC50           ;FOUND\r
3085         IDPB    C,RC            ;DEPOSIT BYTE\r
3086         TLNE    RC,760000       ;HAVE WE FINISHED WORD?\r
3087         JRST    ASC30           ;NO,GET NEXT CHARACTER\r
3088 IFN FORMSW,<    MOVE    AC1,ASCIIF      ;USE ASCII FORM WORD>\r
3089         PUSHJ   PP,STOWZ        ;YES, STOW IT\r
3090         JRST    ASC20           ;GET NEXT WORD\r
3091 \r
3092 ASC55:  TDZA    CS,CS           ;ZERO CS IN CASE NESTED\r
3093 ASC50:  TDZA    RC,SDEL         ;TEST FOR ASCIIZ\r
3094         TROA    ER,ERRA         ;SIXBIT ERROR EXIT\r
3095 ASC60:  PUSHJ   PP,BYPAS1       ;POLISH OFF TERMINATOR\r
3096         SETZM INTXT     ;WE ARE OUT OF IT\r
3097 IFN FORMSW,<    MOVE    AC1,ASCIIF      ;USE ASCII FORM WORD>\r
3098 IFN IIISW,<TLNN SDEL,100000     ;NO EXTRA WORDS FOR ASCID>\r
3099         ANDCM   RC,STPX         ;STORE AT LEAST ONE WORD\r
3100         TLNN SDEL,200000        ;GET OUT WITHOUT STORING\r
3101         JUMPGE  RC,STOWZ        ;STOW\r
3102         POPJ    PP,             ;ASCII, NO BYTES STORED, SO EXIT\r
3103 \fPOINT0:\r
3104 IFN FORMSW,<    PUSH    PP,BPFORM       ;USE BYTE POINTER FORM WORD>\r
3105         PUSH    PP,RC           ;STACK REGISTERS\r
3106         PUSH    PP,AC0\r
3107         PUSHJ   PP,EVAL10       ;EVALUATE RADIX 10\r
3108         DPB     AC0,[POINT 6,0(PP),11]  ;STORE BYTE SIZE\r
3109         JUMPNC  POINT2\r
3110         PUSHJ   PP,EVALEX       ;NO, GET ADDRESS\r
3111         PUSHJ   PP,EVADR        ;EVALUATE STANDARD ADDRESS\r
3112         JUMPNC  POINT2\r
3113         PUSHJ   PP,EVAL10       ;EVALUATE RADIX 10\r
3114         TLNE    IO,NUMSW        ;IF NUMERIC\r
3115         TDCA    AC0,[-1]        ;POSITION=D35-RHB\r
3116 POINT2: MOVEI   AC0,0           ;OTHERWISE SET TO D36\r
3117         ADDI    AC0,?D36\r
3118         LSH     AC0,?D30\r
3119         ADDM    AC0,0(PP)       ;UPDATE VALUE\r
3120         JRST    OP3\r
3121 \fXWD0:\r
3122 IFN FORMSW,<    PUSH    PP,HWFORM       ;USE HALF WORD FORM>\r
3123         PUSH    PP,RC\r
3124         PUSH    PP,AC0          ;STORE ZERO ON STACK\r
3125         PUSHJ   PP,EVALEX       ;EVALUATE EXPRESSION\r
3126         JUMPNC  OP2\r
3127 XWD5:   SKIPN   (PP)            ;ANY CODE YET?\r
3128         JRST    XWD10           ;NO,USE VALUE IN AC0\r
3129         JUMPE   AC0,.+2         ;ANYTHING IN AC0?\r
3130         TRO     ER,ERRQ         ;YES,FLAG "Q"ERROR\r
3131         MOVE    AC0,(PP)        ;USE PREVIOUS VALUE\r
3132         MOVE    RC,-1(PP)       ;AND RELOCATION\r
3133 XWD10:  HRLZM   AC0,0(PP)       ;SET LEFT HALF\r
3134         HRLZM   RC,-1(PP)\r
3135         MOVSS EXTPNT    ;WFW\r
3136         JRST    OP1A            ;EXIT THROUGH OP\r
3137 \r
3138 IOWD0:  PUSHJ   PP,EVALXQ       ;EVALUATE AND TEST FOR EXTERNAL\r
3139         CAIE    C,14            ;","?\r
3140         JRST    [SKIPN  AC0     ;IF NZERO AND NO "," SEEN\r
3141                 TRO ER,ERRQ     ;TREAT AS Q ERROR\r
3142 IFN FORMSW,<    MOVE    AC1,HWFORM      ;USE HALF WORD FORM>\r
3143                 SOJA AC0,STOW]  ;NO, TREAT AS RIGHT HALF\r
3144         PUSH    PP,AC0          ;YES, STACK LEFT HALF\r
3145         PUSHJ   PP,EVALEX       ;WFW\r
3146         SUBI    AC0,1\r
3147         POP     PP,AC1          ;RETRIEVE LEFT HALF\r
3148         MOVNS   AC1\r
3149         HRL     AC0,AC1\r
3150 IFN FORMSW,<    MOVE    AC1,HWFORM      ;USE HALF WORD FORM>\r
3151         JRST    STOW            ;STOW CODE AND EXIT\r
3152 \fBYTE0: PUSHJ   PP,BYPASS       ;GET FIRST NON-BLANK\r
3153         CAIE    C,10            ;"("?\r
3154         JRST    ERRAX           ;NO, FLAG ERROR AND EXIT\r
3155 IFN FORMSW,<\r
3156         PUSH    PP,[1]\r
3157         MOVEI   AC0,0\r
3158 >\r
3159         PUSH    PP,RC\r
3160         PUSH    PP,AC0          ;INITIALIZE STACK TO ZERO\r
3161         MOVSI   ARG,(POINT -1,(PP))\r
3162 \r
3163 BYTE1:  PUSH    PP,ARG\r
3164         PUSHJ   PP,EVAL10       ;EVALUATE RADIX 10\r
3165         POP     PP,ARG\r
3166         CAIG    AC0,?D36        ;TEST SIZE\r
3167         JUMPGE  AC0,.+2\r
3168         TRO     ER,ERRA\r
3169         DPB     AC0,[POINT 6,ARG,11]    ;STORE BYTE SIZE\r
3170 \r
3171 BYTE2:  IBP     ARG             ;INCREMENT BYTE\r
3172         TRZN    ARG,-1          ;OVERFLOW?\r
3173         JRST    BYTE3           ;NO\r
3174         SETZB   AC0,RC          ;YES\r
3175         EXCH    AC0,0(PP)       ;GET CURRENT VALUES\r
3176         EXCH    RC,-1(PP)       ;AND STACK ZEROS\r
3177 IFN FORMSW,<\r
3178         MOVE    AC1,HWFORM      ;USE STANDARD FORM\r
3179         EXCH    AC1,-2(PP)      ;GET FORM WORD\r
3180 >\r
3181         PUSHJ   PP,STOW         ;STOW FULL WORD\r
3182 \r
3183 BYTE3:  PUSH    PP,ARG\r
3184         PUSHJ   PP,EVALEX       ;COMPUTE NEXT BYTE\r
3185         POP     PP,ARG\r
3186         DPB     AC0,ARG         ;STORE BYTE\r
3187         HLLO    AC0,ARG\r
3188         DPB     RC,AC0          ;STORE RELOCATION\r
3189 \r
3190 IFN FORMSW,<\r
3191         MOVEI   AC0,1\r
3192         HRRI    ARG,-2\r
3193         DPB     AC0,ARG         ;STORE FORM BYTE\r
3194         HRRI    ARG,0\r
3195 >\r
3196         JUMPCM  BYTE2\r
3197         CAIN    C,10            ;"("?\r
3198         JRST    BYTE1           ;YES, GET NEW BYTE SIZE\r
3199         JRST    OP3             ;NO, EXIT\r
3200 \fRADX50:        PUSHJ   PP,EVALEX       ;EVALUATE CODE\r
3201         JUMPN   RC,ERRAX                ;ERROR IF NOT ABSOLUTE\r
3202         MOVE    ARG,AC0\r
3203         JUMPNC  ERRAX\r
3204         PUSHJ   PP,GETSYM       ;YES, GET SYMBOL\r
3205         TRZ     ER,ERRA         ;CLEAR ERROR\r
3206         PUSHJ   PP,SQOZE        ;SQUOZE SIXBIT AND ADD CODE\r
3207 IFN FORMSW,<    MOVE    AC1,HWFORM      ;USE STANDARD FORM>\r
3208         JRST    STOW            ;STOW CODE AND EXIT\r
3209 \r
3210 \r
3211 SQOZE:  MOVE    AC1+1,AC0       ;PUT SIXBIT IN AC1+1\r
3212         MOVEI   AC0,0           ;CLEAR RESULT\r
3213 SQOZ1:  MOVEI   AC1,0\r
3214         LSHC    AC1,6           ;PUT 6-BIT CHARACTER IN AC1\r
3215         LDB     AC1,[POINT 6,CSTAT(AC1),23]     ;CONVERT TO RADIX50\r
3216         IMULI   AC0,50          ;MULTIPLY PREVIOUS RESULT\r
3217         ADD     AC0,AC1         ;ADD NEW CHARACTER\r
3218         JUMPN   AC1+1,SQOZ1     ;TEST FOR END\r
3219         LSH     ARG,?D30        ;LEFT-JUSTIFY CODE\r
3220         IOR     AC0,ARG         ;MERGE WITH RESULT\r
3221         POPJ    PP,\r
3222 \fREPEAT 0,<     EXPLANATION OF ARRAY AND LVAR FEATURES\r
3223 \r
3224 WHEN A VARIABLE IS SEEN EITHER BY #, INTEGER OR ARRAY\r
3225 THE VALUE PORTION OF THE SYMBOL TABLE ENTRY (RH OF 2ND WORD)\r
3226 IS USE TO HOLD THE DESIRED SIZE-1. THE CORRECT VALUE IS\r
3227 ASSIGNED BY THE VAR PSEUDO OP.\r
3228 \r
3229 WHEN LVAR IS SEEN, A SEARCH OF THE SYMBOL TABLE IS MADE\r
3230 FOR ALL VARIABLES. THE VARF (VARIABLE) FLAG IS\r
3231 LEFT ON AND EXTF AND PNTF ARE TURNED ON SO THAT THE\r
3232 VARIABLE LOOKS LIKE AN EXTERNAL. THE POINTER\r
3233 (RH OF 2ND WORD OF THE SYMBOL TABLE ENTRY) POINTS\r
3234 TO THE HEADER BLOCK. THE HEADER BLOCK IS FORMATTED AS FOLLOWS:\r
3235 WORD 1: LEFT HALF IS A POINTER TO SYMBOL TABLE FIXUP BLOCKS\r
3236         RIGHT HALF IS A POINTER TO CODE FIXUP BLOCKS\r
3237 WORD 2: 0 THIS IS USED TO DISTINGUISH IT FROM NORMAL EXTERNALS\r
3238                 WHICH HAVE THE SYMBOL NAME HERE\r
3239 WORD 3: THE LOCATION RELATIVE TO THE START OF THE LOW CORE\r
3240                 VARIABLES\r
3241 \r
3242 CORE FIXUP BLOCKS ARE SET UP BY BOUT\r
3243 \r
3244 WORD1:  RH LINK TO NEXT CORE FIXUP BLOCK 0 IF END OF CHAIN\r
3245         LH OFFSET. NUMBER TO BE ADDED TO SYMBOL VALUE BEFORE\r
3246         FIXUP IS DONE\r
3247 WORD 2: POINTER TO A FIXUP CHAIN FOR RIGHT HALVES\r
3248         LEFT HALF IS RELOCATION RH IS ADDRESS\r
3249 WORD 3: SAME AS WORD 2 BUT FOR LEFT HALF FIXUPS\r
3250 \r
3251 NOTE ALL THESE FIXUPS ARE CHAINED EVEN IF IN LEFT HALF.\r
3252 SIMILARY ALL REFERENCES TO SAY A+1 ARE CHAINED\r
3253 \r
3254 SYMBOL TABLE FIXUP BLOCKS. THESE ARE GENERATED BY SOUT\r
3255 AS THE SYMBOL TABLE IS PUT OUT. THESE FIXUPS ARE ADDITIVE\r
3256 NOT CHAINED.\r
3257 \r
3258 WORD 1: RH LINK TO NEXT BLOCK\r
3259         LH 0\r
3260 WORD 2: RADIX50 FOR THE SYMBOL\r
3261 WORD 3: 200000,,0 IF RH FIXUP\r
3262         600000,,0 IF LH FIXUP\r
3263 \r
3264 SOUT ALSO SETS UP FIXLNK. FIXLNK POINTS TO THE CHAIN OF\r
3265 ALL LVAR FIXUPS TO BE DONE. IT POINTS TO THE SECOND WORD\r
3266 \fOF A 2 WORD BLOCK\r
3267 \r
3268 WORD 1: LINK TO 2ND WORD OF NEXT BLOCK 0 IF END\r
3269 WORD 2: RH POINTER TO A HEADER BLOCK\r
3270         LH GARBAGE\r
3271 \r
3272 FIXUPS ARE BLOCK TYPE 13 AS FOLLOWS\r
3273 WORD 1: THE PROGRAM BREAK (AS BLOCK TYPE 5)\r
3274 WORD 2: THE NUMBER OF LOCATION USED FOR VARIABLES IN THE\r
3275         LOW SEGMENT+1\r
3276 \r
3277 REMAINING WORDS COME IN PAIRS AS FOLLOWS:\r
3278 1ST WORD        BIT 0=0 RH FIXUP\r
3279                 BIT 0=1 LH FIXUP\r
3280                 BIT 1=0 CORE FIXUP\r
3281                         WORD 2 LH POINTER TO CHAIN\r
3282                         WORD 2 RH VALUE\r
3283                 BIT 1=1 SYMBOL FIXUP\r
3284                         WORD 1 RH VALUE\r
3285                         WORD 2 SYMBOL\r
3286 >\r
3287 \r
3288 REPEAT 0,<      EXPLANATION OF ICC FEATURES\r
3289 \r
3290         IF FORMSW IS SET NON ZERO THE FORM OF THE OCTAL LISTING OUTPUT\r
3291         IS CHANGED FROM STANDARD HALF WORD FORM TO THE FOLLOWING:-\r
3292 \r
3293         IF INSTRUCTION          BYTE 9,4,1,4,18\r
3294         IF I/O INSTRUCTION      BYTE 3,7,3,1,4,18\r
3295         IF BYTE POINTER         BYTE 6,6,2,4,18\r
3296         IF ASCII                BYTE 7,7,7,7,7\r
3297         IF SIXBIT               BYTE 6,6,6,6,6,6\r
3298 \r
3299         ALL OTHERS ARE STANDARD HALF WORD\r
3300 \r
3301         THIS FEATURE CAN BE OVER RIDDEN BY USE OF /H SWITCH\r
3302         STANDARD HALF WORD FORM IS THEN USED.\r
3303         HOWEVER BECAUSE OF EXTRA SPACING THE OUTPUT IS PUSHED MORE\r
3304         TO THE RIGHT AND LONG COMMENTS OVERFLOW THE LINE\r
3305         >\r
3306 \f; PSEUDO-END STATEMENT FOR MULTI-FILE CAPABILITY\r
3307 \r
3308 ; HERE IF PRGEND (PASS 1)\r
3309 PSEND0: TLO     IO,MFLSW        ;PSEND SEEN\r
3310         PUSHJ   PP,END0         ;AS IF END STATEMENT\r
3311         HLLZS   IO              ;CLEAR ER(RH)\r
3312         SETZM   ERRCNT          ;CLEAR ERROR COUNT FOR EACH PROG.\r
3313         JUMP2   PSEND2          ;DIFFERENT ON PASS2\r
3314         SKIPE   UNIVSN          ;SEEN A UNIVERSAL\r
3315         PUSHJ   PP,UNISYM       ;YES, STORE SYMBOLS\r
3316         PUSHJ   PP,PSEND4       ;SAVE SYMBOLS, POINTERS AND TITLE\r
3317         TLZ     IO,IOTLSN       ;CLEAR TITLE SEEN FLAG\r
3318 PSEND1: TLZ     IO,MFLSW         ;FOR NEXT FILE\r
3319         SETZM   UNISCH          ;CLEAR UNIVERSAL SEARCH TABLE\r
3320         MOVE    AC0,[UNISCH,,UNISCH+1]\r
3321         BLT     AC0,UNISCH+.UNIV-1\r
3322         PUSHJ   PP,OUTFF        ;RESET PAGE COUNT\r
3323         MOVSI   AC0,1           ;SET SO RELOC 0 WORKS\r
3324         JRST    LOC10           ;FOR RELOC 0\r
3325 \r
3326 ; HERE IF PRGEND (PASS 2)\r
3327 PSEND2: SETZM   SBUF            ;SO SUBTTL IS NOT WRONG\r
3328         PUSHJ   PP,PSEND5       ;PUT TITLE BACK\r
3329         PUSHJ   PP,PSEND1       ;COMMON  CODE\r
3330         JRST    PASS20          ;OUTPUT THE ENTRIES\r
3331 \r
3332 ; HERE IF END (PASS 1)\r
3333 PSEND3: PUSHJ   PP,PSEND4       ;SAVE LAST PROGRAM \r
3334         HLRS    PRGPTR          ;REINITIALIZE POINTER\r
3335         PUSHJ   PP,PSEND5       ;READ BACK FIRST PROGRAM\r
3336         JRST    PASS20\r
3337 \f;HERE TO SAVE AND RESTORE SYMBOL TABLE, TITLE AND OTHER USEFUL LOCATIONS\r
3338         XTRA==4                 ;NUMBER OF OTHER LOCATIONS TO SAVE\r
3339 \r
3340 PSEND4: MOVE    V,FREE          ;GET  NEXT FREE LOCATION\r
3341         ADDI    V,LENGTH+.TBUF/5+XTRA\r
3342         CAML    V,SYMBOL        ;WILL WORST CASE FIT?\r
3343         PUSHJ   PP,XCEED        ;NO, EXPAND\r
3344         MOVS    V,FREE\r
3345         HRR     V,PRGPTR        ;LAST PRGEND BLOCK\r
3346         HLRM    V,(V)           ;LINK THIS BLOCK\r
3347         SKIPN   PRGPTR          ;IF FIRST TIME\r
3348         HLLZM   V,PRGPTR        ;SET LINK TO START OF CHAIN\r
3349         HLRM    V,PRGPTR        ;POINTER TO IT\r
3350         SETZM   @FREE           ;CLEAR LINK WORD\r
3351         AOS     FREE            ;THIS LOCATION USED NOW\r
3352         MOVS    AC0,SYMBOL      ;BOTTOM OF SYMBOL TABLE\r
3353         HRR     AC0,FREE        ;FREE SPACE\r
3354         MOVE    V,@SYMBOL       ;GET NUMBER OF SYMBOLS\r
3355         ASH     V,1             ;TWO WORDS PER SYMBOL\r
3356         ADDI    V,1             ;ONE MORE FOR COUNT\r
3357         ADDB    V,FREE          ;END OF TABLE WHEN MOVED\r
3358         BLT     AC0,(V)         ;MOVE TABLE\r
3359         HRRZ    AC0,JOBREL      ;TOP OF CORE\r
3360         SUBI    AC0,1\r
3361         MOVEM   AC0,SYMTOP      ;FOR NEXT SYMBOL TABLE\r
3362         SUBI    AC0,LENGTH      ;LENGTH OF INITIAL SYMBOLS\r
3363         MOVEM   AC0,SYMBOL      ;SET POINTER TO COUNT OF SYMBOLS\r
3364         HRLI    AC0,SYMNUM      ;BLT POINTER\r
3365         BLT     AC0,@SYMTOP     ;SET UP INITIAL SYMBOL TABLE\r
3366         PUSHJ   PP,SRCHI        ;SET UP SEARCH POINTER\r
3367         MOVEI   AC0,.TBUF       ;MAX NUMBER OF CHARS. IN TITLE\r
3368         SUB     AC0,TCNT        ;ACTUAL NUMBER\r
3369         IDIVI   AC0,5           ;NUMBER OF WORDS\r
3370         SKIPE   AC1             ;REMAINDER?\r
3371         ADDI    AC0,1           ;YES\r
3372         MOVEM   AC0,@FREE       ;STORE COUNT\r
3373         AOS     FREE            ;THIS LOCATION USED NOW\r
3374         EXCH    AC0,FREE        ;SET UP AC0 FOR BLT\r
3375         ADDM    AC0,FREE        ;WILL BE AFTER TITLE MOVES\r
3376         HRLI    AC0,TBUF        ;BLT POINTER\r
3377         BLT     AC0,@FREE       ;MOVE TITLE\r
3378         MOVE    AC2,LITHDX      ;POINTER TO LIT INFO.\r
3379         MOVE    AC0,-1(AC2)     ;SIZE OF PASS1 LOCO\r
3380         PUSHJ   PP,STORIT       ;SAVE IT IN SYMBOL TABLE\r
3381         MOVE    AC2,VARHDX      ;SAME FOR VARS\r
3382         MOVE    AC0,-1(AC2)\r
3383         PUSHJ   PP,STORIT\r
3384 PSEND6: MOVE    AC0,FREE        ;GET NEXT FREE LOCATION\r
3385         SUBI    AC0,1           ;LAST ONE USED\r
3386         HRRZ    V,PRGPTR        ;POINTER TO START OF DATA BLOCK\r
3387         HRLM    AC0,(V)         ;LINK TO END OF BLOCK\r
3388         POPJ    PP,             ;RETURN\r
3389 \r
3390 \fPSENDX:        PUSHJ   PP,XCEED        ;NEED TO EXPAND CORE FIRST\r
3391 PSEND5: HRRZ    AC0,JOBREL      ;GET TOP OF CORE\r
3392         SUBI    AC0,1\r
3393         MOVEM   AC0,SYMTOP      ;TOP OF NEW SYMBOL TABLE\r
3394         HRRZ    V,PRGPTR        ;ADDRESS OF THIS BLOCK\r
3395         JUMPE   V,PSNDER        ;ERROR LINK NOT SET UP\r
3396         MOVE    AC1,(V)         ;NEXT LINK\r
3397         MOVE    V,1(V)          ;GET ITS SYMBOL COUNT\r
3398         ASH     V,1             ;NUMBER OF WORDS\r
3399         ADDI    V,1             ;PLUS ONE FOR COUNT\r
3400         SUBI    AC0,(V)         ;START OF NEW SYMBOL TABLE\r
3401         CAMG    AC0,FREE        ;WILL IT FIT\r
3402         JRST    PSENDX          ;NO, NEED TO EXPAND AND RESET AC0\r
3403         ADD     V,PRGPTR        ;POINT TO END OF SYMBOL TABLE\r
3404         MOVEI   V,1(V)          ;THEN TO BEG OF TITLE\r
3405         MOVEM   AC0,SYMBOL      ;BOTTOM OF NEW TABLE\r
3406         HRL     AC0,PRGPTR      ;ADDRESS OF FIRST WORD OF BLOCK\r
3407         ADD     AC0,[1,,0]      ;MAKE BLT POINTER\r
3408         HRRM    AC1,PRGPTR      ;POINT TO NEXT BLOCK\r
3409         BLT     AC0,@SYMTOP     ;MOVE TABLE\r
3410         PUSHJ   PP,SRCHI        ;SET UP POINTER\r
3411         MOVE    AC1,(V)         ;NUMBER OF WORDS OF TITLE\r
3412         MOVEI   AC0,1(V)        ;START OF STORED TITLE\r
3413         ADD     V,AC1           ;INCREMENT PAST TITLE\r
3414         ADDI    AC1,TBUF-1      ;END OF TITLE\r
3415         HRLI    AC0,TBUF        ;WHERE TO PUT IT\r
3416         MOVSS   AC0             ;BLT POINTER\r
3417         BLT     AC0,(AC1)       ;MOVE TITLE\r
3418         TLO     IO,IOTLSN       ;SET AS IF TITLE SEEN\r
3419         MOVE    AC2,LITHDX      ;INVERSE OF ABOVE\r
3420         PUSHJ   PP,GETIT\r
3421         MOVEM   AC0,-1(AC2)\r
3422         MOVE    AC2,VARHDX      ;SAME FOR VARS\r
3423         PUSHJ   PP,GETIT\r
3424         MOVEM   AC0,-1(AC2)\r
3425         POPJ    PP,\r
3426 \r
3427 STORIT: MOVEM   AC0,@FREE       ;STORE IT IN DATA BLOCK\r
3428         AOS     FREE            ;ADVANCE POINTER\r
3429         POPJ    PP,\r
3430 \r
3431 GETIT:  MOVE    AC0,1(V)        ;FILL AC0 OUT OF PRGEND BLOCK\r
3432         AOJA    V,CPOPJ         ;INCREMENT AND RETURN\r
3433 \r
3434 PSNDER: HRROI   RC,[SIXBIT      /PRGEND ERROR @/]\r
3435         JRST    ERRFIN\r
3436 \f;MULTIPLE SYMBOL TABLE FEATURE PSEUDO-OPS\r
3437 \r
3438 UNIV0:  JUMP2   TITLE0          ;DO IT ALL ON PASS 1\r
3439         HRRZ    SX,UNIVNO       ;GET NUMBER OF UNIVERSALS SEEN\r
3440         CAIL    SX,.UNIV        ;ALLOW ONE MORE?\r
3441         JRST    UNVERR          ;NO, GIVE FATAL ERROR\r
3442         AOS     UNIVNO          ;ONE MORE NOW\r
3443         SETOM   UNIVSN          ;AND SET SEEN A UNIVERSAL\r
3444         JRST    TITLE0          ;CONTINUE AS IF TITLE\r
3445 \r
3446 \r
3447 ADDUNV: PUSH    PP,RC           ;AN AC TO USE\r
3448         PUSHJ   PP,NOUT         ;CONVERT TO SIXBIT\r
3449         HRRZ    RC,UNIVNO       ;GET ENTRY INDEX\r
3450         MOVEM   AC0,UNITBL(RC)  ;STORE SIXBIT NAME IN TABLE\r
3451         HRRZS   UNIVSN          ;ONLY DO IT ONCE\r
3452         POP     PP,RC           ;RESTORE RC\r
3453         POPJ    PP,             ;AND RETURN\r
3454 \r
3455 UNVERR: HRROI   RC,[SIXBIT /TOO MANY UNIVERSALS@/]\r
3456         JRST    ERRFIN\r
3457 \r
3458 UNISYM: HRRZ    AC0,FREE        ;GET HIGHEST FREE LOCATION\r
3459         MOVEM   AC0,JOBFF       ;INTO JOBFF\r
3460         PUSHJ   PP,SUPRSA       ;TURN ON SUPPRESS BIT\r
3461         PUSH    PP,SYMBOL       ;NEED TO SAVE INCASE PRGEND\r
3462         MOVE    AC0,SYMTOP      ;TOP OF TABLE\r
3463         SUB     AC0,SYMBOL      ;GET LENGTH OF TABLE\r
3464         HRL     ARG,SYMBOL      ;BOTTOM OF TABLE\r
3465         HRR     ARG,JOBFF       ;WHERE TO GO\r
3466         HRRZ    RC,UNIVNO       ;GET TABLE INDEX\r
3467         HRRM    ARG,SYMBOL      ;WILL BE THERE SOON\r
3468         HRRZM   ARG,UNIPTR(RC)  ;STORE IN CORRESPONDING PLACE\r
3469         ADDB    AC0,JOBFF       ;WHERE TO END\r
3470         HRLM    AC0,UNIPTR(RC)  ;SAVE NEW SYMTOP\r
3471         BLT     ARG,@JOBFF      ;MOVE TABLE\r
3472         HRRZM   AC0,UNITOP      ;SAVE TOP OF TABLES+1\r
3473         CAMLE   AC0,MACSIZ      ;IN CASE OVER A K BOUND\r
3474         MOVEM   AC0,MACSIZ      ;DON'T REDUCE SO FAR NOW\r
3475         MOVEM   AC0,FREE        ;JUST IN CASE IN MACRO\r
3476         MOVE    AC0,SRCHX       ;SAVE OLD SEARCH POINTER\r
3477         PUSHJ   PP,SRCHI        ;GET SEARCH POINTER\r
3478         EXCH    AC0,SRCHX\r
3479         MOVEM   AC0,UNISHX(RC)  ;SAVE IT\r
3480         SETZM   UNIVSN          ;CLEAR FLAG INCASE PRGEND\r
3481         POP     PP,SYMBOL       ;RESTORE OLD VALUE\r
3482         POPJ    PP,             ;RETURN\r
3483 \r
3484 \fSERCH0:        PUSHJ   PP,GETSYM       ;GET A SYMBOL\r
3485         JRST    ERRAX           ;ERROR IF NOT VALID\r
3486         MOVEI   RC,1            ;START AT ENTRY ONE\r
3487         CAIL    RC,.UNIV        ;CHECK FOR CONSISTENCY ERROR\r
3488         JRST    SCHERR          ;CANNOT FIND THIS ONE\r
3489         CAME    AC0,UNITBL(RC)  ;LOOK FOR MATCH\r
3490         AOJA    RC,.-3          ;NOT FOUND YET\r
3491         MOVE    AC0,RC          ;STORE TABLE ENTRY NUMBER\r
3492         MOVEI   RC,1            ;START AT ENTRY ONE\r
3493         CAIL    RC,.UNIV        ;CHECK FOR CONSISTENCY ERROR\r
3494         JRST    SCHERR          ;SHOULD NEVER HAPPEN!!\r
3495         SKIPE   UNISCH(RC)      ;LOOK FOR AN EMPTY SLOT\r
3496         AOJA    RC,.-3          ;NOT FOUND YET\r
3497         MOVEM   AC0,UNISCH(RC)  ;STORE INDEX IN TABLE\r
3498         JUMPCM  SERCH0          ;LOOK FOR MORE NAMES\r
3499         POPJ    PP,             ;FINISHED\r
3500 \r
3501 SCHERR: MOVSI   RC,[SIXBIT /CANNOT FIND UNIVERSAL@/]\r
3502         JRST    ERRFIN          ;NAME IN AC0\r
3503 \r
3504 ;MESSAGE FOR CASE WHERE FILES AFTER UNIVERSAL USED MORE BUFFER SPACE THAN FIRST UNIVERSAL\r
3505 UNIERR: HRROI   RC,[SIXBIT /UNIVERSAL PROGRAM(S) MUST HAVE SAME OUTPUT SPECIFICATION AS OTHER FILES@/]\r
3506         JRST    ERRFIN\r
3507 \fSUBTTL MACRO/REPEAT HANDLERS\r
3508 \r
3509 REPEA0: PUSHJ   PP,EVALXQ       ;EVALUATE REPEAT EXP, EXTERNS ARE ILL.\r
3510         JUMPNC  ERRAX\r
3511 \r
3512 REPEA1: JUMPLE  AC0,REPZ        ;PASS THE EXP., DONT PROCESS\r
3513         SOJE    AC0,REPO        ;REPEAT ONCE\r
3514 REPEA2: PUSHJ   PP,GCHARQ       ;GET STARTING "<"\r
3515         CAIE    C,"<"\r
3516         JRST    REPEA2\r
3517         PUSHJ   PP,SKELI1       ;INITIALIZE SKELETON\r
3518         PUSH    MP,REPEXP\r
3519         MOVEM   AC0,REPEXP\r
3520         PUSH    MP,REPPNT       ;STACK PREVIOUS REPEAT POINTER\r
3521         MOVEM   ARG,REPPNT      ;STORE NEW POINTER\r
3522         TDZA    SDEL,SDEL       ;YES, INITIALIZE BRACKET COUNT AND SKIP\r
3523 \r
3524 REPEA4: PUSHJ   PP,WCHARQ       ;WRITE A CHARACTER\r
3525         PUSHJ   PP,GCHARQ       ;GET A CHARACTER\r
3526         CAIN    C,"<"           ;"<"?\r
3527         AOJA    SDEL,REPEA4     ;YES, INCREMENT AND WRITE\r
3528         CAIE    C,">"           ;">"?\r
3529         JRST    REPEA4          ;NO, WRITE THE CHARACTER\r
3530         SOJGE   SDEL,REPEA4     ;YES, WRITE IF NON-NEGATIVE COUNT\r
3531         MOVSI   CS,(BYTE (7) 177,3)     ;SET "REPEAT" END\r
3532         PUSHJ   PP,WWRXE        ;WRITE END\r
3533         SKIPN   LITLVL          ;LITERAL MIGHT END ON LINE\r
3534         SKIPE   MACLVL          ;IF IN MACRO DARE NOT PROCESS\r
3535         JRST    .+3             ;REST OF LINE SINCE MACRO MIGHT END ON IT\r
3536         PUSHJ   PP,BYPASS       ;BYPASS\r
3537         PUSHJ   PP,STOUTS       ;POLISH OF LINE BEFORE PROCESSING REPEAT\r
3538         PUSH    MP,MRP          ;STACK PREVIOUS READ POINTER\r
3539         PUSH    MP,RCOUNT       ;SAVE WORD COUNT\r
3540         HRRZ    MRP,REPPNT      ;SET UP READ POINTER\r
3541         SKIPN   MACLVL          ;IF IN MACRO GIVE CR-LF FIRST\r
3542         SKIPE   LITLVL          ;SAME FOR LITERAL\r
3543         JRST    REPEA7\r
3544         AOJA    MRP,POPOUT      ;BYPASS ARG COUNT\r
3545 \r
3546 REPEA7: HRRZ    MRP,REPPNT      ;SET UP READ POINTER\r
3547         ADDI    MRP,1           ;BYPASS ARG COUNT\r
3548 REPEA8: MOVEI   C,CR\r
3549         JRST    RSW1\r
3550 \r
3551 REPEND: SOSL    REPEXP\r
3552         JRST    REPEA7\r
3553         HRRZ    V,REPPNT        ;GET START OF TREE\r
3554         PUSHJ   PP,REFDEC       ;DECREMENT REFERENCE\r
3555         POP     MP,RCOUNT\r
3556         POP     MP,MRP\r
3557         POP     MP,REPPNT\r
3558         POP     MP,REPEXP\r
3559         SKIPN   LITLVL          ;IF IN LITERAL OR\r
3560         SKIPE   MACLVL          ;IF IN MACRO\r
3561         JRST    RSW0            ;FINISH OF LINE NOW\r
3562         JRST    REPEA8\r
3563 \r
3564 \fREPZ:  MOVE SDEL,SEQNO2        ;SAVE IN CASE OF END OF FILE\r
3565         MOVEM SDEL,REPSEQ\r
3566         MOVE SDEL,PAGENO\r
3567         MOVEM SDEL,REPPG\r
3568         SETOM INREP\r
3569         MOVEI SDEL,0    ;SET COUNT\r
3570 REPZ1:  PUSHJ   PP,GCHAR        ;GET NEXT CHARACTER\r
3571         CAIN    C,"<"           ;"<"?\r
3572         AOJA    SDEL,REPZ1      ;YES, INCREMENT COUNT\r
3573         CAIN    C,">"           ;">"?\r
3574         SOJLE   SDEL,REPZ2      ;YES, EXIT IF MATCHING\r
3575         JRST    REPZ1           ;NO, RECYCLE\r
3576 REPZ2:  SETZM   INREP   ;FLAG OUT OF IT\r
3577         SETZM   INCND   ;AND CONDITIONAL ALSO\r
3578         JRST    STMNT   ;AND EXIT\r
3579 \r
3580 REPO:   PUSHJ   PP,GCHAR        ;GET "<"\r
3581         CAIE    C,"<"\r
3582         JRST    REPO\r
3583         SKIPE   RPOLVL          ;ARE WE NESTED?\r
3584         AOS     RPOLVL          ;YES, DECREMENT CURRENT\r
3585         PUSH    MP,RPOLVL\r
3586         SETOM   RPOLVL\r
3587         JRST    STMNT\r
3588 \r
3589 REPO1:  CAIN    C,"<"\r
3590         SOS     RPOLVL\r
3591         CAIN    C,">"\r
3592         AOSE    RPOLVL\r
3593         JRST    RSW2\r
3594         POP     MP,RPOLVL\r
3595         PUSHJ   PP,RSW2\r
3596         JRST    RSW0\r
3597 \fDEFIN0:        PUSHJ   PP,GETSYM       ;GET MACRO NAME\r
3598         JRST    ERRAX           ;EXIT ON ERROR\r
3599         MOVEM   PP,PPTMP1       ;SAVE POINTER\r
3600         MOVEM   AC0,PPTMP2      ;SAVE NAME\r
3601         TLO     IO,IORPTC\r
3602         MOVE SX,SEQNO2  ;SAVE IN CASE OF EOF\r
3603         MOVEM SX,DEFSEQ\r
3604         MOVE SX,PAGENO\r
3605         MOVEM SX,DEFPG\r
3606         SETOM INDEF     ;AND FLAG IN DEFINE\r
3607         SYN     .TEMP,COMSW     ;SAVE SPACE\r
3608         SETZB   SX,COMSW        ;SET ARGUMENT AND REFERENCE COUNT AND COMMENT SWITCH\r
3609 DEF02:  PUSHJ   PP,GCHAR        ;SEARCH FOR "(" OR "<"\r
3610         CAIG    C,FF            ;SEARCH FOR END OF LINE\r
3611         CAIGE   C,LF            ;LF,VT, OR FF\r
3612         JRST    .+2             ;WASN'T ANY OF THEM\r
3613         SETZM   COMSW           ;RESET COMMENT SWITCH\r
3614         CAIN    C,";"           ;COMMENT?\r
3615         SETOM   COMSW           ;YES, SET COMMENT SWITCH\r
3616         SKIPE   COMSW           ;INSIDE A COMMENT?\r
3617         JRST    DEF02           ;YES, IGNORE CHARACTER\r
3618         CAIN    C,"<"           ;"<"?\r
3619         JRST    DEF20           ;YES\r
3620         CAIE    C,"("           ;"("?\r
3621         JRST    DEF02           ;NO\r
3622 DEF10:  PUSHJ   PP,GETSYM       ;YES, GET DUMMY SYMBOL\r
3623         TRO     ER,ERRA         ;FLAG ERROR\r
3624         ADDI    SX,1            ;INCREMENT ARG COUNT\r
3625         PUSH    PP,AC0          ;STACK IT\r
3626         CAIN    C,'<'           ;A DEFAULT ARGUMENT COMING UP?\r
3627         JRST    DEF80           ;YES, STORE IT AWAY\r
3628         CAIE    C,11            ;")"?\r
3629         JRST    DEF10           ;NO, GET NEXT DUMMY SYMBOL\r
3630 DEF12:  PUSHJ   PP,GCHAR\r
3631         CAIE    C,"<"           ;"<"?\r
3632         JRST    DEF12           ;NO\r
3633 DEF20:  PUSH    PP,[0]          ;YES, MARK THE LIST\r
3634         LSH     SX,9            ;SHIFT ARG COUNT\r
3635         AOS     ARG,SX\r
3636         PUSHJ   PP,SKELI        ;INITIALIZE MACRO SKELETON\r
3637         MOVE    AC0,PPTMP2      ;GET NAME\r
3638         TLO IO,DEFCRS\r
3639         PUSHJ   PP,MSRCH        ;SEARCH THE TABLE\r
3640         JRST    DEF24           ;NOT FOUND\r
3641         TLNN    ARG,MACF        ;FOUND, IS IT A MACRO?\r
3642         TROA    ER,ERRX         ;NO, FLAG ERROR AND SKIP\r
3643         PUSHJ   PP,REFDEC       ;YES, DECREMENT THE REFERENCE\r
3644 DEF24:  HRRZ    V,WWRXX         ;GET START OF TREE\r
3645         SKIPN   .TEMP           ;ANY DEFAULT ARGUMENTS TO TAKE CARE OF?\r
3646         JRST    DEF25           ;NO\r
3647         HRRZ    C,1(V)          ;GET SHIFTED ARG COUNT\r
3648         LSH     C,-9            ;GET ARG COUNT BACK\r
3649         ADDI    C,1             ;ONE MORE FOR TERMINAL ZERO\r
3650         ADD     C,.TEMP         ;NUMBER OF ITEMS IN STACK\r
3651         HRLS    C               ;MAKE XWD\r
3652         SUB     PP,C            ;BACK UP STACK\r
3653         MOVE    SDEL,.TEMP      ;NUMBER OF WORDS NEEDED\r
3654         ADDB    SDEL,FREE       ;FROM FREE CORE\r
3655         CAML    SDEL,SYMBOL     ;MORE CORE NEEDED\r
3656         PUSHJ   PP,XCEEDS       ;YES, TRY TO GET IT\r
3657         SUB     SDEL,.TEMP      ;FORM POINTER\r
3658         HRLM    SDEL,1(V)       ;STORE IT WITH ARG COUNT IN MACRO\r
3659         SUBI    SDEL,1          ;TO USE FOR PUSHING POINTER INTO STORAGE\r
3660         MOVEI   C,1(PP)         ;POINT TO START OF STACK\r
3661 DEF26:  MOVE    ARG,(C)         ;GET AN ITEM OFF STACK\r
3662         TLNN    ARG,-40         ;A POINTER?\r
3663         JUMPN   ARG,[PUSH SDEL,ARG      ;YES, STORE IT\r
3664 \f               AOJA    C,DEF26]        ;GET NEXT\r
3665         PUSH    PP,ARG          ;RESTACK ARGUMENT\r
3666         SKIPE   ARG             ;FINISHED IF ZERO\r
3667         AOJA    C,DEF26 ;GET NEXT\r
3668         PUSH    SDEL,ARG        ;STORE ZERO IN DEFAULT LIST ALSO\r
3669 \fDEF25: MOVSI   ARG,MACF\r
3670         MOVEM   PP,PPTMP2       ;STORE TEMP STORAGE POINTER\r
3671         PUSHJ   PP,INSERT       ;INSERT/UPDATE\r
3672         TLZ IO,DEFCRS   ;JUST IN CASE\r
3673         SETZM   ARGF            ;NO ARGUMENT SEEN\r
3674         SETZM   SQFLG           ;AND NO ' SEEN\r
3675         TDZA    SDEL,SDEL       ;CLEAR BRACKET COUNT\r
3676 DEF30:  PUSHJ   PP,WCHAR        ;WRITE CHARACTER\r
3677 DEF31:  PUSHJ   PP,GCHAR        ;GET A CHARACTER\r
3678 DEF32:  MOVE    CS,C            ;GET A COPY\r
3679         CAIN    C,";"           ;IS IT A COMMENT\r
3680         JRST    CPEEK           ;YES CHECK FOR ;;\r
3681 DEF33:  CAIG CS,"Z"+40          ;CONVERT LOWER CASE\r
3682         CAIGE CS,"A"+40\r
3683         JRST    .+2\r
3684         SUBI CS,40\r
3685 \f       CAIGE CS,40             ;TEST FOR CONTROL CHAR.\r
3686         JRST    [SKIPN  SQFLG   ;HAS SINGLE QUOTE BEEN SEEN?\r
3687                 JRST    DEF30   ;NO, OUTPUT THIS CHAR.\r
3688                 PUSH    PP,C    ;YES, SAVE CURRENT CHAR\r
3689                 MOVEI   C,47    ;SET UP QUOTE\r
3690                 PUSHJ   PP,WCHAR;WRITE IT\r
3691                 POP     PP,C    ;GET BACK CURRENT CHAR.\r
3692                 SETZM   SQFLG   ;RESET FLAG\r
3693                 JRST    DEF30]  ;AND CONTINUE \r
3694         CAILE CS,77+40\r
3695         JRST    DEF30           ;TEST FOR SPECIAL\r
3696         MOVE    CS,CSTAT-40(CS) ;GET STATUS BITS\r
3697 \f       TLNE    CS,6            ;ALPHA-NUMERIC?\r
3698         JRST    DEF40           ;YES\r
3699         SKIPN   SQFLG           ;WAS A ' SEEN?\r
3700         JRST    DEF36           ;NO, PROCESH\r
3701         PUSH    PP,C            ;YES, SAVE CURRENT CHARACTER\r
3702         MOVEI   C,47            ;AND PUT IN A '\r
3703         PUSHJ   PP,WCHAR        ;...\r
3704         POP     PP,C            ;RESTORE CURRENT CHARACTER\r
3705         SETZM   SQFLG           ;AND RESET FLAG\r
3706 DEF36:  CAIE    C,47            ;IS THIS A '?\r
3707         JRST    DEF35           ;NOPE\r
3708         SKIPN   ARGF            ;YES, WAS LAST THING SEEN AN ARG?\r
3709         SETOM   SQFLG           ;IF NOT, SET SNGL QUOT FLAG\r
3710         SETZM   ARGF            ;BUT NOT ARGUMENT IN ANY CASE\r
3711         JRST    DEF31           ;GO GET NEXT CHARACTER\r
3712 \fDEF35: SETZM   ARGF            ;THIS IS NOT AN ARGUMENT\r
3713         CAIN    C,"<"           ;"<"?\r
3714         AOJA    SDEL,DEF30      ;YES, INCREMENT COUNT AND WRITE\r
3715         CAIN    C,">"           ;">"?\r
3716         SOJL    SDEL,DEF70      ;YES, TEST FOR END\r
3717         JRST    DEF30           ;NO, WRITE IT\r
3718 \r
3719 CPEEK:  TLNN    IO,IOPALL       ;IF LALL IS ON\r
3720         JRST    DEF33           ;JUST RETURN\r
3721         PUSHJ   PP,PEEK         ;LOOK AT NEXT CHAR.\r
3722         CAIN    C,";"           ;IS IT ;;?\r
3723         JRST    CPEEK1          ;YES\r
3724         MOVE    C,CS            ;RESTORE C\r
3725         JRST    DEF33           ;AND RETURN\r
3726 \r
3727 CPEEK1: PUSHJ   PP,GCHAR        ;GET THE CHAR.\r
3728         CAIE    C,">"           ;RETURN IF END OF MACRO\r
3729         CAIG    C,CR            ;IS CHAR ONE OF\r
3730         CAIGE   C,LF            ;LF,VT,FF,CR\r
3731         JRST    CPEEK1          ;NO,SO GET NEXT CHAR.\r
3732         JRST    DEF32           ;YES,RETURN AND STORE\r
3733 \fDEF40: MOVEI   AC0,0           ;CLEAR ATOM\r
3734         MOVSI   AC1,(POINT 6,AC0)       ;SET POINTER\r
3735 DEF42:  PUSH    PP,C            ;STACK CHARACTER\r
3736         TLNE    AC1,770000      ;HAVE WE STORED 6?\r
3737         IDPB    CS,AC1          ;NO, STORE IN ATOM\r
3738         PUSHJ   PP,GCHAR        ;GET NEXT CHARACTER\r
3739         MOVE    CS,C\r
3740         CAIG CS,"Z"+40\r
3741         CAIGE CS,"A"+40\r
3742         JRST    .+2\r
3743         SUBI CS,40              ;CONVERT LOWER TO UPPER\r
3744         CAIL CS,40\r
3745         CAILE CS,77+40\r
3746         JRST    DEF44           ;TEST SPECIAL\r
3747         MOVE    CS,CSTAT-40(CS) ;GET STATUS\r
3748         TLNE    CS,6            ;ALPHA-NUMERIC?\r
3749         JRST    DEF42           ;YES, GET ANOTHER\r
3750 DEF44:  PUSH    PP,[0]          ;NO, MARK THE LIST\r
3751         MOVE    SX,PPTMP1       ;GET POINTER TO TOP\r
3752 \r
3753 DEF46:  SKIPN   1(SX)           ;END OF LIST?\r
3754         JRST    DEF50           ;YES\r
3755         CAME    AC0,1(SX)       ;NO, DO THEY COMPARE?\r
3756         AOJA    SX,DEF46        ;NO, TRY AGAIN\r
3757         SUB     SX,PPTMP1       ;YES, GET DUMMY SYMBOL NUMBER\r
3758         LSH SX,4\r
3759         MOVSI   CS,<(BYTE (7) 177,101)>(SX)     ;SET ESCAPE CODE MACEND\r
3760         LSH     AC0,-?D30\r
3761         CAIN    AC0,5           ;"%"?\r
3762         TLO     CS,1000         ;YES, SET CRESYM FLAG\r
3763         PUSHJ   PP,WWORD        ;WRITE THE WORD\r
3764         SETOM ARGF              ;SET ARGUMENT SEEN FLAG\r
3765         SETZM SQFLG             ;AND IGNORE ANY ' WAITING TO GET INTO STRING\r
3766 DEF48:  MOVE    PP,PPTMP2       ;RESET PUSHDOWN POINTER\r
3767         TLO     IO,IORPTC       ;ECHO LAST CHARACTER\r
3768         JRST    DEF31           ;RECYCLE\r
3769 \r
3770 DEF50:\r
3771         SKIPN   SQFLG           ;HAVE WE SEEN A '?\r
3772         JRST    DEF51           ;NOPE\r
3773         MOVEI   C,47            ;YES, PUT IT IN\r
3774         PUSHJ   PP,WCHAR        ;...\r
3775         SETZM   SQFLG           ;AND CLEAR FLAG\r
3776 DEF51:  MOVE    C,2(SX)         ;GET CHARACTER\r
3777         JUMPE   C,DEF48         ;CLEAN UP IF END\r
3778         PUSHJ   PP,WCHAR        ;WRITE THE CHARACTER\r
3779         AOJA    SX,DEF51        ;GET NEXT\r
3780 \r
3781 DEF70:  MOVE    PP,PPTMP1       ;RESTORE PUSHDOWN POINTER\r
3782         MOVSI   CS,(BYTE (7) 177,1)\r
3783         PUSHJ   PP,WWRXE        ;WRITE END\r
3784         SETZM INDEF     ;OUT OF IT\r
3785         JRST    BYPASS\r
3786 \f; HERE TO STORE DEFAULT ARGUMENTS\r
3787 \r
3788 DEF80:  AOS     .TEMP           ;COUNT ONE MORE\r
3789         PUSHJ   PP,SKELI1       ;INITIALIZE SKELETON\r
3790         HRL     V,SX            ;SYMBOL NUMBER\r
3791         PUSH    PP,V            ;STORE POINTER\r
3792         TDZA    SDEL,SDEL       ;ZERO BRACKET COUNT\r
3793 DEF81:  PUSHJ   PP,WCHARQ       ;WRITE A CHARACTER\r
3794         PUSHJ   PP,GCHARQ       ;GET A CHARACTER\r
3795         CAIN    C,"<"           ;ANOTHER "<"?\r
3796         AOJA    SDEL,DEF81      ;YES, INCREMENT AND WRITE\r
3797         CAIE    C,">"           ;CLOSING ANGLE?\r
3798         JRST    DEF81           ;NO, JUST WRITE THE CHAR.\r
3799         SOJGE   SDEL,DEF81      ;YES, WRITE IF NOT END\r
3800         MOVSI   CS,(BYTE (7) 177,2)\r
3801         PUSHJ   PP,WWRXE        ;WRITE END OF DUMMY ARGUMENT\r
3802         PUSHJ   PP,GCHAR        ;READ AT NEXT CHAR.\r
3803         CAIE    C,")"           ;END OF ARGUMENT LIST?\r
3804         JRST    DEF10           ;NO, GET NEXT SYMBOL\r
3805         JRST    DEF12           ;YES, LOOK FOR "<"\r
3806 \fSUBTTL MACRO CALL PROCESSOR\r
3807 CALLM:  SKIPGE  MACENL          ;ARE WE TRYING TO RE-ENTER?\r
3808         JRST    ERRAX           ;YES, BOMB OUT WITH ERROR\r
3809         HRROS   MACENL          ;FLAG "CALLM IN PROGRESS"\r
3810         EXCH    MP,RP\r
3811         PUSH    MP,V            ;STACK FOR REFDEC\r
3812         EXCH    MP,RP\r
3813         MOVEM   AC0,CALNAM      ;SAVE MACRO NAME INCASE OF ERROR\r
3814         MOVE SDEL,SEQNO2        ;SAVE IN CASE OF EOF\r
3815         MOVEM SDEL,CALSEQ\r
3816         MOVE SDEL,PAGENO\r
3817         MOVEM SDEL,CALPG\r
3818         ADDI    V,1             ;POINT TO DUMMY SYMBOL COUNT\r
3819         AOS     SDEL,0(V)       ;INCREMENT ARG COUNT\r
3820         HLLZM   SDEL,.TEMP      ;DEFAULT ARG POINTER IF NON-ZERO\r
3821         LSHC    SDEL,-?D<9+36>  ;ZERO SDEL, GET ARG COUNT IN SX\r
3822         ANDI    SX,777          ;MASK\r
3823         SKIPE   .TEMP           ;IF AT LEAST ONE DEFAULT ARG\r
3824         HRRM    SX,.TEMP        ;STORE COUNT OF ARGS\r
3825         PUSH    PP,V            ;STACK FOR MRP\r
3826         PUSH    PP,RP           ;STACK FOR MACPNT\r
3827         JUMPE   SX,MAC20        ;TEST FOR NO ARGS\r
3828         PUSHJ   PP,CHARAC\r
3829         CAIE    C,"("           ;"("\r
3830         TROA    SDEL,-1         ;NO, FUDGE PAREN COUNT AND SKIP\r
3831 \r
3832 MAC10:  PUSHJ   PP,GCHAR        ;GET A CHARACTER, LOOK FOR AN ARG\r
3833         CAIG C,CR\r
3834         CAIGE C,LF\r
3835         CAIN    C,";"           ;";"?\r
3836         JRST    MAC21           ;YES, END OF ARGUMENT STRING\r
3837 \r
3838         PUSHJ   PP,SKELI1       ;NO, INITIALIZE SKELETON\r
3839         CAIN    C,"<"           ;"<"?\r
3840         JRST    MAC30           ;YES, PROCESS AS SPECIAL\r
3841         CAIE C,176\r
3842         CAIN    C,134           ;"\"\r
3843         JRST    MAC40           ;YES, PROCESS SYMBOL\r
3844 \r
3845 MAC14:  CAIN    C,","           ;","?\r
3846         JRST    MAC16           ;YES; NULL SYMBOL\r
3847         CAIN    C,"("           ;"("?\r
3848         ADDI    SDEL,1          ;YES, INCREMENT COUNT\r
3849         CAIN    C,")"           ;")"?\r
3850         SOJL    SDEL,MAC16      ;YES, TEST FOR END\r
3851         PUSHJ   PP,WCHAR        ;WRITE INTO SKELETON\r
3852 MAC14A: PUSHJ   PP,CHARAC       ;GET NEXT CHARACTER\r
3853         CAIG C,CR\r
3854         CAIGE C,LF\r
3855         JRST    .+2\r
3856         JRST    MAC15           ;TEST FOR END OF LINE\r
3857         CAIE    C,";"           ;";"?\r
3858         JRST    MAC14           ;YES, END OF LINE\r
3859 \r
3860 MAC15:  TLO     IO,IORPTC\r
3861 MAC16:  MOVSI   CS,(BYTE (7) 177,2)\r
3862         PUSHJ   PP,WWRXE        ;WRITE END\r
3863         EXCH    MP,RP\r
3864         PUSH    MP,WWRXX\r
3865         EXCH    MP,RP\r
3866         SOJLE   SX,MAC20        ;BRANCH IF NO MORE ARGS\r
3867         JUMPGE  SDEL,MAC10      ;HAVEN'T SEEN TERMINAL ")" YET\r
3868 \fMAC20: TLZN    IO,IORPTC\r
3869         PUSHJ   PP,CHARAC\r
3870 MAC21:  EXCH    MP,RP\r
3871         JUMPE   SX,MAC21B       ;NO MISSING ARGS\r
3872 MAC21A: PUSH    MP,[-1]         ;FILL IN MISSING ARGS\r
3873         SKIPN   .TEMP           ;ANY DEFAULT ARGS?\r
3874         JRST    MAC21C          ;NO\r
3875         HRRZ    C,.TEMP         ;GET ARG COUNT\r
3876         SUBI    C,-1(SX)        ;ACCOUNT FOR THOSE GIVEN\r
3877         HRLZS   C               ;PUT IN LEFT HALF\r
3878         HLRZ    SDEL,.TEMP      ;ADDRESS OF TABLE\r
3879 MAC21D: SKIPN   (SDEL)          ;END OF LIST\r
3880         JRST    MAC21C          ;YES\r
3881         XOR     C,(SDEL)        ;TEST FOR CORRECT ARG\r
3882         TLNN    C,-1            ;WAS IT?\r
3883         JRST    MAC21E          ;YES\r
3884         XOR     C,(SDEL)        ;BACK THE WAY IT WAS\r
3885         AOJA    SDEL,MAC21D     ;AND TRY AGAIN\r
3886 \r
3887 MAC21E: MOVEM   C,(MP)          ;REPLACE -1 WITH TREE POINTER\r
3888         AOS     1(C)            ;INCREMENT REFERENCE\r
3889 MAC21C: SOJG    SX,MAC21A\r
3890 MAC21B: PUSH    MP,[0]          ;SET TERMINAL\r
3891         HRRZ    C,LIMBO\r
3892         TLNN    IO,IOSALL       ;SUPPRESSING ALL?\r
3893         JRST    MAC23           ;NO\r
3894         JUMPN   MRP,MAC27       ;IN MACRO?\r
3895         CAIE    C,";"           ;NO,IN COMMENT?\r
3896         JRST    MAC26           ;NO\r
3897 MAC22:  PUSHJ   PP,CHARAC       ;YES,GET IT INTO THE LBUF\r
3898         CAIG    C,CR            ;LESS THAN CR?\r
3899         CAIGE   C,LF            ;AND GREATER THAN LF?\r
3900         JRST    MAC22           ;NO GET ANOTHER\r
3901 MAC26:  HRLZI   SX,70000        ;DECREMENT BYTE POINTER\r
3902         ADDB    SX,LBUFP\r
3903         JUMPGE  SX,MAC27\r
3904         HRLOI   SX,347777\r
3905         ADDM    SX,LBUFP\r
3906 MAC27:  HRLI    C,-1            ;SET FLAG\r
3907         JRST    MAC25\r
3908 \r
3909 MAC23:  MOVEI   SX,"?"\r
3910         JUMPAD  MAC24           ;BRANCH IF ADDRESS FIELD\r
3911         CAIN    C,";"           ;IF SEMI-COLON\r
3912         SKIPE   LITLVL          ;AND NOT IN A LITERAL\r
3913         JRST    MAC24           ;NOT BOTH TRUE\r
3914         JUMPN   MRP,MAC24       ;OR IN A MACRO\r
3915         PUSHJ   PP,STOUT        ;LIST COMMENT OR CR-LF\r
3916         TLNE    IO,IOPALL       ;MACRO EXPANSION SUPPRESSION?\r
3917         TLO     IO,IOMAC        ;  NO, SET TEMP BIT\r
3918         TDOA    C,[-1]          ;FLAG LAST CHARACTER\r
3919 MAC24:  DPB     SX,LBUFP        ;SET ? INTO LINE BUFFER\r
3920 MAC25:  PUSH    MP,MACPNT\r
3921         POP     PP,MACPNT\r
3922         PUSH    MP,C\r
3923         PUSH    MP,RCOUNT       ;STACK WORD COUNT\r
3924         PUSH    MP,MRP          ;STACK MACRO POINTER\r
3925         POP     PP,MRP          ;SET NEW READ POINTER\r
3926         EXCH    MP,RP\r
3927         AOS     MACLVL\r
3928         HRRZS   MACENL          ;RESET "CALLM IN PROGRESS"\r
3929         JUMPOC  STMNT2          ;OP-CODE FIELD\r
3930         JRST    EVATOM          ;ADDRESS FIELD\r
3931 \r
3932 \fMAC30: MOVEI   AC0,0           ;INITIALIZE BRACKET COUNTER\r
3933 MAC31:  PUSHJ   PP,GCHAR        ;GET A CHARACTER\r
3934         CAIN    C,"<"           ;"<"?\r
3935         ADDI    AC0,1           ;YES, INCREMENT COUNT\r
3936         CAIN    C,">"           ;">"?\r
3937         SOJL    AC0,MAC14A      ;YES, EXIT IF MATCHING\r
3938         PUSHJ   PP,WCHAR        ;WRITE INTO SKELETON\r
3939         JRST    MAC31           ;GO BACK FOR ANOTHER\r
3940 \r
3941 MAC40:  PUSH    PP,SX           ;STACK REGISTERS\r
3942         PUSH    PP,SDEL\r
3943         HLLM    IO,TAGINC       ;SAVE IO FLAGS\r
3944         PUSHJ   PP,CELL         ;GET AN ATOM\r
3945         MOVE    V,AC0           ;ASSUME NUMERIC\r
3946         TLNE    IO,NUMSW        ;GOOD GUESS?\r
3947         JRST    MAC41           ;YES\r
3948         PUSHJ   PP,SSRCH        ;SEARCH THE SYMBOL TABLE\r
3949         TROA    ER,ERRX         ;NOT FOUND, ERROR\r
3950 MAC41:  PUSHJ   PP,MAC42        ;FORM ASCII STRING\r
3951         HLL     IO,TAGINC       ;RESTORE IO FLAGS\r
3952         POP     PP,SDEL\r
3953         POP     PP,SX\r
3954         TLO     IO,IORPTC       ;REPEAT LAST CHARACTER\r
3955         JRST    MAC14A          ;RETURN TO MAIN SCAN\r
3956 \r
3957 MAC42:  MOVE    C,V\r
3958 MAC44:  LSHC    C,-?D35\r
3959         LSH     CS,-1\r
3960         DIVI    C,0(RX)         ;DIVIDE BY CURRENT RADIX\r
3961         HRLM    CS,0(PP)\r
3962         JUMPE   C,.+2           ;TEST FOR END\r
3963         PUSHJ   PP,MAC44\r
3964         HLRZ    C,0(PP)\r
3965         ADDI    C,"0"           ;FORM TEXT\r
3966         JRST    WCHAR           ;WRITE INTO SKELETON\r
3967 \fMACEN0:        SOS     MACENL\r
3968 MACEND: SKIPGE  C,MACENL        ;TEST "CALLM IN PROGRESS"\r
3969         AOS     MACENL          ;INCREMENT END LEVEL AND EXIT\r
3970         JUMPL   C,REPEA8\r
3971         EXCH    MP,RP\r
3972         POP     MP,MRP          ;RETRIEVE READ POINTER\r
3973         POP     MP,RCOUNT       ;AND WORD COUNT\r
3974         MOVEI   C,"?"\r
3975         SKIPL   0(MP)           ;TEST FLAG\r
3976         PUSHJ   PP,RSW2         ;MARK END OF SUBSTITUTION\r
3977         POP     MP,C\r
3978         POP     MP,ARG\r
3979         SKIPA   MP,MACPNT       ;RESET MP AND SKIP\r
3980 MACEN1: PUSHJ   PP,REFDEC       ;DECREMENT REFERENCE\r
3981 MACEN2: AOS     V,MACPNT        ;GET POINTER\r
3982         MOVE    V,0(V)\r
3983         JUMPG   V,MACEN1        ;IF >0, DECREMENT REFERENCE\r
3984         JUMPL   V,MACEN2        ;IF <0, BYPASS\r
3985         POP     MP,V            ;IF=0, RETRIEVE POINTER\r
3986         PUSHJ   PP,REFDEC       ;DECREMENT REFERENCE\r
3987         MOVEM   ARG,MACPNT\r
3988         EXCH    MP,RP\r
3989         SOS     MACLVL\r
3990         SKIPN   MACENL          ;CHECK UNPROCESSED END LEVEL\r
3991         JRST    MACEN3          ;NONE TO PROCESS\r
3992         TRNN    MRP,-1          ;MRP AT END OF TEXT\r
3993         JRST    MACEN0          ;THEN POP THE MACRO STACK NOW\r
3994 MACEN3: TRNN    C,77400         ;SALL FLAG?\r
3995         HRLI    C,0             ;YES,TURN IT OFF\r
3996         JUMPL   C,REPEA8        ;IF FLAG SET SUBSTITUTE\r
3997         JRST    RSW1\r
3998 \fIRP0:  SKIPN   MACLVL          ;ARE WE IN A MACRO?\r
3999         JRST    ERRAX           ;NO, BOMB OUT\r
4000 IRP10:  PUSHJ   PP,MREADS       ;YES, GET DATA SPEC\r
4001         CAIE C,40               ;SKIP LEADING BLANKS\r
4002         CAIN    C,"("           ;"("?\r
4003         JRST    IRP10           ;YES, BYPASS\r
4004         CAIN C,11\r
4005         JRST IRP10\r
4006         CAIE    C,177           ;NO, IS IT SPECIAL?\r
4007         JRST    ERRAX           ;NO, ERROR\r
4008         PUSHJ   PP,MREADS       ;YES\r
4009         TRZN C,100              ;CREATED?\r
4010         JRST ERRAX\r
4011         CAIL C,40               ;TOO BIG?\r
4012         JRST ERRAX\r
4013         ADD     C,MACPNT        ;NO, FORM POINTER TO STACK\r
4014         PUSH    MP,IRPCF        ;STACK PREVIOUS POINTERS\r
4015         PUSH    MP,IRPSW\r
4016         PUSH    MP,IRPARP\r
4017         PUSH    MP,IRPARG\r
4018         PUSH    MP,IRPCNT\r
4019         PUSH    MP,0(C)\r
4020         PUSH    MP,IRPPOI\r
4021 \r
4022         HRRZM   C,IRPARP\r
4023         MOVEM   AC0,IRPCF       ;IRPC FLAG FOUND IN AC0\r
4024         SETOM   IRPSW           ;RESET IRP SWITCH\r
4025         MOVE    CS,0(C)\r
4026         MOVEM   CS,IRPARG\r
4027 \r
4028         PUSHJ   PP,MREADS\r
4029         CAIE    C,"<"           ;"<"?\r
4030         JRST    .-2             ;NO, SEARCH UNTIL FOUND\r
4031         PUSHJ   PP,SKELI1       ;INITIALIZE NEW STRING\r
4032         MOVEM   ARG,IRPPOI      ;SET NEW POINTER\r
4033 \r
4034         TDZA    SDEL,SDEL       ;ZERO BRACKET COUNT AND SKIP\r
4035 IRP20:  PUSHJ   PP,WCHAR1\r
4036         PUSHJ   PP,MREADS\r
4037         CAIN    C,"<"           ;"<"?\r
4038         AOJA    SDEL,IRP20      ;YES, INCREMENT COUNT AND WRITE\r
4039         CAIE    C,">"           ;">"?\r
4040         JRST    IRP20           ;NO, JUST WRITE IT\r
4041         SOJGE   SDEL,IRP20      ;YES, WRITE IF NOT MATCHING\r
4042         MOVE    CS,[BYTE (7) 15,177,4]\r
4043         PUSHJ   PP,WWRXE        ;WRITE END\r
4044         PUSH    MP,MRP          ;STACK PREVIOUS READ POINTER\r
4045         PUSH    MP,RCOUNT       ;AND WORD COUNT\r
4046         SKIPG   CS,IRPARG\r
4047         JRST    IRPPOP          ;EXIT IF NOT VALID ARGUMENT\r
4048         MOVEI   C,1(CS)         ;INITIALIZE POINTER\r
4049         MOVEM   C,IRPARG\r
4050 \fIRPSET:        EXCH    MRP,IRPARG      ;SWAP READ POINTERS\r
4051         MOVE    SX,RCOUNT       ;SWAP COUNT OF WORDS TO READ\r
4052         EXCH    SX,IRPCNT\r
4053         MOVEM   SX,RCOUNT\r
4054         PUSHJ   PP,SKELI1       ;INITIALIZE SKELETON FOR DATA\r
4055         HRRZM   ARG,@IRPARP     ;STORE NEW DS POINTER\r
4056         SETZB   SX,SDEL         ;ZERO FOUND FLAG AND BRACKET COUNT\r
4057         LDB     C,MRP           ;GET LAST CHAR\r
4058         CAIN    C,","\r
4059         SKIPE   IRPCF           ;IN IRPC\r
4060         JRST    IRPSE1          ;NO\r
4061         MOVEI   SX,1            ;FORCE ARGUMENT\r
4062 IRPSE1: PUSHJ   PP,MREADS\r
4063         CAIE    C,177           ;SPECIAL?\r
4064         AOJA    SX,IRPSE2       ;NO, FLAG AS FOUND\r
4065         PUSHJ   PP,PEEKM        ;LOOK AT NEXT CHARACTER\r
4066         SETZM   IRPSW           ;SET IRP SWITCH\r
4067         JUMPG   SX,IRPSE4       ;IF ARG FOUND, PROCESS IT\r
4068         JRST    IRPPOP          ;NO, CLEAN UP AND EXIT\r
4069 \r
4070 IRPSE2: SKIPE   IRPCF           ;IRPC?\r
4071         JRST    IRPSE3          ;YES, WRITE IT\r
4072         CAIN    C,","           ;NO, IS IT A COMMA?\r
4073         JUMPE   SDEL,IRPSE4     ;YES, EXIT IF NOT NESTED\r
4074         CAIN    C,"<"           ;"<"?\r
4075         ADDI    SDEL,1          ;YES, INCREMENT COUNT\r
4076         CAIN    C,">"           ;">"?\r
4077         SUBI    SDEL,1          ;YES, DECREMENT COUNT\r
4078 \r
4079 IRPSE3: PUSHJ   PP,WCHAR\r
4080         SKIPN   IRPCF           ;IRPC?\r
4081         JRST    IRPSE1          ;NO, GET NEXT CHARACTER\r
4082 \r
4083 IRPSE4: MOVSI   CS,(BYTE (7) 177,2)\r
4084         PUSHJ   PP,WWRXE        ;WRITE END\r
4085         MOVEM   MRP,IRPARG      ;SAVE POINTER\r
4086         MOVE    MRP,RCOUNT      ;SAVE COUNT\r
4087         MOVEM   MRP,IRPCNT\r
4088         HRRZ    MRP,IRPPOI      ;SET FOR NEW SCAN\r
4089         AOJA    MRP,REPEA8      ;ON ARG COUNT\r
4090 \fSTOPI0:        SKIPN   IRPARP          ;IRP IN PROGRESS?\r
4091         JRST    ERRAX           ;NO, ERROR\r
4092         SETZM   IRPSW           ;YES, SET SWITCH\r
4093         POPJ    PP,\r
4094 \r
4095 IRPEND: MOVE    V,@IRPARP\r
4096         PUSHJ   PP,REFDEC\r
4097         SKIPE   IRPSW           ;MORE TO COME?\r
4098         JRST    IRPSET          ;YES\r
4099 \r
4100 IRPPOP: MOVE    V,IRPPOI\r
4101         PUSHJ   PP,REFDEC       ;DECREMENT REFERENCE\r
4102         POP     MP,RCOUNT\r
4103         POP     MP,MRP          ;RESTORE CELLS\r
4104         POP     MP,IRPPOI\r
4105         POP     MP,@IRPARP\r
4106         POP     MP,IRPCNT\r
4107         POP     MP,IRPARG\r
4108         POP     MP,IRPARP\r
4109         POP     MP,IRPSW\r
4110         POP     MP,IRPCF\r
4111         JRST    REPEA8\r
4112 \fGETDS:                         ;GET DUMMY SYMBOL NUMBER\r
4113         MOVE    CS,C            ;USE CS FOR WORK REGISTER\r
4114         ANDI    CS,37           ;MASK\r
4115         ADD     CS,MACPNT       ;ADD BASE ADDRESS\r
4116         MOVE    V,0(CS)         ;GET POINTER FLAG\r
4117         JUMPG   V,GETDS1        ;BRANCH IF POINTER\r
4118         TRNN    C,40            ;NOT POINTER, SHOULD WE CREATE?\r
4119         JRST    RSW0            ;NO, FORGET THIS ARG\r
4120         PUSH    PP,WWRXX\r
4121         PUSH    PP,MWP          ;STACK MACRO WRITE POINTER\r
4122         PUSH    PP,WCOUNT       ;SAVE WORD  COUNT\r
4123         PUSHJ   PP,SKELI1       ;INITIALIZE SKELETON\r
4124         MOVEM   ARG,0(CS)       ;STORE POINTER\r
4125         MOVE    CS,[BYTE (7) 0,170,170,170,171] ;CREATE A SYMBOL\r
4126         ADD     CS,LSTSYM               ;LSTSYM= # OF LAST CREATED\r
4127         TDZ     CS,[BYTE (7) 0,170,170,170,170]\r
4128         MOVEM   CS,LSTSYM\r
4129         IOR     CS,[ASCII /.0000/]\r
4130         MOVEI C,"."\r
4131         PUSHJ PP,WCHAR\r
4132         PUSHJ   PP,WWORD        ;WRITE INTO SKELETON\r
4133         MOVSI   CS,(BYTE (7) 177,2)\r
4134         PUSHJ   PP,WWRXE        ;WRITE END CODE\r
4135         POP     PP,WCOUNT       ;RESTORE WORD COUNT\r
4136         POP     PP,MWP          ;RESTORE MACRO WRITE POINTER\r
4137         POP     PP,WWRXX\r
4138         MOVE    V,ARG           ;SET UP FOR REFINC\r
4139 \r
4140 GETDS1: PUSHJ   PP,REFINC       ;INCREMENT REFERENCE\r
4141         HRL     V,RCOUNT        ;SAVE WORD COUNT\r
4142         PUSH    MP,V            ;STACK V FOR DECREMENT\r
4143         PUSH    MP,MRP          ;STACK READ POINTER\r
4144         MOVEI   MRP,1(V)        ;FORM READ POINTER\r
4145         JRST    RSW0            ;EXIT\r
4146 \r
4147 DSEND:  POP     MP,MRP\r
4148         POP     MP,V\r
4149         HLREM   V,RCOUNT        ;RESTORE WORD COUNT\r
4150         HRRZS   V               ;CLEAR COUNT\r
4151         PUSHJ   PP,REFDEC       ;DECREMENT REFERENCE\r
4152         JRST    RSW0            ;EXIT\r
4153 \fSKELI1:        MOVEI   ARG,1           ;ENTRY FOR SINGLE ARG\r
4154 SKELI:  SETZ    MWP,            ;SIGNAL FIRST TIME THROUGH\r
4155         PUSHJ   PP,SKELWL       ;GET POINTER WORD\r
4156         HRRZM   MWP,WWRXX       ;SAVE FIRST ADDRESS\r
4157         HRRZM   MWP,LADR        ;SAVE START OF LINKED LIST\r
4158         HRRZM   ARG,1(MWP)      ;STORE COUNT\r
4159         SOS     WCOUNT          ;ACCOUNT FOR WORD\r
4160         HRRZ    ARG,WWRXX       ;SET FIRST ADDRESS\r
4161         ADDI    MWP,2           ;BUMP POINTER\r
4162         HRLI    MWP,(POINT 7)   ;SET FOR 5 ASCII BYTES\r
4163         ;SKELW RETURNS WITH ADR OF NEXT FREE LOC IN V (RIGHT)\r
4164 \r
4165 SKELW:  SOSLE   WCOUNT          ;STILL SOME SPACE IN LEAF?\r
4166         POPJ    PP,             ;YES, RETURN\r
4167 SKELWL: SKIPE   V,NEXT          ;GET FIRST FREE ADDRESS\r
4168         JRST    SKELW1          ;IF NON-ZERO, UPDATE FREE\r
4169         MOVE    V,FREE          ;GET FREE\r
4170         ADDI    V,.LEAF         ;INCREMENT BY LEAF SIZE\r
4171         CAML    V,SYMBOL        ;OVERFLOW?\r
4172         PUSHJ   PP,XCEED        ;YES, BOMB OUT\r
4173         EXCH    V,FREE          ;UPDATE FREE\r
4174         SETZM   (V)             ;CLEAR LINK\r
4175 \r
4176 SKELW1: HLL     V,0(V)          ;GET ADDRESS\r
4177         HLRM    V,NEXT          ;UPDATE NEXT\r
4178         SKIPE   MWP             ;IF FIRST TIME\r
4179         HRLM    V,1-.LEAF(MWP)  ;STORE LINK IN FIRST WORD OF LEAF\r
4180         MOVEI   MWP,.LEAF       ;SIZE OF LEAF\r
4181         MOVEM   MWP,WCOUNT      ;STORE FOR COUNT DOWN\r
4182         MOVEI   MWP,(V)         ;SET UP WRITE POINTER\r
4183         TLO     MWP,(POINT 7,,21)       ;2 ASCII CHARS\r
4184         POPJ    PP,\r
4185 \r
4186         ;WWRXX  POINTS TO END OF TREE\r
4187         ;MWP    IDPB POINTER TO NEXT HOLE\r
4188         ;NEXT   FIRST OF A LINKED PORTION THAT IS NOT BEING USED (LEAVES)\r
4189         ;FREE   POINTS TO FREE CORE BETWEEN TREE AND SYM-TABLE\r
4190         ;LADR   POINTS TO BEG OF LINKED PORTION.\r
4191 \fGCHARQ:        JUMPN   MRP,MREADS      ;IF GETTING CHAR. FROM TREE\r
4192 GCHAR:  PUSHJ   PP,CHARAC       ;GET ASCII CHARACTER\r
4193         CAIG    C,FF            ;TEST FOR LF, VT OR FF\r
4194         CAIGE   C,LF\r
4195         POPJ    PP,             ;NO\r
4196         JRST    OUTIM1          ;YES, LIST IT\r
4197 \r
4198 WCHARQ:\r
4199 WCHAR:  \r
4200 WCHAR1: TLNN    MWP,760000      ;END OF WORD?\r
4201         PUSHJ   PP,SKELW        ;YES, GET ANOTHER\r
4202         IDPB    C,MWP           ;STORE CHARACTER\r
4203         POPJ    PP,\r
4204 \r
4205 WWORD:  LSHC    C,7             ;MOVE ASCII INTO C\r
4206         PUSHJ   PP,WCHAR1       ;STORE IT\r
4207         JUMPN   CS,WWORD        ;TEST FOR END\r
4208         POPJ    PP,             ;YES, EXIT\r
4209 \r
4210 WWRXE:  PUSHJ   PP,WWORD        ;WRITE LAST WORD\r
4211         ADD     MWP,WCOUNT      ;GET TO END OF LEAF\r
4212         SUBI    MWP,.LEAF       ;NOW POINT TO START OF IT\r
4213         HRRZS   (MWP)           ;ZERO LEFT HALF OF LAST LEAF\r
4214         HRRM    MWP,@WWRXX      ;SET POINTER TO END\r
4215         POPJ    PP,\r
4216 \fMREAD: PUSHJ   PP,MREADS       ;READ ONE CHARACTER\r
4217         CAIE    C,177           ;SPECIAL?\r
4218         JRST    RSW1            ;NO, EXIT\r
4219         PUSHJ   PP,MREADS       ;YES, GET CODE WORD\r
4220         TRZE C,100              ;SYMBOL?\r
4221         JRST GETDS              ;YES\r
4222         CAILE C,4               ;POSSIBLY ILLEGAL\r
4223         JRST ERRAX              ;YUP\r
4224         HRRI    MRP,0           ;NO, SIGNAL END OF TEXT\r
4225         JRST    .+1(C)\r
4226         PUSHJ   PP,XCEED\r
4227         JRST    MACEND          ;1; END OF MACRO\r
4228         JRST    DSEND           ;2; END OF DUMMY SYMBOL\r
4229         JRST    REPEND          ;3; END OF REPEAT\r
4230         JRST    IRPEND          ;4; END OF IRP\r
4231 \r
4232 MREADI: HRLI    MRP,700         ;SET UP BYTE POINTER\r
4233         MOVEI   C,.LEAF-1       ;NUMBER OF WORDS\r
4234         MOVEM   C,RCOUNT\r
4235 MREADS: TLNN    MRP,-1          ;FIRST TIME HERE?\r
4236         JRST    MREADI          ;YES, SET UP MRP AND RCOUNT\r
4237         TLNN    MRP,760000      ;HAVE WE FINISHED WORD?\r
4238         SOSLE   RCOUNT          ;YES, STILL ROOM IN LEAF?\r
4239         JRST    MREADC          ;STILL CHAR. IN LEAF\r
4240         HLRZ    MRP,1-.LEAF(MRP);YES, GET LINK\r
4241         HRLI    MRP,(POINT 7,,21)       ;SET POINTER\r
4242         MOVEI   C,.LEAF         ;RESET COUNT\r
4243         MOVEM   C,RCOUNT\r
4244 MREADC: ILDB    C,MRP           ;GET CHARACTER\r
4245         POPJ    PP,\r
4246 \r
4247 PEEK:   JUMPN   MRP,PEEKM       ;THIS IS A MACRO READ\r
4248         PUSHJ   PP,CHARAC       ;READ AN ASCII CHAR.\r
4249         TLO     IO,IORPTC       ;REPEAT  FOR NEXT\r
4250         POPJ    PP,             ;AND RETURN\r
4251 \r
4252 PEEKM:  PUSH    PP,MRP          ;SAVE MACRO READ POINTER\r
4253         PUSH    PP,RCOUNT       ;SAVE WORD COUNT\r
4254         PUSHJ   PP,MREADS       ;READ IN A CHAR.\r
4255         POP     PP,RCOUNT       ;RESTORE WORD COUNT\r
4256         POP     PP,MRP          ;RESET READ POINTER\r
4257         POPJ    PP,             ;IORPTC IS NOT SET\r
4258 \fREFINC:        MOVEI   CS,1(V)         ;GET POINTER TO TREE\r
4259         AOS     0(CS)           ;INCREMENT REFERENCE\r
4260         POPJ    PP,\r
4261 \r
4262 REFDEC: JUMPLE  V,DECERR        ;CATASTROPHIC ERROR SOMEWHERE\r
4263         MOVEI   CS,1(V)         ;GET POINTER TO TREE\r
4264         SOS     CS,0(CS)        ;DECREMENT REFERENCE\r
4265         TRNE    CS,000777       ;IS IT ZERO?\r
4266         POPJ    PP,             ;NO, EXIT\r
4267         HRRZ    CS,0(V)         ;YES, GET POINTER TO END\r
4268         HRL     CS,NEXT         ;GET POINTER TO NEXT RE-USABLE\r
4269         HLLM    CS,0(CS)        ;SET LINK\r
4270         HRRM    V,NEXT          ;RESET NEXT\r
4271         POPJ    PP,\r
4272 \r
4273 DECERR: MOVE    AC0,CALNAM      ;GET MACRO NAME\r
4274         MOVSI   RC,[SIXBIT /ERROR WHILE EXPANDING@/]\r
4275         PUSHJ   PP,TYPMSG\r
4276         JRST    ERRNE2          ;COMMON MESSAGE\r
4277 \fA==    0                       ;ASCII MODE\r
4278 AL==    1                       ;ASCII LINE MODE\r
4279 IB==    13                      ;IMAGE BINARY MODE\r
4280 B==     14                      ;BINARY MODE\r
4281 IFE RUNSW,<DMP==16              ;DUMP MODE>\r
4282 \r
4283 CTL==   0                       ;CONTROL DEVICE NUMBER\r
4284 BIN==   1                       ;BINARY DEVICE NUMBER\r
4285 CHAR==  2                       ;INPUT DEVICE NUMBER\r
4286 LST==   3                       ;LISTING DEVICE NUMBER\r
4287 \r
4288 ;       COMMAND STRING ACCUMULATORS\r
4289 \r
4290 ACDEV== 1                       ;DEVICE\r
4291 ACFILE==2                       ;FILE\r
4292 ACEXT== 3                       ;EXTENSION\r
4293 ACPPN== 4                       ;PPN\r
4294 ACDEL== 4                       ;DELIMITER\r
4295 ACPNTR==5                       ;BYTE POINTER\r
4296 \r
4297 TIO==   6\r
4298 \r
4299 TIORW== 1000\r
4300 TIOLE== 2000\r
4301 TIOCLD==20000\r
4302 \r
4303 DIRBIT==4               ;DIRECTORY DEVICE\r
4304 TTYBIT==10              ;TTY\r
4305 MTABIT==20              ;MTA\r
4306 DTABIT==100             ;DTA\r
4307 DISBIT==2000            ;DISPLAY\r
4308 CONBIT==20000           ;CONTROLING TTY\r
4309 LPTBIT==40000           ;LPT\r
4310 DSKBIT==200000          ;DSK\r
4311 \r
4312 ;GETSTS ERROR BITS\r
4313 \r
4314 IOIMPM==400000          ;IMPROPER MODE (WRITE LOCK)\r
4315 IODERR==200000          ;DEVICE DATA ERROR\r
4316 IODTER==100000          ;CHECKSUM OR PARITY ERROR\r
4317 IOBKTL== 40000          ;BLOCK TOO LARGE\r
4318 ERRBIT==IOIMPM!IODERR!IODTER!IOBKTL\r
4319 \r
4320 SYN     .TEMP,PPN\r
4321 \fSUBTTL I/O ROUTINES\r
4322 BEG:\r
4323         HRRZ    MRP,JOBREL      ;GET LOWSEG SIZE\r
4324         MOVEM   MRP,MACSIZ      ;SAVE CORE SIZE\r
4325                                 ;DECODE VERSION NUMBER\r
4326         MOVEI   PP,JOBFFI       ;TEMP PUSH DOWN STACK\r
4327         PUSH    PP,[0]          ;MARK BOTTOM OF STACK\r
4328         LDB     0,[POINT 3,JOBVER,2]    ;GET USER BITS\r
4329         JUMPE   0,GETE          ;NOT SET IF ZERO\r
4330         ADDI    0,"0"           ;FORM NUMBER\r
4331         PUSH    PP,0            ;STACK IT\r
4332         MOVEI   0,"-"           ;SEPARATE BY HYPHEN\r
4333         PUSH    PP,0            ;STACK IT ALSO\r
4334 GETE:   HRRZ    0,JOBVER        ;GET EDIT NUMBER\r
4335         JUMPE   0,GETU          ;SKIP ALL THIS IF ZERO\r
4336         MOVEI   1,")"           ;ENCLOSE IN PARENS.\r
4337         PUSH    PP,1\r
4338 GETED:  IDIVI   0,8             ;GET OCTAL DIGITS\r
4339         ADDI    1,"0"           ;MAKE ASCII\r
4340         PUSH    PP,1            ;STACK IT\r
4341         JUMPN   0,GETED         ;LOOP TIL DONE\r
4342         MOVEI   0,"("           ;OTHER PAREN.\r
4343         PUSH    PP,0\r
4344 GETU:   LDB     0,[POINT 6,JOBVER,17]   ;UPDATE NUMBER\r
4345         JUMPE   0,GETV          ;SKIP IF ZERO\r
4346         IDIVI   0,8             ;MIGHT BE TWO DIGITS\r
4347         ADDI    1,"@"           ;FORM ALPHA\r
4348         PUSH    PP,1\r
4349         JUMPN   0,GETU+1        ;LOOP IF NOT DONE\r
4350 GETV:   LDB     0,[POINT 9,JOBVER,11]   ;GET VERSION NUMBER\r
4351         IDIVI   0,8             ;GET DIGIT\r
4352         ADDI    1,"0"           ;TO ASCII\r
4353         PUSH    PP,1            ;STACK\r
4354         JUMPN   0,GETV+1        ;LOOP\r
4355         MOVE    1,[POINT 7,VBUF+1,13]   ;POINTER TO DEPOSIT IN VBUF\r
4356         POP     PP,0            ;GET CHARACTER\r
4357         IDPB    0,1             ;DEPOSIT IT\r
4358         JUMPN   0,.-2           ;KEEP GOING IF NOT ZERO\r
4359 IFN FORMSW,<IFE DFRMSW,<\r
4360         SETOM   PHWFMT          ;HALF WORD UNLESS CHANGED BY SWITCH>>\r
4361 \f\r
4362 M:\r
4363         RESET                   ;INITIALIZE PROGRAM\r
4364         SETZM   BINDEV          ;CLEAR INCASE NOT USED NEXT TIME\r
4365         SETZM   LSTDEV          ;SAME REASON\r
4366         SETZM   INDEV           ;INCASE OF ERROR\r
4367         HRRZ    MRP,MACSIZ      ;GET INITIAL SIZE\r
4368         CORE    MRP,            ;BACK TO ORIGINAL SIZ4\r
4369         JFCL                    ;SHOULD NEVER FAIL\r
4370         SETZB   MRP,PASS1I\r
4371         MOVE    [XWD PASS1I,PASS1I+1]\r
4372         BLT     PASS2X-1        ;ZERO THE PASS1 AND PASS2 VARIABLES\r
4373         MOVEI   PP,JOBFFI       ;SET TEMP PUSH-DOWN POINTER\r
4374         MOVE    CS,[POINT 7,DBUF,6]     ;INITIALIZE FOR DATE\r
4375         MSTIME  2,              ;GET TIME FROM MONITOR\r
4376         PUSHJ   PP,TIMOUT       ;TIME FORMAT OUTPUT\r
4377         DATE    1,              ;GET DATE\r
4378         IBP     CS              ;PASS OVER PRESET SPACE\r
4379         PUSHJ   PP,DATOUT       ;DATE FORMAT OUTPUT\r
4380         MOVSI   FR,P1!CREFSW\r
4381 CTLSET:\r
4382         MOVSI   IO,IOPALL       ;ZERO FLAGS\r
4383         INIT    CTL,AL          ;INITIALIZE USER CONSOLE\r
4384         SIXBIT  /TTY/\r
4385         XWD     CTOBUF,CTIBUF\r
4386         EXIT                    ;NO TTY, NO ASSEMBLY\r
4387         MOVSI   C,(SIXBIT /TTY/)\r
4388         DEVCHR  C,              ;GET CHARACTERISTICS\r
4389         TLNN    C,10            ;IS IT REALLY A TTY\r
4390         EXIT                    ;NO\r
4391         INBUF   CTL,1           ;INITIALIZE SINGLE CONTROL\r
4392         OUTBUF  CTL,1           ;BUFFERS\r
4393         PUSHJ   PP,CRLF         ;OUTPUT CARRIAGE RETURN - LINE FEED\r
4394         MOVEI   C,"*"\r
4395         IDPB    C,CTOBUF+1\r
4396         OUTPUT  CTL,\r
4397         INPUT   CTL,\r
4398 \r
4399 \fBINSET:        PUSHJ   PP,NAME1        ;GET FIRST NAME\r
4400         TLNN    FR,CREFSW       ;CROSS REF REQUESTED?\r
4401         JRST    LSTSE1          ;YES, SKIP BINARY\r
4402         CAIN    C,","           ;COMMA?\r
4403         JUMPE   ACDEV,LSTSET    ;YES, SKIP BINARY IF NO DEVICE SPECIFIED\r
4404         CAIN    C,"?"           ;LEFT ARROW?\r
4405         JUMPE   ACDEV,LSTSE1    ;YES, SKIP BINARY IF NO DEVICE SPECIFIED\r
4406         JUMPE   ACDEV,M         ;IGNORE IF JUST <CR-LF>\r
4407         TLO     FR,PNCHSW       ;OK, SET SWITCH\r
4408         MOVEM   ACDEV,BINDEV    ;STORE DEVICE NAME\r
4409         MOVEM   ACFILE,BINDIR   ;STORE FILE NAME IN DIRECTORY\r
4410         JUMPN   ACEXT,.+2       ;EXTENSION SPECIFIED?\r
4411         MOVSI   ACEXT,(SIXBIT /REL/)    ;NO, ASSUME RELOCATABLE BINARY\r
4412         MOVEM   ACEXT,BINDIR+1  ;STORE IN DIRECTORY\r
4413         MOVEM   ACPPN,BINDIR+3  ;SET PPN\r
4414         OPEN    BIN,BININI      ;INITIALIZE BINARY\r
4415         JRST    EINIT           ;ERROR\r
4416         TLZE TIO,TIOLE          ;SKIP TO EOT\r
4417         MTAPE BIN,10\r
4418         TLZE    TIO,TIORW       ;REWIND REQUESTED?\r
4419         MTAPE   BIN,1           ;YES\r
4420         JUMPGE  CS,BINSE2       ;BRANCH IF NO BACK-SPACE\r
4421         MTAPE   BIN,17          ;BACK-SPACE A FILE\r
4422         AOJL    CS,.-1          ;TEST FOR END\r
4423         WAIT    BIN,\r
4424         STATO   BIN,1B24        ;LOAD POINT?\r
4425         MTAPE   BIN,16          ;NO, GO FORWARD ONE\r
4426 BINSE2: SOJG    CS,.-1          ;TEST FORWARD SPACING\r
4427 \r
4428         TLNE    TIO,TIOCLD      ;DIRECTORY CLEAR REQUESTED?\r
4429         UTPCLR  BIN,            ;YES, CLEAR IT\r
4430         OUTBUF  BIN,2           ;SET UP TWO RING BUFFER\r
4431         CAIN    C,"?"\r
4432         JRST    GETSET          ;NO LISTING\r
4433 \fLSTSET:        PUSHJ   PP,NAME1        ;GET NEXT DEVICE\r
4434 LSTSE1: CAIE    C,"?"\r
4435         JRST    ERRCM\r
4436         TLNE    FR,CREFSW       ;CROSS-REF REQUESTED?\r
4437         JRST    LSTSE2          ;NO, BRANCH\r
4438         JUMPN   ACDEV,.+2       ;YES, WAS DEVICE SPECIFIED?\r
4439         MOVSI   ACDEV,(SIXBIT /DSK/)    ;NO, ASSUME DSK\r
4440         JUMPN   ACFILE,.+2\r
4441         MOVE    ACFILE,[SIXBIT /CREF/]\r
4442         JUMPN   ACEXT,.+2\r
4443         MOVSI   ACEXT,(SIXBIT /CRF/)   \r
4444 LSTSE2: JUMPE   ACDEV,GETSET    ;FORGET LISTING IF NO DEVICE SPECIFIED\r
4445         MOVE    AC0,ACDEV\r
4446         DEVCHR  AC0,            ;GET CHARACTERISTICS\r
4447         TLNE    AC0,LPTBIT!DISBIT!TTYBIT\r
4448         TLNE    FR,CREFSW       ; WAS CROSS-REF REQUESTED?\r
4449         AOSA    OUTSW+0*TTYSW   ;NO, ASSUME TTY\r
4450         JRST    ERRCM           ;YES, ERROR - CREF DEV MUST NOT BE LPT, DIS, OR TTY\r
4451         TLNE    AC0,CONBIT      ;CONTROLING TELETYPE LISTING?\r
4452         JRST    GETSET          ;YES, BUFFER ALREADY SET\r
4453         MOVEM   ACDEV,LSTDEV    ;STORE DEVICE NAME\r
4454         AOS     OUTSW+0*LPTSW   ;SET FOR LPT\r
4455         MOVEM   ACFILE,LSTDIR   ;STORE FILE NAME\r
4456         JUMPN   ACEXT,.+2\r
4457         MOVSI   ACEXT,(SIXBIT /LST/)\r
4458         MOVEM   ACEXT,LSTDIR+1\r
4459         MOVEM   ACPPN,LSTDIR+3  ;SET PPN\r
4460         OPEN    LST,LSTINI      ;INITIALIZE LISTING OUTPUT\r
4461         JRST    EINIT           ;ERROR\r
4462         TLZE TIO,TIOLE\r
4463         MTAPE LST,10\r
4464         TLZE    TIO,TIORW       ;REWIND REQUESTED?\r
4465         MTAPE   LST,1           ;YES\r
4466         JUMPGE  CS,LSTSE3\r
4467         MTAPE   LST,17\r
4468         AOJL    CS,.-1\r
4469         WAIT    LST,\r
4470         STATO   LST,1B24\r
4471         MTAPE   LST,16\r
4472 LSTSE3: SOJG    CS,.-1\r
4473         TLNE    TIO,TIOCLD      ;DIRECTORY CLEAR REQUESTED?\r
4474         UTPCLR  LST,            ;YES, CLEAR IT\r
4475         OUTBUF  LST,2           ;SET UP A TWO RING BUFFER\r
4476 \fGETSET:        MOVEI   3,PDPERR\r
4477         HRRM    3,JOBAPR        ;SET TRAP LOCATION\r
4478         MOVEI   3,1B19          ;SET FOR PUSH-DOWN OVERFLOW\r
4479         APRENB  3,\r
4480         SOS     3,PDP           ;GET PDP REQUEST MINUS 1\r
4481         IMULI   3,.PDP          ;COMPUTE SIZE (50*<NUMBER OF /P'S +1>)\r
4482         HRLZ    MP,3\r
4483         HRR     MP,JOBFF        ;SET BASIC POINTER\r
4484         MOVE    PP,MP\r
4485         SUB     PP,3\r
4486         MOVEM   PP,RP           ;SET RP\r
4487         SUB     PP,3\r
4488         ASH     3,1             ;DOUBLE SIZE OF BASIC POINTER\r
4489         HRL     PP,3\r
4490         SUBM    PP,3            ;COMPUTE TOP LOCATION\r
4491         SKIPN   UNITOP          ;IF ANY UNIVERSALS HAVE BEEN SEEN\r
4492         JRST    GETSE0          ;NO\r
4493         HRRZS   3               ;GET TOP OF BUFFERS AND STACKS\r
4494         CAMLE   3,UNISIZ        ;HOPE ITS NOT BIGGER THAN UNIVERSAL ONE\r
4495         JRST    UNIERR          ;IT WAS, YOU LOSE\r
4496         SKIPA   3,UNITOP        ;DON'T LOSE THEM\r
4497 GETSE0: HRRZM   3,UNISIZ        ;STORE UNTIL A UNIVERSAL IS SEEN\r
4498         HRRZM   3,LADR          ;SET START OF MACRO TREE\r
4499         HRRZM   3,FREE\r
4500 \r
4501 GETSE1: HRRZ    JOBREL\r
4502         SUBI    1\r
4503         MOVEM   SYMTOP          ;SET TOP OF SYMBOL TABLE\r
4504         SUBI    LENGTH          ;SET POINTER FOR INITIAL SYMBOLS\r
4505         CAMLE   LADR            ;HAVE WE ROOM?\r
4506         JRST    GETSE2          ;YES\r
4507 \r
4508         HRRZ    2,JOBREL        ;NO, TRY FOR MORE CORE\r
4509         ADDI    2,2000\r
4510         CORE    2,\r
4511         JRST    XCEED2  ;NO MORE, INFORM USER\r
4512         JRST    GETSE1          ;TRY AGAIN\r
4513 \r
4514 GETSE2: MOVEM   SYMBOL          ;SET START OF SYMBOL TABLE\r
4515         HRLI    SYMNUM\r
4516         BLT     @SYMTOP         ;STORE SYMBOLS\r
4517         PUSHJ   PP,SRCHI        ;INITIALIZE TABLE\r
4518         MOVE    [XWD CTIBUF+1,CTLSAV]   ;SAVE CONTROL INPUT BUFFER\r
4519         BLT     CTLS1           ;FOR RESCAN ON PASS 2\r
4520 IFN FTDISK,<MOVSI (SIXBIT /DSK/)        ;SET INPUT TO TAKE DSK AS DEV\r
4521         MOVEM ACDEVX>\r
4522         PUSHJ PP,COUTI  ;INIT OUTPUT JUST IN CASE\r
4523         PUSHJ   PP,INSET        ;GET FIRST INPUT FILE\r
4524 \r
4525         MOVE CS,INDIR   ;SET UP NAME OF FIRST FILE\r
4526         MOVEM CS,LSTFIL ;AS LAST PRINTED\r
4527         SETZM   LSTPGN\r
4528         JRST    ASSEMB          ;START ASSEMBLY\r
4529 \fFINIS: CLOSE   BIN,            ;DUMP BUFFER\r
4530         TLNE    FR,PNCHSW       ;PUNCH REQUESTED?\r
4531         PUSHJ   PP,TSTBIN       ;YES, TEST FOR ERRORS\r
4532         RELEAS  BIN,\r
4533         CLOSE   LST,\r
4534         SOSLE   OUTSW+0*LPTSW   ;LPT TYPE OUTPUT?\r
4535         PUSHJ   PP,TSTLST       ;YES, TEST FOR ERRORS\r
4536         RELEAS  LST,\r
4537         RELEAS  CHAR,\r
4538         OUTPUT CTL,0    ;FLUSH TTY OUTPUT\r
4539         SKIPE   UNIVSN          ;SKIP IF NOT ASSEMBLING UNIVERSAL\r
4540         PUSHJ   PP,UNISYM       ;STORE SYMBOLS ETC. FIRST\r
4541         JRST    M               ;RETURN FOR NEXT ASSEMBLY\r
4542 \fINSET: MOVEI   JOBFFI          ;POINTER TO INPUT BUFFER\r
4543         HRRM    JOBFF           ;INFORM SYSTEM OF BUFFER AREA\r
4544         PUSHJ   PP,NAME2        ;GET NEXT COMMAND NAME\r
4545         JUMPE   ACDEV,ERRNE     ;ERROR  IF NONE LEFT\r
4546         MOVEM   ACDEV,INDEV     ;STORE DEVICE\r
4547         MOVEM   ACFILE,INDIR    ;STORE FILE IN DIRECTORY\r
4548         MOVEM   ACPPN,INDIR+3   ;STORE PPN BEFORE WE LOSE IT\r
4549         OPEN    CHAR,INDEVI\r
4550         JRST    EINIT           ;ERROR\r
4551         DEVCHR  ACDEV,          ;TEST CHARACTERISTICS\r
4552         TLNN    ACDEV,MTABIT    ;MAG TAPE?\r
4553         JRST    INSET3          ;NO\r
4554         TLZN    FR,MTAPSW       ;FIRST MAG TAPE IN PASS 2?\r
4555         JRST    INSET1          ;NO\r
4556         TLNN    TIO,TIORW       ;YES, REWIND REQUESTED?\r
4557         SUB     CS,RECCNT       ;NO, PREPARE TO BACK-SPACE TAPE\r
4558 INSET1: AOS     RECCNT          ;INCREMENT FILE COUNTER\r
4559         ADDM    CS,RECCNT       ;UPDATE  COUNT\r
4560         TLZE TIO,TIOLE\r
4561         MTAPE CHAR,10\r
4562         TLZE    TIO,TIORW       ;REWIND?\r
4563         MTAPE   CHAR,1          ;YES\r
4564         JUMPGE  CS,INSET2\r
4565         MTAPE   CHAR,17\r
4566         MTAPE   CHAR,17\r
4567         AOJL    CS,.-1\r
4568         WAIT    CHAR,\r
4569         STATO   CHAR,1B24\r
4570         MTAPE   CHAR,16\r
4571 INSET2: SOJGE   CS,.-1\r
4572 \r
4573 INSET3: INBUF CHAR,1\r
4574         MOVEI ACPNTR,JOBFFI\r
4575         EXCH ACPNTR,JOBFF\r
4576         SUBI ACPNTR,JOBFFI\r
4577         MOVEI ACDEL,NUMBUF*203+1\r
4578         IDIV ACDEL,ACPNTR\r
4579         INBUF CHAR,(ACDEL)\r
4580         JUMPN   ACEXT,INSET4    ;TAKE USER'S EXTENSION IF NON-BLANK\r
4581         MOVSI   ACEXT,(SIXBIT /MAC/)    ;BLANK, TRY .MAC FIRST\r
4582         PUSHJ   PP,INSETI\r
4583 INSET4: PUSHJ   PP,INSETI\r
4584         JUMPE   ACEXT,ERRCF     ;ERROR IF ZERO\r
4585         TLNE    ACDEV,TTYBIT    ;TELETYPE?\r
4586         SETSTS  CHAR,AL         ;YES, CHANGE TO ASCII LINE\r
4587 \f                               ;DO ALL ENTERS HERE FOR LEVEL D\r
4588         SKIPE   ENTERS          ;HAVE ENTERS BEEN DONE ALREADY?\r
4589         JRST    ENTRDN          ;YES, DON'T DO TWICE\r
4590         SKIPN   ACEXT,LSTDEV    ;IS THERE A LIST DEVICE?\r
4591         JRST    LSTSE5          ;NO SO DON'T DO ENTER\r
4592         SKIPN   ACFILE,LSTDIR   ;GET FILE NAME INCASE OF ERROR\r
4593         JRST    [DEVCHR ACEXT,  \r
4594                 TLNE    ACEXT,DIRBIT    ;DOES IT HAVE A DIRECTORY?\r
4595                 JRST    LSTSE4          ;YES, GIVE UP BEFORE HARM IS DONE\r
4596                 SKIPE   ACFILE,INDIR    ;USE INPUT FILE NAME\r
4597                 MOVEM   ACFILE,LSTDIR   ;TOO BAD IF ZERO ALSO\r
4598                 JRST    LSTSE4]\r
4599         HLLZ    ACEXT,LSTDIR+1  ;EXT ALSO\r
4600         MOVE    ACPPN,LSTDIR+3  ;SAVE PPN\r
4601         LOOKUP  LST,LSTDIR      ;PREVIOUS ONE STILL THERE\r
4602         JRST    LSTSE4          ;NO\r
4603         SETZM   LSTDIR          ;YES,CLEAR NAME\r
4604         MOVEM   ACPPN,LSTDIR+3  ;RESET PPN\r
4605         RENAME  LST,LSTDIR\r
4606         CLOSE   LST,            ;IGNORE FAILURE\r
4607         MOVEM   ACFILE,LSTDIR   ;RESTORE NAME\r
4608         HLLZS   LSTDIR+1        ;BH 11/19/74 FOR DATE75.  CLEAR RH.\r
4609         SETZM   LSTDIR+2        ;CLEAR PROTECTION AND DATE\r
4610         MOVEM   ACPPN,LSTDIR+3  ;SET PPN AGAIN\r
4611 LSTSE4: \r
4612 \r
4613         ENTER   LST,LSTDIR      ;SET UP DIRECTORY\r
4614         JRST    ERRCL           ;ERROR\r
4615 LSTSE5: SKIPN   ACEXT,BINDEV    ;A BINARY DEVICE THEN ?\r
4616         JRST    ENTRDN          ;NO\r
4617         SKIPN   ACFILE,BINDIR   ;INCASE OF ERROR\r
4618         JRST    [DEVCHR ACEXT,  \r
4619                 TLNE    ACEXT,DIRBIT    ;DOES IT HAVE A DIRECTORY?\r
4620                 JRST    .+1             ;YES, GIVE UP BEFORE HARM IS DONE\r
4621                 SKIPE   ACFILE,INDIR    ;USE INPUT FILE NAME\r
4622                 MOVEM   ACFILE,BINDIR   ;TOO BAD IF ZERO ALSO\r
4623                 JRST    .+1]\r
4624 \r
4625         HLLZS   ACEXT,BINDIR+1  ;BH 11/19/74 DATE75.  WAS HLLZ.\r
4626         ENTER   BIN,BINDIR      ;ENTER FILE NAME\r
4627         JRST    ERRCB           ;ERROR\r
4628 \r
4629 ENTRDN: SETOM   ENTERS          ;MAKE SURE ONLY DONE ONCE\r
4630         MOVE    CS,[POINT 7,DEVBUF]\r
4631         PUSH    PP,1            ;SAVE THE ACCS\r
4632         PUSH    PP,2\r
4633         PUSH    PP,3\r
4634         SKIPN   2,INDIR         ;GET INPUT NAME\r
4635         JRST    FINDEV          ;FINISHED WITH DEVICE\r
4636         SETZ    1,              ;CLEAR FOR RECEIVING\r
4637         LSHC    1,6             ;SHIFT ONE CHAR. IN\r
4638         ADDI    1,40            ;FORM ASCII\r
4639         IDPB    1,CS            ;STORE CHAR.\r
4640         JUMPN   2,.-4           ;MORE TO DO?\r
4641         MOVEI   1,"     "       ;SEPARATE BY TAB\r
4642         IDPB    1,CS\r
4643         HLLZ    2,INDIR+1       ;GET EXT\r
4644         JUMPE   2,FINEXT        ;NO EXT\r
4645         SETZ    1,\r
4646         LSHC    1,6             ;SAME LOOP AS ABOVE\r
4647         ADDI    1,40\r
4648         IDPB    1,CS\r
4649         JUMPN   2,.-4\r
4650 FINEXT: MOVEI   1,"     "\r
4651         IDPB    1,CS            ;SEPARATE BY TAB\r
4652         LDB     1,[POINT 12,INDIR+2,35] ;GET DATE\r
4653         LDB     2,[POINT 3,INDIR+1,20]  ;BH 11/19/74 DATE75.\r
4654         DPB     2,[POINT 3,1,23]        ;BH 11/19/74 DATE75.\r
4655         JUMPE   1,FINDEV        ;NO DATE?\r
4656         PUSHJ   PP,DATOUT       ;STORE IT\r
4657         LDB     2,[POINT 11,INDIR+2,23] ;GET CREATION TIME\r
4658         JUMPE   2,FINDEV        ;NO TIME (DECTAPE)\r
4659         MOVEI   1," "           ;SEPARATE BY SPACE\r
4660         IDPB    1,CS\r
4661         PUSHJ   PP,TIMOU1       ;STORE TIME\r
4662 FINDEV: SETZ    1,\r
4663         MOVEI   2,"     "       ;FINAL TAB\r
4664         IDPB    2,CS\r
4665         IDPB    1,CS            ;TERMINATE FOR NOW\r
4666         POP     PP,3            ;RESTORE ACCS\r
4667         POP     PP,2\r
4668         POP     PP,1\r
4669         SKIPN   PAGENO          ;IF FIRST TIME THRU\r
4670         JRST    OUTFF           ;START NEW PAGE\r
4671         SETZM PAGENO            ;ON NEW FILE, RESET PAGES\r
4672         JRST    OUTFF2          ;DON'T START NEW PAGE UNLESS FF\r
4673 \r
4674 INSETI: HLLZM   ACEXT,INDIR+1   ;STORE EXTENSION\r
4675         MOVE    ACPPN,INDIR+3   ;SAVE PPN\r
4676         LOOKUP  CHAR,INDIR\r
4677         SKIPA   ACEXT,INDIR+1   ;GET ERROR CODE\r
4678         JRST    CPOPJ1          ;SKIP-RETURN IF FOUND\r
4679         TRNE    ACEXT,-1        ;ERROR CODE OF 0 IS FILE NOT FOUND\r
4680         JRST    ERRCF           ;FILE THERE BUT NOT READABLE\r
4681         SETZ    ACEXT,          ;CLEAR EXT AND TRY AGAIN\r
4682         MOVEM   ACPPN,INDIR+3   ;RESTORE PPN\r
4683         POPJ    PP,\r
4684 \fREC2:  MOVS    [XWD CTIBUF+1,CTLSAV]   ;RESCAN CONTROL (FROM PASS1 END STMNT)\r
4685         BLT     CTIBUF+2        ;INPUT BUFFER\r
4686         MOVEI   "?"\r
4687         HRLM    ACDELX          ;FUDGE PREVIOUS DELIMITER\r
4688         SETZM   PASS2I\r
4689         MOVE    [XWD PASS2I,PASS2I+1]\r
4690         BLT     PASS2X-1                ;ZERO PASS2 VARIABLES\r
4691         TLO     FR,MTAPSW!LOADSW        ;SET FLAGS \r
4692 \r
4693 GOTEND: MOVE    INDEV           ;GET LAST DEVICE\r
4694         DEVCHR                  ;GET ITS CHARACTERISTICS\r
4695         TLNE    4               ;TEST FOR DIRECTORY (DSK OR DTA)\r
4696         JRST    EOT             ;YES, SO DON'T WASTE TIME\r
4697         JRST    .+3             ;NO, INPUT BUFFER BY BUFFER\r
4698         IN      CHAR,\r
4699         JRST    .-1             ;NO ERRORS\r
4700         STATO   CHAR,1B22       ;TEST FOR EOF\r
4701         JRST    .-3             ;IGNORE ERRORS\r
4702 \r
4703 EOT:    PUSHJ   PP,SAVEXS       ;SAVE REGISTERS\r
4704         PUSHJ   PP,INSET        ;GET THE NEXT INPUT DEVICE\r
4705         HRROI   RC,[SIXBIT /END OF PASS 1@/]    ;ASSUME END OF PASS\r
4706         TLZN    FR,LOADSW       ;ZERO ONLY ON END OF PASS 1\r
4707         HRROI   RC,[SIXBIT /LOAD THE NEXT FILE@/]       ;NOT END OF PASS\r
4708         TLNN    ACDEV,(1B13!1B15)       ;WAS ALL THAT WORK NECESSARY?\r
4709         PUSHJ   PP,TYPMSG       ;YES\r
4710 \r
4711 RSTRXS: MOVSI   RC,SAVBLK       ;SET POINTER\r
4712         BLT     RC,RC-1         ;RESTORE REGISTERS\r
4713         MOVE    RC,SAVERC       ;RESTORE RC\r
4714         POPJ    PP,             ;EXIT\r
4715 \r
4716 SAVEXS: MOVEM   RC,SAVERC       ;SAVE RC\r
4717         MOVEI   RC,SAVBLK       ;SET POINTER\r
4718         BLT     RC,SAVBLK+RC-1  ;BLT ALL REGISTERS BELOW RC\r
4719         POPJ    PP,             ;EXIT\r
4720 \fNAME1: SETZM   ACDEVX          ;ENTRY FOR DESTINATION\r
4721 NAME2:  SETZB   ACDEV,INDIR+2   ;ENTRY FOR SOURCE\r
4722         MOVEI   ACFILE,0        ;CLEAR FILE\r
4723         HLRZ    ACDEL,ACDELX    ;GET PREVIOUS DELIMITER\r
4724         SETZB   TIO,CS\r
4725         SETZB   ACEXT,INDIR+3   ;RESET EXTENSION AND PROGRAM-NUMBER PAIR\r
4726         SETZM   PPN             ;CLEAR PPN\r
4727 NAME3:  MOVSI   ACPNTR,(POINT 6,AC0)    ;SET POINTER\r
4728         TDZA    AC0,AC0         ;CLEAR SYMBOL\r
4729 \r
4730 SLASH:  PUSHJ   PP,SW0\r
4731 GETIOC: PUSHJ   PP,TTYIN        ;GET INPUT CHARACTER\r
4732         CAIN    C,"/"\r
4733         JRST    SLASH\r
4734         CAIN    C,"("\r
4735         JRST    SWITCH\r
4736         CAIN    C,":"\r
4737         JRST    DEVICE\r
4738         CAIN    C,"."\r
4739         JRST    NAME\r
4740         CAIE    C,33            ;CHECK FOR THREE FLAVORS OF ALT-MODE\r
4741         CAIN    C,176           ;...\r
4742         JRST    TERM            ;...\r
4743         CAIG    C,CR            ;LESS THAN CR?\r
4744         CAIGE   C,LF            ;AND GREATER THAN LF?\r
4745         CAIN    C,175           ;OR 3RD ALTMOD\r
4746         JRST    TERM            ;YES\r
4747 IFN FTDISK,<CAIN C,"["\r
4748         JRST    PROGNP          ;GET PROGRAMER NUMBER PAIR>\r
4749         CAIN    C,"="           ;EQUALS IS SAME AS LEFT ARROW\r
4750         TRCA    C,142           ;SO MAKE IT A "?" AND SKIP\r
4751         CAIE    C,","\r
4752         CAIN    C,"?"\r
4753         JRST    TERM\r
4754         CAIGE   C,40            ;VALID AS SIXBIT?\r
4755         JRST    [CAIN C,"Z"-100 ;NO,IS IT ?Z\r
4756                 EXIT            ;YES,EXIT FOR BATCH\r
4757                 JRST    GETIOC] ;JUST IGNORE\r
4758         SUBI    C,40            ;CONVERT TO 6-BIT\r
4759         TLNE    ACPNTR,770000   ;HAVE WE STORED SIX BYTES?\r
4760         IDPB    C,ACPNTR        ;NO, STORE IT\r
4761         JRST    GETIOC          ;GET NEXT CHARACTER\r
4762 \r
4763 DEVICE: JUMPN   ACDEV,ERRCM     ;ERROR IF ALREADY SET\r
4764         MOVE    ACDEV,AC0       ;DEVICE NAME\r
4765         JRST    DEVNAM          ;COMMON CODE\r
4766 \r
4767 NAME:   JUMPN   ACFILE,ERRCM    ;ERROR IF ALREADY SET\r
4768         MOVE    ACFILE,AC0      ;FILE NAME\r
4769 DEVNAM: MOVE    ACDEL,C         ;SET DELIMITER\r
4770         JRST    NAME3           ;GET NEXT SYMBOL\r
4771 \r
4772 TERM:   JUMPE   ACDEL,TERM1     ;IF NO PREVIOUS TERMINATOR, THEN FILENAME\r
4773         CAIN    ACDEL,"?"       ;...\r
4774         JRST    TERM1           ;...\r
4775         CAIE    ACDEL,":"       ;IF PREVIOUS DELIMITER\r
4776         CAIN    ACDEL,","       ;WAS COLON OR COMMA\r
4777 TERM1:  MOVE    ACFILE,AC0      ;SET FILE\r
4778         CAIN    ACDEL,"."       ;IF PERIOD,\r
4779         HLLZ    ACEXT,AC0       ;SET EXTENSION\r
4780         HRLM    C,ACDELX        ;SAVE PREVIOUS DELIMITER\r
4781         JUMPN   ACDEV,.+2       ;IF DEVICE SET USE IT\r
4782         SKIPA   ACDEV,ACDEVX    ;OTHERWISE USE LAST DEVICE\r
4783         MOVEM   ACDEV,ACDEVX    ;AND DEVICE\r
4784         MOVE    ACPPN,PPN       ;PUT PPN IN RIGHT PLACE\r
4785 IFN FTDISK,<CAIN C,"!"          ;IMPERATIVE?\r
4786         POPJ    PP,             ;YES, DON'T ASSUME DEV\r
4787         JUMPE   ACFILE,CPOPJ    ;IF THERE IS A FILE,\r
4788         JUMPN   ACDEV,.+2       ;BUT NO DEVICE\r
4789         MOVSI   ACDEV,(SIXBIT /DSK/)    ;THEN ASSUME DISK>\r
4790         POPJ    PP,             ;EXIT\r
4791 \fERRCM: HRROI   RC,[SIXBIT /COMMAND ERROR@/]\r
4792         JRST    ERRFIN\r
4793 \r
4794 IFN FTDISK,<PROGNP:\r
4795 PROGN1: HRLZM   RC,PPN          ;COMMA, STORE LEFT HALF\r
4796 PROGN2: MOVEI   RC,0            ;CLEAR AC\r
4797 PROGN3: PUSHJ   PP,TTYIN\r
4798         CAIN    C,","\r
4799         JRST    PROGN1          ;STORE LEFT HALF\r
4800         HRRM    RC,PPN          ;ASSUME TERMINAL\r
4801         CAIN    C,"]"\r
4802         JRST    GETIOC          ;YES, RETURN TO MAIN SCAN\r
4803         CAIL    C,"0"           ;CHECK FOR VALID NUMBERS\r
4804         CAILE   C,"7"\r
4805         JRST    ERRCM           ;NOT VALID\r
4806         LSH     RC,3            ;SHIFT PREVIOUS RESULT\r
4807         ADDI    RC,-"0"(C)      ;ADD IN NEW NUMBER\r
4808         JRST    PROGN3          ;GET NEXT CHARACTER>\r
4809 \fSWITC0:        PUSHJ   PP,SW1          ;PROCESS CHARACTER\r
4810 SWITCH: PUSHJ   PP,TTYIN        ;GET NEXT CHARACTER\r
4811         CAIE    C,")"           ;END OF STRING?\r
4812         JRST    SWITC0          ;NO\r
4813         JRST    GETIOC          ;YES\r
4814 \r
4815 SW0:    PUSHJ   PP,TTYIN\r
4816 SW1:    MOVEI   C,-"A"(C)       ;CONVERT FROM ASCII TO NUMERIC\r
4817         CAILE   C,"Z"-"A"       ;WITHIN BOUNDS? (IS IT ALPHA?)\r
4818         JRST    ERRCM           ;NO, ERROR\r
4819         MOVE    RC,[POINT 4,BYTAB]\r
4820         IBP     RC\r
4821         SOJGE   C,.-1           ;MOVE TO PROPER BYTE\r
4822         LDB     C,RC            ;PICK UP BYTE\r
4823         JUMPE   C,ERRCM         ;TEST FOR VALID SWITCH\r
4824         CAIG    C,SWTABT-SWTAB  ;LEGAL ON SOURCE?\r
4825         JUMPL   PP,ERRCM        ;NO, TEST FOR SOURCE\r
4826         LDB     RC,[POINT 4,SWTAB-1(C),12]\r
4827         CAIN    RC,IO\r
4828         SKIPN   CTLSAV          ;IF PASS2 OR IO SWITCH,\r
4829         XCT     SWTAB-1(C)      ;EXECUTE INSTRUCTION\r
4830         POPJ    PP,             ;EXIT\r
4831         TLZ     IO,IOSALL       ;TAKE CARE OF /X\r
4832         POPJ    PP,\r
4833 \r
4834 DEFINE HELP (TEXT)<\r
4835         XLIST\r
4836         ASCIZ ?TEXT?\r
4837         LIST>\r
4838 \r
4839 HLPMES: HELP <\r
4840 Switches are :-\r
4841 /A advance one file\r
4842 /B backspace one file\r
4843 /C produce a cref listing\r
4844 /E list macro expansions (LALL)\r
4845 /F list in new format (.MFRMT)\r
4846 /G list in old format (.HWFRMT)\r
4847 /H type this text\r
4848 /L reinstate listing (LIST)\r
4849 /M suppress ascii in macro and repeat expansion (SALL)\r
4850 /N suppress error printout on tty\r
4851 /O set MLOFF pseudo-op\r
4852 /P increase size of the pushdown stack\r
4853 /Q suppress Q errors on the listing\r
4854 /S suppress listing (XLIST)\r
4855 /T rewind device\r
4856 /X suppress all macro expansions (XALL)\r
4857 /Z zero the directory\r
4858 Switches A,B,C,T,W,X, and Z must immediately follow\r
4859 the device or file to which they refer.\r
4860 >\r
4861 \f       DEFINE  SETSW   (LETTER,INSTRUCTION) <  INSTRUCTION\r
4862 J=      <"LETTER"-"A">-?D9*<I=<"LETTER"-"A">/?D9>\r
4863         SETCOD  \I,J>\r
4864 \r
4865         DEFINE  SETCOD          (I,J)\r
4866         <BYTAB'I=BYTAB'I!<.-SWTAB>B<4*J+3>>\r
4867 \r
4868 BYTAB0= 0                       ;INITIALIZE TABLE\r
4869 BYTAB1= 0\r
4870 BYTAB2= 0\r
4871 \r
4872 SWTAB:\r
4873         SETSW   Z,<TLO  TIO,TIOCLD      >\r
4874         SETSW   C,<TLZ  FR,CREFSW       >\r
4875         SETSW   P,<SOS  PDP             >\r
4876 SWTABT:                         ;THE ABOVE SW'S ARE LEGAL ON OUTPUT ONLY\r
4877         SETSW   A,<ADDI CS,1            >\r
4878         SETSW   B,<SUBI CS,1            >\r
4879         SETSW   E,<TLZ  IO,IOPALL!IOSALL        >\r
4880 IFN FORMSW,<    SETSW   F,<SETZM        HWFMT>\r
4881                 SETSW   G,<SETOM        HWFMT>>\r
4882         SETSW   H,<OUTSTR       HLPMES>\r
4883         SETSW   L,<TLZ  IO,IOMSTR       >\r
4884         SETSW   M,<TLO  IO,IOPALL!IOSALL        >\r
4885         SETSW   N,<HLLOS   TYPERR       >\r
4886         SETSW   O,<XCT  OFFML           >\r
4887         SETSW   Q,<TLO  FR,ERRQSW       >\r
4888         SETSW   S,<TLO  IO,IOMSTR       >\r
4889         SETSW   T,<TLO  TIO,TIOLE       >\r
4890         SETSW   W,<TLO  TIO,TIORW       >\r
4891         SETSW   X,<TLOA IO,IOPALL       >\r
4892 \r
4893 BYTAB:                          ;BYTAB CONTAINS AN INDEX TO SWTAB\r
4894                                 ;IT CONSIST OF 9 4BIT BYTES/WORD\r
4895                                 ;OR ONE BYTE FOR EACH LETTER\r
4896 \r
4897         +BYTAB0                 ;A-I    BYTE = 1 THROUGH 17 = INDEX\r
4898         +BYTAB1                 ;J-R    BYTE = 0 = COMMAND ERROR\r
4899         +BYTAB2                 ;S-Z\r
4900 \r
4901 IF2,<PURGE I,J,BYTAB0,BYTAB1,BYTAB2>\r
4902 \fTTYIN: SOSGE   CTIBUF+2        ;ENUF CHAR.?\r
4903         JRST    TTYERR          ;NO\r
4904         ILDB    C,CTIBUF+1      ;GET CHARACTER\r
4905         CAIE    C," "           ;SKIP BLANKS\r
4906         CAIN    C,HT            ;AND TABS\r
4907         JRST    TTYIN\r
4908         CAIN    C,15            ;CR?\r
4909         SETZM   CTIBUF+2        ;YES,IGNORE REST OF LINE\r
4910         CAIG C,"Z"+40           ;CHECK FOR LOWER CASE\r
4911         CAIGE C,"A"+40\r
4912         POPJ    PP,             ;NO,EXIT\r
4913         SUBI C,40\r
4914         POPJ    PP,             ;YES, EXIT\r
4915 \r
4916 TTYERR: SKIPN   INDEV           ;INPUT DEVICE SEEN?\r
4917         JRST    ERRCM           ;NO, SO MISSING "?"\r
4918 ERRNE:  HRROI   RC,[SIXBIT /?NO END STATEMENT ENCOUNTERED ON INPUT FILE@/]\r
4919 ERRNE0: SKPINC  V       ;SEE IF WE CAN INPUT A CHAR.\r
4920           JFCL          ;BUT ONLY TO DEFEAT ?O\r
4921         PUSHJ PP,TYPMSG ;OUTPUT IT\r
4922         SKIPE LITLVL    ;SEE IF IN LITERAL\r
4923         SKIPN   LITPG   ;PAGE 0 MEANS NOT IN A LITERAL REALY\r
4924         JRST ERRNE1     ;NO, TRY OTHERS\r
4925         MOVE V,[XWD [SIXBIT /IN LITERAL@/],LITPG]\r
4926         PUSHJ PP,PRNUM  ;GO PRINT INFORMATION\r
4927 ERRNE1: MOVEI V,0       ;CHECK FOR OTHER PLACES\r
4928         SKIPE INDEF\r
4929         MOVE V,[XWD [SIXBIT /IN DEFINE@/],DEFPG]\r
4930         SKIPE INTXT\r
4931         MOVE V,[XWD [SIXBIT /IN TEXT@/],TXTPG]\r
4932         SKIPE INREP\r
4933         MOVE V,[XWD [SIXBIT /IN CONDITIONAL OR REPEAT@/],REPPG]\r
4934         SKIPE INCND\r
4935         MOVE V,[XWD [SIXBIT /IN CONDITIONAL@/],CNDPG]\r
4936         SKIPGE MACENL\r
4937 ERRNE2: MOVE V,[XWD [SIXBIT /IN MACRO CALL@/],CALPG]\r
4938         JUMPN V,ERRNE3\r
4939         SKIPN   LITLVL          ;HAD ONE PAGE NUMBER ALREADY\r
4940         SKIPA   V,[XWD [SIXBIT /@/],PAGENO]     ;BETTER THAN NOTHING\r
4941         JRST    .+2\r
4942 ERRNE3: PUSHJ PP,PRNUM\r
4943         HRROI RC,[SIXBIT /@/]   ;WILL GET A RETURN\r
4944         JRST ERRFIN\r
4945 \r
4946 ERRMS1: SIXBIT / ERRORS DETECTED@/\r
4947 ERRMS2: SIXBIT /?1 ERROR DETECTED@/\r
4948 ERRMS3: SIXBIT /NO ERRORS DETECTED@/\r
4949 EINIT:  MOVE    RC,[XWD ACDEV,[SIXBIT /NOT AVAILABLE@/]]\r
4950         JRST    ERRFIN\r
4951 \fERRCL: HRRZ    RC,LSTDIR+1     ;GET LST DEV ERROR CODE\r
4952         JRST    .+2             ;GET ERROR MESSAGE\r
4953 ERRCB:  HRRZ    RC,BINDIR+1     ;GET BIN DEV ERROR CODE\r
4954         JUMPN   RC,ERRTYP\r
4955         SOJA    RC,ERRTYP       ;SPECIAL CASE IF ERROR CODE 0\r
4956 \r
4957 ERRCF:  HRRZ    RC,INDIR+1      ;GET INPUT DEV ERROR CODE\r
4958         HLLZ    ACEXT,INDIR+1   ;SET UP EXT\r
4959 \r
4960 ERRTYP: CAIL    RC,TABLND-TABLE ;IS ERROR CODE LEGAL?\r
4961         SKIPA   RC,TABLND       ;NO, GIVE CATCH ALL MESSAGE\r
4962         MOVE    RC,TABLE(RC)    ;YES, PICK UP MESSAGE\r
4963 \r
4964 ERRFIN: SKPINC  C               ;SEE IN WE CAN INPUT A CHAR.\r
4965           JFCL                  ;BUT ONLY TO DEFEAT ?O\r
4966         PUSHJ   PP,CRLF\r
4967         MOVEI   C,"?"\r
4968         PUSHJ   PP,TYO\r
4969         PUSHJ   PP,TYPMS1\r
4970         CLOSE   LST,            ;GIVE USER A PARTIAL LISTING\r
4971         CLOSE   BIN,40          ;BUT NEVER A BUM REL FILE\r
4972         JRST    M\r
4973 \r
4974         [SIXBIT /(0) ILLEGAL FILE NAME@/],,ACFILE\r
4975 TABLE:  [SIXBIT /(0) FILE WAS NOT FOUND@/],,ACFILE\r
4976         [SIXBIT /(1) NO DIRECTORY FOR PROJECT-PROGRAMMER NUMBER@/],,ACFILE\r
4977         [SIXBIT /(2) PROTECTION FAILURE@/],,ACFILE\r
4978         [SIXBIT /(3) FILE WAS BEING MODIFIED@/],,ACFILE\r
4979         [SIXBIT /(4) RENAME FILE NAME ALREADY EXISTS@/],,ACFILE\r
4980         [SIXBIT /(5) ILLEGAL SEQUENCE OF UUOS@/],,ACFILE\r
4981         [SIXBIT /(6) BAD UFD OR BAD RIB@/],,ACFILE\r
4982         [SIXBIT /(7) NOT A SAV FILE@/],,ACFILE\r
4983         [SIXBIT /(10) NOT ENOUGH CORE@/],,ACFILE\r
4984         [SIXBIT /(11) DEVICE NOT AVAILABLE@/],,ACFILE\r
4985         [SIXBIT /(12) NO SUCH DEVICE@/],,ACFILE\r
4986         [SIXBIT /(13) NOT TWO RELOC REG. CAPABILITY@/],,ACFILE\r
4987         [SIXBIT /(14) NO ROOM OR QUOTA EXCEEDED@/],,ACFILE\r
4988         [SIXBIT /(15) WRITE LOCK ERROR@/],,ACFILE\r
4989         [SIXBIT /(16) NOT ENOUGH MONITOR TABLE SPACE@/],,ACFILE\r
4990         [SIXBIT /(17) PARTIAL ALLOCATION ONLY@/],,ACFILE\r
4991         [SIXBIT /(20) BLOCK NOT FREE ON ALLOCATION@/],,ACFILE\r
4992         [SIXBIT /(21) CAN'T SUPERSEDE (ENTER) AN EXISTING DIRECTORY@/],,ACFILE\r
4993         [SIXBIT /(22) CAN'T DELETE (RENAME) A NON-EMPTY DIRECTORY@/],,ACFILE\r
4994         [SIXBIT /(23) SFD NOT FOUND@/],,ACFILE\r
4995         [SIXBIT /(24) SEARCH LIST EMPTY@/],,ACFILE\r
4996         [SIXBIT /(25) SFD NESTED TOO DEEPLY@/],,ACFILE\r
4997         [SIXBIT /(26) NO-CREATE ON FOR SPECIFIED PATH@/],,ACFILE\r
4998 \r
4999 TABLND: [SIXBIT /(?) LOOKUP, ENTER, OR RENAME ERROR@/],,ACFILE\r
5000 \fTYPMSG:        PUSHJ   PP,CRLF         ;MOVE TO NEXT LINE\r
5001 TYPMS1: HLRZ    CS,RC           ;GET FIRST MESSAGE\r
5002         CAIE    CS,-1           ;SKIP IF MINUS ONE\r
5003         PUSHJ   PP,TYPM2        ;TYPE MESSAGE\r
5004         HRRZ    CS,RC           ;GET SECOND HALF\r
5005         PUSHJ   PP,TYPM2\r
5006 \r
5007 CRLF:   MOVEI   C,CR            ;OUTPUT CARRIAGE RETURN\r
5008         PUSHJ   PP,TYO\r
5009         MOVEI   C,LF            ;AND LINE FEED\r
5010 \r
5011 TYO:    SOSG    CTOBUF+2        ;BUFFER FULL?\r
5012         OUTPUT  CTL,0           ;YES, DUMP IT\r
5013         IDPB    C,CTOBUF+1      ;STORE BYTE\r
5014         CAIG    C,FF            ;FORM FEED?\r
5015         CAIGE   C,LF            ;V TAB OR LINE FEED?\r
5016         POPJ    PP,             ;NO\r
5017         OUTPUT  CTL,0           ;YES\r
5018         POPJ    PP,             ;AND EXIT\r
5019 \r
5020 TYPM2:  MOVSI   C,(1B0)         ;ANTICIPATE REGISTER WORD\r
5021         CAIN    CS,ACFILE       ;FILE NAME ?\r
5022         JRST    [JUMPE  ACEXT,.+1       ;YES, TEST FOR EXT\r
5023                 LSH     ACEXT,-6        ;MAKE SPACE FOR "."\r
5024                 IOR     ACEXT,[SIXBIT /.   @/]\r
5025                 JRST    TYPM2A]\r
5026         CAIG    CS,17           ;IS IT?\r
5027         MOVEM   C,1(CS)\r
5028 TYPM2A: HRLI    CS,(POINT 6,,)  ;FORM BYTE POINTER\r
5029 \r
5030 TYPM3:  ILDB    C,CS            ;GET A SIXBIT BYTE\r
5031         CAIN    C,40            ;"@"?\r
5032         JRST    TYO             ;YES, TYPE SPACE AND EXIT\r
5033         ADDI    C,40            ;NO, FORM 7-BIT ASCII\r
5034         PUSHJ   PP,TYO          ;OUTPUT CHARACTER\r
5035         JRST    TYPM3\r
5036 \r
5037 \fXCEEDS:        ADDI SX,2000            ;ADJUST SYMBOL POINTER\r
5038 XCEED:  PUSHJ   PP,SAVEXS       ;SAVE THE REGISTERS\r
5039         HRRZ    1,JOBREL        ;GET CURRENT TOP\r
5040         MOVEI   0,2000(1)\r
5041         CORE    0,              ;REQUEST MORE CORE\r
5042         JRST    XCEED2          ;ERROR, BOMB OUT\r
5043         HRRZ    2,JOBREL        ;GET NEW TOP\r
5044 \r
5045 XCEED1: MOVE    0,0(1)          ;GET ORIGIONAL\r
5046         MOVEM   0,0(2)          ;STORE IN NEW LOCATION\r
5047         SUBI    2,1             ;DECREMENT UPPER\r
5048         CAMLE   1,SYMBOL        ;HAVE WE ARRIVED?\r
5049         SOJA    1,XCEED1        ;NO, GET ANOTHER\r
5050         MOVEI   1,2000\r
5051         ADDM    1,SYMBOL\r
5052         ADDM    1,SYMTOP\r
5053         PUSHJ   PP,SRCHI        ;RE-INITIALIZE SYMBOL TABLE\r
5054         JRST    RSTRXS          ;RESTORE REGISTERS AND EXIT\r
5055 \r
5056 XCEED2: HRROI   RC,[SIXBIT /INSUFFICIENT CORE@/]\r
5057         JRST    ERRNE0\r
5058 PDPERR: HRROI   RC,[SIXBIT .PDP OVERFLOW, TRY /P@.]\r
5059         JRST    ERRNE0\r
5060 \r
5061 PRNUM:  HLRZ CS,V       ;GET MESSAGE\r
5062         PUSHJ PP,TYPM2\r
5063         MOVEI   CS,[SIXBIT /ON PAGE@/]\r
5064         PUSHJ   PP,TYPM2\r
5065         MOVE AC0,(V)    ;GET PAGE\r
5066         PUSHJ PP,DP1    ;PRINT NUMBER\r
5067         MOVEI C,40\r
5068         PUSHJ PP,TYO\r
5069         SKIPN AC1,1(V)  ;GET SEQ NUM IF THERE\r
5070         POPJ PP,        ;NO, RETURN\r
5071         MOVEM AC1,OUTSQ\r
5072         MOVEI   CS,[SIXBIT /LINE@/]\r
5073         PUSHJ   PP,TYPM2\r
5074         MOVEI AC0,OUTSQ ;PRINT IT\r
5075         OUTPUT CTL,0    ;TO MAKE THINGS PRINT IN RIGHT ORDER\r
5076         DDTOUT AC0,\r
5077         MOVEI C,40\r
5078         JRST TYO        ;AND RETURN\r
5079 \r
5080 DP1:    IDIVI AC0,?D10\r
5081         HRLM AC1,(PP)\r
5082         JUMPE   AC0,.+2\r
5083         PUSHJ PP,DP1\r
5084         HLRZ C,(PP)\r
5085         ADDI C,"0"\r
5086         JRST TYO\r
5087 \fRIM0:  TDO     FR,AC0          ;SET RIM/RIM10 FLAG\r
5088         TLNE    FR,PNCHSW       ;FORGET IT IF PUNCH RESET\r
5089         SETSTS  BIN,IB          ;SET TO IMAGE BINARY MODE\r
5090         POPJ    PP,\r
5091 \r
5092 ROUT:   EXCH CS,RIMLOC\r
5093         SUB PP,[XWD 1,1]        ;CLEAR OUT STACK WFW\r
5094         TLNE FR,R1BSW\r
5095         JRST ROUT6\r
5096         TLNN    FR,RIM1SW\r
5097         JRST    ROUT1\r
5098         JUMPE   CS,ROUT1        ;RIM10 OUTPUT\r
5099         SUB     CS,RIMLOC\r
5100         JUMPE   CS,ROUT1\r
5101         JUMPG   CS,ERRAX\r
5102         MOVEI   C,0\r
5103         PUSHJ   PP,PTPBIN\r
5104         AOJL    CS,.-1\r
5105 ROUT1:  MOVSI   C,(DATAI PTR,)  ;RIM OUTPUT\r
5106         HRR C,LOCO              ;GET ADDRESS\r
5107         TLNE    FR,RIM1SW       ;NO DATAI IF RIM10\r
5108         AOSA    RIMLOC\r
5109         PUSHJ   PP,PTPBIN       ;OUTPUT\r
5110         MOVE    C,AC0           ;CODE\r
5111         AOSA    LOCO            ;INCREMENT CURRENT LOCATION\r
5112 \r
5113 OUTBIN: TLNN    FR,RIMSW!RIM1SW!R1BSW   ;EXIT IF RIM MODE\r
5114 PTPBIN: TLNN    FR,PNCHSW       ;EXIT IF PUNCH NOT REQUESTED\r
5115         POPJ    PP,\r
5116         SOSG    BINBUF+2        ;TEST FOR BUFFER FULL\r
5117         PUSHJ   PP,DMPBIN       ;YES, DUMP IT\r
5118         IDPB    C,BINBUF+1      ;DEPOSIT BYTE\r
5119         POPJ    PP,             ;EXIT\r
5120 \r
5121 \fDMPBIN:        OUT     BIN,0           ;DUMP THE BUFFER\r
5122         POPJ    PP,             ;NO ERRORS\r
5123 TSTBIN: GETSTS  BIN,C           ;GET STSTUS BITS\r
5124         TRNN    C,ERRBIT        ;ERROR?\r
5125         POPJ    PP,             ;NO, EXIT\r
5126         MOVE    AC0,BINDEV      ;YES, GET TAG\r
5127         JRST    ERRLST          ;TYPE MESSAGE AND ABORT\r
5128 \r
5129 DMPLST: OUT     LST,0           ;OUTPUT BUFFER\r
5130         POPJ    PP,             ;NO ERRORS\r
5131 TSTLST: GETSTS  LST,C           ;ANY ERRORS?\r
5132         TRNN    C,ERRBIT\r
5133         POPJ    PP,             ;NO, EXIT\r
5134         MOVE    AC0,LSTDEV\r
5135 ERRLST: MOVSI   RC,[SIXBIT /OUTPUT WRITE-LOCK ERROR DEVICE@/]\r
5136         TRNE    C,IOIMPM        ;IMPROPER MODE?\r
5137         JRST    ERRFIN          ;YES\r
5138         MOVSI   RC,[SIXBIT /OUTPUT DATA ERROR DEVICE@/]\r
5139         TRNE    C,IODERR        ;DEVICE DATA ERROR?\r
5140         JRST    ERRFIN          ;YES\r
5141         MOVSI   RC,[SIXBIT /OUTPUT CHECKSUM OR PARITY ERROR DEVICE@/]\r
5142         TRNE    C,IODTER        ;IS IT\r
5143         JRST    ERRFIN          ;YES\r
5144         MOVE    CS,AC0          ;GET DEVICE\r
5145         DEVCHR  CS,             ;FIND OUT WHAT IT IS\r
5146         MOVSI   RC,[SIXBIT /OUTPUT QUOTA EXCEEDED ON DEVICE@/]\r
5147         TLNN    CS,DSKBIT       ;SKIP IF DSK OUTPUT\r
5148         MOVSI   RC,[SIXBIT /OUTPUT BLOCK TOO LARGE DEVICE@/]\r
5149         JRST    ERRFIN\r
5150 \f       \r
5151 R1BDMP: SETCM CS,R1BCNT\r
5152         JUMPE CS,R1BI\r
5153         HRLZS C,CS\r
5154         HRR C,R1BLOC\r
5155         HRRI C,-1(C)\r
5156         MOVEM C,R1BCHK\r
5157         PUSHJ PP,PTPBIN\r
5158         HRRI CS,R1BBLK\r
5159 R1BDM1: MOVE C,0(CS)\r
5160         ADDM C,R1BCHK\r
5161         PUSHJ PP,PTPBIN\r
5162         AOBJN CS,R1BDM1\r
5163         MOVE C,R1BCHK\r
5164         PUSHJ PP,PTPBIN\r
5165 R1BI:   SETOM R1BCNT\r
5166         PUSH PP,LOCO\r
5167         POP PP,R1BLOC\r
5168         POPJ PP,\r
5169 \r
5170 ROUT6:  CAME CS,RIMLOC\r
5171         PUSHJ PP,R1BDMP\r
5172         AOS C,R1BCNT\r
5173         MOVEM AC0,R1BBLK(C)\r
5174         AOS LOCO\r
5175         CAIN C,.R1B-1\r
5176         PUSHJ PP,R1BDMP\r
5177         AOS RIMLOC\r
5178         POPJ PP,\r
5179         \r
5180 \r
5181 \fREAD0: PUSHJ   PP,EOT          ;END OF TAPE\r
5182 \r
5183 READ:   SOSGE   IBUF+2          ;BUFFER EMPTY?\r
5184         JRST    READ3           ;YES\r
5185 READ1:  ILDB    C,IBUF+1        ;PLACE CHARACTER IN C\r
5186         MOVE CS,@IBUF+1         ;CHECK FOR SEQUENCE NUMBER\r
5187         TRNN CS,1\r
5188         JRST READ1A\r
5189         CAIN CS,1               ;CHECK FOR SPECIAL\r
5190         MOVE CS,[<ASCII/     />+1]\r
5191         MOVEM CS,SEQNO\r
5192         MOVEM CS,SEQNO2\r
5193         MOVNI CS,4\r
5194         ADDM CS,IBUF+2          ;ADJUST WORD COUNT\r
5195 REPEAT 4,<      IBP IBUF+1>     ;SKIP SEQ NO\r
5196         PUSHJ PP,READ   ;AND THE TAB\r
5197         JRST    READ            ;GET NEXT CHARACTER\r
5198 \r
5199 READ1A: JUMPE   C,READ          ;IGNORE NULL\r
5200         CAIN    C,32            ;IF IT'S A "?Z"\r
5201         MOVEI   C,LF            ;TREAT IT AS A "LF"\r
5202         CAIE    C,37            ;CONTROL ?\r
5203         POPJ    PP,\r
5204         MOVEI   C,"?"           ;MAKE CONTROL-SHIFT ? VISIBLE\r
5205         PUSHJ   PP,RSW2\r
5206         MOVEI   C,"?"\r
5207         PUSHJ   PP,RSW2\r
5208 READ2:  PUSHJ   PP,READ         ;YES, TEST FOR LINE FEED\r
5209         PUSHJ   PP,RSW2         ;LIST IN ANY EVENT\r
5210         CAIG    C,FF            ;IS IT ONE OF\r
5211         CAIGE   C,LF            ;LF, VT, OR FF?\r
5212         JRST    READ2           ;NO\r
5213         PUSHJ   PP,OUTIM1       ;YES, DUMP THE LINE\r
5214         JRST    READ            ;RETURN NEXT CHARACTER\r
5215 \r
5216 READ3:  IN      CHAR,0          ;GET NEXT BUFFER\r
5217         JRST    READ            ;NO ERRORS\r
5218         GETSTS  CHAR,C\r
5219         TRNN    C,ERRBIT!2000   ;ERRORS?\r
5220         JRST    READ0           ;EOF\r
5221         MOVE    AC0,INDEV\r
5222         MOVSI   RC,[SIXBIT/ INPUT PHYSICAL END OF TAPE DEVICE@/]\r
5223         TRNE    C,2000\r
5224         JRST    ERRFIN          ;E-O-T\r
5225         MOVSI   RC,[SIXBIT /MONITOR DETECTED SOFTWARE INPUT ERROR DEVICE@/]\r
5226         TRNE    C,IOIMPM        ;IMPROPER MODE?\r
5227         JRST    ERRFIN          ;YES\r
5228         MOVSI   RC,[SIXBIT /INPUT DATA ERROR DEVICE@/]\r
5229         TRNE    C,IODERR        ;DEVICE DATA ERROR?\r
5230         JRST    ERRFIN          ;YES\r
5231         MOVSI   RC,[SIXBIT /INPUT CHECKSUM OR PARITY ERROR DEVICE@/]\r
5232         TRNN    C,IODTER\r
5233         MOVSI   RC,[SIXBIT /INPUT BLOCK TOO LARGE DEVICE@/]\r
5234         JRST    ERRFIN\r
5235 \r
5236 \fOUTAB2:        PUSHJ   PP,OUTTAB       ;PRINT TWO TABS\r
5237 OUTTAB: MOVEI   C,HT\r
5238 PRINT:  CAIE    C,CR            ;IS THIS A CR?\r
5239         CAIN    C,LF            ;OR LF?\r
5240         JRST    OUTCR           ;YES, GO PROCESS\r
5241         CAIN    C,FF            ;FORM FEED?\r
5242         JRST    OUTFF           ;YES, FORCE NEW PAGE\r
5243         JRST    OUTL\r
5244 \r
5245 OUTCR:  TRNN    ER,ERRORS!LPTSW!TTYSW\r
5246         POPJ    PP,\r
5247         MOVEI   C,CR            ;CARRIAGE RETURN, LINE FEED\r
5248         PUSHJ   PP,OUTL\r
5249         SOSGE   LPP             ;END OF PAGE?\r
5250         TLO     IO,IOPAGE       ;YES, SET FLAG\r
5251         TRCA    C,7             ;FORM LINE FEED AND SKIP\r
5252 \r
5253 OUTL:   TLZN    IO,IOPAGE       ;NEW PAGE REQUESTED?\r
5254         JRST    OUTC            ;NO\r
5255         JUMP1   OUTC            ;YES, BYPASS IF PASS ONE\r
5256         PUSH    PP,C            ;SAVE C AND CS\r
5257         PUSH    PP,CS\r
5258         PUSH    PP,ER\r
5259         TLNN    IO,IOMSTR!IOPROG\r
5260         HRR     ER,OUTSW\r
5261         TLNE    IO,IOCREF       ;IF DOING CREF OUTPUT NOW\r
5262         TLNE    FR,CREFSW       ;AND CREFFING (JUST IN CASE)\r
5263         JRST    .+2\r
5264         PUSHJ   PP,CLSC3        ;CLOSE IT OUT\r
5265         HLLM    IO,(PP)         ;SAVE THIS NEW STATE OF IO\r
5266         MOVEI   C,.LPP\r
5267         MOVEM   C,LPP           ;SET NEW COUNTER\r
5268         MOVEI   C,CR\r
5269         PUSHJ   PP,OUTC\r
5270         MOVEI   C,FF\r
5271         PUSHJ   PP,OUTC         ;OUTPUT FORM FEED\r
5272         MOVEI   CS,TBUF\r
5273         PUSHJ   PP,OUTAS0       ;OUTPUT TITLE\r
5274         MOVEI   CS,VBUF\r
5275         PUSHJ   PP,OUTAS0       ;OUTPUT VERSION\r
5276         MOVEI   CS,DBUF\r
5277         PUSHJ   PP,OUTAS0       ; AND DATE\r
5278         MOVE    C,PAGENO\r
5279         PUSHJ   PP,DNC          ;OUTPUT PAGE NUMBER\r
5280         AOSG    PAGEN.          ;FIRST PAGE OF THIS NUMBER?\r
5281         JRST    OUTL1           ;YES\r
5282         MOVEI   C,"-"           ;NO, PUT OUT MODIFIER\r
5283         PUSHJ   PP,OUTC\r
5284         MOVE    C,PAGEN.\r
5285         PUSHJ   PP,DNC\r
5286 OUTL1:  PUSHJ   PP,OUTCR\r
5287         MOVEI CS,DEVBUF\r
5288         PUSHJ PP,OUTAS0\r
5289         HRRZ    CS,SUBTTX       ;SWITCH FOR SUB-TITLE\r
5290         SKIPE   0(CS)           ;IS THERE A SUB-TITLE?\r
5291         PUSHJ   PP,OUTTAB       ;YES, OUTPUT A TAB\r
5292         PUSHJ   PP,SOUT20       ;OUTPUT ASCII WITH CARRIAGE RETURN\r
5293         PUSHJ   PP,OUTCR\r
5294         POP     PP,ER\r
5295         POP     PP,CS           ;RESTORE REGISTERS\r
5296         POP     PP,C\r
5297 \r
5298 OUTC:   TRNE    ER,ERRORS!TTYSW\r
5299         PUSHJ   PP,TYO\r
5300         TRNN    ER,LPTSW\r
5301         POPJ    PP,\r
5302 OUTLST: SOSG    LSTBUF+2        ;BUFFER FULL?\r
5303         PUSHJ   PP,DMPLST       ;YES, DUMP IT\r
5304 COMMENT $ REG DOESN'T LIKE THIS FEATURE ANY MORE 9-5-72\r
5305 $\r
5306         IDPB    C,LSTBUF+1      ;STORE BYTE\r
5307         POPJ    PP,             ;EXIT\r
5308 \r
5309 \fPAGE0: PUSHJ   PP,STOUTS       ;PAGE PSEUDO-OP\r
5310 OUTFF1: TLNE    IO,IOCREF       ;CURRENTLY DOING CREF?\r
5311         TLNE    IO,IOPROG       ;AND NOT XLISTED?\r
5312         JRST    OUTFF           ;NO\r
5313         HRR     ER,OUTSW\r
5314         PUSHJ   PP,CLSCRF\r
5315         PUSHJ   PP,OUTCR\r
5316         HRRI    ER,0\r
5317 OUTFF:  TLO     IO,IOPAGE\r
5318 OUTFF2: SETOM   PAGEN.\r
5319         AOS     PAGENO\r
5320         POPJ    PP,\r
5321 \r
5322 TIMOUT: IDIVI   2,?D60*?D1000\r
5323 TIMOU1: IDIVI   2,?D60\r
5324         PUSH    PP,3            ;SAVE MINUTES\r
5325         PUSHJ   PP,OTOD         ;STORE HOURS\r
5326         MOVEI   3,":"           ;SEPARATE BY COLON\r
5327         IDPB    3,CS\r
5328         POP     PP,2            ;STORE MINUTES\r
5329 OTOD:   IDIVI   2,?D10\r
5330         ADDI    2,60            ;FORM ASCII\r
5331         IDPB    2,CS\r
5332         ADDI    3,60\r
5333         IDPB    3,CS\r
5334         POPJ    PP,\r
5335 \r
5336 DATOUT: IDIVI   1,?D31          ;GET DAY\r
5337         ADDI    2,1\r
5338         CAIG    2,?D9           ;TWO DIGITS?\r
5339         ADDI    2,7760*?D10     ;NO, PUT IN SPACE\r
5340         PUSHJ   PP,OTOD         ;STORE DAY\r
5341         IDIVI   1,?D12          ;GET MONTH\r
5342         MOVE    2,DTAB(2)       ;GET MNEMONIC\r
5343         IDPB    2,CS            ;DEPOSIT RIGHT MOST 7 BITS\r
5344         LSH     2,-7            ;SHIFT NEXT IN\r
5345         JUMPN   2,.-2           ;DEPOSIT IFIT EXISTS\r
5346         MOVEI   2,?D64(1)       ;GET YEAR\r
5347         JRST    OTOD            ;STORE IT\r
5348 \r
5349 DTAB:   "-NAJ-"\r
5350         "-BEF-"\r
5351         "-RAM-"\r
5352         "-RPA-"\r
5353         "-YAM-"\r
5354         "-NUJ-"\r
5355         "-LUJ-"\r
5356         "-GUA-"\r
5357         "-PES-"\r
5358         "-TCO-"\r
5359         "-VON-"\r
5360         "-CED-"\r
5361 \fSUBTTL MACHINE INSTRUCTION SEARCH ROUTINES\r
5362 IFE OPHSH,<\r
5363 OPTSCH: MOVEI   RC,0\r
5364         MOVEI   ARG,1B?L<OP1END-OP1TOP> ;SET UP INDEX\r
5365         MOVEI   V,1B?L<OP1END-OP1TOP>/2 ;SET UP INCREMENT\r
5366 \r
5367 OPT1A:  CAMN    AC0,OP1TOP(ARG) ;ARE WE POINTING AT SYMBOL?\r
5368         JRST    OPT1D           ;YES, GET THE CODE\r
5369         JUMPE   V,POPOUT        ;TEST FOR END\r
5370         CAML    AC0,OP1TOP(ARG) ;NO, SHOULD WE MOVE DOWN?\r
5371         TDOA    ARG,V           ;NO, INCREMENT\r
5372 OPT1B:  SUB     ARG,V           ;YES, DECREMENT\r
5373         ASH     V,-1            ;HALVE INCREMENT\r
5374         CAIG    ARG,OP1END-OP1TOP       ;ARE WE OUT OF BOUNDS?\r
5375         JRST    OPT1A           ;NO, TRY AGAIN\r
5376         JRST    OPT1B           ;YES, BRING IT DOWN A PEG\r
5377 >\r
5378 \r
5379 IFN OPHSH,<\r
5380 OPTSCH: MOVE    ARG,AC0         ;GET SIXBIT NAME\r
5381         TLZ     ARG,400000      ;CLEAR SIGN BIT\r
5382         IDIVI   ARG,PRIME       ;REM. GOES IN V\r
5383         CAMN    AC0,OP1TOP(V)   ;ARE WE POINTING AT SYMBOL?\r
5384         JRST    OPT1D           ;YES\r
5385         SKIPN   OP1TOP(V)       ;TEST FOR END\r
5386         POPJ    PP,             ;SYMBOL NOT FOUND\r
5387         HLRZ    RC,ARG          ;SAVE LHS OF QUOTIENT\r
5388         SKIPA   ARG,RC          ;GET IT BACK\r
5389 OPT1A:  ADDI    ARG,(RC)        ;INCREMENT ARG\r
5390         ADDI    V,(ARG)         ;QUADRATIC INCREASE TO V\r
5391         CAIL    V,PRIME         ;V IS MODULO PRIME\r
5392         JRST    [SUBI   V,PRIME\r
5393                 JRST    .-1]\r
5394         CAMN    AC0,OP1TOP(V)   ;IS THIS IT?\r
5395         JRST    OPT1D           ;YES\r
5396         SKIPE   OP1TOP(V)       ;END?\r
5397         JRST    OPT1A           ;TRY AGAIN\r
5398         POPJ    PP,             ;FAILED\r
5399 >\r
5400 OPT1D:\r
5401 IFN OPHSH,<     SETZ    RC,     ;CLEAR RELOCATION\r
5402         MOVE    ARG,V           ;GET INDEX IN RIGHT ACC.>\r
5403         IDIVI   ARG,4           ;ARG HAS INDEX USED IN OPTTAB\r
5404         LDB     V,OPTTAB(V)     ;V HAS INDEX TO OPTTAB\r
5405         CAIL    V,700           ;PSEUDO-OP OR IO INSTRUCTION?\r
5406         JRST    OPT1G           ;YES\r
5407         ROT     V,-?D9          ;LEFT JUSTIFY\r
5408         HRRI    V,OP            ;POINT TO BASIC FORMAT\r
5409 OPT1F:  AOS     0(PP)           ;SET FOR SKIP EXIT\r
5410         MOVEI   SDEL,%OP        ;SET OP-CODE CROSS-REF FLAG\r
5411         JRST    CREF            ;TEST AND OUTPUT, AC0=SYMBOL, V=VALUE\r
5412 \r
5413 OPT1G:  JUMPG   AC0,.+3         ;IF ".","$",OR "%" USE TABLE 1\r
5414         TLNN    AC0,200000      ;PSEUDO-OP OR IO INST., TEST FOR PROPER TABLE\r
5415         SKIPA   V,OP2TAB-700(V) ;2ND TABLE, FIRST LETTER IS "A" TO "O"\r
5416         MOVE    V,OP1TAB-700(V) ;1ST TABLE, ..."P" TO "Z"\r
5417         JRST    OPT1F           ;EXIT\r
5418 \r
5419 OPTTAB:\r
5420 IFE OPHSH,<     POINT   9,OP1COD-1(ARG),35>\r
5421         POINT   9,OP1COD  (ARG), 8\r
5422         POINT   9,OP1COD  (ARG),17\r
5423         POINT   9,OP1COD  (ARG),26\r
5424 IFN OPHSH,<     POINT   9,OP1COD  (ARG),35>\r
5425 \r
5426 \fIFDEF .XCREF,< .XCREF  ;DON'T CREF THIS MESS>\r
5427 IFE OPHSH,<\r
5428         RELOC   .-1\r
5429 OP1TOP:\r
5430         RELOC\r
5431 \r
5432         IF1,<N1=0\r
5433         DEFINE  X  <N1=N1+1 ;>>\r
5434 \r
5435         IF2, <\r
5436         N2=?D36\r
5437         CC=0\r
5438         RELOC   OP1COD\r
5439         RELOC\r
5440 DEFINE  X (SYMBOL,CODE) \r
5441 <SIXBIT /SYMBOL/\r
5442 CC=CC+CODE?<N2=N2-9>\r
5443 IFE N2, <OUTLIT>>\r
5444 \r
5445 DEFINE  OUTLIT  <\r
5446         RELOC\r
5447         +CC\r
5448         RELOC\r
5449 N2=?D36+<CC=0>>>\r
5450         SYN X,XX                ;JUST THE SAME MACRO>\r
5451 \f\r
5452 IFN OPHSH,<\r
5453 DEFINE XX (SB,CD)<>             ;A NUL MACRO\r
5454 OP1TOP: IF1,<   BLOCK PRIME>\r
5455 IF1,<DEFINE X (SB,CD)<>>\r
5456 IF2,<\r
5457 DEFINE OPSTOR (RM)<.$'RM=.$'RM+<OPCODE?<9*<3-R&3>>>>\r
5458 \r
5459 DEFINE X (SB,CD)<\r
5460 SXB=<SIXBIT /SB/>\r
5461 Q=SXB&-1?-1/PRIME\r
5462 R=SXB&-1?-1-Q*PRIME\r
5463 H=Q?-22&777\r
5464 TRY=1\r
5465 OPCODE=CD\r
5466 ITEM Q,\R\r
5467 IFL PRIME-TRY,<PRINTX HASH FAILURE>>\r
5468 \r
5469 DEFINE ITEM (QT,RM)<\r
5470 IFN .%'RM,<R=R+H\r
5471 IFL PRIME-R,<R=R-R/PRIME*PRIME>\r
5472 H=H+Q?-22&777\r
5473 IFGE PRIME-<TRY=TRY+1>,<ITEM Q,\R>>\r
5474 IFE .%'RM,<.%'RM=SXB\r
5475 OPSTOR \<R/4>>>>\r
5476 IF1,<\r
5477 DEFINE GETSYM (N)<.%'N=0>\r
5478 \r
5479 N=0\r
5480         XLIST\r
5481 REPEAT PRIME,<GETSYM \N\r
5482 N=N+1>\r
5483 DEFINE GETSYM (N)<.$'N=0>\r
5484 N=0\r
5485 REPEAT <PRIME/4+1>,<GETSYM \N\r
5486 N=N+1>\r
5487 >\r
5488         LIST>\r
5489 \r
5490 ;MACRO TO HANDLE KI10 OP-CODES\r
5491 DEFINE XK (SB,CD) <>            ;NUL MACRO\r
5492 \fIFN OPHSH,<            ;PUT THE MOST USED OP CODES FIRST\r
5493 X       JRST  , 254\r
5494 X       PUSHJ , 260\r
5495 X       POPJ  , 263\r
5496 X       PUSH  , 261\r
5497 X       POP   , 262\r
5498 X       AOS   , 350\r
5499 X       ASCIZ , 701\r
5500 X       CALLI , 047\r
5501 X       EXTERN, 724\r
5502 X       INTERN, 744\r
5503 X       JFCL  , 255\r
5504 X       JSP   , 265\r
5505 X       MOVE  , 200\r
5506 X       MOVEI , 201\r
5507 X       MOVEM , 202\r
5508 X       SETZM , 402\r
5509 X       SIXBIT, 717\r
5510 X       SOS   , 370\r
5511 X       TLNE  , 603\r
5512 X       TLNN  , 607\r
5513 X       TLO   , 661\r
5514 X       TLZ   , 621\r
5515 X       TLZA  , 625\r
5516 X       TLZE  , 623\r
5517 X       TLZN  , 627\r
5518 X       TRNE  , 602\r
5519 X       TRNN  , 606\r
5520 X       TRZ   , 620\r
5521 >\r
5522 \fX      ADD   , 270\r
5523 X       ADDB  , 273\r
5524 X       ADDI  , 271\r
5525 X       ADDM  , 272\r
5526 \r
5527 X       AND   , 404\r
5528 X       ANDB  , 407\r
5529 X       ANDCA , 410\r
5530 X       ANDCAB, 413\r
5531 X       ANDCAI, 411\r
5532 X       ANDCAM, 412\r
5533 X       ANDCB , 440\r
5534 X       ANDCBB, 443\r
5535 X       ANDCBI, 441\r
5536 X       ANDCBM, 442\r
5537 X       ANDCM , 420\r
5538 X       ANDCMB, 423\r
5539 X       ANDCMI, 421\r
5540 X       ANDCMM, 422\r
5541 X       ANDI  , 405\r
5542 X       ANDM  , 406\r
5543 \r
5544 X       AOBJN , 253\r
5545 X       AOBJP , 252\r
5546 \r
5547 X       AOJ   , 340\r
5548 X       AOJA  , 344\r
5549 X       AOJE  , 342\r
5550 X       AOJG  , 347\r
5551 X       AOJGE , 345\r
5552 X       AOJL  , 341\r
5553 X       AOJLE , 343\r
5554 X       AOJN  , 346\r
5555 \r
5556 XX      AOS   , 350\r
5557 X       AOSA  , 354\r
5558 X       AOSE  , 352\r
5559 X       AOSG  , 357\r
5560 X       AOSGE , 355\r
5561 X       AOSL  , 351\r
5562 X       AOSLE , 353\r
5563 X       AOSN  , 356\r
5564 X       ARG   , 320\r
5565 IFN IIISW,<X    ASCID , 771>\r
5566 X       ASCII , 700\r
5567 XX      ASCIZ , 701\r
5568 \r
5569 X       ASH   , 240\r
5570 X       ASHC  , 244\r
5571 \r
5572 X       ASUPPR, 705\r
5573 X       BLKI  , 702\r
5574 X       BLKO  , 703\r
5575 X       BLOCK , 704\r
5576 \r
5577 X       BLT   , 251\r
5578 \r
5579 X       BYTE  , 707\r
5580 \r
5581 XX      CAI   , 300\r
5582 X       CAIA  , 304\r
5583 X       CAIE  , 302\r
5584 X       CAIG  , 307\r
5585 X       CAIGE , 305\r
5586 X       CAIL  , 301\r
5587 X       CAILE , 303\r
5588 X       CAIN  , 306\r
5589 \r
5590 X       CALL  , 040\r
5591 XX      CALLI , 047\r
5592 \r
5593 XX      CAM   , 310\r
5594 X       CAMA  , 314\r
5595 X       CAME  , 312\r
5596 X       CAMG  , 317\r
5597 X       CAMGE , 315\r
5598 X       CAML  , 311\r
5599 X       CAMLE , 313\r
5600 X       CAMN  , 316\r
5601 \r
5602 XX      CLEAR , 400\r
5603 XX      CLEARB, 403\r
5604 XX      CLEARI, 401\r
5605 XX      CLEARM, 402\r
5606 \r
5607 X       CLOSE , 070\r
5608 X       COMMEN, 770\r
5609 \r
5610 \r
5611 X       CONI  , 710\r
5612 X       CONO  , 711\r
5613 X       CONSO , 712\r
5614 X       CONSZ , 713\r
5615 \r
5616 XX      DATA. , 020\r
5617 \r
5618 X       DATAI , 714\r
5619 X       DATAO , 715\r
5620 X       DEC   , 716\r
5621 X       DEFINE, 717\r
5622 X       DEPHAS, 720\r
5623 \r
5624 X       DFN   , 131\r
5625 \r
5626 X       DIV   , 234\r
5627 X       DIVB  , 237\r
5628 X       DIVI  , 235\r
5629 X       DIVM  , 236\r
5630 \r
5631 X       DPB   , 137\r
5632 \r
5633 X       END   , 721\r
5634 \r
5635 X       ENTER , 077\r
5636 \r
5637 X       ENTRY , 722\r
5638 \r
5639 X       EQV   , 444\r
5640 X       EQVB  , 447\r
5641 X       EQVI  , 445\r
5642 X       EQVM  , 446\r
5643 \r
5644 X       EXCH  , 250\r
5645 \r
5646 X       EXP   , 723\r
5647 XX      EXTERN, 724\r
5648 \r
5649 X       FAD   , 140\r
5650 X       FADB  , 143\r
5651 X       FADL  , 141\r
5652 X       FADM  , 142\r
5653 \r
5654 X       FADR  , 144\r
5655 X       FADRB , 147\r
5656 X       FADRI , 145\r
5657 X       FADRM , 146\r
5658 \r
5659 X       FDV   , 170\r
5660 X       FDVB  , 173\r
5661 X       FDVL  , 171\r
5662 X       FDVM  , 172\r
5663 \r
5664 X       FDVR  , 174\r
5665 X       FDVRB , 177\r
5666 X       FDVRI , 175\r
5667 X       FDVRM , 176\r
5668 \r
5669 XX      FIN.  , 021\r
5670 \r
5671 X       FMP   , 160\r
5672 X       FMPB  , 163\r
5673 X       FMPL  , 161\r
5674 X       FMPM  , 162\r
5675 \r
5676 \fX      FMPR  , 164\r
5677 X       FMPRB , 167\r
5678 X       FMPRI , 165\r
5679 X       FMPRM , 166\r
5680 \r
5681 X       FSB   , 150\r
5682 X       FSBB  , 153\r
5683 X       FSBL  , 151\r
5684 X       FSBM  , 152\r
5685 \r
5686 X       FSBR  , 154\r
5687 X       FSBRB , 157\r
5688 X       FSBRI , 155\r
5689 X       FSBRM , 156\r
5690 \r
5691 X       FSC   , 132\r
5692 \r
5693 X       GETSTS, 062\r
5694 \r
5695 \fX      HALT  , 725\r
5696 X       HISEG , 706\r
5697 \r
5698 X       HLL   , 500\r
5699 X       HLLE  , 530\r
5700 X       HLLEI , 531\r
5701 X       HLLEM , 532\r
5702 X       HLLES , 533\r
5703 X       HLLI  , 501\r
5704 X       HLLM  , 502\r
5705 X       HLLO  , 520\r
5706 X       HLLOI , 521\r
5707 X       HLLOM , 522\r
5708 X       HLLOS , 523\r
5709 X       HLLS  , 503\r
5710 X       HLLZ  , 510\r
5711 X       HLLZI , 511\r
5712 X       HLLZM , 512\r
5713 X       HLLZS , 513\r
5714 \r
5715 X       HLR   , 544\r
5716 X       HLRE  , 574\r
5717 X       HLREI , 575\r
5718 X       HLREM , 576\r
5719 X       HLRES , 577\r
5720 X       HLRI  , 545\r
5721 X       HLRM  , 546\r
5722 X       HLRO  , 564\r
5723 X       HLROI , 565\r
5724 X       HLROM , 566\r
5725 X       HLROS , 567\r
5726 X       HLRS  , 547\r
5727 X       HLRZ  , 554\r
5728 X       HLRZI , 555\r
5729 X       HLRZM , 556\r
5730 X       HLRZS , 557\r
5731 \r
5732 \fX      HRL   , 504\r
5733 X       HRLE  , 534\r
5734 X       HRLEI , 535\r
5735 X       HRLEM , 536\r
5736 X       HRLES , 537\r
5737 X       HRLI  , 505\r
5738 X       HRLM  , 506\r
5739 X       HRLO  , 524\r
5740 X       HRLOI , 525\r
5741 X       HRLOM , 526\r
5742 X       HRLOS , 527\r
5743 X       HRLS  , 507\r
5744 X       HRLZ  , 514\r
5745 X       HRLZI , 515\r
5746 X       HRLZM , 516\r
5747 X       HRLZS , 517\r
5748 \r
5749 X       HRR   , 540\r
5750 X       HRRE  , 570\r
5751 X       HRREI , 571\r
5752 X       HRREM , 572\r
5753 X       HRRES , 573\r
5754 X       HRRI  , 541\r
5755 X       HRRM  , 542\r
5756 X       HRRO  , 560\r
5757 X       HRROI , 561\r
5758 X       HRROM , 562\r
5759 X       HRROS , 563\r
5760 X       HRRS  , 543\r
5761 X       HRRZ  , 550\r
5762 X       HRRZI , 551\r
5763 X       HRRZM , 552\r
5764 X       HRRZS , 553\r
5765 \r
5766 X       IBP   , 133\r
5767 \r
5768 X       IDIV  , 230\r
5769 X       IDIVB , 233\r
5770 X       IDIVI , 231\r
5771 X       IDIVM , 232\r
5772 \r
5773 X       IDPB  , 136\r
5774 \r
5775 X       IF1   , 726\r
5776 X       IF2   , 727\r
5777 X       IFB   , 730\r
5778 X       IFDEF , 731\r
5779 X       IFDIF , 732\r
5780 X       IFE   , 733\r
5781 X       IFG   , 734\r
5782 X       IFGE  , 735\r
5783 X       IFIDN , 736\r
5784 X       IFL   , 737\r
5785 X       IFLE  , 740\r
5786 X       IFN   , 741\r
5787 X       IFNB  , 742\r
5788 X       IFNDEF, 743\r
5789 \r
5790 X       ILDB  , 134\r
5791 \r
5792 X       IMUL  , 220\r
5793 X       IMULB , 223\r
5794 X       IMULI , 221\r
5795 X       IMULM , 222\r
5796 \r
5797 X       IN    , 056\r
5798 XX      IN.   , 016\r
5799 X       INBUF , 064\r
5800 XX      INF.  , 026\r
5801 X       INIT  , 041\r
5802 X       INPUT , 066\r
5803 \r
5804 XX      INTERN, 744\r
5805 \r
5806 X       IOR   , 434\r
5807 X       IORB  , 437\r
5808 X       IORI  , 435\r
5809 X       IORM  , 436\r
5810 \r
5811 \r
5812 X       IOWD  , 745\r
5813 X       IRP   , 746\r
5814 X       IRPC  , 747\r
5815 X       JCRY  , 750\r
5816 X       JCRY0 , 751\r
5817 X       JCRY1 , 752\r
5818 X       JEN   , 753\r
5819 \r
5820 XX      JFCL  , 255\r
5821 \r
5822 X       JFFO  , 243\r
5823 X       JFOV  , 765\r
5824 X       JOV   , 754\r
5825 \r
5826 X       JRA   , 267\r
5827 XX      JRST  , 254\r
5828 \r
5829 X       JRSTF , 755\r
5830 \r
5831 X       JSA   , 266\r
5832 XX      JSP   , 265\r
5833 X       JSR   , 264\r
5834 \r
5835 XX      JUMP  , 320\r
5836 XX      JUMPA , 324\r
5837 X       JUMPE , 322\r
5838 X       JUMPG , 327\r
5839 X       JUMPGE, 325\r
5840 X       JUMPL , 321\r
5841 X       JUMPLE, 323\r
5842 X       JUMPN , 326\r
5843 \r
5844 X       LALL  , 756\r
5845 \r
5846 X       LDB   , 135\r
5847 \r
5848 X       LIST  , 757\r
5849 X       LIT   , 760\r
5850 X       LOC   , 761\r
5851 \r
5852 X       LOOKUP, 076\r
5853 \r
5854 X       LSH   , 242\r
5855 X       LSHC  , 246\r
5856 XK      MAP   , 257\r
5857 X       MLOFF , 767\r
5858 X       MLON  , 766\r
5859 XX      MOVE  , 200\r
5860 XX      MOVEI , 201\r
5861 XX      MOVEM , 202\r
5862 X       MOVES , 203\r
5863 X       MOVM  , 214\r
5864 X       MOVMI , 215\r
5865 X       MOVMM , 216\r
5866 X       MOVMS , 217\r
5867 X       MOVN  , 210\r
5868 X       MOVNI , 211\r
5869 X       MOVNM , 212\r
5870 X       MOVNS , 213\r
5871 X       MOVS  , 204\r
5872 X       MOVSI , 205\r
5873 X       MOVSM , 206\r
5874 X       MOVSS , 207\r
5875 \r
5876 \r
5877 X       MTAPE , 072\r
5878 XX      MTOP. , 024\r
5879 \r
5880 X       MUL   , 224\r
5881 X       MULB  , 227\r
5882 X       MULI  , 225\r
5883 X       MULM  , 226\r
5884 XX      NLI.  , 031\r
5885 XX      NLO.  , 032\r
5886 \r
5887 X       NOSYM , 762\r
5888 \r
5889 \fX      OCT   , 763\r
5890 X       OPDEF , 764\r
5891 \r
5892 X       OPEN  , 050\r
5893 \r
5894 X       OR    , 434\r
5895 X       ORB   , 437\r
5896 X       ORCA  , 454\r
5897 X       ORCAB , 457\r
5898 X       ORCAI , 455\r
5899 X       ORCAM , 456\r
5900 X       ORCB  , 470\r
5901 X       ORCBB , 473\r
5902 \r
5903 X       ORCBI , 471\r
5904 X       ORCBM , 472\r
5905 X       ORCM  , 464\r
5906 X       ORCMB , 467\r
5907 X       ORCMI , 465\r
5908 X       ORCMM , 466\r
5909 X       ORI   , 435\r
5910 X       ORM   , 436\r
5911 \r
5912 X       OUT   , 057\r
5913 XX      OUT.  , 017\r
5914 X       OUTBUF, 065\r
5915 XX      OUTF. , 027\r
5916 X       OUTPUT, 067\r
5917 \r
5918 \fX      PAGE  , 700\r
5919 X       PASS2 , 701\r
5920 X       PHASE , 702\r
5921 X       POINT , 703\r
5922 \r
5923 XX      POP   , 262\r
5924 XX      POPJ  , 263\r
5925 \r
5926 X       PRGEND, 714\r
5927 X       PRINTX, 704\r
5928 X       PURGE , 705\r
5929 \r
5930 XX      PUSH  , 261\r
5931 XX      PUSHJ , 260\r
5932 \r
5933 X       RADIX , 706\r
5934 X       RADIX5, 707\r
5935 \r
5936 X       RELEAS, 071\r
5937 \r
5938 X       RELOC , 710\r
5939 X       REMARK, 711\r
5940 \r
5941 X       RENAME, 055\r
5942 \r
5943 X       REPEAT, 712\r
5944 \r
5945 XX      RESET., 015\r
5946 X       RIM   , 715\r
5947 X       RIM10 , 735\r
5948 X       RIM10B, 736\r
5949 \r
5950 X       ROT   , 241\r
5951 X       ROTC  , 245\r
5952 \r
5953 X       RSW   , 716\r
5954 XX      RTB.  , 022\r
5955 X       SALL  , 720\r
5956 X       SEARCH, 721\r
5957 \r
5958 X       SETA  , 424\r
5959 X       SETAB , 427\r
5960 X       SETAI , 425\r
5961 X       SETAM , 426\r
5962 X       SETCA , 450\r
5963 X       SETCAB, 453\r
5964 X       SETCAI, 451\r
5965 X       SETCAM, 452\r
5966 X       SETCM , 460\r
5967 X       SETCMB, 463\r
5968 X       SETCMI, 461\r
5969 X       SETCMM, 462\r
5970 X       SETM  , 414\r
5971 X       SETMB , 417\r
5972 X       SETMI , 415\r
5973 X       SETMM , 416\r
5974 X       SETO  , 474\r
5975 X       SETOB , 477\r
5976 X       SETOI , 475\r
5977 X       SETOM , 476\r
5978 X       SETSTS, 060\r
5979 X       SETZ  , 400\r
5980 X       SETZB , 403\r
5981 X       SETZI , 401\r
5982 XX      SETZM , 402\r
5983 \r
5984 XX      SIXBIT, 717\r
5985 \r
5986 XX      SKIP  , 330\r
5987 X       SKIPA , 334\r
5988 X       SKIPE , 332\r
5989 X       SKIPG , 337\r
5990 X       SKIPGE, 335\r
5991 X       SKIPL , 331\r
5992 X       SKIPLE, 333\r
5993 X       SKIPN , 336\r
5994 \r
5995 XX      SLIST., 025\r
5996 \r
5997 X       SOJ   , 360\r
5998 X       SOJA  , 364\r
5999 X       SOJE  , 362\r
6000 X       SOJG  , 367\r
6001 X       SOJGE , 365\r
6002 X       SOJL  , 361\r
6003 X       SOJLE , 363\r
6004 X       SOJN  , 366\r
6005 \r
6006 XX      SOS   , 370\r
6007 X       SOSA  , 374\r
6008 X       SOSE  , 372\r
6009 X       SOSG  , 377\r
6010 X       SOSGE , 375\r
6011 X       SOSL  , 371\r
6012 X       SOSLE , 373\r
6013 X       SOSN  , 376\r
6014 \r
6015 X       SQUOZE, 707\r
6016 \r
6017 X       STATO , 061\r
6018 X       STATUS, 062\r
6019 X       STATZ , 063\r
6020 \r
6021 X       STOPI , 722\r
6022 \r
6023 X       SUB   , 274\r
6024 X       SUBB  , 277\r
6025 X       SUBI  , 275\r
6026 X       SUBM  , 276\r
6027 \r
6028 IF2,<IFE OPHSH,<SUBTL:>>\r
6029 X       SUBTTL, 723\r
6030 X       SUPPRE, 713\r
6031 X       SYN   , 724\r
6032 X       TAPE  , 725\r
6033 \r
6034 \fX      TDC   , 650\r
6035 X       TDCA  , 654\r
6036 X       TDCE  , 652\r
6037 X       TDCN  , 656\r
6038 X       TDN   , 610\r
6039 X       TDNA  , 614\r
6040 X       TDNE  , 612\r
6041 X       TDNN  , 616\r
6042 X       TDO   , 670\r
6043 X       TDOA  , 674\r
6044 X       TDOE  , 672\r
6045 X       TDON  , 676\r
6046 X       TDZ   , 630\r
6047 X       TDZA  , 634\r
6048 X       TDZE  , 632\r
6049 X       TDZN  , 636\r
6050 \r
6051 X       TITLE , 726\r
6052 \r
6053 X       TLC   , 641\r
6054 X       TLCA  , 645\r
6055 X       TLCE  , 643\r
6056 X       TLCN  , 647\r
6057 X       TLN   , 601\r
6058 X       TLNA  , 605\r
6059 XX      TLNE  , 603\r
6060 XX      TLNN  , 607\r
6061 XX      TLO   , 661\r
6062 X       TLOA  , 665\r
6063 X       TLOE  , 663\r
6064 X       TLON  , 667\r
6065 XX      TLZ   , 621\r
6066 XX      TLZA  , 625\r
6067 XX      TLZE  , 623\r
6068 XX      TLZN  , 627\r
6069 \r
6070 \fX      TRC   , 640\r
6071 X       TRCA  , 644\r
6072 X       TRCE  , 642\r
6073 X       TRCN  , 646\r
6074 X       TRN   , 600\r
6075 X       TRNA  , 604\r
6076 XX      TRNE  , 602\r
6077 XX      TRNN  , 606\r
6078 X       TRO   , 660\r
6079 X       TROA  , 664\r
6080 X       TROE  , 662\r
6081 X       TRON  , 666\r
6082 XX      TRZ   , 620\r
6083 X       TRZA  , 624\r
6084 X       TRZE  , 622\r
6085 X       TRZN  , 626\r
6086 \r
6087 X       TSC   , 651\r
6088 X       TSCA  , 655\r
6089 X       TSCE  , 653\r
6090 X       TSCN  , 657\r
6091 X       TSN   , 611\r
6092 X       TSNA  , 615\r
6093 X       TSNE  , 613\r
6094 \r
6095 X       TSNN  , 617\r
6096 X       TSO   , 671\r
6097 X       TSOA  , 675\r
6098 X       TSOE  , 673\r
6099 X       TSON  , 677\r
6100 X       TSZ   , 631\r
6101 X       TSZA  , 635\r
6102 X       TSZE  , 633\r
6103 X       TSZN  , 637\r
6104 X       TTCALL, 051\r
6105 X       TWOSEG, 731\r
6106 X       UFA   , 130\r
6107 X       UGETF , 073\r
6108 X       UJEN  , 100\r
6109 X       UNIVER, 737\r
6110 X       USETI , 074\r
6111 X       USETO , 075\r
6112 \r
6113 X       VAR   , 727\r
6114 \r
6115 XX      WTB.  , 023\r
6116 \r
6117 X       XALL  , 732\r
6118 \r
6119 X       XCT   , 256\r
6120 \r
6121 X       XLIST , 733\r
6122 \r
6123 X       XOR   , 430\r
6124 X       XORB  , 433\r
6125 X       XORI  , 431\r
6126 X       XORM  , 432\r
6127 \r
6128 X       XPUNGE, 730\r
6129 X       XWD   , 734\r
6130 \r
6131 X       Z     , 000\r
6132 \r
6133 X       .CREF , 740\r
6134 X       .HWFRM, 742\r
6135 X       .MFRMT, 743\r
6136 X       .XCREF, 741\r
6137 \r
6138 \r
6139 \fIFN OPHSH,<            ;NO-OPS, OLD MNEMONICS,F4 UUOS\r
6140 X       CAI   , 300\r
6141 X       CAM   , 310\r
6142 X       CLEAR , 400\r
6143 X       CLEARB, 403\r
6144 X       CLEARI, 401\r
6145 X       CLEARM, 402\r
6146 X       JUMP  , 320\r
6147 X       JUMPA , 324\r
6148 X       SKIP  , 330\r
6149 X       RESET., 015\r
6150 X       IN.   , 016\r
6151 X       OUT.  , 017\r
6152 X       DATA. , 020\r
6153 X       FIN.  , 021\r
6154 X       RTB.  , 022\r
6155 X       WTB.  , 023\r
6156 X       MTOP. , 024\r
6157 X       SLIST., 025\r
6158 X       INF.  , 026\r
6159 X       OUTF. , 027\r
6160 X       NLI.  , 031\r
6161 X       NLO.  , 032\r
6162 >\r
6163 \fIFE OPHSH,<\r
6164 IF1, <  BLOCK   N1>\r
6165 OP1END: -1B36\r
6166 OP1COD: BLOCK   N1/4\r
6167         CC>\r
6168 IFN OPHSH,<\r
6169 IF2,<\r
6170 DEFINE SETVAL (N)<EXP   .%'N\r
6171 PURGE .%'N>\r
6172 N=0\r
6173 XLIST\r
6174 REPEAT PRIME,<SETVAL \N\r
6175 N=N+1>\r
6176 LIST\r
6177 >\r
6178 OP1COD: IF1,<   BLOCK <PRIME/4+1>>\r
6179 IF2,<\r
6180 DEFINE SETVAL (N)<EXP   .$'N\r
6181 PURGE .$'N>\r
6182 N=0\r
6183 XLIST\r
6184 REPEAT <PRIME/4+1>,<SETVAL      \N\r
6185 N=N+1>\r
6186 >\r
6187 LIST>\r
6188 \r
6189 IFDEF .CREF,<   .CREF   ;START CREFFING AGAIN>\r
6190 \fSUBTTL PERMANENT SYMBOLS\r
6191 SYMNUM: EXP     LENGTH/2        ;NUMBER OF PERMANENT SYMBOLS\r
6192 DEFINE  P       (A,B)<\r
6193         SIXBIT  /A/\r
6194         XWD     SYMF!NOOUTF,B>\r
6195 \r
6196 P       @,      0(SUPRBT)\r
6197 P       ??????, 0(SUPRBT)\r
6198 \r
6199 LENGTH= .-SYMNUM-1                      ;LENGTH OF INITIAL SYMBOLS\r
6200 \r
6201 PRMTBL:                 ;PERMANENT SYMBOLS\r
6202 P       ADC,    24\r
6203 P       APR,    0\r
6204 P       CCI,    14\r
6205 P       CDP,    110\r
6206 P       CDR,    114\r
6207 P       CPA,    0\r
6208 P       CR,     150\r
6209 P       DC,     200\r
6210 P       DCSA,   300\r
6211 P       DCSB,   304\r
6212 P       DF,     270\r
6213 P       DIS,    130\r
6214 P       DLS,    240\r
6215 P       DPC,    250\r
6216 P       DSK,    170\r
6217 P       DTC,    320\r
6218 P       DTS,    324\r
6219 P       LPT,    124\r
6220 P       MDF,    260\r
6221 P       MTC,    220\r
6222 P       MTM,    230\r
6223 P       MTS,    224\r
6224 P       PAG,    10\r
6225 P       PI,     4\r
6226 P       PLT,    140\r
6227 P       PTP,    100\r
6228 P       PTR,    104\r
6229 \r
6230 P       TMC,    340\r
6231 P       TMS,    344\r
6232 P       TTY,    120\r
6233 P       UTC,    210\r
6234 P       UTS,    214\r
6235         XLIST   \r
6236         LIST\r
6237 PRMEND:                         ;END OF PERMANENT SYMBOLS\r
6238 \r
6239 \f       OPDEF   ZL      [Z      LITF]   ;INVALID IN LITERALS\r
6240         OPDEF   ZA      [Z      ADDF]   ;INVALID IN ADDRESSES\r
6241         OPDEF   ZAL     [Z      ADDF!LITF]\r
6242 \r
6243 OP1TAB:\r
6244 \r
6245         ZA      PAGE0                   ;PAGE\r
6246         ZAL     PASS20                  ;PASS2\r
6247         ZAL     PHASE0                  ;PHASE\r
6248         Z       POINT0                  ;POINT\r
6249         ZA      PRNTX0                  ;PRINTX\r
6250         ZA      PURGE0                  ;PURGE\r
6251         ZA      RADIX0                  ;RADIX\r
6252         Z       RADX50                  ;RADIX50,SQUOZE\r
6253         ZAL     LOC0    (1)             ;RELOC\r
6254         ZAL     REMAR0                  ;REMARK\r
6255         ZA      REPEA0                  ;REPEAT\r
6256         ZA      SUPRE0                  ;SUPRESS\r
6257         ZAL     PSEND0                  ;PRGEND\r
6258         ZAL     RIM0    (RIMSW)         ;RIM\r
6259         DATAI   0,IOP                   ;RSW\r
6260         Z       ASCII0  (1)             ;SIXBIT\r
6261         ZAL     IOSET   (IOPALL!IOSALL) ;SALL\r
6262         ZAL     SERCH0                  ;SEARCH\r
6263         ZA      STOPI0                  ;STOPI\r
6264         ZA      SUBTT0  (Z (POINT 7,,)) ;SUBTTL\r
6265         ZA      SYN0                    ;SYN\r
6266         ZAL     TAPE0                   ;TAPE\r
6267         ZA      TITLE0  (Z (POINT 7,,)) ;TITLE\r
6268         ZAL     VAR0                    ;VAR\r
6269 \r
6270         Z       XPUNG0                  ;XPUNGE\r
6271         ZAL     TWSEG0                  ;TWOSEGMENTS\r
6272         ZAL     XALL0   (IOPALL)        ;XALL\r
6273         ZAL     IOSET   (IOPROG)        ;XLIST\r
6274         Z       XWD0                    ;XWD\r
6275         ZAL     RIM0    (RIM1SW)        ;RIM10\r
6276         ZAL     RIM0    (R1BSW)         ;RIM10B\r
6277         ZA      UNIV0   (Z (POINT 7,,)) ;UNIVERSAL\r
6278         ZAL     IORSET  (IONCRF)        ;.CREF\r
6279         ZAL     IOSET   (IONCRF)        ;.XCREF\r
6280         ZA      OFFORM                  ;.HWFRMT\r
6281         ZA      ONFORM                  ;.MFRMT\r
6282 \fOP2TAB:\r
6283 \r
6284         Z       ASCII0  (0)             ;ASCII\r
6285         Z       ASCII0  (1B18)          ;ASCIZ\r
6286         BLKI    IOP                     ;BLKI\r
6287         BLKO    IOP                     ;BLKO\r
6288         ZAL     BLOCK0                  ;BLOCK\r
6289         ZA      SUPRSA                  ;ASUPPRESS\r
6290         ZAL     HISEG0                  ;HISEG\r
6291         Z       BYTE0                   ;BYTE\r
6292         CONI    IOP                     ;CONI\r
6293         CONO    IOP                     ;CONO\r
6294         CONSO   IOP                     ;CONSO\r
6295         CONSZ   IOP                     ;CONSZ\r
6296         DATAI   IOP                     ;DATAI\r
6297         DATAO   IOP                     ;DATAO\r
6298         Z       OCT0    (?D10)          ;DEC\r
6299         ZA      DEFIN0                  ;DEFINE\r
6300 \r
6301         ZAL     DEPHA0                  ;DEPHASE\r
6302         ZAL     END0                    ;END\r
6303         ZA      INTER0  (INTF!ENTF)     ;ENTRY\r
6304         Z       EXPRES                  ;EXP\r
6305         ZA      EXTER0                  ;EXTERN\r
6306         JRST    4,OP                    ;HALT\r
6307         TLNN    FR,IFPASS               ;IF1\r
6308         TLNE    FR,IFPASS               ;IF2\r
6309 \r
6310         TRNE    AC0,IFB0                ;IFB\r
6311         TLNE    ARG,IFDEF0              ;IFDEF\r
6312         Z       IFIDN0  (0)             ;IFDIF\r
6313         SKIPE   IF                      ;IFE\r
6314         SKIPG   IF                      ;IFG\r
6315         SKIPGE  IF                      ;IFGE\r
6316         Z       IFIDN0  (1)             ;IFIDN\r
6317         SKIPL   IF                      ;IFL\r
6318 \r
6319         SKIPLE  IF                      ;IFLE\r
6320         SKIPN   IF                      ;IFN\r
6321         TRNN    AC0,IFB0                ;IFNB\r
6322         TLNN    ARG,IFDEF0              ;IFNDEF\r
6323         ZA      INTER0  (INTF)          ;INTERN\r
6324         Z       IOWD0                   ;IOWD\r
6325         Z       IRP0    (0)             ;IRP\r
6326         Z       IRP0    (400000)        ;IRPC\r
6327 \r
6328         JFCL    6,OP                    ;JCRY\r
6329         JFCL    4,OP                    ;JCRY0\r
6330         JFCL    2,OP                    ;JCRY1\r
6331         JRST    12,OP                   ;JEN\r
6332         JFCL    10,OP                   ;JOV\r
6333         JRST    2,OP                    ;JRSTF\r
6334         ZAL     IORSET  (IOPALL!IOSALL) ;LALL\r
6335         ZAL     IORSET  (IOPROG)        ;LIST\r
6336         ZAL     LIT0                    ;LIT\r
6337         ZAL     LOC0    (0)             ;LOC\r
6338         ZA      OFFSYM                  ;NOSYM\r
6339         Z       OCT0    (?D8)           ;OCT\r
6340         ZA      OPDEF0                  ;OPDEF\r
6341         JFCL    1,OP                    ;JFOV\r
6342         ZA      ONML                    ;MLON\r
6343         ZA      OFFML                   ;MLOFF\r
6344         Z       ASCII0  (3B19)          ;COMMENT\r
6345         Z       ASCII0  (5B20)          ;ASCID\r
6346 \f\r
6347 CALTBL:\r
6348                                 ;USER DEFINED CALLI'S GO HERE\r
6349         SIXBIT  /LIGHTS/        ;-1\r
6350 CALLI0: SIXBIT  /RESET/         ; 0\r
6351         SIXBIT  /DDTIN/         ; 1\r
6352         SIXBIT  /SETDDT/        ; 2\r
6353         SIXBIT  /DDTOUT/        ; 3\r
6354         SIXBIT  /DEVCHR/        ; 4\r
6355         SIXBIT  /DDTGT/         ; 5\r
6356         SIXBIT  /GETCHR/        ; 6\r
6357         SIXBIT  /DDTRL/         ; 7\r
6358         SIXBIT  /WAIT/          ;10\r
6359         SIXBIT  /CORE/          ;11\r
6360         SIXBIT  /EXIT/          ;12\r
6361         SIXBIT  /UTPCLR/        ;13\r
6362         SIXBIT  /DATE/          ;14\r
6363         SIXBIT  /LOGIN/         ;15\r
6364         SIXBIT  /APRENB/        ;16\r
6365         SIXBIT  /LOGOUT/        ;17\r
6366         SIXBIT  /SWITCH/        ;20\r
6367         SIXBIT  /REASSI/        ;21\r
6368         SIXBIT  /TIMER/         ;22\r
6369         SIXBIT  /MSTIME/        ;23\r
6370         SIXBIT  /GETPPN/        ;24\r
6371         SIXBIT  /TRPSET/        ;25\r
6372         SIXBIT  /TRPJEN/        ;26\r
6373         SIXBIT  /RUNTIM/        ;27\r
6374         SIXBIT  /PJOB/          ;30\r
6375         SIXBIT  /SLEEP/         ;31\r
6376         SIXBIT  /SETPOV/        ;32\r
6377         SIXBIT  /PEEK/          ;33\r
6378         SIXBIT  /GETLIN/        ;34\r
6379         SIXBIT  /RUN/           ;35\r
6380         SIXBIT  /SETUWP/        ;36\r
6381         SIXBIT  /REMAP/         ;37\r
6382         SIXBIT  /GETSEG/        ;40\r
6383         SIXBIT  /GETTAB/        ;41\r
6384         SIXBIT  /SPY/           ;42\r
6385         SIXBIT  /SETNAM/        ;43\r
6386         SIXBIT  /TMPCOR/        ;44\r
6387         SIXBIT  /DSKCHR/        ;45\r
6388         SIXBIT  /SYSSTR/        ;46\r
6389         SIXBIT  /JOBSTR/        ;47\r
6390         SIXBIT  /STRUUO/        ;50\r
6391         SIXBIT  /SYSPHY/        ;51\r
6392         SIXBIT  /FRECHN/        ;52\r
6393         SIXBIT  /DEVTYP/        ;53\r
6394         SIXBIT  /DEVSTS/        ;54\r
6395         SIXBIT  /DEVPPN/        ;55\r
6396         SIXBIT  /SEEK/          ;56\r
6397         SIXBIT  /RTTRP/         ;57\r
6398         SIXBIT  /LOCK/          ;60\r
6399         SIXBIT  /JOBSTS/        ;61\r
6400         SIXBIT  /LOCATE/        ;62\r
6401         SIXBIT  /WHERE/         ;63\r
6402         SIXBIT  /DEVNAM/        ;64\r
6403         SIXBIT  /CTLJOB/        ;65\r
6404         SIXBIT  /GOBSTR/        ;66\r
6405         0                       ;67\r
6406         0                       ;70\r
6407         SIXBIT  /HPQ/           ;71\r
6408         SIXBIT  /HIBER/         ;72\r
6409         SIXBIT  /WAKE/          ;73\r
6410         SIXBIT  /CHGPPN/        ;74\r
6411         SIXBIT  /SETUUO/        ;75\r
6412         SIXBIT  /DEVGEN/        ;76\r
6413         SIXBIT  /OTHUSR/        ;77\r
6414         SIXBIT  /CHKACC/        ;100\r
6415         SIXBIT  /DEVSIZ/        ;101\r
6416         SIXBIT  /DAEMON/        ;102\r
6417         SIXBIT  /JOBPEK/        ;103\r
6418         SIXBIT  /ATTACH/        ;104\r
6419         SIXBIT  /DAEFIN/        ;105\r
6420         SIXBIT  /FRCUUO/        ;106\r
6421         SIXBIT  /DEVLNM/        ;107\r
6422         SIXBIT  /PATH./         ;110\r
6423 \r
6424 CALNTH==.-CALTBL\r
6425 NEGCAL==CALLI0-CALTBL           ;NUMBER OF NEGATIVE CALLI'S\r
6426 \r
6427 TTCTBL: SIXBIT  /INCHRW/        ; 0     INPUT A CHAR. AND WAIT\r
6428         SIXBIT  /OUTCHR/        ; 1     OUTPUT A CHAR.\r
6429         SIXBIT  /INCHRS/        ; 2     INPUT A CHAR. AND SKIP\r
6430         SIXBIT  /OUTSTR/        ; 3     OUTPUT A STRING\r
6431         SIXBIT  /INCHWL/        ; 4     INPUT CHAR., WAIT, LINE MODE\r
6432         SIXBIT  /INCHSL/        ; 5     INPUT CHAR., SKIP, LINE MODE\r
6433         SIXBIT  /GETLCH/        ; 6     GET LINE CHARACTERISTICS\r
6434         SIXBIT  /SETLCH/        ; 7     SET LINE CHARACTERISTICS\r
6435         SIXBIT  /RESCAN/        ;10     RESET INPUT STREAM TO COMMAND\r
6436         SIXBIT  /CLRBFI/        ;11     CLEAR TYPEIN BUFFER\r
6437         SIXBIT  /CLRBFO/        ;12     CLEAR TYPEOUT BUFFER\r
6438         SIXBIT  /SKPINC/        ;13     SKIPS IF A CHAR. CAN BE INPUT\r
6439         SIXBIT  /SKPINL/        ;14     SKIPS IF A LINE CAN BE INPUT\r
6440         SIXBIT  /IONEOU/        ;15     OUTPUT AS AN IMAGE CHAR.\r
6441 \r
6442 TTCLTH==.-TTCTBL\r
6443         SUBTTL  USER-DEFINED SYMBOL SEARCH ROUTINES\r
6444 MSRCH:  PUSHJ   PP,SEARCH       ;PERFORM GENERAL SEARCH\r
6445         POPJ    PP,             ;NOT FOUND, EXIT\r
6446         JUMPG   ARG,MSRCH2      ;SKIP-EXIT AND CROSS-REF IF FOUND\r
6447         CAME    AC0,1(SX)       ;WE ARE LOOKING AT SYMBOL, TRY ONE ABOVE\r
6448         POPJ    PP,             ;NO, EXIT\r
6449         ADDI    SX,2            ;YES, POINT TO IT\r
6450         PUSHJ   PP,SRCH5        ;LOAD REGISTERS\r
6451 MSRCH2: AOSA    0(PP)           ;SET SKIP-EXIT\r
6452 QSRCH:  JUMPL   ARG,SSRCH3      ;BRANCH IF OPERAND\r
6453         MOVEI   SDEL,%MAC       ;SET OPERATOR FLAG\r
6454         TLZE IO,DEFCRS  ;IS IT A DEFINITION?\r
6455         MOVEI SDEL,%DMAC        ;YES\r
6456         JRST    CREF            ;CROSS-REF AND EXIT\r
6457 \r
6458 SSRCH:  PUSHJ   PP,SEARCH       ;PERFORM GENERAL SEARCH\r
6459         POPJ    PP,             ;NOT FOUND, EXIT\r
6460         JUMPL   ARG,SSRCH2      ;SKIP-EXIT AND CROSS-REF IF FOUND\r
6461 SSRCH1: CAME    AC0,-3(SX)      ;WE ARE LOOKING AT MACRO, LOOK ONE SLOT BELOW\r
6462         POPJ    PP,             ;NO DICE, EXIT\r
6463         SUBI    SX,2            ;YES, POINT TO IT\r
6464         PUSHJ   PP,SRCH5        ;LOAD REGISTERS\r
6465 SSRCH2: AOS     0(PP)           ;SET FOR SKIP-EXIT\r
6466 SSRCH3: MOVEI   SDEL,%SYM       ;SET OPERAND FLAG\r
6467 \r
6468 CREF:   TLNN    IO,IONCRF       ;NO CREFFING FOR THIS SYMBOL?\r
6469         TLNE    FR,P1!CREFSW    ;PASS ONE OR CROSS-REF SUPPRESSION?\r
6470         POPJ    PP,             ;YES, EXIT\r
6471         EXCH    SDEL,C          ;PUT FLAG IN C, SACE C\r
6472         PUSH    PP,CS\r
6473         TLNE IO,IOCREF          ;HAVE WE PUT OUT THE 177,102\r
6474         JRST CREF3              ;YES\r
6475         PUSH PP,C               ;START OF CREF DATA\r
6476 \r
6477 \fREPEAT 0,<     ;NEEDS CHANGE TO CREF\r
6478         MOVEI C,177\r
6479         PUSHJ PP,OUTLST\r
6480         MOVEI C,102\r
6481         PUSHJ PP,OUTLST\r
6482         TLO IO,IOCREF   ;WE NOW ARE IN THAT STATE\r
6483         POP PP,C        ;WE HAVE NOW\r
6484 CREF3:  JUMPE C,NOFLG           ;JUST CLOSE IT\r
6485         PUSHJ   PP,OUTLST       ;TYPE OF SYMBOL (%MAC,%DMAC,%SYM)\r
6486         MOVSI CS,770000         ;COUNT CHRS\r
6487         TDZA C,C        ;STARTING AT 0\r
6488         LSH CS,-6       ;TRY NEXT\r
6489         TDNE AC0,CS     ;IS THAT ONE THERE?\r
6490         AOJA C,.-2      ;YES\r
6491         PUSHJ PP,OUTLST         ;PRINT NUMBER OF SYMBOL CONSTITUENTS\r
6492         MOVE    CS,AC0\r
6493 \r
6494 CREF2:  MOVEI   C,0\r
6495         LSHC    C,6\r
6496         ADDI    C,40\r
6497         PUSHJ   PP,OUTLST       ;THE ASCII SYMBOL\r
6498         JUMPN   CS,CREF2\r
6499         MOVEI   C,%DSYM\r
6500         TLZE    IO,DEFCRS\r
6501         PUSHJ   PP,OUTLST       ;MARK IT AS A DEFINING OCCURENCE\r
6502 NOFLG:  MOVE    C,SDEL\r
6503         POP     PP,CS\r
6504         POPJ    PP,\r
6505 \r
6506 CLSCRF: TRNN ER,LPTSW\r
6507         POPJ PP,        ;LEAVE IF WE SHOULD NOT BE PRINTING\r
6508 CLSCR2: MOVEI C,177\r
6509         PUSHJ PP,PRINT\r
6510         TLZE IO,IOCREF  ;WAS IT OPEN?\r
6511         JRST CLSCR1     ;YES, JUST CLOSE IT\r
6512         MOVEI C,102     ;NO, OPEN IT FIRST\r
6513         PUSHJ PP,OUTLST         ;MARK BEGINNING OF CREF DATA\r
6514         MOVEI C,177\r
6515         PUSHJ PP,OUTLST\r
6516 CLSCR1: MOVEI C,103\r
6517         JRST OUTLST             ;MARK END OF CREF DATA\r
6518 \r
6519 CLSC3:  TLZ IO,IOCREF\r
6520         MOVEI C,177\r
6521         PUSHJ PP,OUTLST\r
6522         MOVEI C,104\r
6523         JRST OUTLST     ;177,104 CLOSES IT FOR NOW\r
6524 >       ;END OF REPEAT 0\r
6525 \fREPEAT 1,<                     ;WORKS WITH EXISTING CREF\r
6526         TLNE IO,IOPAGE\r
6527         PUSHJ PP,CRFHDR         ;GET CORRECT SUBTTL\r
6528         MOVEI C,177\r
6529         PUSHJ PP,OUTLST\r
6530         MOVEI C,102\r
6531         PUSHJ PP,OUTLST\r
6532         TLO IO,IOCREF   ;WE NOW ARE IN THAT STATE\r
6533         POP PP,C        ;WE HAVE NOW\r
6534 CREF3:  PUSHJ   PP,OUTLST       ;TYPE OF SYMBOL (%MAC,%DMAC,%SYM)\r
6535         MOVSI CS,770000         ;COUNT CHRS\r
6536         TDZA C,C        ;STARTING AT 0\r
6537         LSH CS,-6       ;TRY NEXT\r
6538         TDNE AC0,CS     ;IS THAT ONE THERE?\r
6539         AOJA C,.-2      ;YES\r
6540         PUSHJ PP,OUTLST         ;PRINT NUMBER OF SYMBOL CONSTITUENTS\r
6541         MOVE    CS,AC0\r
6542 \r
6543 CREF2:  MOVEI   C,0\r
6544         LSHC    C,6\r
6545         ADDI    C,40\r
6546         PUSHJ   PP,OUTLST       ;THE ASCII SYMBOL\r
6547         JUMPN   CS,CREF2\r
6548         MOVEI   C,%DSYM\r
6549         TLZE    IO,DEFCRS\r
6550         PUSHJ   PP,OUTLST       ;MARK IT AS A DEFINING OCCURENCE\r
6551         MOVE    C,SDEL\r
6552         POP     PP,CS\r
6553         POPJ    PP,\r
6554 \r
6555 IFN OPHSH,<\r
6556 SUBTL:  SIXBIT  /SUBTTL/>\r
6557 CRFHDR: CAME    AC0,SUBTL       ;IS FIRST SYMBOL "SUBTTL"\r
6558         JRST    CRFHD1          ;NO\r
6559         HLLZ    AC0,V\r
6560         PUSHJ   PP,SUBTT0       ;UPDATE SUBTTL\r
6561         MOVE    AC0,SUBTL       ;RESTORE ARG.\r
6562         MOVEI   V,CPOPJ\r
6563 CRFHD1: MOVEI   C,0\r
6564         JRST    OUTL\r
6565 \r
6566 CLSC3:\r
6567 CLSCRF: TRNN ER,LPTSW\r
6568         POPJ PP,        ;LEAVE IF WE SHOULD NOT BE PRINTING\r
6569 CLSCR2: TLZE IO,IOCREF  ;FINISH UP LINE\r
6570         JRST CLSCR1\r
6571         MOVEI   C,0\r
6572         TLNE    IO,IOPAGE       ;NEW PAGE?\r
6573         PUSHJ   PP,OUTL         ;YES,GIVE IT A ROUSING SENDOFF!\r
6574         MOVEI C,177\r
6575         PUSHJ PP,OUTLST\r
6576         MOVEI C,102\r
6577         PUSHJ PP,OUTLST         ;MARK BEGINNING OF CREF DATA\r
6578 CLSCR1: MOVEI C,177\r
6579         PUSHJ PP,OUTLST\r
6580         MOVEI C,103\r
6581         JRST OUTLST             ;MARK END OF CREF DATA\r
6582 >       ;END OF REPEAT 1\r
6583 \fSEARCH:        HLRZ    SX,SRCHX\r
6584         HRRZ    SDEL,SRCHX\r
6585 \r
6586 SRCH1:  CAML    AC0,-1(SX)\r
6587         JRST    SRCH3\r
6588 SRCH2:  SUB     SX,SDEL\r
6589         LSH     SDEL,-1\r
6590         CAMG    SX,SYMTOP\r
6591         JUMPN   SDEL,SRCH1\r
6592         JUMPN   SDEL,SRCH2\r
6593         SOJA    SX,SRCHNO       ;NOT FOUND\r
6594 \r
6595 SRCH3:  CAMN    AC0,-1(SX)\r
6596         JRST    SRCH4           ;NORMAL / FOUND EXIT\r
6597         ADD     SX,SDEL\r
6598         LSH     SDEL,-1\r
6599         CAMG    SX,SYMTOP\r
6600         JUMPN   SDEL,SRCH1\r
6601         JUMPN   SDEL,SRCH2\r
6602         SOJA    SX,SRCHNO       ;NOT FOUND\r
6603 \r
6604 SRCH4:  AOS     0(PP)           ;SET FOR SKIP EXIT\r
6605 SRCH5:  MOVSI ARG,SUPRBT        ;HE IS USING IT, TURN OFF BIT\r
6606         ANDCAM ARG,(SX) ; IN THE TABLE\r
6607 SRCH7:  MOVE ARG,0(SX)          ;FLAG AND VALUE TO ARG\r
6608         LDB     RC,RCPNTR       ;POINT 1,ARG,17\r
6609         TLNE ARG,LELF   ;CHECK LEFT RELOCATE\r
6610         TLO RC,1\r
6611         HRRZ    V,ARG\r
6612         TLNE ARG,SPTR   ;CHECK SPECIAL EXTESN POINTER\r
6613         JRST SRCH6\r
6614         TLNE    ARG,PNTF\r
6615         MOVE    V,0(ARG)                ;36BIT VALUE TO V\r
6616         JRST    SRCHOK\r
6617         \r
6618 SRCH6:  MOVE V,0(ARG)   ;VALUE\r
6619         MOVE RC,1(ARG)  ;AND RELOC\r
6620         TLNE RC,-2      ;CHECK AND SET EXTPNT\r
6621         HLLM RC,EXTPNT\r
6622         TRNE RC,-2      \r
6623         HRRM RC,EXTPNT\r
6624         JRST    SRCHOK\r
6625 SRCHNO: SKIPN   UNISCH+1        ;ALLOWED TO SEARCH OTHER TABLES\r
6626         POPJ    PP,             ;NO, JUST RETURN\r
6627         AOS     V,UNISCH        ;GET NEXT INDEX TO TABLE\r
6628         CAIE    V,1             ;FIRST TIME IN\r
6629         JRST    SRCHN1          ;YES, SAVE SYMBOL INFO\r
6630         HRLM    SX,UNISCH       ;SAVE SX AND SET FLAG\r
6631         MOVE    ARG,SRCHX       ;SEARCH POINTER\r
6632         MOVEM   ARG,UNISHX      ;TO A SAFE PLACE\r
6633         HRR     ARG,SYMBOL\r
6634         HRL     ARG,SYMTOP\r
6635         MOVEM   ARG,UNIPTR      ;STORE ALSO\r
6636 SRCHN1: MOVE    V,UNISCH(V)     ;GET TRUE INDEX\r
6637         JUMPE   V,SRCHKO        ;IF ZERO ALL TABLE SCANNED\r
6638         MOVE    ARG,UNISHX(V)   ;NEW SRCHX\r
6639         MOVEM   ARG,SRCHX       ;SET IT UP\r
6640         MOVE    ARG,UNIPTR(V)   ;SYMTOP,,SYMBOL\r
6641         HRRZM   ARG,SYMBOL\r
6642         HLRZM   ARG,SYMTOP\r
6643         JRST    SEARCH          ;TRY AGAIN\r
6644 \r
6645 SRCHKO: SETZ    ARG,            ;CLEAR ARG SO ZERO STORED\r
6646 SRCHOK: SKIPN   UNISCH          ;HAVE WE SEARCH OTHER TABLES\r
6647         POPJ    PP,             ;NO, JUST RETURN\r
6648 SYMBCK: HLRZ    SX,UNISCH       ;RESTORE SX\r
6649         SETZM   UNISCH          ;CLEAR SYMBCK FLAG\r
6650         PUSH    PP,V            ;SAVE AN AC\r
6651         MOVE    V,UNISHX        ;SRCHX\r
6652         MOVEM   V,SRCHX         ;RESTORE ORIGINAL\r
6653         MOVE    V,UNIPTR        ;SYMTOP,,SYMBOL\r
6654         HRRZM   V,SYMBOL\r
6655         HLRZM   V,SYMTOP\r
6656         JUMPE   ARG,SRCHK2      ;TOTALLY UNDEFINED\r
6657         PUSH    PP,RC           ;SAVE SOME ACCS\r
6658         PUSH    PP,ARG\r
6659         PUSH    PP,EXTPNT\r
6660         SETZB   ARG,EXTPNT      ;CLEAR ALL SYMBOL DATA\r
6661         SETZB   RC,V\r
6662         PUSHJ   PP,INSERT       ;INSERT SYMBOL IN TABLE\r
6663         POP     PP,EXTPNT       ;RESTORE ACCS ETC.\r
6664         POP     PP,ARG\r
6665         POP     PP,RC\r
6666         MOVEM   ARG,(SX)        ;SET FLAGS AND VALUE AS IT SHOULD BE\r
6667 SRCHK2: POP     PP,V\r
6668         POPJ    PP,             ;RETURN\r
6669 \r
6670 \fINSERQ:        TLNE    ARG,UNDF!VARF\r
6671 INSERZ: SETZB   RC,V\r
6672 INSERT: CAME    AC0,-1(SX)      ;ARE WE LOOKING AT MATCHING MNEMONIC?\r
6673         JRST    INSRT2          ;NO, JUST INSERT\r
6674         JUMPL   ARG,INSRT1      ;YES, BRANCH IF OPERAND\r
6675         SKIPL   0(SX)           ;OPERATOR, ARE WE LOOKING AT ONE?\r
6676         JRST    UPDATE          ;YES, UPDATE\r
6677         JRST    INSRT2          ;NO, INSERT\r
6678 \r
6679 INSRT1: SKIPG   0(SX)           ;OPERAND, ARE WE LOOKING AT ONE?\r
6680         JRST    UPDATE          ;YES, UPDATE\r
6681         SUBI    SX,2            ;NO, MOVE UNDER OPERATOR AND INSERT\r
6682 INSRT2: MOVE    SDEL,SYMBOL\r
6683         SUBI    SDEL,2\r
6684         CAMLE   SDEL,FREE\r
6685         JRST    INSRT3\r
6686         PUSHJ   PP,XCEEDS\r
6687         ADDI    SDEL,2000\r
6688 INSRT3: MOVEM   SDEL,SYMBOL     ;MAKE ROOM FOR A TWO WORD ENTRY\r
6689         HRLI    SDEL,2(SDEL)\r
6690         BLT     SDEL,-2(SX)     ;PUSH EVERYONE DOWN TWO LOACTIONS\r
6691         AOS     @SYMBOL         ;INCREMENT THE SYMBOL COUNT\r
6692         TLNN RC,-2      ;NEED SPECIAL?\r
6693         TRNE RC,-2      ;LEFT OR RIGHT EXTERNAL?\r
6694         JRST INSRT5     ;YES, JUMP\r
6695         TLNN    V,-1            ;SKIP IF V IS A 36BIT VALUE\r
6696         JRST    INSRT4          ;JUMP, ITS A 18BIT VALUE\r
6697         AOS     SDEL,FREE       ;36BIT, SO GET A CELL FROM FREE CORE\r
6698         CAML    SDEL,SYMBOL     ;MORE CORE NEEDED?\r
6699         PUSHJ   PP,XCEEDS       ;YES\r
6700         HRRI    ARG,-1(SDEL)    ;POINTER TO ARG\r
6701         MOVEM   V,0(ARG)        ;36BIT VALUE TO FREE CORE\r
6702         TLOA    ARG,PNTF        ;NOTE THAT ARG IS APOINTER, NOT A 18BIT VALUE\r
6703 \r
6704 INSRT4: HRR     ARG,V           ;18BIT VALUE TO ARG\r
6705         DPB     RC,RCPNTR       ;FIX RIGHT RELOCATION\r
6706         TLNE RC,1\r
6707         TLO ARG,LELF    ;FIX LEFT RELOCATION\r
6708 INSRT6: MOVEM   ARG,0(SX)       ;INSERT FLAGS AND VALUE.\r
6709         MOVEM   AC0,-1(SX)      ;INSERT SYMBOL NAME.\r
6710         PUSHJ   PP,SRCHI        ;INITILIAZE SRCHX\r
6711         JRST    QSRCH           ;EXIT THROUGH CREF\r
6712         \r
6713 INSRT5: MOVEI SDEL,2    ;GET TWO CELLS FROM FREE CORE\r
6714         ADDB SDEL,FREE\r
6715         CAML SDEL,SYMBOL;MORE CORE NEEDED?\r
6716         PUSHJ PP,XCEEDS ;YES\r
6717         MOVEM RC,-1(SDEL)\r
6718         HRRI ARG,-2(SDEL)       ;POINTER TO ARG\r
6719         MOVEM V,0(ARG)\r
6720         TLO ARG,SPTR    ;SET SPECIAL POINTER, POINTS TO TWO CELLS\r
6721         JRST INSRT6\r
6722 \fREMOVE:        SUBI    SX,2            ;MOVE EVERYONE UP TWO LOCATIONS\r
6723 REMOV1: MOVE    0(SX)\r
6724         MOVEM   2(SX)           ;OVERWRITE THE DELETED SYMBOL\r
6725         CAME    SX,SYMBOL       ;SKIP WHEN DONE\r
6726         SOJA    SX,REMOV1\r
6727         ADDI    SX,2\r
6728         MOVEM   SX,SYMBOL\r
6729         SOS     0(SX)           ;DECREMENT THE SYMBOL COUNT\r
6730 \r
6731 SRCHI:  MOVEI   AC2,0           ;THIS CODE SETS UP SRCHX\r
6732         FAD     AC2,@SYMBOL\r
6733         LSH     AC2,-?D27\r
6734         MOVEI   AC1,1000\r
6735         LSH     AC1,-357(AC2)\r
6736         HRRM    AC1,SRCHX\r
6737         LSH     AC1,1\r
6738         ADD     AC1,SYMBOL\r
6739         HRLM    AC1,SRCHX\r
6740         POPJ    PP,             ;SRCHX=XWD <SYMTBL+LENGTH/2>,LENGTH/4\r
6741 \r
6742 \fUPDATE:        DPB     RC,RCPNTR       ;FIX RIGHT RELOCATION\r
6743         TLNE ARG,SPTR   ;SKIP IF THERE IS NO SPECIAL POINTER\r
6744         JRST UPDAT4     ;YES, USE THE TWO CELLS\r
6745         TLNN RC,-2      ;NEED TO CHANGE\r
6746         TRNE RC,-2      ;ANY CURRENT EXTERNS?\r
6747         JRST UPDAT5     ;YES ,JUMP\r
6748         TLZ ARG,LELF    ;CLEAR LELF\r
6749         TLNE RC,1       ;LEFT RELOCATABLE?\r
6750         TLO ARG,LELF    ;YES, SET THE FLAG\r
6751         TLNE    ARG,PNTF        ;WAS THERE A 36BIT VALUE?\r
6752         JRST    UPDAT2          ;YES, USE IT.\r
6753         TLNE    V,-1            ;NO,IS THERE A 36BIT VALUE?\r
6754         JRST    UPDAT1          ;YES, GET A CELL\r
6755         HRR     ARG,V           ;NO, USE RH OF ARG\r
6756 UPDAT3: MOVEM   ARG,0(SX)       ;OVERWRITE THE ONE IN THE TABLE\r
6757         POPJ    PP,             ;AND EXIT\r
6758 \r
6759 UPDAT1: AOS     SDEL,FREE       ;GET ONE CELL\r
6760         CAML    SDEL,SYMBOL     ;NEED MORE CORE?\r
6761         PUSHJ   PP,XCEEDS       ;YES\r
6762         HRRI    ARG,-1(SDEL)    ;POINTER TO ARG\r
6763         TLO     ARG,PNTF        ;AND NOTE IT.\r
6764 UPDAT2: TLNE ARG,EXTF   ;IS THERE A EXTERNAL?\r
6765         JRST UPDAT3             ;YES, - JUST SAVE A LOCATION\r
6766         MOVEM   ARG,0(SX)       ;NO, OVERWRITE THE POINTER IN THE TABLE\r
6767         MOVEM   V,0(ARG)        ;STORE VALUE AS A 36BIT VALUE\r
6768         POPJ    PP,             ;AND EXIT\r
6769         \r
6770 UPDAT4: MOVEM ARG,0(SX) ;WE HAVE TWO CELLS, WE USE THEM\r
6771         MOVEM V,0(ARG)  ;SAVE AS 36BIT VALUE\r
6772         MOVEM RC,1(ARG) ;SAVE RELOCATION BITS\r
6773         POPJ PP,                ;AND EXIT\r
6774 \r
6775 UPDAT5: MOVEI SDEL,2            ;THERE IS A EXTERNAL\r
6776         ADDB SDEL,FREE          ;SO WE NEED TWO LOACTIONS\r
6777         CAML SDEL,SYMBOL        ;NEED MORE CORE?\r
6778         PUSHJ PP,XCEEDS         ;YES\r
6779         MOVEM RC,-1(SDEL)       ;SAVE RELOCATION BITS\r
6780         HRRI ARG,-2(SDEL)       ;SAVE THE POINTER IN ARG\r
6781         MOVEM V,0(ARG)          ;SAVE A 36BIT VALUE\r
6782         TLO ARG,SPTR            ;SET SPECIAL PNTR FLAG\r
6783         TLZ ARG,PNTF            ;CLEAR POINTER FLAG\r
6784         JRST UPDAT3             ;SAVE THE POINTER AND EXIT\r
6785 \r
6786 \f       SUBTTL  CONSTANTS\r
6787 \r
6788 \r
6789 IFN FORMSW,<\r
6790 HWFORM: BYTE    (18) 1,1\r
6791 INFORM: BYTE    (9) 1 (4) 1 (1) 1 (4) 1 (18) 1\r
6792 IOFORM: BYTE    (3) 1 (7) 1 (3) 1 (1) 1 (4) 1 (18) 1\r
6793 BPFORM: BYTE    (6) 1,1 (2) 1 (4) 1 (18) 1\r
6794 ASCIIF: BYTE    (7) 1,1,1,1,1\r
6795 SXFORM: BYTE    (6) 1,1,1,1,1,1\r
6796 >\r
6797 \r
6798 \f       SUBTTL PHASED CODE\r
6799 LSTFIL: BLOCK 1\r
6800         SIXBIT /@/      ;SYMBOL TO STOP PRINTING\r
6801 TAG:    BLOCK   1\r
6802         SIXBIT  / + @/\r
6803 TABI:\r
6804 IFE FORMSW,<    BYTE    (7) 0, 11, 11, 11, 11>\r
6805 IFN FORMSW,<    BYTE    (7) 11,11, 11, 11, 11>\r
6806 SEQNO:  BLOCK   1\r
6807         ASCIZ   /       /\r
6808 BININI: EXP     B\r
6809 BINDEV: BLOCK   1\r
6810         XWD     BINBUF,0\r
6811 LSTINI: EXP     AL\r
6812 LSTDEV: BLOCK   1\r
6813         XWD     LSTBUF,0\r
6814 INDEVI: EXP     A\r
6815 INDEV:  BLOCK   1\r
6816         XWD     0,IBUF\r
6817 DBUF:   ASCIZ   / TI:ME DY-MON-YR PAGE /\r
6818 VBUF:   ASCIZ   /       MACRO / ;MUST BE LAST LOCATIONS IN BLOCK\r
6819         BLOCK   3       ;ALLOW FOR LONG TITLE\r
6820 \r
6821 \r
6822 \fSUBTTL STORAGE CELLS\r
6823 \r
6824 PASS1I:\r
6825 \r
6826 RP:     BLOCK   1\r
6827 \r
6828 CTIBUF: BLOCK   3\r
6829 CTOBUF: BLOCK   3\r
6830 LSTBUF: BLOCK   3\r
6831 BINBUF: BLOCK   3\r
6832 IBUF:   BLOCK   3\r
6833 LSTDIR: BLOCK   4\r
6834 BINDIR: BLOCK   4\r
6835 INDIR:  BLOCK   4\r
6836 \r
6837 ACDELX:                         ;LEFT HALF\r
6838 BLKTYP: BLOCK   1               ;RIGHT HALF\r
6839 \r
6840 COUTX:  BLOCK   1\r
6841 COUTY:  BLOCK   1\r
6842 COUTP:  BLOCK   1\r
6843 COUTRB: BLOCK   1\r
6844 COUTDB: BLOCK   ?D18\r
6845 \r
6846 ERRCNT: BLOCK   1\r
6847 FREE:   BLOCK   1\r
6848 IFBLK:  BLOCK   .IFBLK\r
6849 IFBLKA: BLOCK   .IFBLK\r
6850 LADR:   BLOCK   1\r
6851 NCOLLS: BLOCK   1\r
6852 LIMBO:  BLOCK   1\r
6853 LBUFP:  BLOCK   1\r
6854 LBUF:   BLOCK   <.CPL+5>/5\r
6855         BLOCK 1\r
6856 VARHD:  BLOCK   1\r
6857 VARHDX: BLOCK   1\r
6858 \r
6859 LITAB:  BLOCK   1\r
6860 LITABX: BLOCK   1\r
6861         BLOCK   1\r
6862 LITHD:  BLOCK   1\r
6863 LITHDX: BLOCK   1\r
6864 LITCNT: BLOCK   1\r
6865 LITNUM: BLOCK   1\r
6866 \r
6867 LOOKX:  BLOCK   1\r
6868 NEXT:   BLOCK   1\r
6869 OUTSW:  BLOCK   1\r
6870 PDP:    BLOCK   1\r
6871 RECCNT: BLOCK   1\r
6872 SAVBLK: BLOCK   RC\r
6873 SAVERC: BLOCK   1\r
6874 SBUF:   BLOCK   .SBUF/5\r
6875 SRCHX:  BLOCK   1\r
6876 SUBTTX: BLOCK   1\r
6877 SVSYM:  BLOCK   1\r
6878 SYMBOL: BLOCK   1\r
6879 SYMTOP: BLOCK   1\r
6880 SYMCNT: BLOCK 1\r
6881 \r
6882 STPX:   BLOCK   1\r
6883 STPY:   BLOCK   1\r
6884 STCODE: BLOCK   .STP\r
6885 STOWRC: BLOCK   .STP\r
6886 \r
6887 IFN FORMSW,<\r
6888 STFORM: BLOCK   .STP\r
6889 FORM:   BLOCK   1\r
6890 HWFMT:  BLOCK   1\r
6891 FLDSIZ: BLOCK   1\r
6892 IOSEEN: BLOCK   1\r
6893 >\r
6894 TABP:   BLOCK   1\r
6895 TCNT:   BLOCK   1               ;COUNT OF CHARS. LEFT IN TBUF\r
6896 TBUF:   BLOCK   .TBUF/5\r
6897 DEVBUF: BLOCK   6               ;STORE NAME.EXT CREATION DATE AND TIME\r
6898 TYPERR: BLOCK   1\r
6899 IONSYM: BLOCK   1       ;-1 SUPRESS LISTING OF SYMBOLS\r
6900 PRGPTR: BLOCK   1       ;POINTER TO CHAIN OF PRGEND BLOCKS\r
6901 ENTERS: BLOCK   1       ;-1 WHEN ENTERS HAVE BEEN DONE\r
6902 UNIVSN: BLOCK   1       ;-1 WHEN A UNIVERSAL SEEN\r
6903 \r
6904 \fPASS2I:\r
6905 \r
6906 ABSHI:  BLOCK 1\r
6907 HIGH:   BLOCK   1\r
6908 ACDEVX: BLOCK   1\r
6909 CPL:    BLOCK   1\r
6910 CTLSAV: BLOCK   1\r
6911 CTLS1:  BLOCK   1\r
6912 EXTPNT: BLOCK   1\r
6913 INTENT: BLOCK   1\r
6914 INREP:  BLOCK 1\r
6915 INDEF:  BLOCK 1\r
6916 INTXT:  BLOCK 1\r
6917 INCND:  BLOCK   1\r
6918 CALNAM: BLOCK   1\r
6919 CALPG:  BLOCK 1\r
6920 CALSEQ: BLOCK 1\r
6921 DEFPG:  BLOCK 1\r
6922 DEFSEQ: BLOCK 1\r
6923 LITPG:  BLOCK 1\r
6924 LITSEQ: BLOCK 1\r
6925 REPPG:  BLOCK 1\r
6926 REPSEQ: BLOCK 1\r
6927 TXTPG:  BLOCK 1\r
6928 TXTSEQ: BLOCK 1\r
6929 CNDPG:  BLOCK   1\r
6930 CNDSEQ: BLOCK   1\r
6931 IRPCNT: BLOCK   1\r
6932 IRPARG: BLOCK   1\r
6933 IRPARP: BLOCK   1\r
6934 IRPCF:  BLOCK   1\r
6935 IRPPOI: BLOCK   1\r
6936 IRPSW:  BLOCK   1\r
6937 LITLVL: BLOCK   1\r
6938 LITLBL: BLOCK   1               ;NAME OF LABEL DEFINED INSIDE A LITERAL\r
6939 \r
6940 ASGBLK: BLOCK   1\r
6941 LOCBLK: BLOCK   1\r
6942 \r
6943 LOCA:   BLOCK   1\r
6944 LOCO:   BLOCK   1\r
6945 RELLOC: BLOCK   1\r
6946 ABSLOC: BLOCK   1\r
6947 LPP:    BLOCK   1\r
6948 MODA:   BLOCK   1\r
6949 MODLOC: BLOCK   1\r
6950 MODO:   BLOCK   1\r
6951 OUTSQ:  BLOCK 2\r
6952 PAGEN.: BLOCK   1\r
6953 PPTEMP: BLOCK   1\r
6954 PPTMP1: BLOCK   1\r
6955 PPTMP2: BLOCK   1\r
6956 \r
6957 REPCNT: BLOCK   1\r
6958 REPEXP: BLOCK   1\r
6959 REPPNT: BLOCK   1\r
6960 RPOLVL: BLOCK   1\r
6961 R1BCNT: BLOCK 1\r
6962 R1BCHK: BLOCK 1\r
6963 R1BBLK: BLOCK .R1B\r
6964 R1BLOC: BLOCK 1\r
6965 RIMLOC: BLOCK   1\r
6966 TAGINC: BLOCK   1\r
6967 VECREL: BLOCK   1\r
6968 VECTOR: BLOCK   1\r
6969 .TEMP:  BLOCK   1               ;TEMPORARY STORAGE\r
6970 UNISCH: BLOCK   .UNIV           ;SEARCH TABLE FOR UNIVERSALS\r
6971 SQFLG:  BLOCK 1\r
6972 ARGF:   BLOCK   1\r
6973 MACENL: BLOCK   1\r
6974 MACLVL: BLOCK   1\r
6975 MACPNT: BLOCK   1\r
6976 WWRXX:  BLOCK   1\r
6977 RCOUNT: BLOCK   1               ;COUNT OF WORDS STILL TO READ IN LEAF\r
6978 WCOUNT: BLOCK   1               ;COUNT OF WORDS STILL FREE IN LEAF\r
6979 PASS2Z:                         ;ONLY CLEAR TO HERE ON PRGEND\r
6980 LSTSYM: BLOCK   1\r
6981 PAGENO: BLOCK   1\r
6982 SEQNO2: BLOCK 1\r
6983 PASS2X:\r
6984 \r
6985 \fSUBTTL MULTI-ASSEMBLY STORAGE CELLS\r
6986 \r
6987 LSTPGN: BLOCK 1\r
6988 HDAS:   BLOCK 1\r
6989 IFN FORMSW,<PHWFMT:     BLOCK 1>\r
6990 MACSIZ: BLOCK   1               ;INITIAL SIZE OF LOW SEG\r
6991 UNISIZ: BLOCK   1               ;TOP OF BUFFERS AND STACKS\r
6992 UNITOP: BLOCK   1               ;TOP OF UNIVERSAL SYMBOL TABLE\r
6993 UNIVNO: BLOCK   1               ;NUMBER OF UNIVERSALS SEEN\r
6994 UNITBL: BLOCK   .UNIV           ;TABLE OF UNIVERSAL NAMES\r
6995 UNIPTR: BLOCK   .UNIV           ;TABLE OF SYMBOL POINTERS\r
6996 UNISHX: BLOCK   .UNIV           ;TABLE OF SRCHX POINTERS\r
6997         VAR                     ;CLEAR VARIABLES\r
6998 \r
6999 JOBFFI: BLOCK   203*NUMBUF+1            ;INPUT BUFFER PLUS ONE\r
7000 \r
7001         END     BEG\r
7002 \f\r
7003 \r