src/macro.25

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