src/macro.v46

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