sw/os8/v3d/sources/system/dectapes/dectape6/PAL8.PA

   1 /2 PAL8 ASSEMBLER FOR OS/8 MONITOR      VERSION 10
   2 /
   3 /
   4 /
   5 /
   6 /
   7 /
   8 /
   9 /
  10 /
  11 /COPYRIGHT  (C) 1970,1971,1972,1973,1974,1975 BY DIGITAL EQUIPMENT CORPORATION
  12 /
  13 /
  14 /
  15 /
  16 /
  17 /
  18 /
  19 /
  20 /
  21 /
  22 /THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
  23 /AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
  24 /CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
  25 /FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
  26 /
  27 /THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
  28 /UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
  29 /(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
  30 /SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
  31 /
  32 /DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
  33 /OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
  34 /DIGITAL.
  35 /
  36 /
  37 /
  38 /
  39 /
  40 /
  41 /
  42 /
  43 /
  44 /
  45 \f/1-OCT-75                              MB/MB/SM/MB/RL/JR/SR
  46
  47 DECIMAL
  48
  49 VERSION=        10
  50 SUBVERSION=     "A
  51
  52 OCTAL
  53
  54 /PAL8 IS AN 8K THREE PASS ASSEMBLER DESIGNED
  55 /TO BE COMPATIBLE WITH THE OS/8 SYSTEM.
  56
  57 /PASS 1 READS THE INPUT (SOURCE) FILE AND CONSTRUCTS
  58 /THE SYMBOL TABLE.
  59
  60 /PASS 2 GENERATES THE BINARY (OBJECT) FILE, WHICH
  61 /MAY BE LOADED WITH THE ABSOLUTE (BINARY) LOADER.
  62
  63 /PASS 3 GENERATES THE OCTAL SYMBOLIC ASSEMBLY
  64 /LISTING.
  65
  66 /PAL8 IS COMPATIBLE IN MOST RESPECTS WITH PAL III, MACRO-8
  67 /4K PAL-D, AND 8K PAL-D, AS WELL AS THE CROSS-ASSEMBLER PAL10.
  68
  69         IFNDEF HASH<HASH=1>     /DEFINE FOR HASH SYMBOL TABLE
  70 /SET HASH=0 TO GET OLD PAL8 WAY OF HANDLING SYMBOL TABLE
  71
  72 /MAINTENANCE RELEASE CHANGES:
  73
  74 /1.     INCLUDED JIM ROTH'S HASH TABLE MODIFICATIONS
  75 /2.     ALLOWED /B TO WORK PROPERLY [SEQ #2 PATCH FROM AUG '74 DSN]
  76 /3.     PUT CREFLS.TM ON SYS: NOT DSK: [PATCH SEQ #3, SEP '74 DSN]
  77 /4.     FIXED 7TH LEVEL CHECKSUM BIT [PATCH SEQ #7, MARCH '75 DSN]
  78 /5.     ALLOWED PAL8 TO RESTART BEFORE CD EXECUTED [DSN APR '75, SEQ #8]
  79 /6.     FIXED /F SO IT WORKS [PATCH SEQ #9, DSN APRIL 1975]
  80 /7.     FIXED /W SO IT DOESN'T REMEMBER TOP OF PAGE [DSN OCT '75]
  81 /8.     FIXED BUG RE MULTIPLE NON-RES INPUT HANDLERS
  82 /9.     CHANGED VERSION # TO V10, EDIT 1, 1975 COPYRIGHT
  83 /10.    ADDED DOCUMENTATION ON LOCATION OF HANDLERS AND BUFFERS
  84 /11.    CORE ALLOCATION:
  85 /       WITHOUT /K, ALL CORE BUT 10000-11777 USED FOR SYMBOLS
  86 /       WITH /K, USES ALL CORE (AND SWAPS USR BETWEEN PASSES)
  87 /       UNDER BATCH, N5000-N7777 IS RESERVED FOR BATCH RESIDENT AS WELL
  88 /12.    /7 WITH HASH FEATURES PRINTS 7 COLUMN SYMBOL TABLE
  89 /13.    14-DEC-75 JR: FIXED TYPO IN /W CODE IN LITERAL DUMP ROUTINE
  90
  91 /JR     14-APR-77 ADDED STANDARD DATE FORMAT TO HEADING
  92 \f/COMMAND DECODER RULES:
  93
  94 /*BINARY(.BN),LISTING(.LS),CREF(.LS)<SOURCE(.PA),.../OPTIONS
  95
  96 /OPTIONS:
  97 /B      BYTE SHIFT      - ! IS 6 BIT SHIFT (!=^100+)
  98 /C      CREF AFTER      - "CREFLS.TM" CREATED IF NO CREF
  99 /D      DDT TYPE SYMBOL - ONLY IF LISTING
 100 /E      'LG' ERROR      - LINKS ARE ERRORS
 101 /F      NO TEXT FILL    - NO EXTRA 0 FILL IN 'TEXT'
 102 /G      LOAD+GO AFTER   - SAME AS /L, BUT /G PASSED TO ABSLDR
 103 /H      NO PAGING       - ONLY IF LISTING
 104 /J      JUST WHAT LOADS - INHIBITS LISTING OF UNASSEMBLED CODE
 105 /K      CHECK FOR MORE THAN 8K OF CORE (DEFAULT IS 8K)
 106 /L      LOAD AFTER      - "PAL8BN.TM" CREATED IF NO BINARY
 107 /N      NO LISTING      - ONLY IF LISTING
 108 /O      NO 200 ORG      - NO AUTOMATIC 200 ORIGIN AFTER 'FIELD'
 109 /S      NO SYMBOL TABLE - ONLY IF LISTING
 110 /T      CR-LF NOT FF    - ONLY IF LISTING
 111 /W      WIPE LITERALS   - INHIBITS REMEMBERING OF LITERAL BOUNDS
 112
 113 /PERMANENT PATCH LOCATIONS FOR THE ABOVE SWITCHES ARE SYMBOLS
 114 /OF THE FORM Z(SW)(PATCH) - E.G. ZT7640 IS THE LOC TO PATCH TO 7640
 115 /TO REVERSE THE POLARITY OF THE "T" SWITCH.
 116
 117 /PSEUDO-OPS:
 118 /DECIMAL        RADIX TO BASE 10
 119 /DEVICE         2 WORD DEVICE CODE
 120 /DTORG          TYPESETTING TAPE ORIGIN
 121 /EJECT          SKIPS TO A NEW PAGE, AND IF ANY TEXT FOLLOWS,
 122 /               THAT TEXT BECOMES THE NEW HEADER LINE
 123 /ENPUNCH        ENABLE PUNCHING
 124 /EXPUNGE        REMOVE ALL SYMBOLS
 125 /FIELD          SET FIELD
 126 /FILENAME       4 WORD FILE CODE
 127 /FIXMRI         DEFINE MEMORY REFERENCE INSTRUCTION
 128 /FIXTAB         MAKE ALL SYMBOLS PERMANENT
 129 /IFDEF          CONDITIONAL ON DEFINITION
 130 /IFNDEF         CONDITIONAL ON UNDEFINED
 131 /IFNZRO         CONDITIONAL ON NON-ZERO
 132 /IFZERO         CONDITIONAL ON ZERO
 133 /NOPUNCH        DISABLE PUNCHING
 134 /OCTAL          RADIX TO BASE 8
 135 /PAGE           RE-ORIGIN TO BEGINNING OF NEXT PAGE OR PAGE N
 136 /PAUSE          ALTERNATE END-OF-FILE
 137 /RELOC          ASSEMBLE FOLLOWING CODE AS IF LOC = ARG OF RELOC
 138 /TEXT           6 BIT TEXT
 139 /XLIST          LISTING INHIBIT UNLESS THE XLIST IS
 140 /               FOLLOWED BY AN EXPRESSION. THEN IF THE EXPRESSION
 141 /               IS 0 START LISTING, OR NON-0 THEN INHIBIT LISTING
 142 /ZBLOCK         RESERVE BLOCK OF ZEROS
 143 \f/SYMBOL LAYOUT:
 144
 145 /       WORD 1  BIT 0=1 PERMANENT SYMBOL
 146 /               BIT 1=1 "I" OR "Z"
 147 /               BITS 3-11       CHARS 1 AND 2
 148 /
 149 /       WORD 2  BIT 0=1 MEMORY REFERENCE INSTRUCTION
 150 /               BITS 2-11       CHARS 3 AND 4
 151 /
 152 /       WORD 3  BIT 0=1 PSEUDO-OP
 153 /               BITS 2-11       CHARS 5 AND 6
 154 /
 155 /       WORD 4  BITS 0-11       OCTAL VALUE
 156 /CHARS ARE STORED AS:
 157 /       A TO Z ARE 01 TO 32
 158 /       0 TO 9 ARE 33 TO 44
 159 /
 160 /       CHAR1^45+CHAR2
 161
 162 /OPERATORS:
 163 /+              TWO'S COMPLEMENT ADD
 164 /-              TWO'S COMPLEMENT SUBTRACT
 165 /&              BOOLEAN AND
 166 /!              BOOLEAN INCLUSIVE 'OR' OR BYTE SHIFT
 167 /  (SPACE)      DELIMITER OR INCLUSIVE OR
 168 /^              MULTIPLY (REPEATED ADDITION)
 169 /%              DIVIDE (REPEATED SUBTRACTION)
 170 \f/DEFINITIONS
 171
 172 ASWAP=  40              /WATCH THIS SWAP AREA!!
 173 MDATE=  7666            /MONITOR DATE
 174 BIPCCL= 7777            /DATE EXTENSION AND BATCH IN PROG FLG IN FIELD 0
 175 MPARAM= 7643            /COMMAND DECODER OPTION LIST
 176 DCB=    7760            /DEVICE CONTROL BLOCK
 177 JSBITS= 7746            /JOB STATUS WORD
 178 BATOUT= 7400            /BATCH LOG OUTPUT ROUTINE IN BATCH RESIDENT
 179 LNPRPG= 70              /56 LINES PER PAGE
 180 HEDLEN= 50              /40 CHARACTERS IN PAGE TITLE
 181                         /(MUST BE A MULTIPLE OF 8)
 182
 183 AC7776= STA CLL RAL
 184 AC7775= STA CLL RTL
 185 AC4000= STL CLA RAR
 186 AC3777= STA CLL RAR
 187 AC2000= STL CLA RTR
 188 AC0002= STL CLA RTL
 189
 190
 191 /TABLE OF ERROR MESSAGE DEFINITIONS
 192
 193
 194 IZ= "I-240^100+"Z-240   /ILLEGAL PAGE ZERO REFERENCE
 195 CF= "C-240^100+"F-240   /CREF.SV NOT FOUND
 196 US= "U-240^100+"S-240   /UNDEFINED SYMBOL
 197 IP= "I-240^100+"P-240   /ILLEGAL PSEUDO-OP USAGE
 198 SE= "S-240^100+"E-240   /SYMBOL TABLE EXCEEDED
 199 ZE= "Z-240^100+"E-240   /PAGE ZERO EXCEEDED
 200 PE= "P-240^100+"E-240   /CURRENT PAGE EXCEEDED
 201 IC= "I-240^100+"C-240   /ILLEGAL CHARACTER
 202 ID= "I-240^100+"D-240   /ILLEGAL DEFINITION
 203 BE= "B-240^100+"E-240   /PUSH-DOWN OVERFLOW
 204 DE= "D-240^100+"E-240   /DEVICE ERROR
 205 DF= "D-240^100+"F-240   /DEVICE FULL
 206 LD= "L-240^100+"D-240   /ABSLDR.SV NOT FOUND
 207 IE= "I-240^100+"E-240   /ILLEGAL EQUATE
 208 PH= "P-240^100+"H-240   /PHASE ERROR
 209 II= "I-240^100+"I-240   /ILLEGAL INDIRECT
 210 RD= "R-240^100+"D-240   /REDEFINITION
 211 UO= "U-240^100+"O-240   /UNDEFINED ORIGIN
 212 LG= "L-240^100+"G-240   /LINK GENERATED
 213
 214
 215
 216 /ABBREVIATIONS
 217 /CR/LF  CARRIAGE RETURN/LINE FEED (215,212)
 218 /F/F    FORM FEED (214)
 219 \f/PAGE ZERO
 220
 221 *0
 222 FORMF6, 0               /USED IN DECIMAL PRINT ROUTINE
 223 ERROR5, 0               /USED BY PACKED ASCII PRINT ROUTINE
 224 PTR,    0               /V3C USED BY
 225 KNTR,   0               /INPUT ROUTINE
 226
 227 /AUTOINDEX REGISTERS
 228 /PRESET FOR ONCE ONLY CODE
 229
 230 *10
 231 PDLXR,  PDLST           /PUSH-DOWN AUTO INDEX REGISTER
 232 TAGXR,  SWAP1-1         /TAG AUTO INDEX REGISTER
 233 XREG1,  DSWIT1-1        /GENERAL AUTO INDEX REGISTER
 234 XREG2,  DSWIT2-1        /GENERAL AUTO INDEX REGISTER
 235
 236 /NOT USED AS AUTO INDEX REGISTERS
 237 /EXCEPT DURING ONCE ONLY CODE
 238
 239 LAST1,  DATE-1          /LAST DEFINED SYMBOL
 240 LAST2,  SWAP2-1
 241 LAST3,  IFZERO  HASH    <SYMPRT+4-1>
 242         IFNZRO  HASH    <SYMNWP-1>
 243 LAST4,  IFZERO  HASH    <SYMPR9-2-1>
 244         IFNZRO  HASH    <SYMDDT-1>
 245
 246 *20
 247 TAG1,   0               /TAG STORAGE
 248 TAG2,   0
 249 TAG3,   0
 250
 251 LITPTR, 200             /LITERAL POINTER
 252
 253 RADIX,  0               /7777 IF DECIMAL MODE
 254 PUNCHX, 0               /NON-ZERO IF NO PUNCHING
 255 XLISTX, 0               /NON-ZERO IF NO LISTING
 256 /*NOTE* PUNCHX AND XLISTX MUST BE TOGETHER
 257 /AND IN THIS ORDER
 258
 259 LOC,    200             /CURRENT LOCATION
 260 OFFSET, 0               /LOCATION COUNTER OFFSET FROM "LOC"
 261 OFSBUF, 0               /LOCATION COUNTER OFFSET BUFFER
 262 STARSW, 0               /-1 IF NEXT ORIGIN SHOULD BE INHIBITED
 263
 264 OP,     0               /LAST OPERATOR CODE (0-6)
 265 VALUE,  0               /EXPRESSION VALUE
 266 VALUE2, 0               /EXPRESSION OPERAND
 267
 268 TXTSWT, 0               /SPACE SWITCH
 269 TXTPTR, LINBUF+120      /TEXT POINTER
 270 CHAR,   0               /CURRENT CHARACTER
 271
 272 THISPG, 0               /OVERFLOW PAGE
 273 EDITPG, 0               /EDITOR PAGE
 274 \fTEMP,  0               /TEMPORARY REGISTERS
 275 TEMP1,  0
 276 TEMP2,  0
 277 TEMP3,  0
 278
 279 OCHAR,  OUTPUT          /OUTPUT ROUTINE
 280 OERROR, OTYPEO          /PASS 1=OTYPEO; 2=OTYPEO; 3=LISOUT
 281 PASS,   -2              /-1 IF PASS 1, 0 IF PASS 2, 1 IF PASS 3
 282 IOMON,  200             /USER SERVICE ROUTINES
 283 CONDSW, 0               /NUMBER OF NESTED CONDITIONALS
 284 EXPIND, 0               /0 IF MRI OK HERE
 285                         /NOT 0 IF MRI NOT OK HERE
 286 CHKSUM, 0               /BINARY CHECK SUM
 287 IZIND,  0               /"I" AND "Z" INDICATOR
 288                         /IF I, LEFT 6 BITS ARE NON-ZERO
 289                         /IF Z, RIGHT 6 BITS ARE NON-ZERO
 290 THISTG, 0               /ASSIGNED NUMBER OF CURRENT TAG
 291 HIGHTG, SYME-SYMS%4-1   /ASSIGNED NUMBER OF LAST TAG
 292 LINCNT, 0               /LINE COUNT
 293 ALPHAI, 0               /UNDEFINED TAG INDICATOR
 294                         /-1 IF UNDEFINED
 295 GETCI,  0               /NOT=0 IF ONLY CARRIAGE RETURN ENDS LINE
 296                         /OTHERWISE /,;, OR CARRIAGE RETURN ENDS
 297 LSTCNT, 0               /TAB COUNTER
 298 UNDFSW, 0               /UNDEFINED SWITCH
 299 INCTL,  601             /CONTROL WORD - FOR OS/8 I/O
 300 LINKSW, 0               /OFF-PAGE LINK SWITCH
 301                         /0 IF NO LINK GENERATED, 0700 IF LINK
 302 LININD, 0               /BACK-UP FOR LINKSW
 303 PERROR, PERRO1          /DUMMY ERROR ROUTINE TO SUPPRESS CERTAIN
 304                         /MESSAGES DURING PASS 1
 305 FLDIND, "0              /CURRENT FIELD IN ASCII DIGIT FORM
 306 BINSRT, 0               /BINARY OR LISTING STARTING
 307 ERCNT,  0               /ERROR COUNTER
 308 LINK,   0               /LINK COUNTER
 309         IFNZRO HASH<
 310 TAGMAX, 0               /SET TO PRIME # EQ TO MAX # SYMS
 311         >
 312         PAGE
 313 \f/STARTING ADDRESS OF PAL8 (0200)
 314 /CHAINING ADDRESS (0201)
 315
 316 NAME1,  JMP I NAME3     /NAME1-NAME3 USED LATER
 317 NAME2,  JMP I GETTA2    /TO STORE TAGS AS THEY ARE BUILT
 318 NAME3,  BEGIN           /V3C
 319 GETTA2, NOCD            /BUILDING SWITCH AND OVERFLOW PROTECT
 320
 321
 322 /HANDLERS FOR NOPUNCH AND ENPUNCH PSEUDO-OPS
 323
 324 NOPUNX, CLA IAC         /NON-ZERO FOR NO PUNCHING
 325 ENPUNX, DCA PUNCHX      /ZERO FOR PUNCHING
 326         JMP I [LOOKEX   /--EXIT TO MAIN--
 327
 328
 329 /HANDLERS FOR DECIMAL AND OCTAL PSEUDO-OPS
 330
 331 DECIMX, STA             /7777 FOR DECIMAL RADIX
 332 OCTALX, DCA RADIX       /ZERO FOR OCTAL RADIX
 333         JMP I [LOOKEX   /--EXIT TO MAIN--
 334 \f/GET A TAG ROUTINE
 335 /PICKS UP A TAG AND SEARCHES FOR IT
 336 /"THISTG" HAS NUMBER OF TAG
 337 /"VALUE2" HAS VALUE
 338 /AC=7777 ON RETURN IF TAG NOT FOUND, 0 IF FOUND
 339
 340 GETTAG, 0
 341         DCA NAME1       /CLEAR BUILD AREA
 342         DCA NAME2
 343         DCA NAME3
 344         TAD [NAME1
 345         DCA GETTA4      /SET POINTER FOR BUILDING
 346         DCA GETTA2      /ZERO SWITCH
 347 GETTG1, TAD CHAR        /GET THE CHARACTER
 348         AND [77         /MAKE IT 01-32 OR 60-71
 349         TAD (-32        /WAS IT A TO Z?
 350         SMA SZA
 351         TAD (-25        /NO - MAKE 60-71 INTO 33-44
 352         TAD (32         /YES - IT IS NOW 01-32 OR 33-44
 353         ISZ GETTA2      /LEFT SIDE?
 354         JMP GETTA3      /YES
 355         TAD I GETTA4    /NO - RIGHT SIDE
 356         DCA I GETTA4    /BUILD THE WORD
 357         ISZ GETTA4      /BUMP TO NEXT WORD
 358 GETTA1, JMS I [GETC     /GET NEXT CHARACTER
 359         JMS I [TSTALN   /IS IT ALPHANUMERIC?
 360         JMP GETTG1      /YES - KEEP BUILDING
 361         IFZERO HASH<
 362         TAD HIGHTG      /NO - GET NUMBER OF HIGHEST TAG
 363         CLL RAR         /DIVIDE BY 2
 364         DCA TEMP2       /SAVE DIFFERENCE
 365         DCA THISTG      /START AT TAG ZERO
 366         CLL CML         /LINK MUST BE ON INITIALLY
 367         DCA TEMP1
 368
 369
 370 /GETTA4 IS POINTER TO NAME1-NAME3
 371 /FOR DEPOSITING TAG AS IT IS BUILT
 372
 373 /TEMP2 IS # OF TAGS TO SKIP BETWEEN CHECKS FOR MATCH
 374 /DURING BINARY SEARCHING
 375 \fGETTG2,        SZL             /IS THISTG HIGHER THAN TAG?
 376         JMP GETTG3      /NO-LOWER
 377 GETTG4, DCA TEMP1       /CLEAR LAST TIME SWITCH
 378         SNL
 379         ISZ TEMP1       /SET LAST TIME SWITCH TO 1
 380         TAD TEMP2       /GET # OF TAGS TO SKIP
 381         SNL
 382         CIA
 383         TAD THISTG      /INCREASE OR DECREASE TAG NUMBER
 384         DCA THISTG
 385         TAD TEMP2       /GET NUMBER
 386         CLL RAR         /DIVIDE BY 2
 387         SNA             /IS RESULT 0?
 388         ISZ TEMP1       /YES-BUMP LAST TIME SWITCH
 389         SNA
 390         IAC             /IF RESULT WAS 1, MAKE IT 2
 391         DCA TEMP2       /SAVE IT FOR NEXT TIME
 392         JMS I [FINDTG   /GET THE TAG
 393         TAD [1777       /MASK
 394         AND TAG1        /GET WORD 1
 395         CLL CIA
 396         TAD NAME1       /DOES IT MATCH?
 397         SZA CLA
 398         JMP GETTG2      /NO - TRY NEXT TAG
 399         AC3777
 400         AND TAG2        /YES - GET WORD 2
 401         CLL CIA
 402         TAD NAME2       /DOES IT MATCH?
 403         SZA CLA
 404         JMP GETTG2      /NO - TRY NEXT TAG
 405         AC3777
 406         AND TAG3        /YES - DOES IT MATCH?
 407         CLL CIA
 408         TAD NAME3
 409         SZA CLA
 410         JMP GETTG2      /NO - TRY NEXT TAG
 411         JMP I GETTAG    /YES--RETURN--
 412 \fGETTG3,        AC7776
 413         TAD TEMP1       /LAST TIME SWITCH = 2?
 414         SZA CLA
 415         JMP GETTG4      /NO-KEEP TRYING
 416         ISZ THISTG      /YES-QUIT SEARCHING
 417         DCA VALUE2
 418         DCA TAG1
 419         DCA TAG2
 420         DCA TAG3        /TAG NOT FOUND
 421         STA             /AC=7777 MEANS NOT FOUND
 422         JMP I GETTAG    /--RETURN--
 423         >
 424 \f       IFNZRO HASH<
 425         PRIME=TAGMAX
 426
 427 GETTGH,/JMS I   [TLYREF /HACK ONLY
 428         TAD NAME1       /HASH OUR NAME
 429         CLL RTL
 430         TAD     NAME2
 431         RTL
 432         TAD     NAME3
 433         RTL
 434         TAD     NAME1
 435         JMS     PROBE   /NOW PROBE THE TABLE
 436         TAD     NAME1   /RE HASH THE NAME FOR A STEPSIZE
 437         CLL RAL
 438         RTL
 439         TAD     NAME2
 440         CLL             /CALC MODULO PRIME INLINE
 441         TAD     MPRIME
 442         SZL
 443         JMP     .-3
 444         TAD     PRIME
 445         SNA
 446         IAC             /STEPSIZE MUST BE NON ZERO!
 447         DCA     CRPDEL
 448 PRBLUP, CLL
 449         TAD     THISTG  /BUMP THE POINTER RANDOMLY
 450         TAD     CRPDEL
 451         SZL             /PROTECT AGAINST WRAP AROUND
 452         TAD     MPRIME  /PROBABLY UNOPTIMAL SOLUTION
 453         JMS     PROBE
 454         JMP     PRBLUP
 455
 456 PROBE,  0
 457         CLL
 458         TAD     MPRIME
 459         SZL
 460         JMP     .-3
 461         TAD     PRIME
 462         DCA     THISTG  /THISTG MODULO PRIME
 463 /       JMS I   [TLYPRB /HACK ONLY
 464         JMS I   [FINDTG /GO GET IT
 465         TAD     [1777   /MASK THE TYPE BITS OUT
 466         AND     TAG1    /IS THERE ONE?
 467         SNA
 468         JMP     NOTFND  /NO EXIT POINTING AT IT
 469         CIA             /YES, DO A COMPARE
 470         TAD     NAME1
 471         SZA CLA
 472         JMP I   PROBE
 473         AC3777
 474         AND     TAG2
 475         CIA
 476         TAD     NAME2
 477         SZA CLA
 478         JMP I   PROBE
 479         AC3777
 480         AND     TAG3
 481         CIA
 482         TAD     NAME3
 483         SZA CLA
 484         JMP I   PROBE   /FOUND EXIT WITH AC CLEAR
 485         JMP I   GETTAG
 486 NOTFND, STA             /NOT FOUND EXIT WITH AC SET
 487         JMP I   GETTAG
 488
 489 CRPDEL, 0
 490 MPRIME, 0               /INITIALIZED BY ONCE ONLY CODE FOR MACHINE AT HAND
 491         >
 492
 493
 494 GETTA3, DCA GETTA2      /SAVE CHAR
 495         TAD GETTA2
 496         CLL RTL         /*4
 497         RAL             /*10
 498         TAD GETTA2      /*11
 499         RTL             /*44
 500         TAD GETTA2      /*45
 501         DCA I GETTA4    /SET LEFT SIDE
 502         TAD GETTA4
 503         TAD (-GETTA2
 504         SZA CLA         /IS THIS AN OVERFLOW (>6) CHAR?
 505         STA             /NO - SET SWITCH TO RIGHT HALF
 506         DCA GETTA2      /YES - LEAVE SWITCH AT LEFT HALF
 507         JMP GETTA1
 508
 509 GETTA4, NAME1
 510 \f/IGNORE SPACES ROUTINE
 511
 512 SPNOR,  0
 513         TAD CHAR        /GET THE CHARACTER
 514         TAD [-240       /IS IT A SPACE?
 515         SZA CLA
 516         JMP I SPNOR     /NO --RETURN--
 517         JMS I [GETC     /YES - GET NEXT CHARACTER
 518         JMP SPNOR+1     /LOOP
 519
 520
 521 /HANDLER FOR PAUSE PSEUDO-OP
 522 /END-OF-TAPE OR END-OF-FILE
 523
 524 PAUSEX, AC4000
 525         DCA CHAR        /SET END-OF-LINE CHARACTER
 526         TAD [LINBUF+120 /REINITIALIZE TEXT POINTER
 527         DCA TXTPTR
 528         CLA CMA
 529         DCA I (INCHCT   /INDICATE EMPTY BUFFER
 530         ISZ I (INEOF    /SET END-OF-FILE
 531         JMP I [LOOKEX   /--EXIT TO MAIN--
 532         PAGE
 533 \f/OUTPUT 2 CHARACTER ERROR CODE
 534
 535 ERROR1, 0
 536         DCA ERROR5
 537         TAD ERROR5
 538         JMS I [RTL6
 539         RAL
 540         AND [77
 541         TAD [240        /CONVERT SIXBIT TO ASCII
 542         JMS I OERROR    /OUTPUT FIRST CHAR
 543         TAD ERROR5
 544         AND [77
 545         TAD [240
 546         JMS I OERROR    /OUTPUT SECOND CHAR
 547         JMP I ERROR1    /--RETURN--
 548
 549 /HANDLER FOR FIELD PSEUDO-OP
 550
 551 FIELDX, JMS I [SPNOR    /IGNORE SPACES
 552         JMS I [DUMPS    /DUMP CURRENT PAGE LITERALS
 553         JMS I [DUMPZ    /DUMP PAGE ZERO LITERALS
 554         JMS I [EXP      /GET EXPRESSION
 555         TAD VALUE       /TRIM TO RIGHT 3 BITS
 556         AND [7
 557         DCA FLDIND      /STORE FOR LISTING
 558         TAD PASS        /IS THIS PASS 2?
 559         SZA CLA
 560         JMP FIELDY      /NO - PREPARE TO EXIT
 561         TAD FLDIND      /YES - GET FIELD NUMBER
 562         CLL RTL
 563         RAL             /AND CHANNELS 7 AND 8
 564         TAD [7700
 565         JMS I OCHAR     /OUTPUT FIELD SETTING
 566 FIELDY, JMS I [CLEAN    /CLEAN UP THINGS
 567         TAD [200        /RESET ORIGIN TO 200
 568         JMP STAR1
 569
 570 /CHANGE LAST 2 LOCATIONS TO:
 571 /       CLA
 572 /       JMP STAR1+1
 573 /FOR INDAC GROUP TO OMIT RE-ORIGIN
 574 \f/HANDLER FOR PAGE PSEUDO-OP
 575
 576 PAGEX,  JMS I [DUMPS    /DUMP SAME PAGE LITERALS
 577         JMS I (XLISTZ   /ANY EXPRESSION?
 578         JMP PAGEY       /NO
 579         JMS I [EXP      /YES - GET EXPRESSION
 580         TAD VALUE
 581         JMS I [RTL6
 582         RAL             /GET PAGE NUMBER
 583         JMP STAR3-1
 584
 585 PAGEY,  TAD LOC         /NO ARGUMENT - FIND NEXT PAGE
 586         TAD [177
 587         AND [7600
 588 STAR3,  DCA VALUE
 589         TAD VALUE       /GET START OF PAGE
 590 STAR1,  JMS I [PUNORG   /PUNCH ORIGIN
 591         JMS I [FINDSP
 592         TAD [LITBUF     /RESET POINTERS
 593         DCA TEMP
 594         TAD I TEMP
 595         DCA LITPTR      /INITIALIZE LITERAL POINTER FOR NEW PAGE
 596         DCA LAST1
 597         JMP I [PUNVAL   /SEE ABOUT DUMPING SOURCE CODE
 598
 599 /HANDLER FOR FIXMRI PSEUDO-OP
 600
 601 FIXMRX, JMS I [SPNOR    /IGNORE SPACES
 602         JMS I [TSTALP   /IS CHARACTER ALPHABETIC?
 603         JMP FIXMR1      /YES-CONTINUE
 604         JMS I [ICMESG   /NO - GENERATE IC MESSAGE, GET NEXT CHAR
 605         JMP FIXMRX+1    /KEEP LOOKING FOR ALPHABETIC CH. OR END OF LINE
 606 FIXMR1, JMS I [GETTAG   /PICK UP TAG
 607         DCA ALPHAI      /STORE UNDEFINED SWITCH
 608         SKP
 609 FIXMR2, JMS I [ICMESG
 610         JMS I [SPNOR    /IGNORE SPACES
 611         TAD CHAR        /WAS CHARACTER = ?
 612         TAD (-"=
 613         SZA CLA
 614         JMP FIXMR2      /NO - PRINT IC MESSAGE AND KEEP LOOKING
 615                         /FALL INTO EQUALS PROCESSOR
 616 \f/HANDLER FOR =
 617
 618         AC4000          /FALL INTO HERE FROM FIXMRI
 619 EQUAL,  JMS I [PUSHA    /PUSH FIXMRI FLAG
 620         JMS I [GETC     /GET NEXT CHARACTER
 621         TAD I (NAME1    /STORE THE SYMBOL NAME
 622         JMS I [PUSHA    /ON THE PUSH DOWN LIST
 623         TAD I (NAME2
 624         JMS I [PUSHA
 625         TAD I (NAME3
 626         JMS I [PUSHA
 627         TAD THISTG      /AND ITS PRESENT (OR FUTURE)
 628         JMS I [PUSHA    /POSITION IN THE SYMTAB
 629         TAD ALPHAI
 630         JMS I [PUSHA    /STORE UNDEFINED INDICATOR
 631         JMS I [SPNOR    /IGNORE SPACES
 632         JMS I [EXP      /GET EXPRESSION TO RIGHT OF =
 633         TAD I PDLXR
 634         DCA ALPHAI      /RESTORE UNDEFINED INDICATOR
 635         TAD I PDLXR
 636         DCA THISTG      /RESTORE SYMBOL TABLE POSITION
 637         TAD I PDLXR     /RESTORE TAG NAME
 638         DCA I (NAME3
 639         TAD I PDLXR
 640         DCA I (NAME2
 641         TAD I PDLXR
 642         DCA I (NAME1
 643         ISZ UNDFSW      /WAS ANY PART OF DEFINITION UNDEFINED?
 644         JMP EQUAL3      /NO
 645         JMS I PERROR    /YES - GENERATE IE ERROR MESSAGE
 646         IE
 647         ISZ PDLXR       /CLEAR EXTRA WORD FROM PDL
 648         JMP I [PUNVAL   /FORGET ABOUT DEFINING TAG
 649 \f/MORE = PROCESSING
 650
 651 EQUAL3, ISZ ALPHAI      /WAS TAG DEFINED BEFORE?
 652         JMP .+3         /YES - CHECK FOR ILLEGAL REDEFINITION
 653         JMS I [INSRTG   /NO - INSERT TAG INTO SYMBOL TABLE
 654         JMP EQUAL2      /AND BYPASS ILLEGAL REDEF CHECK
 655         JMS I [FINDTG   /PUT TAG IN TAG1-TAGE AND VALUE2
 656         TAD VALUE
 657         CIA
 658         TAD VALUE2
 659         SZA CLA         /WERE DEFINITIONS THE SAME?
 660         TAD TAG1        /NO - IS IT A PERMANENT SYMBOL?
 661         SMA CLA
 662         JMP EQUAL2      /NO - OK TO REDEFINE
 663         JMS I [ERROR    /YES - GENERATE RD ERROR MESSAGE FIRST
 664         RD
 665 EQUAL2, TAD VALUE       /DEFINE OR REDEFINE
 666         DCA VALUE2
 667         AC3777
 668         AND TAG2        /CLEAR OLD FIXMRI BIT
 669         TAD I PDLXR     /INSERT NEW ONE
 670         DCA TAG2
 671         JMS I [PUTTAG   /STORE TAG
 672         JMP I [PUNVAL   /SEE ABOUT DUMPING SOURCE CODE
 673         PAGE
 674 \f/ROTATE AC 6 LEFT
 675
 676 RTL6,   0
 677         CLL RTL
 678         RTL
 679         RTL
 680         JMP I RTL6      /--RETURN--
 681
 682
 683 /GET NEXT CHARACTER ROUTINE
 684 /READS FROM THE INPUT FILES AND PASSES THE MODIFIED CHARACTERS
 685 /TO THE PROGRAM
 686 /IT ALSO PRINTS THE LATEST LINE IF IT HAS NOT BEEN PRINTED
 687
 688 GETC,   0
 689         ISZ TXTPTR      /POINT TO NEXT CHARACTER
 690 GETC7,  TAD I TXTPTR    /GET NEXT CHARACTER
 691         SZA             /IS IT 0?
 692         JMP GETC8       /NO - MORE ARE IN THIS LINE
 693         TAD PASS        /IS THIS PASS 3?
 694         SPA SNA CLA
 695         JMP GETC1       /NO
 696         TAD [LINBUF     /YES
 697         DCA TXTPTR      /RESET POINTER TO BEGINNING
 698         TAD I TXTPTR    /GET 1ST CHARACTER
 699         SNA             /IS IT 0?
 700         JMP GETC1       /YES - LINE HAS BEEN PRINTED
 701         TAD [-215       /IS IT 215?
 702         SNA CLA
 703         JMP GETC2       /YES - DO NOT PRINT THE SPACES
 704         TAD [211        /NO-OUTPUT 2 TABS
 705         JMS I OERROR
 706         TAD [211
 707         JMS I OERROR
 708 GETC2,  JMS LINPRT      /NOW PRINT THE LINE
 709 GETC1,  TAD (-121
 710         DCA TXTSWT
 711         TAD (LINBUF-1
 712         DCA TXTPTR      /RESET POINTER
 713         ISZ TXTPTR
 714 GETC6,  JMS I (INPUT    /GET NEXT CHARACTER
 715         JMP GETC4       /215
 716         DCA I TXTPTR    /STORE THE CHARACTER
 717         ISZ TXTSWT      /TOO MANY?
 718         JMP GETC6-1     /NO
 719         CLA CMA         /YES
 720         DCA TXTSWT
 721         JMP GETC6
 722 \fGETC4, DCA I TXTPTR    /SET END
 723         ISZ TXTPTR
 724         DCA I TXTPTR    /SET END OF LINE
 725         TAD [LINBUF
 726         DCA TXTPTR      /RESET POINTER
 727         CLA CMA
 728         DCA TXTSWT      /RESET SWITCH
 729         JMP GETC7       /GET THAT CHARACTER
 730
 731 GETC8,  TAD [-215       /IS IT A CARRIAGE RETURN?
 732         SNA
 733         JMP GETC12      /YES-END OF LINE
 734         TAD GETCI       /NO-
 735         TAD (215-"/     /IS IT A /?
 736         SNA             /YES-
 737         JMP GETC13      /"/" IS END
 738         TAD ("/-";      /IS IT A ;?
 739         SNA             /YES-
 740         JMP GETC12      /";" IS END
 741         TAD (";-211     /IS IT A TAB?
 742         SZA
 743         TAD (211-240    /OR A SPACE?
 744         SZA CLA
 745         JMP GETC9       /NO-NOT ANYTHING SPECIAL
 746         ISZ TXTSWT      /YES-2ND OCCURANCE?
 747         JMP GETC+1      /YES - IGNORE
 748         TAD [240
 749         DCA CHAR        /NO - GIVE A SPACE
 750         JMP I GETC      /--RETURN--
 751
 752 GETC16, ISZ CONDSW      /DECREMENT CONDITIONAL COUNTER
 753         JMP GETC15
 754 GETC17, TAD [LINBUF+120
 755         DCA TXTPTR
 756 GETC12, AC4000
 757 GETC9,  TAD I TXTPTR
 758         DCA CHAR        /STORE CHARACTER
 759         CLA CMA
 760         DCA TXTSWT      /SET THE SWITCH
 761         JMP I GETC      /--RETURN--
 762 \fGETC13,        TAD CONDSW      /CURRENTLY IN CONDITIONALS?
 763         SNA
 764         JMP GETC17      /NO
 765         DCA CONDSW      /STORE UPDATED CONDITIONAL LEVEL
 766 GETC15, ISZ TXTPTR      /YES-SCAN LINE FOR < AND >
 767         TAD I TXTPTR
 768         TAD [-215       /IS CHARACTER A CARRIAGE RETURN?
 769         SNA
 770         JMP GETC17      /YES
 771         TAD (215-">     /NO IS IT A >?
 772         SNA
 773         JMP GETC16      /YES
 774         TAD (">-"<      /NO-IS IT <?
 775         SNA CLA
 776         STA             /YES - INCREMENT CONDITIONAL COUNTER
 777         JMP GETC13      /NO - KEEP LOOKING
 778
 779
 780 /CHAR IS NEGATIVE IF LOGICAL END OF LINE:
 781 /       CARRIAGE RETURN
 782 /       /
 783 /       ;
 784
 785 /CHAR MAY BE ZERO IF PHYSICAL END OF LINE:
 786 /       CARRIAGE RETURN
 787 \f/PRINT A LINE OF SOURCE CODE
 788
 789 LINPRT, 0
 790         TAD (LINBUF-1
 791         DCA XREG1       /SET POINTER TO LINE
 792 LINPR1, TAD I XREG1     /GET CHARACTER
 793         SNA             /IS IT END OF LINE?
 794         JMP I LINPRT    /YES - END LINE
 795         JMS I OERROR    /NO - OUTPUT CHARACTER
 796         DCA I [LINBUF   /CLEAR OUT 1ST CHAR IN LINE AS "PRINTED" FLAG
 797         JMP LINPR1
 798
 799 /HANDLE PHASE ERROR
 800 /AND ALL ERROR EXITS TO MONITOR
 801
 802 SYMOFL, CLA
 803         TAD (SE         /SYMBOL TABLE EXCEEDED MESSAGE
 804 MONERR, DCA MONER1      /ERROR IS SERIOUS ENOUGH TO
 805 PHASE,  TAD (OTYPEO     / CAUSE IMMEDIATE RETURN TO
 806         DCA OERROR      / MONITOR
 807         JMS I [ERROR
 808 MONER1, PH              /STORE ERROR TYPE HERE
 809         JMP I [7600     /***EXIT TO MONITOR***
 810
 811
 812 /FIND CURRENT PAGE NUMBER
 813 /EXIT WITH NUMBER IN AC
 814
 815 FINDSP, 0
 816         TAD LOC
 817         AND [7600
 818         JMS I [RTL6
 819         JMP I FINDSP    /--RETURN--
 820         PAGE
 821 \f/**********************************************************
 822 /THIS AREA IS SWAPPED OUT DURING PASS 1 AND 2
 823 /** NO LITERALS IN THIS PAGE, AS THERE IS A PAGE OVERLAYING IT **
 824
 825 SWAP1=.
 826
 827 /PASS 3 LISTING OUTPUT
 828
 829 LISOUT, 0
 830         DCA LISOU2
 831         TAD XLISTX      /IS THIS COVERED BY XLIST?
 832         SZA CLA
 833         JMP I LISOUT    /YES--RETURN--
 834         ISZ LISCNT      /NO-WAS PREVIOUS CHARACTER A 215?
 835         JMP LISOU1      /NO
 836         ISZ LINCNT      /WAS IT END OF PAGE?
 837         JMP LISOU1      /NO
 838         ISZ THISPG      /YES-START OVERFLOW PAGE
 839 BEGIAB, JMS CRLF        /OUTPUT CARRIAGE RETURN/LINE FEED
 840 HSWIT1, JMS I [FORMFD   /0 IF /H SWITCH OPTION TO SUPRESS PAGING
 841         ISZ LINCNT
 842 LISOU1, TAD LISOU2      /IS CHARACTER A CARRIAGE RETURN?
 843         TAD [-215
 844         SNA
 845         JMP LISOU3      /YES - OUTPUT CR/LF
 846         TAD [215        /NO - RESTORE CHARACTER
 847         JMS I OCHAR     /OUTPUT CHARACTER
 848         JMP I LISOUT    /--RETURN--
 849
 850 LISOU3, CLA CMA
 851         DCA LISCNT      /REMEMBER THE 215 FOR NEXT TIME
 852         JMS CRLF        /OUTPUT CARRIAGE RETURN/LINE FEED
 853         JMP I LISOUT    /--RETURN--
 854
 855 LISCNT, -1
 856 LISOU2, 0
 857 \f/FORM FEED OUTPUT ROUTINES
 858
 859 FORMFD, 0
 860         TAD LINCNT      /GET LINE COUNTER
 861         TAD FORMLN
 862         SNA CLA         /ARE WE AT TOP OF PAGE?
 863         JMP I FORMFD    /YES - NO NEED FOR FORM FEED
 864         TAD XLISTX      /IS THIS COVERED BY XLIST?
 865         SZA CLA
 866         JMP I FORMFD    /YES--RETURN--
 867 HSWITC, JMP FORMF1      /0 IF /T OR TTY:; JMP FORMF3 IF /H
 868                         /OUTPUT IF TTY:OR /T OPTION
 869         TAD LINCNT
 870         TAD [-4
 871         DCA LINCNT
 872         JMS CRLF        /OUTPUT CARRIAGE RETURN/LINE FEED
 873         ISZ LINCNT
 874         JMP CRLF1       /OUTPUT LINE FEED
 875                         /CRLF1 WILL RETURN TO
 876                         /JMP-1 UNTIL LINCNT HAS
 877                         /BEEN BUMPED SUFFICIENTLY
 878         TAD FORMM6
 879         DCA LINCNT
 880         TAD MINUS       /OUTPUT ------
 881         JMS I OCHAR
 882         ISZ LINCNT      /* NEXT 3 LOCS CHANGED IF NO /T OR TTY:
 883 FORMF1, JMP .-3         /* STA
 884         TAD [-4         /* DCA LINCNT   /GENERATE ONE FORM FEED
 885         DCA LINCNT      /* STA          /TURN CR INTO FF
 886         JMS CRLF        /OUTPUT CR/LF OR FF/LF
 887         ISZ LINCNT
 888         JMP CRLF1       /OUTPUT LINE FEED
 889         TAD FORMLN
 890         CIA
 891         DCA LINCNT
 892 FORM22, TAD [HEADER-1   /OUTPUT HEADER
 893         DCA XREG2
 894         DCA LSTCNT
 895 FORM30, TAD I XREG2     /GET NEXT CHARACTER OF HEADING
 896         SNA             /IS IT LAST + 1
 897         JMP FORM20      /YES
 898         JMS I OCHAR     /NO-OUTPUT IT
 899         TAD LSTCNT
 900         TAD [-HEDLEN    /DONE "HEDLEN" CHARACTERS YET?
 901         SZA CLA
 902         JMP FORM30      /NO-CONTINUE
 903         TAD FORMHD      /YES-START SYSTEM HEADER
 904         JMP FORM22      /WHICH STARTS AT HEADER+HEDLEN
 905
 906 FORMLN, LNPRPG
 907 FORMHD, HEDLEN
 908 MINUS,  "-
 909 \f/TTY: OR /T OUTPUTS FORM FEED AS
 910 /CARRIAGE RETURN, MULTIPLE LINE FEEDS TO END OF PAGE
 911 /------
 912 /CARRIAGE RETURN, 5 LINE FEEDS
 913 /HEADER
 914 /NO OPTIONS TREATS F/F AS
 915 /F/F, LF, CR/LF
 916 /HEADER
 917
 918 / /H OPTION TREATS F/F AS 2 CR/LF
 919
 920 /USER HEADER IS "HEDLEN" CHARACTERS WIDE
 921 /ASSEMBLER HEADER ENDS WITH 0
 922
 923
 924 /OUTPUT PAGE NUMBERS
 925
 926 FORM20, TAD EDITPG      /OUTPUT EDITOR PAGE NUMBER
 927         JMS FORMF4
 928         TAD THISPG      /IS THERE PAGE OVERFLOW?
 929         SNA CLA
 930 FORM21, JMP FORMF3      /NO
 931         TAD MINUS       /YES
 932         JMS I OCHAR     /OUTPUT -
 933         TAD THISPG      /OUTPUT NUMBER OF OVERFLOW PAGE
 934         JMS FORMF4
 935                         /OUTPUT IF /H OPTION
 936 FORMF3, JMS CRLF        /OUTPUT 2 CR/LF
 937         JMS CRLF
 938         JMP I FORMFD    /--RETURN--
 939 \f/DECIMAL PRINT ROUTINE
 940
 941 FORMF4, 0
 942         DCA FORMF6      /SAVE NUMBER
 943         TAD FORM8F
 944         DCA CRLF        /POINT TO DIVISION LIST
 945 FORM12, DCA FORMF7      /START WITH 0
 946         JMP .+3
 947 FORMF5, DCA FORMF6
 948         ISZ FORMF7      /ADD 1 TO DIGIT
 949         TAD I CRLF      /SUBTRACT 1000, 100, OR 10
 950         SNA
 951         JMP FORM11      /0 IS END OF TABLE - NO MORE DIGITS
 952         TAD FORMF6
 953         SMA             /OVERFLOW
 954         JMP FORMF5      /NO-KEEP SUBTRACTING
 955         CLA             /YES-DIGIT DONE
 956         ISZ CRLF        /BUMP LIST POINTER
 957         TAD FORMF7      /WAS DIGIT A 0?
 958         SNA
 959         JMP FORM12      /YES
 960         TAD ["0         /NO-MAKE IT ASCII
 961         JMS I OCHAR     /OUTPUT DIGIT
 962         AC4000
 963         JMP FORM12      /4000 IN AC FORCES SIGNIFICANCE
 964
 965 FORM11, TAD FORMF6      /GET LAST DIGIT (UNITS PLACE)
 966         TAD ["0
 967         JMS I OCHAR     /OUTPUT DIGIT
 968         JMP I FORMF4    /--RETURN--
 969
 970 FORMM6, -6
 971 FORM8F, FORMF8
 972 \f/OUTPUT CARRIAGE RETURN/LINE FEED
 973 /ENTER WITH AC=-1 TO GENERATE F/F LF
 974
 975 HEDCL2,
 976 CRLF,   0
 977         TAD [215
 978         JMS I OCHAR
 979 CRLF1,  TAD [212        /RE-ENTRY FOR MULTIPLE LINE FEEDS
 980         JMS I OCHAR
 981         JMP I CRLF      /--RETURN--
 982
 983 /CLEAR PAGE HEADING BUFFER
 984
 985 FORMF7,
 986 HEDCLR, 0
 987         TAD [-HEDLEN    /SET HEADING BUFFER
 988         DCA HEDCL2      /TO TABS
 989         TAD [HEADER-1
 990         DCA XREG2
 991         TAD [211
 992         DCA I XREG2
 993         ISZ HEDCL2
 994         JMP .-3
 995         JMP I HEDCLR    /--RETURN--
 996         PAGE
 997 \f/SYMBOL TABLE OUTPUT (COLUMNAR)
 998                         /*CODE TO GENERATE DDT COMPATIBLE*
 999                         /**SYMBOL TABLE--SUBSTITUTED WITH*
1000                         /**ONCE ONLY CODE IF NEEDED*******
1001         IFZERO  HASH<
1002
1003 SYMPRT, 0
1004         ISZ EDITPG                      /NEW PAGE
1005         DCA THISPG
1006         JMS I [FORMFD
1007         TAD SMIN67      /DCA I SYMPR6-1
1008         DCA SYMPR7      /JMS SYMPR9+6
1009 SYMPR8, DCA SYMPR2      /TAD [377       //RUBOUT
1010         CLA CMA         /JMS I OERROR
1011         DCA THISTG      /CLA CMA
1012         TAD SYMPR2      /DCA THISTG
1013         CMA             /TAD [215       //CARRIAGE RETURN
1014         DCA SYMPR3      /JMS I OERROR
1015 SYMPR5, ISZ SYMPR3      /JMS SYMPPP
1016         JMP SYMPR4      /JMP SYMPR9-1
1017         TAD [-4         /JMP SYMPR6+2
1018         DCA SYMPR3      /HSWIT1
1019 SYMPR6, JMS SYMPPP      /204            //EOT
1020         JMP SYMPRB
1021 SYMPR1, TAD [1777
1022         AND TAG1                        /OUTPUT TAG
1023         JMS I SDIV45
1024         TAD TAG2
1025         JMS I SDIV45
1026         TAD TAG3
1027         JMS I SDIV45
1028         TAD [240
1029         JMS I OERROR                    /OUTPUT SPACE
1030         TAD VALUE2
1031         JMS OCTPRT                      /OUTPUT OCTAL VALUE
1032         ISZ SYMPR3      /JMP SYMPR5-2
1033         JMP SYMPR0      /TAD SYMPR6
1034 SYMPR9, TAD [215        /JMS I OERROR   /CARRIAGE RETURN
1035         JMS I OERROR    /TAD [377       //RUBOUT
1036 SYMPRB, ISZ SYMPR7      /JMS I OERROR
1037         JMP SYMPRA      /JMS SYMPR9+6
1038 HSWIT2, JMS I [FORMFD   /DCA LINCNT     /0 IF NOT /H
1039         TAD SMIN67      /JMP I SYMPRT   //--RETURN--
1040         DCA SYMPR7      /0
1041         TAD SYMOFS      /TAD [-200
1042 SYMPRA, IAC             /DCA SYMPR2
1043         TAD SYMPR2      /TAD [200       //LEADER-TRAILER
1044         JMP SYMPR8      /JMS I OERROR
1045
1046 SYMPR4, JMS SYMPPP      /ISZ SYMPR2
1047         JMP I SYMPRT    /JMP SYMPR4-2   /--RETURN--
1048         JMP SYMPR5      /JMP I SYMPR9+6
1049
1050 SDIV45, DIV45
1051 SMIN67, 1-LNPRPG
1052 \fSYMPR0,        TAD SMIN67
1053         DCA SYMPPB
1054         JMS SYMPPP      /SKIP 67(8) SYMBOLS
1055         JMP SYMPR9
1056         ISZ SYMPPB
1057         JMP .-3
1058         JMS I [ERROR1
1059         JMS I [ERROR1
1060         JMS I [ERROR1
1061         JMP SYMPR1      /GO PRINT THE 67TH(8) SYMBOL
1062
1063 SYMPR2= LINKSW
1064 SYMPR3= UNDFSW
1065 SYMPR7= ALPHAI
1066 SYMPPB= CHKSUM
1067
1068 SYMPPP, 0
1069         ISZ THISTG
1070 SYMOFS, 245
1071         TAD THISTG
1072         CLL CIA
1073         TAD HIGHTG
1074         SNL CLA
1075         JMP I SYMPPP    /--RETURN--
1076         JMS I [FINDTG
1077         AC4000
1078         AND TAG1
1079         TAD TAG3
1080         SPA SZL CLA
1081         JMP SYMPPP+1
1082         ISZ SYMPPP
1083         JMP I SYMPPP    /--RETURN--
1084 /SYMNCL,        -4      /DEFAULT IN LIU OF =N OPTION
1085 /SYMOFS,        245     /OFFSET TO FIRST SYM ON NEXT PAGE
1086
1087         >
1088 \f       IFNZRO  HASH<
1089
1090 SYMPRT, 0
1091         ISZ     EDITPG
1092         DCA     THISPG
1093         JMS I   [FORMFD /OUTPUT A HEADING
1094         JMS I   SYMHND  /NOW READ THE SYMBOL TABLE SORT OVERLAY
1095         0200            /2 PAGES
1096 SYMSRT, OUDEVH+400      /TO HERE
1097         ASWAP+1         /FROM HERE
1098         JMP I   SYMERR  /UGH
1099         JMS I   SYMSRT  /SORT THEM AND SET LINK
1100 SYMNWP, DCA     SYMTAG  /POINT TO SYMBOL
1101         SZL             /LINK OFF IF ANY SYMBOLS TO LIST
1102         JMP I   SYMPRT  /NONE --RETURN--
1103         TAD     SMIN67  /SET LINE/PAGE COUNT
1104         DCA     SYMLCT
1105 SYMPAG, TAD     HIGHTG
1106         CLL CIA
1107         TAD     SYMTAG
1108         SZL CLA
1109         JMP I   SYMPRT  /NO MORE IF AT HIGHTAG NOW
1110         TAD     SYMTAG
1111         DCA     THISTG  /PREPARE TO PRINT LEFTMOST SYMBOL
1112         TAD     SYMNCL  /4 PER LINE (DEFAULT)
1113         DCA     SYMCCT  /TO COLLUMS/LINE CNTR
1114         JMP     SYMGO
1115 SYMLIN, JMS I   [ERROR1
1116         JMS I   [ERROR1
1117         JMS I   [ERROR1
1118         TAD     HIGHTG
1119         CLL CIA
1120         TAD     THISTG
1121         SZL CLA
1122         JMP     SYMNXL  /SKIP TO NEXT LINE IF OFF TABLE
1123 \fSYMGO, JMS I   [FINDTG /OK, GET IT
1124         TAD     TAG1
1125         JMS I   SDIV45
1126         TAD     TAG2
1127         JMS I   SDIV45
1128         TAD     TAG3
1129         JMS I   SDIV45
1130         TAD     [240
1131         JMS I   OERROR
1132         TAD     VALUE2  /PRINT VALUE NOW
1133         JMS     OCTPRT
1134 SYMDDT, TAD     SMIN67
1135         CLL CIA
1136         TAD     THISTG
1137         DCA     THISTG
1138         SZL
1139         JMP     SYMNXL  /SKIP IF WRAP AROUND
1140         ISZ     SYMCCT  /ELSE DO NEXT COLUMN
1141         JMP     SYMLIN
1142 SYMNXL, TAD     [215
1143         JMS I   OERROR  /CR/LF
1144         ISZ     SYMTAG  /POINT TO NEXT SYMBOL
1145         ISZ     SYMLCT
1146         JMP     SYMPAG
1147 HSWIT2, JMS I   [FORMFD
1148         TAD     SYMTAG
1149         CLL
1150         TAD     SYMOFS  /OFFSET TO NEXT SYMBOL
1151         JMP     SYMNWP  /DO THE NEXT PAGE
1152
1153 SDIV45, DIV45
1154 SMIN67, -67
1155 SYMERR, SYSERR
1156 SYMHND, 7607
1157 SYMOFS, 245             /DEFAULT
1158 SYMNCL, -4
1159         SYMTAG= LINKSW
1160         SYMLCT= UNDFSW
1161         SYMCCT= ALPHAI
1162         ZBLOCK  4       /WASTE SOME SPACE
1163         >
1164
1165
1166 /END OF AREA WHICH MAY BE SWAPPED OUT
1167 /DURING PASSES 1 AND 2
1168 /**********************************************************************
1169
1170         ENDOVL= .
1171 \f/OCTAL PRINT ROUTINE
1172 /ENTER WITH # TO BE OUTPUT IN AC
1173 /** DO NOT USE TEMPS BELOW THIS LOC!
1174
1175 OCTPRT, 0
1176         DCA OCTPR1
1177         TAD [-4
1178         DCA OCTPR3
1179 OCTPR2, TAD OCTPR1      /GET EACH DIGIT SEPARATELY
1180         CLL RTL
1181         RAL
1182         DCA OCTPR1
1183         TAD OCTPR1
1184         RAL
1185         AND [7
1186         TAD ["0         /MAKE IT INTO AN ASCII CHARACTER
1187         JMS I OERROR    /OUTPUT IT
1188         ISZ OCTPR3
1189         JMP OCTPR2
1190         JMP I OCTPRT    /--RETURN--
1191
1192 OCTPR1, 0
1193 OCTPR3, 0
1194 \f/OUTPUT ONE REGISTER
1195
1196 PUNONE, 0
1197         TAD PASS        /WHICH PASS IS THIS?
1198         SNA
1199         JMP PUNON2      /PASS 2--OUTPUT BINARY
1200         SPA CLA
1201         JMP PUNON3      /PASS 1--EXIT
1202         TAD FLDIND      /GET FIELD NUMBER
1203         TAD ["0         /CONVERT TO ASCII
1204         JMS I OERROR    /PRINT IT
1205         TAD LOC         /GET LOW ORDER 4 DIGITS (LOC CTR)
1206         JMS OCTPRT      /PRINT IT TOO
1207         TAD OFFSET      /IF THIS CODE IS IN A RELOC SECTION,
1208         SZA CLA         /
1209         TAD (1200       /FLAG THE LOCATION COUNTER WITH A *
1210 DTORG1, JMS I [ERROR1   /OUTPUT 2 SPACES
1211         TAD VALUE
1212         JMS OCTPRT      /OUTPUT CONTENTS
1213         TAD I [LINBUF   /IS THERE SOURCE CODE TO DUMP?
1214         SNA CLA
1215         JMP PUNON1      /NO-OUTPUT CARRIAGE RETURN
1216         TAD LINKSW      /YES-DUMP LINK SWITCH (' ) OR (  )
1217         JMS I [ERROR1
1218         JMS I [LINPRT   /DUMP SOURCE CODE
1219         JMP PUNON3      /AND EXIT
1220
1221 PUNON1, TAD LINKSW      /NO LINE - OUTPUT LINK SWITCH ANYWAY
1222         SZA             /IF THERE IS ONE
1223         JMS I [ERROR1
1224         TAD [215        /OUTPUT CARRIAGE RETURN
1225         JMS I OERROR
1226 PUNON3, DCA LINKSW      /CLEAR LINK SWITCH
1227         JMP I PUNONE    /--RETURN--
1228
1229 /PASS 2-OUTPUT ONE REGISTER
1230
1231 PUNON2, TAD VALUE       /GET CONTENTS
1232         CLL
1233         JMS I [PUNOUT   /OUTPUT AS 2 FRAMES
1234         JMP PUNON3      /AND EXIT
1235         PAGE
1236 \f/**CURRENT PAGE LITERALS ON THIS PAGE WILL BE LOST**
1237 /***WHEN OVERLAYED BY PUSHDOWN LIST**
1238
1239 /ARRANGE TO OUTPUT ONE REGISTER
1240
1241 PUNBIN, 0
1242         DCA VALUE
1243         JMS I [FINDSP   /FIND CURRENT PAGE NUMBER
1244         TAD [LITBUF
1245         DCA TEMP2       /POINT TO NUMBER OR LITERALS
1246         TAD LOC
1247         AND [177
1248         DCA TEMP
1249         TAD I TEMP2     /IS PAGE FULL?
1250         CIA
1251         TAD TEMP
1252         ISZ TEMP
1253         SPA CLA
1254         JMP ONEOK       /NO-OK TO ADD ONE MORE REGISTER
1255         TAD TEMP        /YES-
1256         DCA I TEMP2
1257         JMS I [FINDSP   /FIND CURRENT PAGE NUMBER
1258         JMS I PPEZE     /GENERATE PE OR ZE ERROR
1259 ONEOK,  JMS I [FINDSP   /FIND CURRENT PAGE NUMBER
1260         TAD [TPINST
1261         DCA TEMP2
1262         TAD TEMP        /IS THIS ADDRESS HIGHER THAN PREVIOUS
1263         CIA             /HIGH INSTRUCTION PAGE?
1264         TAD I TEMP2
1265         SMA CLA
1266         JMP PUNMOD      /NO
1267         TAD TEMP        /YES-THIS IS NEW HIGH INSTRUCTION
1268         DCA I TEMP2
1269
1270 PUNMOD, JMS I [PUNONE   /OUTPUT THIS REGISTER
1271         ISZ LOC         /GET NEXT LOCATION
1272         TAD LOC         /IF THE "ISZ" SKIPS IT IS O.K. (A 0)
1273         AND [177        /IS THIS FIRST INSTRUCTION ON NEXT PAGE?
1274         SZA CLA
1275         JMP I PUNBIN    /NO--RETURN--
1276         JMS I [FINDSP   /YES-FIND CURRENT PAGE NUMBER
1277         TAD [LITBUF     /RESET POINTERS
1278         DCA TEMP2
1279         TAD I TEMP2
1280         DCA LITPTR
1281         JMP I PUNBIN    /--RETURN--
1282
1283 PPEZE,  PEZE
1284 \fHEADER,        "S;"Y;"M;"B;"O;"L;"S
1285         211;211;211;211;211     /FOR /N HEADER
1286
1287 /************************************************************
1288 /CODE OVERLAYED ON PASS 3
1289 /BY USER HEADER BUFFER
1290
1291 /CONTINUATION OF EXPUNGE HANDLER
1292 /ENTER ON PASS 1 ONLY
1293
1294 EXPUNW, IFZERO  HASH<
1295         DCA TEMP1
1296         DCA EXPUN2      /CLEAR NEW HIGH TAG COUNTER
1297         TAD HIGHTG
1298         CMA
1299         DCA TEMP3       /SAVE NUMBER OF SYM TBL ENTRIES
1300 EXPUNY, TAD TEMP1
1301         DCA THISTG
1302         JMS I [FINDTG   /GET A SYMBOL
1303         TAD TAG1        /ONLY SAVE THE SYMBOL IF
1304         RTL
1305         CLA             /IT WAS A PSEUDO-OP, OR
1306         TAD TAG3        /THE SYMBOLS I OR Z
1307         SNL SMA CLA
1308         JMP EXPUA4      /NO-FORGET TAG
1309         TAD EXPUN2      /YES-RETURN TAG TO SYMBOL TABLE
1310         DCA THISTG
1311         JMS I [PUTTAG
1312         ISZ EXPUN2
1313 EXPUA4, ISZ TEMP1
1314         ISZ TEMP3       /DONE YET?
1315         JMP EXPUNY      /NO- TRY NEXT TAG
1316         CLA CMA         /YES
1317         TAD EXPUN2      /RESET HIGH TAG
1318         DCA HIGHTG
1319         JMP I [LOOKEX   /--EXIT TO MAIN--
1320
1321 EXPUN2, 0
1322         >
1323 \f       IFNZRO  HASH<
1324         /HASH TABLE EXPUNGE - DEPENDS ON PSEUDO OPS
1325         /BEING HASHED FIRST. SCANS WHOLE TABLE (SLOW AS HELL!)
1326
1327         DCA     THISTG  /POINT TO FIRST ENTRY
1328         TAD     TAGMAX  /SET THE COUNT
1329         CIA
1330         DCA     TEMP1
1331 EXPUNL, JMS I   [FINDTG /GO GET ONE
1332         TAD     TAG1
1333         RTL
1334         CLA
1335         TAD     TAG3
1336         SPA SZL CLA     /PSEUDO OP?
1337         JMP     EXPUNS  /YES, SKIP DELETION
1338         DCA     TAG1    /NO, WIPE IT
1339         DCA     TAG2
1340         DCA     TAG3
1341         JMS I   [PUTTAG /AND PUT IT BACK
1342         STA
1343         TAD     HIGHTG
1344         DCA     HIGHTG  /DECREMENT SYMBOL COUNT
1345 EXPUNS, ISZ     THISTG  /POINT TO NEXT ENTRY
1346         ISZ     TEMP1   /TALLY COUNT
1347         JMP     EXPUNL  /GET ANOTHER
1348         JMP I   [LOOKEX /DONE --RETURN--
1349         >
1350
1351 /***************************************************************
1352 \f/ASSEMBLER HEADER BUFFER
1353
1354         ZBLOCK  HEADER+HEDLEN-.
1355
1356         " ;" ;"P;"A;"L;"8;"-
1357         "V;"1;VERSION-12+"0;SUBVERSION
1358         "
1359 DATE,   "N;"O;" ;"D;"A;"T;"E;"  /GETS SET TO DD-MMM-YY IF DATE PRESENT
1360         " ;" ;"P;"A;"G;"E;" ;0
1361 \f/PUSHDOWN LIST
1362 /OCCUPIES NEXT 43(8) LOCATIONS
1363 PDLND=.
1364
1365
1366
1367 /*********************************************************
1368 /ONCE ONLY CODE FOR /D OPTION
1369 /PUT INTO SYMLST FOR DDT COMPATIBLE SYMBOL TABLE
1370 /OVERLAYED DURING ASSEMBLY BY PUSHDOWN LIST
1371
1372 DSWIT1, IFZERO  HASH<
1373         RELOC SYMPRT+4
1374
1375         DCA I SYMPRF
1376         JMS SYMPRC
1377         TAD [377
1378         JMS I OERROR
1379         CLA CMA
1380         DCA THISTG
1381 SYMPRE, TAD [215
1382         JMS I OERROR
1383         JMS SYMPPP
1384         JMP SYMPRD
1385         JMP SYMPR1
1386 SYMPRF, HSWIT1
1387 SYM204, 204
1388         RELOC
1389
1390         >
1391         IFNZRO  HASH<
1392         RELOC   SYMNWP
1393         DCA     THISTG
1394         DCA I   SYMHSW
1395         JMS     DDTLDR
1396         TAD     [377
1397         JMS I   OERROR
1398 SYMLUP, TAD     [215
1399         JMS I   OERROR
1400         TAD     HIGHTG
1401         CLL CIA
1402         TAD     THISTG
1403         SZL CLA
1404         JMP     SYMXIT
1405         JMP     SYMGO
1406 SYMHSW, HSWIT1
1407         RELOC
1408         >
1409 DSWITA= .
1410
1411 /**********************************************************
1412         PAGE
1413 \f/*************************************************************
1414
1415 /PAL8 TABLES - LOAD OVER INITIALIZATION CODE
1416
1417 PDLST=  PDLND+42        /PUSHDOWN LIST 43(8) LOCS LONG
1418
1419
1420 LINBUF= PDLST+1         /LINE BUFFER OCCUPIES 122(8) LOCATIONS
1421
1422 LITBUF= LINBUF+122      /LITERAL TABLE IS 40(8) LOCATIONS (ONE PER PAGE)
1423                         /  SHOWING LOWEST PAGE ADDRESS USED FOR LITERALS
1424
1425 TPINST= LITBUF+40       /TOP INSTRUCTION TABLE IS 40(8) LOCTIONS
1426                         /  SHOWING HIGHEST PAGE ADDRESS USED FOR INSTRUCTIONS
1427
1428 LITBF2= TPINST+40-17    /LITERAL BUFFER 2 CONTAINS UP TO 160(8)
1429                         /PAGE 0 LITERALS, SUBSCRIPTS 20-177
1430
1431 LITBF1= LITBF2+200-100  /LITERAL BUFFER 1 CONTAINS UP TO 100(8)
1432                         /CURRENT PAGE LITERALS, SUBSCRIPTS 100-177
1433
1434 /*************************************************************
1435 \f/ONCE ONLY CODE FOR ASSEMBLER START UP
1436 /OVERLAYED BY BUFFERS
1437
1438 /HANDLES SWITCH OPTIONS
1439
1440 BEGIN,  CIF 10
1441         JMS I IOMON     /CALL USER SERVICE ROUTINES
1442         5               /*COMMAND DECODER*
1443         2001            /DEFAULT INPUT EXTENSION IS .PA
1444 NOCD,   CDF 10          /RETURN
1445         TAD I (7604     /IS THERE A BINARY FILE EXTENSION?
1446         SNA
1447         TAD (216        /NO - DEFAULT EXTENSION IS .BN
1448         DCA I (7604     /YES
1449         TAD I (7611     /IS THERE A LISTING FILE EXTENSION?
1450         SNA
1451         TAD (1423       /NO - DEFAULT EXTENSION IS .LS
1452         DCA I (7611
1453         TAD I (MPARAM+1 /WAS THE /T OPTION SELECTED?
1454         CDF
1455         AND (20
1456 ZT7640, SNA CLA
1457         JMP BEGINA      /NO
1458 BEGIAA, DCA I (HSWITC   /YES - GENERATE CR/LF IN PLACE OF F/F
1459         JMP BEGIN2
1460
1461 BEGINA, TAD [7605       /WAS TTY THE PASS 3 DEVICE?
1462         JMS I (OTYPE
1463         AND (770
1464         SNA CLA
1465         JMP BEGIAA      /YES - GENERATE CR/LF IN PLACE OF F/F
1466         DCA I (BEGIAB   /NOT /T OR TTY:
1467
1468 BEGIN2, CDF 10
1469         TAD I (MPARAM+1 /WAS THE /S OPTION SELECTED?
1470         CDF
1471         AND (40
1472         SZA CLA
1473         DCA I (SSWITC   /YES -OMIT SYMBOL TABLE
1474         CDF 10
1475         AC2000
1476         AND I (MPARAM+1
1477         CDF
1478         SNA CLA         /WAS THE /N OPTION SELECTED?
1479         JMP BEGIN4      /NO
1480         TAD BEGSKP      /SET SWITCH
1481         DCA I (NSWITC   /YES -SYMBOL TABLE BUT NO LISTING
1482 \fBEGIN4,        CDF 10
1483         TAD I (MPARAM   /WAS THE /H OPTION SELECTED?
1484         CDF
1485         AND (20
1486 ZH7640, SNA CLA
1487         JMP BEGINB      /NO
1488 BEGHSW, TAD I (FORM21   /YES -SUPPRESS LISTING PAGE FORMAT
1489         DCA I (HSWITC
1490         DCA I (HSWIT1
1491 BEGSKP, CLA SKP
1492 BEGINB, DCA I (HSWIT2
1493         CDF 10
1494         TAD I (MPARAM   /WAS THE /D OPTION SELECTED?
1495         CDF
1496         AND [400
1497 ZD7640, SNA CLA
1498         JMP BEGIN1      /NO
1499         TAD I XREG1     /YES -DDT COMPATIBLE SYMBOL TABLE
1500         DCA I LAST3     /SUBSTITUTE ALTERNATE CODE
1501         ISZ DSWIT3      /INTO SYMBOL TABLE OUTPUT ROUTINE
1502         JMP .-3
1503         TAD I XREG2
1504         DCA I LAST4
1505         ISZ DSWIT4
1506         JMP .-3
1507
1508 BEGIN1, TAD I (JSBITS   /RESET JOB STATUS WORD TO
1509         AND (6777       /INDICATE PAL8 NOT RESTARTABLE
1510         TAD (1000
1511         DCA I (JSBITS
1512         CIF CDF 10
1513         JMS I   (FMTDAT /CALL ROUTINE IN FIELD 1 TO SETUP DATE
1514         JMP I   (BEGINZ /CONTINUE ON
1515 \f
1516 DSWIT3, DSWIT1-DSWITA
1517 DSWIT4, DSWIT2-DSWITB
1518         PAGE
1519 \f/ONCE ONLY CODE CONTINUED
1520 /ASSEMBLER INITIALIZATION PROCEDURES
1521
1522
1523 BEGINZ, TAD [7600       /WHAT DEVICE FOR BINARY OUTPUT?
1524         JMS I (OTYPE
1525         SMA CLA
1526         TAD (-70        /STAND-ALONE
1527         TAD (-10        /DIRECTORY
1528         DCA I (SWAPR2+LEADER    /SET AMOUNT OF LEADER TRAILER
1529         DCA LAST1       /NO DEFINED TAG
1530 BEGIN5, IFZERO  HASH<
1531         CDF
1532         TAD I BLK1      /MOVE SYMBOL TABLE TO FIELD 1
1533         CDF 10
1534         DCA I BLK2
1535         ISZ BLK1
1536         ISZ BLK2
1537         ISZ BLK3
1538         JMP BEGIN5
1539         >
1540         CDF
1541         DCA I [LINBUF+120       /SET BUFFER POINTERS
1542         DCA I (LINBUF+121
1543         TAD [7600       /IS PTP BINARY OUTPUT DEVICE?
1544         JMS I (OTYPE
1545         DCA BLK1
1546         TAD BLK1
1547         AND (770
1548         TAD (-20
1549         SNA CLA
1550         DCA I (PTPSW    /YES - SET PTP SWITCH
1551         TAD BLK1        /NO - IS IT A DIRECTORY DEVICE?
1552         SPA CLA
1553         JMP .+3         /NO
1554         TAD (TAD [77    /YES - SET DIRECTORY SWITCH
1555         DCA I (DIRSW
1556         TAD [7605       /IS PTP GETTING LISTING OUTPUT?
1557         JMS I (OTYPE
1558         AND (770
1559         TAD (-20
1560         SNA CLA
1561         DCA I (SWAPR2+PTPSW1    /YES - SET PASS 3 PTP SWITCH
1562         TAD [7605       /NO - IS DIRECTORY DEVICE GETTING
1563         JMS I (OTYPE    /LISTING OUTPUT?
1564         SPA CLA
1565         JMP .+3         /NO
1566         TAD (TAD [77    /YES - SET PASS 3 DIRECTORY SWITCH
1567         DCA I (SWAPR2+DIRSW1
1568         JMP I (BEGINF
1569 \fMONLST,        TEXT    /JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC/
1570         *.-1
1571
1572 /CONTINUED CHECK OF COMMAND DECODER OPTIONS
1573
1574 BEGINH, CDF 10
1575         TAD I (MPARAM   /WAS THE /G OR /L OPTION CHOSEN?
1576         CDF
1577         AND (41
1578         SNA CLA
1579         JMP I (BEGISW   /NO
1580         CDF 10          /YES
1581         TAD I [7600
1582         SZA CLA         /WAS THERE A BINARY OUTPUT FILE?
1583         JMP YESBIN      /YES
1584 BINLOP, TAD PALBIN      /NO - CREATE FILE PAL8BN.TM
1585         DCA I PALBIX    /ON SYSTEM DEVICE
1586         ISZ BINLOP
1587         ISZ PALBIX
1588         ISZ BINCNT
1589         JMP BINLOP
1590         CDF
1591         TAD (-10        /SET AMOUNT OF LEADER TRAILER
1592         DCA I (SWAPR2+LEADER
1593 \f/SET UP FOR LOAD OR LOAD AND GO
1594
1595 YESBIN, CDF
1596         CIF 10
1597         CLA IAC
1598         JMS I IOMON     /CALL USER SERVICE ROUTINES
1599         2               /* LOOKUP PERMANENT FILE *
1600 LOAD,   PLOAD           /FILENAME ABSLDR.SV
1601 BINCNT, -5              /FILE LENGTH
1602         JMP NOLOAD      /ABSLDR.SV NOT FOUND
1603         TAD LOAD        /NORMAL RETURN
1604         DCA I (CHAIN    /SET STARTING BLOCK NUMBER
1605         DCA I (LSWITC   /FOR CHAIN CALL
1606         JMP I (BEGISW
1607
1608 NOLOAD, JMS I [ERROR    /GENERATE LD ERROR MESSAGE
1609         LD
1610         JMP I (BEGISW   /ASSEMBLE BUT DO NOT CHAIN TO LOADER
1611
1612 BLK1,   SYMS
1613 BLK2,   7600+SYMS-SYME
1614 BLK3,   SYMS-SYME
1615
1616 PALBIX, 7600
1617 PALBIN, 1
1618         FILENAME PAL8BN.TM
1619         PAGE
1620 \fCCC,   TAD I CC231     /FINAL PIECE OF STARTUP ONCE-ONLY CODE
1621         SNA
1622         TAD CC23
1623         DCA I CC231     /"HSWITC"=JMP FORMF1 IF WAS 0
1624 BEGISW, CDF 10
1625         TAD I CCJWD
1626         CDF 0
1627         AND CCJBIT
1628 ZJ7640, SNA CLA         /WAS /J OPTION SPECIFIED?
1629         DCA I CCJLOC    /NO - PRINT UNASSEMBLED CONDITIONAL CODE
1630         CDF 10
1631         TAD I CCWWD
1632         CDF 0
1633         AND CCWBIT
1634 ZW7640, SNA CLA         /WAS /W OPTION SPECIFIED?
1635         JMP D4          /V3C
1636 D5,     TAD I CC231
1637         CIA
1638         TAD CC23
1639         SZA CLA         /ARE WE OUTPUTTING FF'S IN LISTING?
1640         JMP BEGIS3      /NO
1641         TAD CC24        /YES - SUBSTITUTE SOME CODE
1642         DCA I CC25
1643         TAD CC26
1644         DCA I CC27
1645         TAD CC24
1646         DCA I CC28
1647 BEGIS3, JMS I OVLL7     /CALL SYSTEM DEVICE
1648         4200            /WRITE 2 PAGES
1649         SWAP1           /FORM SWAP1
1650         ASWAP           /INTO TEMP AREA
1651         JMP I OVLL8     /ERROR?!
1652         TAD I LAST2     /MOVE PASS 1&2 ONLY CODE
1653         DCA I TAGXR     /OVER PASS3 SWAPPED OUT CODE
1654         ISZ CC29
1655         JMP     .-3
1656         IFNZRO  HASH<
1657         JMS I   CCHSH   /FINALLY HASH OUT THE TABLE
1658         >
1659
1660         JMP I   .+1
1661         START2-1        /OK - NOW GO DO SOME ASSEMBLING!
1662 D4,     DCA I CCWLOC    /NO - DON'T WIPE LITERALS AS YOU DUMP THEM
1663         DCA I (D3
1664         JMP D5          /V3C
1665 \fOVLL7, 7607
1666 OVLL8,  SYSER3
1667
1668 CC231,  HSWITC
1669 CC23,   FORMF1&177+5200
1670 CC24,   STA
1671 CC25,   FORMF1
1672 CC26,   DCA LINCNT
1673 CC27,   FORMF1+1
1674 CC28,   FORMF1+2
1675 CC29,   SWAPB2-SWAPE2
1676
1677         IFNZRO  HASH<
1678 CCHSH,  HSHSMS
1679         >
1680 CCJWD,  MPARAM
1681 CCJBIT, 4
1682 CCJLOC, IFTST4
1683 CCWWD,  MPARAM+1
1684 CCWBIT, 2
1685 CCWLOC, LITHAK
1686 PLOAD,  FILENAME ABSLDR.SV
1687
1688 CKBAT,  TAD I CC7777    /GET BATCH FLAG WORD
1689         CLL RTL
1690         SNL CLA         /BATCH RUNNING?
1691         JMP I CCOPTM    /NO, GO WITH LINK OFF
1692         TAD I CC7777
1693         AND CC0070      /GET BATCH FIELD
1694         TAD CCCIF0      /FORM CIF TO BATCH FIELD
1695         DCA OTYPB1      /MODIFY TTY OUTPUT ROUTINE TO GO TO BATCH
1696         TAD CCJMSB      /LOG INSTEAD
1697         DCA OTYPB2
1698         TAD OTYPTD
1699         DCA OTYPB3
1700         JMP I CCOPTM    /RETURN TO CORE DETERMINER, LINK SET
1701
1702 CC7777, 7777
1703 CCOPTM, OPTIM4
1704 CC0070, 70
1705 CCCIF0, CIF 0
1706 CCJMSB, JMS I [BATOUT
1707 \f/THIS CODE SITS AFTER THE END OF THE LITERAL TABLE
1708
1709         IFNZRO  .-LITBF1-200&4000 <*LITBF1+200>
1710
1711 OTYPEO, 0               /TYPE A CHARACTER, CHECKING FOR ^O AND ^C
1712         DCA OTYPEC      /SAVE CHAR
1713         JMS CTCCHK      /CHECK FOR ^C - RETURN CHAR-203 IN AC
1714         TAD (-14
1715         SNA CLA         /^O?
1716         JMP I OTYPEO    /YES
1717 OTYPTD, TAD OTYPEC
1718 OTYPB1, TLS
1719 OTYPB2, TSF
1720 OTYPB3, JMP     .-1     /WAIT FOR TTY
1721         TAD     [-215
1722 OTYPCR, SZA CLA         /SET TO CLA DURING "ERRORS DETECTED" STUFF
1723         JMP I   OTYPEO
1724         TAD [212        /IF CHAR WAS CR, TYPE LF
1725         JMP OTYPEO+1
1726 OTYPEC, 0
1727
1728 CTCCHK, 0               /CHECK FOR ^C
1729         TAD [200
1730         KRS             /OR IN KEYBOARD CHAR
1731         TAD (-203
1732         SNA
1733         KSF             /3B BUT WAS CHAR REALLY THERE?
1734         JMP I CTCCHK    /NO ^C - RETURN
1735         JMP I [7600     /RETURN TO OS/8
1736
1737 TTLMSG, "E-240^100+"R-240       /ERRORS DETECTED:
1738         "R-240^100+"O-240
1739         "R-240^100+"S-240
1740         "D-240
1741         "E-240^100+"T-240
1742         "E-240^100+"C-240
1743         "T-240^100+"E-240
1744         "D-240^100+":-240
1745         0
1746
1747         "L-240^100+"I-240       /LINKS GENERATED:
1748         "N-240^100+"K-240
1749         "S-240^100
1750         "G-240^100+"E-240
1751         "N-240^100+"E-240
1752         "R-240^100+"A-240
1753         "T-240^100+"E-240
1754         "D-240^100+":-240
1755         0
1756         PAGE
1757 \f/OUTPUT A CHARACTER TO OUTPUT DEVICE
1758 /CALLED BY JMS I OCHAR
1759 /WITH CHARACTER IN 8-BIT ASCII IN AC
1760
1761 OUTPT1, PUNCHX          /PASS 2=PUNCHX; 3=XLISTX
1762
1763 OUTPUT, 0
1764         AND [377        /MASK OUT LEFT 4 BITS
1765         DCA OUTPT2      /STORE
1766         TAD I OUTPT1    /IS THIS PASS 3 AND
1767         SNA
1768         TAD OUTINH      /IS THIS COVERED BY XLIST?
1769         SZA CLA
1770         JMP I OUTPUT    /YES--RETURN--
1771         TAD OUTPT2      /NO - GET CHARACTER
1772         AND [200
1773         SNA CLA
1774         TAD OUTPT2      /IF LESS THAN 200, THEN
1775         TAD CHKSUM      /ADD IT TO CHECKSUM
1776         DCA CHKSUM
1777         TAD OUTPT2      /GET CHARACTER
1778         TAD (-211       /IS IT A TAB?
1779         SNA CLA
1780         JMP OUTPT3      /YES - OUTPUT SPACES
1781         JMS OUTPUX      /NO - OUTPUT CHARACTER
1782         TAD OUTPT2      /IS IT LINE FEED?
1783         TAD (-212
1784         SZA CLA
1785         JMP I OUTPUT    /NO--RETURN--
1786         TAD [7773       /YES - RESET LSTCNT
1787         DCA LSTCNT
1788         JMP I OUTPUT    /--RETURN--
1789
1790 \f/OUTPUT SPACES INSTEAD OF TAB
1791
1792 OUTPT3, TAD [240
1793         DCA OUTPT2
1794         JMS OUTPUX      /OUTPUT SPACE
1795         TAD LSTCNT      /TAB STOPS ARE EVERY 8 SPACES
1796         AND [7
1797         SZA CLA
1798         JMP .-4
1799         JMP I OUTPUT    /--RETURN--
1800
1801 /OUTPUT THE CHARACTER
1802 /PACKS CHARACTERS IN STANDARD OS/8 FORMAT
1803
1804 OUTPUX, 0
1805         ISZ OUJMP       /BUMP 3-WAY SWITCH
1806 OUJMP,  HLT             /WILL BE CHANGED - SHOULD NEVER HALT
1807         JMP OCHAR1      /CHARACTER #1
1808         JMP OCHAR2      /CHARACTER #2
1809 OCHAR3, TAD OUTPT2      /CHARACTER #3
1810         CLL RTL
1811         RTL
1812         AND [7400
1813         TAD I OUPOLD    /ADD 4 BITS TO WORD 1
1814         DCA I OUPOLD
1815         TAD OUTPT2
1816         CLL RTR
1817         RTR
1818         RAR
1819         AND [7400
1820         TAD I OUPTR     /ADD 4 BITS TO WORD 2
1821         DCA I OUPTR
1822         TAD OUJMPE
1823         DCA OUJMP       /RESET SWITCH
1824         ISZ OUPTR
1825         ISZ OUDWCT      /BUFFER FULL?
1826         JMP OUCHLV      /NO
1827         TAD [200        /YES
1828         JMS I (OUTDMP   /DUMP BUFFER
1829         JMS OUSETP      /RESET POINTERS
1830         JMP OUCHLV
1831
1832 \fOCHAR2,        TAD OUPTR       /SAVE POINTER
1833         DCA OUPOLD
1834         ISZ OUPTR
1835 OCHAR1, TAD OUTPT2
1836         DCA I OUPTR     /SET 8 BIT WORD
1837 OUCHLV, TAD OUTPT2
1838         TAD [40
1839         AND [100        /CHECK FOR PRINTABLE CHAR
1840         SZA CLA         /IF IT IS,
1841         ISZ LSTCNT      /BUMP TAB COUNT
1842 OUTINH, 0               /ALWAYS 0 OR 1!
1843         JMP I OUTPUX    /--RETURN--
1844
1845 OUPOLD, 0
1846 OUPTR,  0
1847 OUJMPE, JMP OUJMP
1848 OUDWCT, 0
1849 OUTPT2, 0
1850
1851 OUSETP, 0
1852         TAD [7600       /SET OUTPUT WORD COUNT
1853         DCA OUDWCT      /TO 200
1854         TAD (OUBUF
1855         DCA OUPTR       /RESET POINTER
1856         TAD OUJMPE
1857         DCA OUJMP       /RESET SWITCH
1858         CLL             /MUST CLEAR LINK!!
1859         JMP I OUSETP    /--RETURN--
1860 \f/HANDLER FOR DEVICE PSEUDO-OP
1861
1862 DEVICX, JMS I [SPNOR    /IGNORE TRAILING SPACES
1863         TAD [-5
1864         JMP DEVIC1      /PACK 4 CHARACTERS
1865
1866
1867 /HANDLER FOR FILENAME PSEUDO-OP
1868
1869 FILENX, JMS I [SPNOR    /IGNORE TRAILING SPACES
1870         TAD (-7
1871         JMS FILE1       /PACK 6 CHARACTERS
1872         TAD CHAR
1873         TAD [-".        /WAS CHARACTER . ?
1874         SNA CLA
1875         JMS I [GETC     /YES-SKIP TO EXTENSION
1876         AC7775
1877 DEVIC1, JMS FILE1       /PACK 2 CHARACTERS
1878         JMP I [LOOKEX   /--EXIT TO MAIN--
1879
1880 /PACK CHARACTERS
1881 /NEGATIVE OF # OF CHARACTERS TO BE PACKED IN AC ON ENTRY
1882
1883 FILE1,  0
1884         DCA FILE6       /SAVE # OF CHARACTERS TO PACK
1885         DCA I (TEXT6    /RESET PACK SWITCH
1886 FILE4,  JMS I [TSTALN   /IS CHARACTER IN CHAR ALPHANUMERIC?
1887         SKP
1888         JMP FILE5       /NO-DONE PACKING
1889         ISZ FILE6       /YES-TOO MANY CHARACTERS?
1890         JMP FILE3       /NO-O.K.
1891         CLA CMA /YES
1892         DCA FILE6       /RESET # OF CHARACTERS AND IGNORE
1893         JMP FILE2
1894
1895 FILE3,  TAD CHAR
1896         JMS I (TEXT2    /PACK A CHARACTER
1897 FILE2,  JMS I [GETC     /GET A CHARACTER
1898         JMP FILE4       /TEST IT
1899
1900         JMS I (TEXT2    /PACK A ZERO CHAR
1901 FILE5,  ISZ FILE6       /ARE WE DONE?
1902         JMP .-2         /NO - PAD WITH ZEROES
1903         JMP I FILE1     /YES--RETURN--
1904 FILE6,  0
1905         PAGE
1906 \f/HANDLER FOR TEXT PSEUDO-OP
1907 /SPACES ARE IGNORED TO DELIMITER
1908 /DELIMITER IS FIRST PRINTING CHARACTER
1909 /OTHER THAN SPACE
1910 /NON-PRINTING CHARACTERS ARE ILLEGAL
1911 /A PRINTING CHARACTER HAS EITHER BIT 5
1912 /OR BIT 6 SET, BUT NOT BOTH
1913
1914 TEXT8,  JMS I [GETC     /GET NEXT CHARACTER
1915 TEXTX,  CLL CLA CML RAR /AC=4000
1916         DCA GETCI       /; AND / ARE NOT END OF LINE
1917         JMS TEXT1A      /CHECK FOR PRINTING CHARACTER
1918         JMP TEXT8       /NON PRINTING - IGNORE
1919         TAD [-240       /IGNORE SPACES UNTIL DELIMITER
1920         SNA             /HAS BEEN FOUND
1921         JMP TEXT8
1922         TAD [240        /RESTORE CHARACTER
1923         CIA
1924         DCA VALUE2      /STORE NEGATIVE DELIMITER
1925         DCA TEXT6       /SET PACKING SWITCH
1926 TEXT3,  JMS I [GETC     /GET NEXT CHARACTER
1927         JMS TEXT1A      /IS IT A PRINTING CHARACTER?
1928         JMP TEXT9       /NO - IC
1929         TAD VALUE2      /YES - IS IT DELIMITER?
1930         SNA CLA
1931         JMP TEXT4       /YES - TERMINATE
1932         TAD CHAR        /NO - PACK AND OUTPUT
1933         JMS TEXT2       /PACK IT
1934         JMP TEXT3
1935
1936 TEXT4,  DCA GETCI       /RESET GETCI TO CALL ; AND / END OF LINE
1937         JMS I [GETC     /SKIP DELIMITER
1938 TEXT4X, JMS TEXT2       /OUTPUT 0 TO FILE
1939         JMS TEXT2
1940 /CHANGE TEXT4X TO:
1941 /       NOP
1942 /FOR NO EXTRA WORD OF ZEROS
1943         DCA GETCI       /RESET GETCI IN CASE WE HIT CR
1944         JMP I [LOOKEX   /--EXIT TO MAIN--
1945 \fTEXT9, JMS I [ERROR    /GENERATE IC ERROR MESSAGE
1946         IC
1947         JMP TEXT3
1948
1949 /SKIP ON PRINTING CHARACTER
1950
1951 TEXT1A, 0
1952         TAD CHAR
1953         SPA SNA CLA     /IS CHARACTER -
1954         JMP TEXT4X      /YES
1955         TAD CHAR
1956         TAD [40
1957         AND [100
1958         SZA CLA         /IS THE CHAR PRINTING?
1959         ISZ TEXT1A      /YES - INCREMENT RETURN
1960         TAD CHAR        /WITH CHARACTER IN AC
1961         JMP I TEXT1A    /--RETURN--
1962
1963 /OUTPUT 2 TEXT CHARACTERS (ONE REGISTER)
1964 /ENTER WITH CHARACTERS IN AC
1965
1966 TEXT2,  0
1967         AND [77         /GET RIGHT 6 BITS
1968         ISZ TEXT6       /WHICH HALF OF WORD?
1969         JMP TEXT5       /LEFT
1970         TAD TEXT7       /RIGHT--ADD IN LEFT HALF
1971         JMS I [PUNBIN   /OUTPUT IT
1972         JMP I TEXT2     /--RETURN--
1973
1974 TEXT5,  JMS I [RTL6     /GET LEFT HALF OF WORD
1975         DCA TEXT7       /SAVE IT
1976         CLA CMA         /SET SWITCH FOR RIGHT HALF
1977         DCA TEXT6
1978         JMP I TEXT2     /--RETURN--
1979
1980 TEXT6,  0
1981 TEXT7,  0
1982 \f/HANDLER FOR EXPUNGE PSEUDO-OP
1983
1984 EXPUNX, TAD PASS        /IS THIS PASS 1
1985         SMA CLA
1986         JMP I [LOOKEX   /NO--EXIT TO MAIN--
1987         JMP I (EXPUNW   /YES-CONTINUE AT EXPUNW
1988
1989
1990
1991 /CLOSE OUTPUT FILE
1992
1993 OCLOSE, 0
1994         TAD I (OUTINH   /OUTPUT INHIBITED?
1995         SZA CLA
1996         JMP I OCLOSE    /YES--RETURN--
1997 PTPSW,  TAD [232        /NO-0 IF PTP: - OUTPUT ^Z
1998         JMS I OCHAR
1999         JMS I OCHAR     /AND ZEROS
2000 FILLLP, JMS I OCHAR
2001 DIRSW,  TAD [177        /TAD [77 IF NOT DIRECTORY
2002         AND I (OUDWCT   /FILL OUT BUFFER OR HALF BUFFER
2003         SZA CLA         /WITH ZEROS
2004         JMP FILLLP
2005         TAD I (OUDWCT   /IS THERE OUTPUT TO BE DUMPED?
2006         TAD [200
2007         SZA
2008         JMS OUTDMP      /YES - DUMP IT
2009         TAD OUFILE      /GET DEVICE NUMBER IN AC
2010         CIF 10
2011         JMS I IOMON     /CALL USER SERVICE ROUTINES
2012         4               /*CLOSE OUTPUT FILE*
2013 OUCNAM, 0               /POINTER TO FILENAME TO BE DELETED
2014 OUCCNT, 0               /LENGTH OF NEW PERMANENT FILE
2015         JMP SYSER3      /DE**FATAL ERROR**
2016         JMP I OCLOSE    /--RETURN--
2017
2018 OUFILE, ZBLOCK 5
2019 \f/OUTPUT DUMP
2020 /AC CONTAINS CONTROL WORD FOR DUMP
2021
2022 OUTDMP, 0
2023         TAD [4000       /BE SURE CONTROL WORD IS
2024         DCA OUCTLW      /A WRITE OPERATION
2025         TAD OUBLK       /GET STARTING BLOCK NUMBER
2026         TAD OUCCNT      /ADD IN COUNT
2027         DCA OUREC       /SET THIS BLOCK NUMBER
2028         TAD OUCTLW
2029         TAD [100        /ROUND HALF-BLOCK, IF ANY
2030         CLL RTL
2031         RTL
2032         RTL
2033         AND [17         /GET THIS COUNT
2034         TAD OUCCNT
2035         DCA OUCCNT      /ADD TO TOTAL COUNT
2036         TAD OUCCNT      /IS OUTPUT DEVICE FULL?
2037         CLL CML
2038         TAD OUELEN      /CHECK AGAINST MAXIMUM LENGTH
2039         SNL SZA CLA
2040         JMP SYSER2      /DF**FATAL ERROR**
2041         JMS I OUHNDL    /CALL OUTPUT DEVICE HANDLER
2042 OUCTLW, 0               /CONTROL WORD
2043         OUBUF           /BEGINNING OF OUTPUT BUFFER
2044 OUREC,  0               /STARTING BLOCK NUMBER
2045 SYSER3, CLA SKP         /ERROR RETURN
2046         JMP I OUTDMP    /--RETURN--
2047 SYSERR, TAD (DE         /DE **FATAL ERROR**
2048         JMP I [MONERR
2049
2050 OUHNDL, 0
2051 OUBLK,  0
2052 OUELEN, 0
2053
2054 SYSER2, TAD (DF         /GENERATE DF ERROR MESSAGE
2055         JMP I [MONERR   /**FATAL ERROR**
2056         PAGE
2057 \f/MAINLINE CODE
2058
2059 LOOKE2, 0               /WAS THIS END OF LINE
2060         TAD CHAR        / OR END OF CONDITIONAL?
2061         TAD [-">
2062         SNA
2063         JMP CONEND      /END OF CONDITIONAL
2064         TAD (">
2065         SMA CLA
2066         JMP I LOOKE2    /NOT END OF LINE--RETURN--
2067 LOOKE1, JMS I [GETC     /GET A CHARACTER
2068 MAIN,   JMS I (CTCCHK   /CHECK FOR ^C
2069         CLA             /** CTCCHK RETURNS AC NON-ZERO!
2070         JMS I [SPNOR    /IGNORE SPACES
2071         TAD CHAR
2072         TAD (-"$        /WAS IT $ ?
2073         SNA             /YES--
2074         JMP I (ENDPAS   /NO-END THIS PASS
2075         TAD ("$-"*
2076         SNA CLA         /WAS IT * ?
2077         JMP STAR        /YES-HANDLE *
2078         JMS I [TSTALP   /NO-WAS IT ALPHABETIC?
2079         JMP ALPHA       /YES
2080         JMS LOOKE2      /NO
2081 TOEXP,  JMS I [EXP      /GET REST OF EXPRESSION
2082         TAD LININD
2083         DCA LINKSW      /STORE LINK SWITCH
2084         TAD VALUE
2085         JMS I [PUNBIN   /OUTPUT THE REGISTER
2086 LOOKEX, JMS I [SPNOR    /IGNORE TRAILING SPACES
2087         JMS LOOKE2      /IS LINE ENDED?
2088 ILCHAR, JMS I [ERROR    /NO-GENERATE IC ERROR MESSAGE
2089         IC
2090         JMP CONEN1
2091
2092 CONEND, TAD CONDSW      /ARE WE INTO CONDITIONALS?
2093         SNA
2094         JMP ILCHAR      /NO - > IS ILLEGAL
2095         IAC             /ONE LESS CONDITIONAL
2096         DCA CONDSW
2097 CONEN1, JMS I [GETC     /GET NEXT CHARACTER
2098         JMP LOOKEX      /AND TRY FOR END AGAIN
2099 \f/HANDLER FOR *
2100
2101 STAR,   JMS I [GETC     /GET NEXT CHARACTER AFTER *
2102         JMS I [SPNOR    /IGNORE SPACES
2103         JMS I [EXP      /GET REST OF EXPRESSION
2104 STAR0,  DCA STARSW      /ENTER HERE FROM RELOC WITH AC = -1
2105         ISZ UNDFSW      /WAS ANYTHING UNDEFINED?
2106         JMP .+3
2107         JMS I [ERROR    /YES-GENERATE UO ERROR MESSAGE
2108         UO
2109         TAD VALUE       /NO
2110         DCA OP
2111         TAD LOC         /IS THIS THE SAME PAGE AS
2112         AND [7600       /THE PREVIOUS CODE?
2113         CIA
2114         TAD OP
2115         AND [7600
2116         SNA CLA
2117         JMP STAR2       /YES-PUNCH ORIGIN
2118         JMS I [DUMPS    /NO-DUMP LITERALS
2119         TAD OFSBUF      /SET OFFSET TO NEW VALUE
2120         DCA OFFSET      /AFTER LITERALS ARE DUMPED.
2121         TAD OP          /PUNCH NEW ORIGIN, SET "VALUE"
2122         JMP I (STAR3    /FOR LISTING, AND SET UP IN NEW PAGE
2123
2124 STAR2,  TAD OFSBUF      /SET OFFSET TO NEW VALUE
2125         DCA OFFSET      /
2126         TAD OP
2127         JMS I [PUNORG   /PUNCH ORIGIN
2128         DCA LAST1       /CLEAR LAST DEFINED SYMBOL
2129         JMP I [PUNVAL
2130
2131 ALPHA,  JMS I [GETTAG   /PICK UP TAG-IS IT IN TABLE?
2132         DCA ALPHAI      /STORE UNDEFINED TAG SWITCH
2133         TAD TAG3        /IS IT A PSEUDO-OP?
2134         SPA CLA
2135         JMP I VALUE2    /YES-GO TO ITS HANDLER
2136         TAD CHAR        /NO
2137         TAD (-",        /WAS IT TERMINATED BY , ?
2138         SNA
2139         JMP COMMA       /YES-DEFINE THE SYMBOL
2140         TAD (",-"=      /NO-WAS IT TERMINATED BY = ?
2141         SNA CLA
2142         JMP I (EQUAL    /YES-EQUATE THE SYMBOL
2143         AC4000          /NO
2144         JMP TOEXP       /TREAT AS AN EXPRESSION
2145 \f/HANDLER FOR ,
2146
2147 COMMA,  JMS I [GETC     /GET NEXT CHARACTER
2148         ISZ ALPHAI      /WAS TAG DEFINED PREVIOUSLY?
2149         JMP COMMA2      /YES
2150         TAD LOC         /NO-STORE CURRENT ADDRESS FOR DEFINITION
2151         DCA VALUE2
2152         JMS I [INSRTG   /PUT TAG IN SYMBOL TABLE
2153 COMMA1, TAD TAG1        /STORE FOR ERROR MESSAGE OUTPUT
2154         DCA LAST1
2155         TAD TAG2
2156         DCA LAST2
2157         TAD TAG3
2158         DCA LAST3
2159         TAD VALUE2
2160         DCA LAST4
2161         JMP MAIN        /--EXIT TO MAIN--
2162
2163 COMMA2, TAD LOC         /DO NEW AND OLD DEFINITIONS AGREE?
2164         CIA
2165         TAD VALUE2
2166         SNA CLA
2167         JMP COMMA1      /YES-ALLOW REDEFINITION
2168         JMS I [ERROR    /NO-GENERATE ID ERROR MESSAGE
2169         ID
2170         JMP MAIN        /--EXIT TO MAIN--
2171 \fOPTABL,        OP0             /+
2172         OP1             /-
2173         OP6             /%
2174         OP2             /&
2175         OP5             /(SPACE)
2176 OPEXPL, OP5             /! - CHANGED TO OP3 IF /B ON
2177         OP4             /^
2178         PAGE
2179 \f/EXPRESSION PROCESSOR
2180 /POSSIBLE RECURSIVE ENTRY
2181 /ENTER WITH CHARACTER IN CHAR
2182
2183 EXP,    0
2184         DCA EXPIND      /SET INDICATOR (NOT 0 IF NO MRI FOUND)
2185         DCA LININD      /CLEAR LINK GENERATED SWITCH (' )
2186         DCA VALUE       /START WITH "VALUE" = 0
2187         DCA UNDFSW      /CLEAR UNDIFINED SWITCH
2188         TAD EXP
2189         JMS I [PUSHA    /SAVE RETURN ADDRESS
2190         DCA OP          /OP=0; ADD
2191         TAD EXPIND
2192         SPA CLA
2193         JMP I (EXPINT
2194         TAD CHAR        /IS CHARACTER A + ?
2195         TAD [-"+
2196         CLL RTR         /PUT THE 2 BIT IN THE LINK
2197         SZA CLA         /WAS CHAR 53(+) OR 55(-)?
2198         JMP EXP1A       /NO
2199         RAL             /YES - OP IS 0 OR 1, DEPENDING
2200 EXP1,   DCA OP
2201         JMS I [GETC     /GET NEXT CHARACTER
2202         ISZ EXPIND      /MRI NO LONGER LEGAL ON THIS LINE
2203 EXP1A,  TAD CHAR        /IS CHARACTER A . ?
2204         TAD [-".
2205         SNA
2206         JMP PERIOD      /YES-GO TO . HANDLER
2207         TAD (".-""      /NO-IS IT " ?
2208         SNA
2209         JMP QUOTE       /YES-GO TO " HANDLER
2210         TAD (""-"[      /NO-IS IT [ ?
2211         CLL
2212         SZA
2213         TAD ("[-"(      /OR (?
2214         SNA CLA
2215         JMP I (LIT      /YES - LITERAL - LINK HOLDS WHICH KIND
2216         JMS I [TSTALP   /NO-IS IT ALPHABETIC?
2217         JMP I (ALPHA1   /YES-HANDLE SYMBOL
2218         JMS I [TSTNUM   /NO-IS IT NUMERIC?
2219         JMP NUMBER      /YES-HANDLE NUMBER
2220
2221 EXP2,   JMS ENDCHK      /NO-CHECK FOR END
2222         JMP EXP1A       /NOGO - TRY AGAIN
2223         TAD OP
2224         TAD [-4         /IS OP SPACE (4)
2225         SNA CLA
2226         JMP I (EXPXIT   /YES-EXIT
2227         JMS I [ERROR
2228         IC              /GIVE IC MESSAGE ON ILLEGAL OPERATOR
2229         JMP I (EXPINT   /EXIT ANYWAY
2230 \f/END OF EXPRESSION CHECK
2231 /SKIP IF OK
2232
2233 ENDCHK, 0
2234         TAD CHAR
2235         TAD (-"]        /IS CHARACTER A ] ?
2236         SZA             /YES-SKIP A EXIT
2237         TAD ("]-")      /IS CHARACTER A ) ?
2238         SZA             /YES-SKIP A EXIT
2239         TAD (")-">      /IS CHARACTER A > ?
2240         SZA             /YES-SKIP AND EXIT
2241         TAD (">-"<      /IS CHARACTER A < ?
2242         SNA
2243         JMP ENDCH1      /YES-SKIP AND EXIT
2244         TAD ("<
2245         SPA CLA         /IS IT END-OF-LINE?
2246         JMP ENDCH1      /YES-SKIP AND EXIT
2247         JMS I [ICMESG   /NO - GENERATE IC MESSAGE AND GET NEXT CHAR
2248         JMP I ENDCHK    /--RETURN--
2249
2250 ENDCH1, ISZ ENDCHK      /INCREMENT RETURN ADDRESS
2251         JMP I ENDCHK    /--RETURN--
2252
2253 NUMBER, DCA TEMP
2254 NUMBE2, TAD RADIX       /IS THE CURRENT RADIX OCTAL?
2255         SNA CLA
2256         TAD CHAR        /YES-IS THE DIGIT GREATER THAN 7?
2257         TAD (-"8
2258         SMA CLA
2259         JMP NUMBE3      /YES-ILLEGAL CHARACTER
2260         TAD TEMP        /NO-ADD IT TO THE PREVIOUS
2261         CLL RAL         /ACCUMULATED VALUE
2262         CLL RAL
2263         DCA TEMP2
2264         TAD RADIX       /IS RADIX OCTAL?
2265         AND TEMP        /NO
2266         TAD TEMP2       /YES
2267         CLL RAL
2268         TAD CHAR
2269         TAD (-"0
2270         DCA TEMP
2271         JMS I [GETC     /GET NEXT CHARACTER
2272 NUMBE4, JMS I [TSTNUM   /IS IT NUMERIC?
2273         JMP NUMBE2      /YES-CONTINUE ACCUMULATING NUMBER
2274         TAD TEMP        /NO-STORE NUMBER
2275 NUMBE1, DCA VALUE2
2276 NUMBE5, TAD OP          /GO COMBINE IT VIA LAST OPERATION
2277         TAD (OPTABL
2278         DCA TEMP        /FIND THE OPERATOR HANDLER
2279         TAD I TEMP
2280         DCA TEMP
2281         JMP I TEMP      /GO TO THE HANDLER
2282 \f/8 OR 9 FOUND DURING OCTAL RADIX
2283
2284 NUMBE3, JMS I [ICMESG   /GENERATE IC ERROR MESSAGE AND
2285         JMP NUMBE4      /IGNORE CHARACTER
2286
2287
2288 /HANDLER FOR .
2289
2290 PERIOD, JMS I [GETC     /GET NEXT CHARACTER
2291         TAD LOC         /MAKE CURRENT LOCATION
2292         JMP NUMBE1      /INTO VALUE OF NUMBER
2293
2294 /HANDLER FOR "
2295
2296 QUOTE,  ISZ TXTPTR
2297         TAD I TXTPTR    /GET CHARACTER FROM TEXT BUFFER
2298         TAD [-215       /WAS IT CARRIAGE RETURN?
2299         SNA CLA
2300         JMP QUOTE1      /YES-IT IS IC-IGNORE "
2301         TAD I TXTPTR    /NO-PUT ASCII CODE INTO
2302         DCA VALUE2      /VALUE WORD
2303         JMS I [GETC     /GET NEXT CHARACTER
2304         JMP NUMBE5      /RETURN TO EXPRESSION PROCESSOR
2305
2306 /CARRIAGE RETURN FOUND IN SINGLE CHARACTER TEXT
2307
2308 QUOTE1, JMS I [ERROR    /GENERATE IC ERROR MESSAGE
2309         IC
2310         CLA CMA
2311         DCA CHAR
2312         JMP I (EXPXIT
2313         PAGE
2314 \f/COME HERE IF FIRST THING IN EXPRESSION IS ALPHA CHARACTER
2315
2316 ALPHA1, JMS I [GETTAG   /PICK UP TAG
2317         DCA ALPHAI      /STORE UNDEFINED INDICATOR
2318 ALPHA3, TAD TAG3        /IS IT A PSEUDO-OP?
2319         SMA CLA
2320         JMP .+3
2321         JMS I [ERROR    /YES-GENERATE IP ERROR MESSAGE
2322         IP
2323         ISZ ALPHAI      /NO-WAS IT UNDEFINED?
2324         JMP ALPHA0
2325         ISZ UNDFSW      /YES-SET UNDEFINED SWITCH
2326         TAD PASS        /IS THIS PASS 1?
2327         SPA CLA
2328         JMP ALPHA0      /YES-SUPPRESS ERROR MAESSAGE
2329         JMS I [ERROR    /NO-GENERATE US ERROR MESSAGE
2330         US
2331 ALPHA0, TAD TAG2        /NO-WAS IT A MEMORY REFERENCE INSTRUCTION?
2332         SPA CLA
2333         TAD CHAR        /YES-GET TERMINATING CHARACTER
2334         TAD [-240       /WAS IT SPACE?
2335         SZA CLA
2336         JMP I (NUMBE5   /NOT MEMREF FOLLOWED BY SPACE
2337         JMS I [SPNOR    /YES-IGNORE SPACES
2338         TAD CHAR
2339         SPA CLA
2340         JMP I (NUMBE5
2341         TAD EXPIND      /IS MEMORY REFERENCE INSTRUCTION OK?
2342         SZA CLA
2343         JMP I (NUMBE5   /NO-
2344         DCA IZIND       /YES-CLEAR I AND Z INDICATOR
2345         TAD VALUE2      /STORE MRI ON PUSHDOWN LIST
2346         JMS I [PUSHA
2347 \fALPHA6,        TAD IZIND
2348         JMS I [PUSHA    /PUSH THE I AND Z INDICATOR
2349         JMS I [TSTALP   /WAS TERMINATING CHARACTER ALPHABETIC?
2350         SKP
2351         JMP ALPHA4      /NO-
2352         JMS I [GETTAG   /YES-PICK UP TAG
2353         DCA ALPHAI      /STORE UNDEFINED INDICATOR
2354         AC2000
2355         AND TAG1        /WAS IT AN I OR Z?
2356         SNA CLA
2357         JMP ALPHA5      /NO
2358         TAD VALUE2      /YES-WAS IT I?
2359         SNA
2360         IAC             /NO - SET LOW ORDER
2361         TAD I   PDLXR   /GET OLD IZIND FROM PDL
2362         DCA IZIND       /SET NEW IZIND
2363         JMS I [SPNOR    /IGNORE SPACES
2364         JMP ALPHA6
2365
2366 EXPINT, TAD EXPIND
2367         TAD [4000
2368         DCA EXPIND
2369         JMP ALPHA3
2370
2371 ALPHA5, AC4000
2372 ALPHA4, IAC
2373         JMS I [EXP      /GET REST OF EXPRESSION
2374         TAD I PDLXR     /RETRIEVE MRI
2375         DCA IZIND
2376         TAD I PDLXR
2377         DCA VALUE2
2378                         /FALL INTO NEXT PAGE
2379 \f/COMBINE ADDRESS WITH MEMORY REFERENCE INSTRUCTION
2380
2381         TAD VALUE       /GET ADDRESS
2382         AND [7600
2383         SNA             /IS IT PAGE 0?
2384         JMP FIX4        /YES
2385         CIA             /NO-IS IT ON CURRENT PAGE?
2386         TAD LOC
2387         AND [7600
2388         SNA CLA
2389         JMP FIX2        /YES
2390         TAD VALUE       /NO-SET UP LINK
2391         JMS I (FINDS
2392         DCA VALUE
2393         TAD FIXMD0      /SET ' IN LISTING
2394         DCA LININD
2395         ISZ LINK        /BUMP NUMBER OF LINKS GENERATED
2396 FIXMD0, 0700            /PROTECTION FOR ISZ
2397 LGERR,  SKP             /JMS I PERROR IF /E SPECIFIED
2398         LG
2399         JMS ADDIND      /SET INDIRECT BIT IN INSTRUCTION
2400 FIX2,   TAD [200        /SET CURRENT PAGE BIT
2401         TAD VALUE2
2402         DCA VALUE2
2403         TAD IZIND
2404         AND [77         /WAS Z SPECIFIED?
2405         SNA CLA
2406         JMP FIX4        /NO
2407         JMS I [ERROR    /YES - ILLEGAL REFERENCE
2408         IZ              /TO PAGE 0
2409 FIX4,   TAD IZIND       /WAS THERE AN I?
2410         AND [7700
2411         SZA CLA
2412         JMS ADDIND      /YES - ADD INDIRECT BIT TO INSTRUCTION
2413         TAD VALUE       /GET ADDRESS
2414         AND [177
2415         TAD VALUE2      /GET OP CODE
2416         DCA VALUE       /STORE
2417 POPJ,   TAD I PDLXR
2418         DCA TEMP        /POP A WORD OFF THE STACK
2419         JMP I TEMP      /JUMP THROUGH IT.
2420 \fADDIND,        0               /ROUTINE TO ADD INDIRECT BIT TO AN INSTR
2421         TAD VALUE2
2422         CMA
2423         AND [400
2424         SZA             /WAS THERE ONE ALREADY?
2425         JMP .+3 /NO
2426         JMS I [ERROR    /YES - ILLEGAL INDIRECT
2427         II
2428         TAD VALUE2
2429         DCA VALUE2
2430         JMP I ADDIND
2431
2432 /       ALLOWS MULTIPLE NON-RESIDENT INPUT HANDLERS TO NOT BOMB
2433
2434 PTCH,   0               /RUNS IN DF 10
2435         TAD (7647       /POINT TO DEVICE
2436         DCA PTR         /HANDLER RESIDENCY TABLE
2437         TAD [-17        /IT HAS 15 ENTRIES
2438         DCA KNTR        /V3C
2439 KLOOP,  TAD I PTR       /GET HANDLER ENTRY POINT
2440         AND [7600       /LOOK AT PAGE IT'S ON
2441         TAD [-INDEVH    /IS IT ON THE PAGE WE PUT BUFFER OVER?
2442         SNA CLA         /WELL?
2443         DCA I PTR       /YES IT IS, WIPE IT FROM RESIDENCY
2444         ISZ PTR         /LOOK AT NEXT ENTRY
2445         ISZ KNTR        /ANY MORE ENTRIES?
2446         JMP KLOOP       /YES, MIGHT HAVE TO WIPE SEVERAL GUYS
2447         TAD [200        /INCREASE INPUT BUFFER SIZE
2448         JMP I PTCH      /V3C
2449         PAGE
2450 \f/COMBINE CURRENT VALUE WITH PREVIOUS VALUE
2451 /ACCORDING TO LAST OPERATOR
2452
2453 OP0,    TAD VALUE2      /HANDLER FOR +
2454         TAD VALUE       /** OP0+1 AND OP0+2 JUMPED TO **
2455         DCA VALUE
2456 EXP3,   TAD CHAR        /GET LAST OPERATOR
2457         TAD [-"+        /WAS IT A + OR - ?
2458         CLL RTR
2459         SNA
2460         JMP PLSMIN      /YES - LINK=0 FOR +, 1 FOR -
2461         RTL
2462         TAD ("+-"%
2463         CLL RAR
2464         SNA             /IS THE CHAR % OR &?
2465         JMP DIVAND      /YES - LINK=0 FOR %, 1 FOR &
2466         RAL
2467         TAD ("%-240
2468         CLL RAR
2469         SNA             /IS THE CHAR SPACE OR !?
2470         JMP BLKEXP      /YES - LINK=0 FOR SPACE, 1 FOR !
2471         RAL
2472         TAD (240-"^
2473         SNA CLA         /IS THE CHAR ^?
2474         JMP MUL         /YES - LINK IRRELEVANT
2475         JMS I (ENDCHK   /NO-SEE IF END OF LINE FOUND
2476         JMP EXP3        /NO-TRY AGAIN
2477 EXPXIT, TAD UNDFSW      /EXIT FROM EXP
2478         SNA CLA         /RESTORE EXIT POINT
2479         JMP I (POPJ     /--EXIT VIA POPJ--
2480         CLA CMA
2481         DCA UNDFSW      /SET UNDEFINED SWITCH
2482         DCA VALUE       /RESULT IS 0
2483         JMP I (POPJ     /--EXIT VIA POPJ--
2484 \fMUL,   CLL IAC         /LINK DOESN'T COUNT FOR ^
2485 BLKEXP, IAC             /** BLANK ASSUMED TO BE 4 ELSEWHERE **
2486 DIVAND, IAC
2487 PLSMIN, RAL
2488         JMP I (EXP1     /GET REST OF EXPRESSION
2489
2490 /HANDLER FOR &
2491
2492 OP2,    TAD VALUE
2493         AND VALUE2
2494         JMP OP0+2
2495
2496
2497 /HANDLER FOR ^
2498 /MULTIPLY BY REPEATED ADDITION
2499
2500 OP4,    TAD VALUE
2501         CIA
2502         DCA TEMP
2503         TAD VALUE2
2504         ISZ TEMP
2505         JMP .-2
2506         JMP OP0+2
2507
2508 OP1,    TAD VALUE2      /- OPERATOR
2509         CIA
2510         JMP I (OP0+1    /JUMP INTO ADD OPERATOR
2511
2512 /OPTIONAL HANDLER FOR ! AS 6 BIT LEFT SHIFT AND THEN OR:
2513
2514 OP3,    TAD VALUE
2515         JMS I [RTL6
2516         AND [7700       /ISOLATE 6 BITS AND FALL INTO "OR"
2517         DCA VALUE       /V3C
2518
2519 /HANDLER FOR ! AND SPACE AS INCLUSIVE OR
2520
2521 OP5,    TAD VALUE
2522         CMA
2523         AND VALUE2
2524         JMP I (OP0+1
2525 \f/CHARACTER INPUT CHECK
2526 /ENTER WITH CHARACTER IN AC
2527
2528 LSTCH9, SZA             /IGNORE NULL (0)
2529         TAD (-177
2530         SZA             /IGNORE RUBOUT (377)
2531         TAD (177-13
2532         SZA             /IGNORE VERTICAL TAB (213)
2533         IAC
2534         SNA
2535         JMP I (INPUT+1  /IGNORE LINE FEED (212)
2536         TAD [12-32      /WAS IT ^Z (END-OF-FILE=232)?
2537         SNA
2538         JMP I (ENDCHR   /YES - GET NEXT FILE
2539         TAD (32-15      /NO - WAS IT CARRIAGE RETURN?
2540         SNA
2541         JMP LSTCHR      /YES - LAST CHARACTER OF LINE
2542         IAC             /NO
2543         SNA             /WAS IT FORM FEED (214)?
2544         JMP FORCHR      /YES - HANDLER FORM FEED
2545         ISZ I (INPUT
2546         TAD (14+200
2547         DCA LSTCH5      /STORE CHARACTER
2548         TAD PASS        /IS THIS PASS 3?
2549         SPA SNA CLA
2550         JMP LSTCH4      /NO -
2551         ISZ LSTCH6      /YES - FILLING HEADER AREA?
2552         JMP LSTCH3      /YES
2553         CLA CMA         /NO - RESET SWITCH
2554         DCA LSTCH6
2555 LSTCH4, TAD I (INPUT
2556         DCA TEMP
2557         TAD LSTCH5      /GET CHARACTER IN AC
2558         JMP I TEMP      /-EXIT FROM INPUT-
2559
2560 LSTCH3, ISZ LSTCH7      /FILLING HEADER
2561         TAD LSTCH5      /STORE CHARACTER IN HEADER AREA
2562         DCA I LSTCH7
2563         JMP LSTCH4
2564
2565 LSTCH5, 0
2566 LSTCH6, -HEDLEN
2567 LSTCH7, HEADER-1
2568 \fLSTCHR,        TAD FORMSW      /CARRIAGE RETURN WAS FOUND
2569         SNA CLA         /HAS THERE BEEN A FORM FEED?
2570         JMP LSTCH1      /NO -
2571         DCA FORMSW      /YES - CLEAR FORM FEED SWITCH
2572         ISZ EDITPG      /GO TO NEXT EDITOR PAGE
2573         DCA THISPG      /CLEAR OVERFLOW PAGE
2574         TAD PASS        /IS THIS PASS 3?
2575         SMA SZA CLA
2576         JMS I [FORMFD   /YES - GENERATE FORM FEED
2577 LSTCH1, TAD [215        /NO - CARRIAGE RETURN IS CHARACTER
2578         DCA LSTCH5
2579         JMP LSTCH4-2    /EXIT
2580
2581 FORCHR, ISZ FORMSW      /SET FORM FEED SWITCH
2582         JMP I (INPUT+1  /GET ANOTHER CHARACTER
2583
2584 FORMSW, 1
2585         PAGE
2586 \f/ERROR MESSAGE OUTPUT
2587
2588 DUMPS1,
2589 ERROR,  0
2590         CLA
2591         ISZ ERCNT       /COUNT THE ERRORS
2592 ERPLUS, "+              /PROTECTION
2593         TAD I ERROR     /GET ERROR MESSAGE
2594         ISZ ERROR       /INCREMENT RETURN ADDRESS
2595         JMS I [ERROR1   /OUTPUT 2 CHARACTER ERROR MESSAGE
2596         TAD (JMP I [7600 /PUT EXIT TO MONITOR
2597 CSWIT1, DCA I (LSWITC   /IN SWITCH - "CLA" IF /C
2598         TAD PASS        /IS THIS PASS 3?
2599         SMA SZA CLA
2600         JMP ERROR4      /YES - CARRIAGE RETURN/LINE FEED
2601         JMS I [ERROR1   /NO - OUTPUT 2 SPACES
2602         TAD [1777       /IS THERE A TAG SAVED?
2603         AND LAST1
2604         SNA
2605         JMP ERROR3      /NO
2606         JMS I (DIV45    /YES - OUTPUT FIRST 2 CHARACTERS
2607         TAD LAST2       /OUTPUT SECOND 2 CHARACTERS
2608         JMS I (DIV45
2609         TAD LAST3
2610         JMS I (DIV45    /OUTPUT THIRD 2 CHARACTERS
2611         TAD LAST4       /IS ERROR LOCATION SAME AS LAST TAG?
2612         CIA
2613         TAD LOC
2614         SNA CLA
2615         JMP ERROR4      /YES - CARRIAGE RETURN
2616         TAD ERPLUS
2617         JMS I OERROR
2618         TAD LAST4
2619         CIA
2620 ERROR3, TAD LOC         /OUTPUT 4 DIGIT ADDRESS OR INCREMENT
2621         JMS I (OCTPRT
2622 ERROR4, TAD [215        /OUTPUT CARRIAGE RETURN/LINE FEED
2623         JMS I OERROR
2624         JMP I ERROR     /--RETURN--
2625 \f/RESET LITERAL TABLES AND POINTERS
2626
2627 DUMPS5,
2628 CLEAN,  0
2629         TAD (LITBUF-1
2630         DCA XREG1       /SET LITERAL TABLE POINTER
2631         TAD (TPINST-1
2632         DCA XREG2       /SET TOP INST. TABLE POINTER
2633         TAD (-40
2634         DCA TEMP
2635         TAD [200
2636         DCA I XREG1     /SET LITERAL TABLE ENTRIES TO 200
2637         DCA I XREG2     /SET TOP INST. TABLE ENTRIES TO 0
2638         ISZ TEMP
2639         JMP .-4
2640         DCA LAST1       /CLEAR LAST DEFINED TAG
2641         JMP I CLEAN     /--RETURN--
2642
2643 /DUMP CURRENT PAGE LITERALS
2644
2645 DUMPS,  0
2646         JMS I [FINDSP
2647         SNA             /IF THIS IS PAGE 0,
2648         JMP I DUMPS     /--RETURN--
2649         TAD [LITBUF
2650         DCA DUMPS1
2651         TAD LITPTR
2652         CIA CLL
2653         TAD I DUMPS1
2654         DCA DUMPS2      /STORE NUMBER OF LITERALS ON THIS PAGE
2655         SZL             /ARE THERE ANY?
2656         JMP D2          /V3C
2657         DCA STARSW      /FORCE ORIGIN PUNCH IF RELOC JUST INVOKED
2658         TAD LOC
2659         AND [7600
2660         TAD I DUMPS1
2661         JMS I [PUNORG   /OUTPUT ORIGIN
2662         TAD I DUMPS1
2663         TAD [LITBF1
2664 DUMPS3, DCA DUMPS5
2665         TAD I [LINBUF   /SAVE LINBUF
2666         JMS I [PUSHA
2667         DCA I [LINBUF
2668 DUMPS6, TAD I DUMPS5
2669         DCA VALUE
2670 JMSPUN, JMS I [PUNONE   /OUTPUT ONE REGISTER
2671         ISZ LOC
2672         ISZ DUMPS5
2673 LITHAK, ISZ I DUMPS1    /DESTROY RECORD OF CURRENT PAGE LITERALS -
2674                         /ZEROED IF NO /W OPTION SPECIFIED
2675         ISZ DUMPS2
2676         JMP DUMPS6
2677         TAD I PDLXR
2678         DCA I [LINBUF   /RESTORE LINBUF
2679 D2,     TAD DUMPS1      /WIPE REMEMBRANCE OF TOP OF PAGE (JR)
2680         TAD (40         /V3C
2681         DCA DUMPS5
2682 D3,     DCA I DUMPS5
2683         JMP I DUMPS     /--RETURN--
2684 \f/HANDLER FOR ZBLOCK PSEUDO-OP
2685 /RESERVES AS MANY WORDS OF ZERO
2686 /AS VALUE OF EXPRESSION
2687
2688 ZBLOCX, JMS I [SPNOR    /IGNORE SPACES
2689         JMS I [EXP      /GET THE EXPRESSION
2690         TAD VALUE
2691         CMA             /PROTECT AGAINST ZERO CASE
2692         DCA TEMP3       /STORE NEGATIVE AS COUNTER
2693         JMP ZBLOCZ      /JUMP INTO LOOP
2694 ZBLOCY, JMS I [PUNBIN   /OUTPUT ONE WORD OF ZERO
2695         TAD PASS        /IS THIS PASS 3?
2696         SMA SZA CLA
2697         DCA I (PUNMOD   /YES - PREVENT OUTPUT
2698 ZBLOCZ, ISZ TEMP3       /NO - DONE YET?
2699         JMP ZBLOCY      /NO - CONTINUE
2700         TAD JMSPUN      /YES - RESTORE PUNMOD
2701         DCA I (PUNMOD
2702         JMP I [LOOKEX   /--EXIT TO MAIN--
2703
2704 /DUMP PAGE 0 LITERALS
2705
2706 DUMPS2,
2707 DUMPZ,  0
2708         TAD DUMPZ       /RESET EXIT FROM DUMPS
2709         DCA DUMPS
2710         TAD [200
2711         CIA CLL
2712         TAD I [LITBUF   /STORE THE NUMBER OF LITERALS ON PAGE 0
2713         DCA DUMPS2
2714         SZL             /ARE THERE ANY?
2715         JMP I DUMPS     /NO - ** DUMPZ IS DESTROYED **
2716         TAD I [LITBUF
2717         JMS I [PUNORG   /OUTPUT ORIGIN
2718         TAD I [LITBUF   /SET VALUES FOR DUMPS
2719         TAD (LITBF2
2720         JMP DUMPS3
2721         PAGE
2722 \f/ENTER A TAG INTO SYMBOL TABLE
2723
2724         IFZERO  HASH<
2725 INSRTG, 0
2726         TAD VALUE2      /SAVE VALUE 2
2727         JMS I [PUSHA
2728         ISZ HIGHTG      /COUNT IN THIS TAG
2729         TAD TAGMAX
2730         CLL CIA         /GET LIMIT OF SYMBOL STORAGE
2731         TAD HIGHTG      /IS THERE ROOM FOR ONE MORE?
2732         SZL
2733         JMP I (SYMOFL   /NO - SE**FATAL ERROR**
2734         TAD TAGMAX      /YES - IS USR IN CORE?
2735         TAD (-1340
2736         SZL CLA
2737         JMP GETTG5      /YES
2738         TAD [7700       /NO - RESET ADDRESS TO
2739         DCA IOMON       /USR NON-RESIDENT
2740         AC7776
2741         AND I (JSBITS   /RESET JOB STATUS WORD TO
2742         DCA I (JSBITS   /SAVE CORE WHEN USR CALLED
2743 GETTG5, TAD THISTG      /SEARCH SYMBOL TABLE
2744         DCA TEMP2
2745         TAD HIGHTG
2746         IAC
2747         DCA THISTG
2748 GETTG8, AC7776
2749         TAD THISTG
2750         DCA THISTG
2751         JMS I [FINDTG   /GET NEXT TAG FROM SYMBOL TABLE
2752         ISZ THISTG
2753         TAD THISTG
2754         CIA
2755         TAD TEMP2       /DOES NEW TAG GO WHERE PREVIOUS TAG WAS?
2756         SNA CLA
2757         JMP GETTG9      /YES-PUT IT THERE AND EXIT
2758         JMS I [PUTTAG   /NO-REPLACE RETRIEVED TAG WHERE PREVIOUS TAG WAS
2759         JMP GETTG8
2760
2761 /THE ABOVE CODE WILL BE OPTIMIZED AT INITIALIZATION
2762 /IF THE ASSEMBLER IS TO BE RESTRICTED TO 8K OF CORE
2763
2764 GETTG9, TAD I (NAME1    /GET CURRENT TAG
2765         DCA TAG1        /PUT IT IN TAG1-TAG3
2766         TAD I (NAME2
2767         DCA TAG2
2768         TAD I (NAME3
2769         DCA TAG3
2770         TAD I PDLXR     /RESTORE VALUE 2
2771         DCA VALUE2
2772         JMS I [PUTTAG   /PUT TAG1 - TAG3 INTO SYMBOL TABLE
2773         JMP I INSRTG    /--RETURN--
2774
2775 TAGMAX, 1740            /12K=3740, ...
2776         >
2777
2778 /       IFNZRO  HASH<   /***HACK ONLY***
2779 /TLYREF,        0               /TALLY REFS TO SYMBOL TABLE
2780 /       ISZ     NREFL
2781 /       JMP I   TLYREF
2782 /       ISZ     NREFH
2783 /       JMP I   TLYREF
2784 /       JMP I   TLYREF
2785 /TLYPRB,        0               /TALLY PROBES INTO TABLE
2786 /       JMS I   [FINDTG /FUDGE, OUT OF ROOM
2787 /       ISZ     NPROBL
2788 /       JMP I   TLYPRB
2789 /       ISZ     NPROBH
2790 /       JMP I   TLYPRB
2791 /       JMP I   TLYPRB
2792 /NREFH, 0
2793 /NREFL, 0
2794 /NPROBH,        0
2795 /NPROBL,        0
2796 /       >               /***HACK ONLY***
2797 \f       IFNZRO  HASH<
2798
2799         /INSERT A TAG INTO THE HASH TABLE
2800
2801 INSRTG, 0
2802         ISZ     HIGHTG  /BUMP SYM NUM (SKIPS ON 0)
2803         TAD     HIGHTG
2804         STL CMA
2805         TAD     TAGMAX
2806         SNA SZL CLA     /STILL ROOM FOR AT LEAST 2 MORE?
2807         JMP I   (SYMOFL /NO SE** FATAL ERROR**
2808         TAD I   (NAME1
2809         DCA     TAG1
2810         TAD I   (NAME2
2811         DCA     TAG2
2812         TAD I   (NAME3
2813         DCA     TAG3
2814         JMS I   [PUTTAG /NOW ACTUALLY INSERT IT
2815         JMP I   INSRTG
2816         >
2817 \f/OUTPUT 2 CHARACTER WORD
2818 /FROM SYMBOL TABLE FORMAT
2819 /DIVIDE BY 45(8)
2820
2821 DIV45,  0
2822         RAL
2823         CLL RAR         /CLEAR SIGN BIT
2824 DIV45A, ISZ DIV45C
2825         TAD (-45
2826         SMA
2827         JMP DIV45A
2828         TAD (45
2829         JMS DIV45E
2830         DCA DIV45B
2831         STA
2832         TAD DIV45C
2833         JMS DIV45E
2834         JMS I [RTL6
2835         TAD DIV45B
2836         JMS I [ERROR1   /OUTPUT 2 CHARACTERS
2837         DCA DIV45C      /CLEAR DIV45C FOR NEXT GO-ROUND
2838         JMP I DIV45     /--RETURN--
2839
2840 DIV45B, 0
2841 DIV45C, 0               /** MUST BE 0 WHEN DIV45 IS ENTERED **
2842
2843 DIV45E, 0
2844         SNA
2845         JMP I DIV45E
2846         TAD (-33
2847         SMA
2848         TAD (20-40-33
2849         TAD (33+40
2850         JMP I DIV45E    /--RETURN--
2851 \f/HANDLER FOR FIXTAB PSEUDO-OP
2852
2853 FIXTBX, TAD PASS        /IS THIS PASS 1?
2854         SMA CLA
2855         JMP I [LOOKEX   /NO--EXIT TO MAIN--
2856         JMP I (FIXTAY   /YES--DO FIXTAB
2857
2858 /SET FIELD
2859
2860 SETFLD, 0
2861         CLA CLL         /SETFLD CALLED WITH AC RANDOM
2862         DCA SETFL1      /INITIALIZE FIELD
2863         IFNZRO  HASH<
2864         TAD     USROFS  /FUDGE FOR KEEPING USR AROUND
2865         >
2866         TAD THISTG
2867 SETFLP, ISZ SETFL1
2868         CML
2869         TAD (-1740      /PUT 1740 SYMBOLS IN EACH FIELD
2870         SNL             /IS THE DIVIDE THROUGH?
2871         JMP SETFLP      /NO - CONTINUE
2872         IFZERO  HASH<
2873         CLL CMA RTL     /AC CONTAINED REM-1740; THIS MAKES IT INTO
2874         TAD (-1         /7573-4*REM WHICH IS THE ADDRESS WE WANT
2875         >
2876         IFNZRO  HASH<
2877         CLL RTL         /AC GETS 0201 TO 7775
2878         TAD     (-202   /AC GETS 7777 TO 7573 FOR TAGXR
2879         >
2880         DCA TAGXR       /TO STICK INTO AN AUTO-XR
2881         TAD SETFL1
2882         CLL RTL
2883         RAL
2884         TAD SETFL2
2885         DCA SETFL1
2886 SETFL1, HLT
2887         JMP I SETFLD    /--RETURN--
2888         IFNZRO  HASH<
2889 USROFS, 0               /GETS 400 IF KEEPING USR
2890         >
2891 \f/FIND TAG
2892 /GET TAG FROM SYMBOL TABLE
2893 /PUT IT INTO TAG1-TAG3
2894 /WITH ITS VALUE IN VALUE2
2895
2896 FINDTG, 0
2897         TAD THISTG
2898         JMS SETFLD
2899         TAD I TAGXR
2900         DCA TAG1
2901         TAD I TAGXR
2902         DCA TAG2
2903         TAD I TAGXR
2904         DCA TAG3
2905         TAD I TAGXR
2906         DCA VALUE2
2907 SETFL2, CDF
2908         JMP I FINDTG    /--RETURN--
2909
2910 /OPTIMIZATION MAY CHANGE SETFLD TO
2911 /REMOVE CLA ON ENTRY
2912         PAGE
2913 \f/BEGINNING OF PASS CODE
2914
2915         JMS I (IOPEN    /SET INPUT ROUTINE TO OPEN FILE
2916 START2, ISZ PASS        /SET UP COUNTERS AND POINTERS
2917         DCA XLISTX      /CLEAR XLIST SWITCH
2918         DCA FLDIND      /SET FIELD TO 0
2919         DCA CONDSW
2920         DCA EDITPG
2921         DCA LINK
2922         DCA RADIX
2923         DCA ERCNT
2924         DCA GETCI
2925         DCA PUNCHX
2926         DCA I [LINBUF
2927         TAD (PDLST
2928         DCA PDLXR
2929         JMS I [CLEAN
2930         TAD [200
2931         DCA LITPTR
2932         TAD [200
2933         JMS I [PUNORG
2934         JMP I (LOOKE1   /--EXIT TO MAIN--
2935
2936 /HANDLER FOR $
2937
2938 ENDPAS, JMS I [DUMPS    /DUMP CURRENT PAGE LITERALS
2939         DCA OFSBUF      /CLEAR OFFSET FOR NEXT PASS
2940         TAD PASS        /WHAT PASS IS ENDING?
2941         SNA
2942         JMP I (ENDPA2   /PASS 2
2943         SPA CLA
2944         JMP I (START1   /PASS 1
2945         TAD I [LINBUF   /PASS 3
2946         SNA CLA         /ANYTHING TO PRINT?
2947         JMP ENDPA1-1    /NO
2948         TAD [211        /YES - TAB OVER TWICE
2949         JMS I OERROR
2950         TAD [211
2951         JMS I OERROR
2952         JMS I [LINPRT   /PRINT LINE
2953         JMS I [DUMPZ    /DUMP PAGE 0 LITERALS
2954 ENDPA1, DCA XLISTX
2955 /OUTPUT SYMBOL TABLE
2956 SSWITC, JMS I (SYMPRT   /(0 IF /S)
2957         TAD I (FORM21
2958         DCA I (FORM22
2959         JMS I [FORMFD   /OUTPUT FORM FEED
2960 ERMSGS, TAD ERCNT
2961         JMS OUTTTL      /PRINT "ERRORS DETECTED: N"
2962         TAD LINK
2963         JMS OUTTTL      /PRINT "LINKS GENERATED: N"
2964 FINLFF, JMS I [FORMFD   /PRINT FINAL FF (ZEROED IF NO PASS 3)
2965         JMS I (OCLOSE   /AND CLOSE THE OUTPUT FILE
2966 \f/CREF AND LOAD-AND-GO OPTIONS
2967 /****FINAL EXIT TO MONITOR****
2968 LSWITC, JMP I [7605     /0 IF /L OR /G OR /C
2969         TAD (7616
2970         DCA XREG1
2971         CDF 10
2972 CSWITC, TAD I [7600     /"TAD I [7605" IF /C
2973         AND [17
2974         DCA I XREG1     /SET BINARY DEVICE
2975         TAD BINSRT
2976
2977 /EXIT FROM PAL8 BY CHAINING
2978 /TO NEXT PROGRAM
2979 /SHOULD BE ABSLDR OR CREF
2980
2981         DCA I XREG1     /SET STARTING BLOCK
2982         DCA I XREG1     /SET 0 TERMINATOR
2983         CDF
2984         TAD I (JSBITS   /SET BIT 11 OF JOB STATUS WORD
2985         RAR             /SO 10000-11777 IS NOT SAVED
2986         CLL CML RAL
2987         DCA I (JSBITS
2988         CIF 10
2989         JMS I IOMON     /CALL USER SERVICE ROUTINES
2990         6               /*CHAIN TO NEXT PROGRAM*
2991 CHAIN,  0               /STARTING BLOCK OF NEXT PROGRAM
2992
2993 OUTTTL, 0
2994         DCA LAST1       /SAVE NUMBER TO BE PRINTED
2995 OUTTLL, TAD I TTLPTR    /GET A WORD OF MESSAGE
2996         ISZ TTLPTR
2997         SNA             /END?
2998         JMP PRTTTL      /YES
2999         JMS I [ERROR1   /NO - PRINT IT
3000         JMP OUTTLL      /AND LOOP
3001 PRTTTL, TAD [240        /PRINT A SPACE
3002         JMS I OCHAR
3003         TAD LAST1
3004         JMS I (FORMF4   /PRINT NUMBER IN DECIMAL
3005         JMS I (CRLF     /PRINT CR AND 2 LF'S (1 IF PASS 3)
3006         JMP I OUTTTL    /AND RETURN
3007
3008 TTLPTR, TTLMSG
3009 \f/COME HERE TO LOAD THE PASS 3 OVERLAY AT THE END OF PASS 2
3010
3011 LOADOV, JMS I (7607     /CALL SYSTEM DEVICE HANDLER
3012         0200            /SWAP IN CODE UNIQUE TO PASS 3
3013         SWAP1           /BUFFER ADDRESS
3014         ASWAP           /STARTING BLOCK NUMBER
3015         JMP I (SYSER3   /DE**FATAL ERROR**
3016 NSWITC, JMP START2      /(0 IF NO LIST FILE, SKP IF /N) START PASS3
3017         JMP ERMSG1
3018         JMP ENDPA1
3019
3020 ERMSG1, TAD (OTYPEO     /COME HERE IF NO PASS 3 OUTPUT FILE
3021         DCA OCHAR
3022         TAD (OTYPEO
3023         DCA OERROR
3024         TAD [7600
3025         DCA I (OTYPCR   /INHIBIT AUTO-LF ON CARRIAGE RETURN
3026         DCA FINLFF      /KILL LAST FORM FEED
3027         JMP ERMSGS
3028
3029 /ADD BITS TO PUNCH ORIGIN
3030
3031 PUNORG, 0
3032         DCA LOC
3033         TAD PASS        /IS THIS PASS 2?
3034         SZA CLA
3035         JMP I PUNORG    /NO--RETURN--
3036         TAD LOC         /YES - OUTPUT ORIGIN SETTING
3037         TAD OFFSET      /"LOC" MAY BE FICTITIOUS - MAKE IT REAL
3038         CLL CML
3039         ISZ STARSW      /INHIBIT PUNCHING ORIGIN IF NECESSARY
3040         JMS I [PUNOUT
3041         CLA
3042         DCA STARSW      /RESET SWITCH
3043         JMP I PUNORG    /--RETURN--
3044         PAGE
3045 \f\f/EVALUATE LITERAL
3046
3047 LIT,    STA RAL         /-2 IF PAGE 0 LITERAL, -1 IF CUR PAGE
3048         DCA FINDS1      /SAVE FLAG
3049         JMS I [GETC     /GET NEXT CHARACTER
3050         JMS I [SPNOR    /IGNORE SPACES
3051         TAD EXPIND      /STORE IMPORTANT VALUES PRIOR TO
3052         JMS I [PUSHA    /ENTRANCE INTO EXP
3053         TAD OP
3054         JMS I [PUSHA
3055         TAD VALUE
3056         JMS I [PUSHA
3057         TAD FINDS1
3058         JMS I [PUSHA
3059         JMS I [EXP      /GET EXPRESSION
3060         TAD VALUE       /FIND LITERAL IN TABLE
3061         ISZ I PDLXR     /PAGE 0?
3062         JMP .+3
3063         JMS FINDS       /NO
3064         SKP
3065         JMS FIND0       /YES
3066         DCA VALUE2      /STORE ADDRESS
3067         TAD I PDLXR
3068         DCA VALUE
3069         TAD I PDLXR     /RESTORE SAVED VALUES
3070         DCA OP
3071         TAD I PDLXR
3072         DCA EXPIND
3073         TAD CHAR        /IGNORE ) OR ]
3074         TAD (-")
3075         SZA
3076         TAD (")-"]
3077         SNA CLA
3078         JMS I [GETC     /GET NEXT CHARACTER
3079         JMP I (NUMBE5   /RETURN TO EXPRESSION PROCESSOR
3080
3081
3082 PEZE,   0               /SUBR TO ISSUE PE OR ZE MESSAGE
3083         SNA CLA         /WHICH ONE?
3084         JMP .+4 /PAGE 0
3085         JMS I PERROR
3086         PE
3087         JMP I PEZE
3088         JMS I PERROR
3089         ZE
3090         JMP I PEZE
3091 \f/FIND LITERAL ON CURRENT PAGE
3092
3093 FINDS,  0
3094         DCA FINDS1
3095         TAD LOC
3096         AND [7600
3097         SNA             /IS THIS PAGE 0?
3098         JMP FIND01      /YES
3099         DCA FINDS2      /NO - SAVE PAGE NUMBER
3100         TAD [LITBF1
3101         DCA FIND0
3102         TAD [7700       /ALLOW 100(8) CURRENT PAGE LITERALS
3103         DCA FORMF6
3104         TAD LITPTR      /GET PG ADDR OF 1ST LITERAL IN BUFFER
3105 FIND02, DCA FINDS3
3106         TAD FINDS2
3107         JMS I [RTL6
3108         TAD [LITBUF
3109         DCA TEMP
3110         TAD FIND0       /COMPUTE ACTUAL CORE ADDRESS OF LITERAL
3111         TAD I TEMP
3112         DCA TEMP2
3113         TAD FINDS3      /COMPUTE THE NUMBER OF ENTRIES
3114         CIA
3115         TAD I TEMP      /IN THE LITERAL BUFFER
3116         SNA
3117         JMP FINDS6      /NONE
3118         DCA FINDS3
3119 FINDS4, TAD I TEMP2     /GET LITERAL FROM TABLE
3120         CIA
3121         TAD FINDS1      /AND CURRENT LITERAL
3122         SNA CLA         /DO THEY MATCH?
3123         JMP FINDS5      /YES
3124         ISZ TEMP2       /NO - BUMP COUNTERS
3125         ISZ FINDS3
3126         JMP FINDS4      /TRY AGAIN
3127 FINDS6, TAD FINDS2
3128         JMS I [RTL6
3129         TAD [TPINST
3130         DCA FINDS3
3131         TAD I TEMP      /DOES THIS OVERFLOW PAGE?
3132         CIA
3133         TAD I FINDS3
3134         SPA CLA
3135         JMP FINDS7      /NO
3136
3137 \fFIND03,        TAD FINDS2      /PAGE FULL - WHICH PAGE?
3138         JMS PEZE        /GENERATE PE OR ZE MESSAGE
3139         CLA CMA
3140         JMP FINDS9
3141 FINDS7, CLA CMA
3142         TAD I TEMP      /IS PAGE FULL?
3143         AND FORMF6
3144         SNA CLA
3145         JMP FIND03      /YES - OUTPUT ERROR MESSAGE
3146         CLA CMA
3147         TAD I TEMP      /NO
3148         DCA I TEMP
3149 FINDS9, TAD I TEMP
3150         TAD FIND0
3151         DCA TEMP2
3152         TAD FINDS1
3153         DCA I TEMP2
3154 FINDS5, TAD FIND0       /GET ADDRESS OF LITERAL
3155         CIA
3156         TAD TEMP2
3157         TAD FINDS2
3158         JMP I FINDS     /--RETURN--
3159
3160
3161 /FIND LITERAL ON PAGE 0
3162
3163 FIND0,  0
3164         DCA FINDS1
3165         TAD FIND0       /RESET EXIT FROM FINDS
3166         DCA FINDS
3167 FIND01, DCA FINDS2      /SET POINTERS
3168         TAD (LITBF2
3169         DCA FIND0
3170         TAD [7760       /ALLOW 160(8) PAGE 0 LITERALS
3171         DCA FORMF6
3172         TAD [200
3173         JMP FIND02
3174
3175 FINDS1, 0
3176 FINDS2, 0
3177 FINDS3, 0
3178         PAGE
3179 \f/HANDLER FOR IFZERO PSEUDO-OP
3180
3181 IF0,    TAD (10         /IFTST1, SNA CLA
3182
3183 /HANDLER FOR IFNZERO PSEUDO-OP
3184
3185 IFN0,   TAD IFSZA       /IFTST1, SZA CLA
3186         DCA IFTST1
3187         JMS I [SPNOR    /IGNORE SPACES
3188         JMS I [EXP      /GET EXPRESSION
3189 IFTST3, TAD CHAR        /GET LAST CHARACTER
3190         TAD (-"<
3191         SNA CLA         /IS IT <?
3192         JMP IFTST2      /YES
3193         JMS ICMESG      /PRINT IC MESSAGE AND GET NEXT CHAR
3194 IFTST9, JMS I [SPNOR    /IGNORE SPACES
3195         JMP IFTST3      /TRY AGAIN
3196
3197 IFTST2, JMS I [GETC     /GET NEXT CHARACTER
3198         TAD CONDSW
3199         CIA
3200         DCA CONDTM      /SET NUMBER OF NESTED CONDITIONALS
3201         CLA CMA         /DECREMENT NUMBER OF NESTED CONDITIONALS
3202         TAD CONDSW
3203         DCA CONDSW
3204         TAD VALUE
3205 IFTST1, HLT             /SZA CLA OR SNA CLA
3206         JMP I (MAIN     /--EXIT TO MAIN--
3207 IFTST5, TAD CONDSW      /DONE WITH ALL CONDITIONALS IN NEST?
3208         TAD CONDTM
3209         SMA CLA
3210         JMP I (MAIN     /YES --EXIT TO MAIN--
3211         TAD CHAR
3212         TAD (-"<        /NO - GET NEXT CHARACTER
3213         SNA             /IS IT <?
3214         JMP IFTST6      /YES - HANDLE NEXT CONDITIONAL
3215         TAD ("<-">      /NO - IS IT >?
3216 IFSZA,  SZA CLA
3217         JMP IFTST4      /NO - FINISH THIS CONDITIONAL
3218         AC7776
3219 IFTST6, CMA
3220         TAD CONDSW
3221         DCA CONDSW
3222 IFTST4, DCA I [LINBUF   /INHIBIT LISTING OF UNASSEMBLED CODE -
3223                         /ZEROED IF /J OPTION NOT SPECIFIED
3224         JMS I [GETC     /GET NEXT CHARACTER
3225         JMP IFTST5
3226 \f/HANDLER FOR IFDEF PSEUDO-OP
3227
3228 IFD,    TAD (10         /IFTST1, SNA CLA
3229
3230 /HANDLER FOR IFNDEF PSEUDO-OP
3231
3232 IFND,   TAD IFSZA       /IFTST1, SZA CLA
3233         DCA IFTST1
3234 IFTST7, JMS I [SPNOR    /IGNORE SPACES
3235         JMS I [TSTALP   /IS NEXT CHARACTER ALPHABETIC
3236         JMP IFTST8      /YES
3237         JMS ICMESG      /PRINT IC MESSAGE AND GET NEXT CHAR
3238         JMP IFTST7      /KEEP TRYING
3239
3240 IFTST8, JMS I [GETTAG   /PICK UP TAG
3241         DCA VALUE       /STORE UNDEFINED INDICATOR
3242         TAD TAG3        /WAS IT A PSEUDO-OP?
3243         SMA CLA
3244         JMP IFTST9      /NO
3245         JMS I [ERROR    /YES - GENERATE IP ERROR MESSAGE
3246         IP
3247         JMP IFTST9
3248
3249 ICMESG, 0
3250         JMS I   [ERROR
3251         IC              /IC COMES OUT ON ALL PASSES
3252         TAD CHAR
3253         SPA CLA
3254         JMP I [LOOKEX   /END OF LINE - GO AWAY
3255         JMS I [GETC     /GET NEXT CHAR
3256         JMP I ICMESG
3257 \fCONDTM,
3258
3259 /PUT TAG IN SYMBOL TABLE
3260
3261 PUTTAG, 0
3262         TAD THISTG
3263         JMS I (SETFLD   /SET FIELD
3264         TAD TAG1
3265         DCA I TAGXR
3266         TAD TAG2
3267         DCA I TAGXR
3268         TAD TAG3
3269         DCA I TAGXR
3270         TAD VALUE2
3271         DCA I TAGXR
3272         CDF
3273         JMP I PUTTAG    /--RETURN--
3274
3275
3276 /PUSHDOWN ROUTINE
3277 /PUT NEW ENTRY ON PUSHDOWN STACK
3278
3279 PUSHA,  0
3280         DCA TEMP
3281         CLA CMA
3282         TAD PDLXR
3283         DCA PDLXR
3284         TAD PDLXR
3285         TAD (-PDLND
3286         SPA CLA         /IS LIST TOO FULL?
3287         JMP PUSHA1      /BE**FATAL ERROR**
3288         TAD TEMP        /NO - MAKE ENTRY
3289         DCA I PDLXR
3290         CLA CMA
3291         TAD PDLXR
3292         DCA PDLXR
3293         JMP I PUSHA     /--RETURN--
3294
3295 PUSHA1, TAD (BE
3296         JMP I [MONERR   /PUSHDOWN OVERFLOW IS FATAL ERROR
3297 \f/TEST NUMERIC ROUTINE
3298 /CALL WITH CHARACTER TO TEST IN "CHAR"
3299 /SKIPS IF THE CHARACTER IS NOT NUMERIC
3300
3301 TSTNUM, 0
3302         TAD CHAR        /GET THE CHARACTER
3303         TAD (-"9-1
3304         CLL
3305         TAD ("9-"0+1
3306         SNL CLA         /CHECK FOR RANGE 0-9
3307         ISZ TSTNUM      /OUT OF RANGE
3308         JMP I TSTNUM    /--RETURN--
3309
3310 /TEST ALPHANUMERIC ROUTINE
3311 /CALL WITH CHARACTER IN "CHAR"
3312 /SKIPS IF CHARACTER IS NOT ALPHANUMERIC
3313
3314 TSTALN, 0
3315         JMS I [TSTNUM   /IS IT NUMERIC
3316         JMP I TSTALN    /YES--RETURN--
3317         JMS I [TSTALP   /IS IT ALPHABETIC
3318         JMP I TSTALN    /YES--RETURN--
3319         ISZ TSTALN      /NEITHER
3320         JMP I TSTALN    /--RETURN--
3321
3322 /TEST ALPHABETIC ROUTINE
3323 /CALL WITH CHARACTER IN "CHAR"
3324 /SKIPS IF NOT ALPHABETIC
3325
3326 TSTALP, 0
3327         TAD CHAR
3328         TAD (-"Z-1
3329         CLL
3330         TAD ("Z-"A+1
3331         SNL CLA         /CHECK FOR RANGE A-Z
3332         ISZ TSTALP      /OUT OF RANGE
3333         JMP I TSTALP    /--RETURN--
3334         PAGE
3335 \f/INPUT ROUTINE
3336 /UNPACKS CHARACTERS FROM BUFFER
3337
3338 INPUT,  0
3339         ISZ INCHCT      /ARE THERE CHARACTERS LEFT IN BUFFER?
3340         JMP I CHARLV    /YES - FETCH ONE
3341         TAD INEOF       /NO - WAS OLD FILE ENDED?
3342         SZA CLA
3343         JMP ENDCHR      /YES - START NEW FILE
3344 INGBUF, TAD INCTLA      /NO
3345         AND [7600
3346         JMS I [RTL6
3347         TAD INCTR
3348         SNL
3349         DCA INCTR
3350         SZL
3351         ISZ INEOF
3352         CLL CML CMA RTR /SET CONTROL WORD
3353         RTR
3354         RTR
3355         TAD INCTLA
3356         DCA INCTLW
3357         JMS I INHNDL    /CALL INPUT DEVICE HANDLER
3358 INCTLW, 0               /CONTROL WORD
3359 INBUFP, INBUF           /INPUT BUFFER ADDRESS
3360 INREC,  0               /STARTING BLOCK NUMBER
3361         JMP INERRX      /ERROR RETURN
3362 INBREC, TAD INCTLA      /NORMAL RETURN
3363         AND [7600
3364         JMS I [RTL6
3365         TAD INREC
3366         DCA INREC       /RESET STARTING BLOCK NUMBER
3367         TAD INCTLW
3368         AND [7600
3369         CLL RAL
3370         TAD INCTLW
3371         AND [7600
3372         CIA
3373         DCA INCHCT      /SET CHARACTER COUNT
3374         TAD INBUFP
3375         DCA INPTR       /SET BUFFER POINTER
3376 \f/CHARACTERS ARE FOUND IN BUFFER
3377 /IN STANDARD OS/8 PACKING
3378 /WORD 1: AAA A11 111 111
3379 /WORD 2: BBB B22 222 222
3380 /WHICH REPRESENTS 3 CHARACTERS
3381 /CHARACTER 1: 11 111 111
3382 /CHARACTER 2: 22 222 222
3383 /CHARACTER 3: AA AAB BBB
3384
3385
3386 ICHAR1, TAD I INPTR     /PICK UP CHARACTER WORD 1
3387         JMS CHARLV      /CHECK RIGHT 8 BITS
3388 ICHAR2, TAD I INPTR     /PICK UP WORD 1
3389         ISZ INPTR       /(INCREMENT POINTER TO WORD 2)
3390         AND [7400       /WITH WORD 1 IN AC
3391         DCA INCTLW      /RETRIEVE LEFT 4 BITS AND SAVE
3392         TAD I INPTR     /PICK UP WORD 2
3393         JMS CHARLV      /CHECK RIGHT 8 BITS
3394 ICHAR3, TAD I INPTR     /PICK UP WORD 2
3395         ISZ INPTR       /(POINT TO NEXT WORD 1)
3396         AND [7400       /WITH WORD 2 IN AC
3397         CLL RTR         /RETRIEVE LEFT 4 BITS
3398         RTR
3399         TAD INCTLW      /PUT BOTH SETS OF 4 BITS TOGETHER
3400         RTR
3401         RTR
3402         JMS CHARLV      /CHECK CHARACTER
3403         JMP ICHAR1      /TRY NEXT SET OF 2 WORDS
3404
3405 INERRX, ISZ INEOF
3406         SMA CLA         /EOF OR FATAL ERROR?
3407         JMP INBREC      /EOF - UNPACK THIS BUFFER
3408         JMP I (SYSERR   /FATAL - GENERATE DE ERROR MESSAGE
3409
3410 INCHCT, -1
3411 INEOF,  1
3412 INPTR,  0
3413 INCTR,  0
3414 INCTLA, 0
3415 INFPTR, 7617
3416 \f/START NEW FILE
3417
3418 ENDCHR, ISZ I (FORMSW   /^Z OR EOF SIMULATES FORM FEED
3419         TAD PASS        /IS THIS PASS 3?
3420         SPA SNA CLA
3421         JMP NXTFLE      /NO
3422         JMS I (HEDCLR   /YES - CLEAR HEADING BUFFER
3423         TAD [-HEDLEN
3424         DCA I (LSTCH6
3425         TAD [HEADER-1
3426         DCA I (LSTCH7
3427         DCA LSTCNT
3428 NXTFLE, TAD (INDEVH+1   /SET ADDRESS OF DEVICE HANDLER
3429         DCA INHNDL
3430         CDF 10
3431         TAD I INFPTR
3432         CDF
3433         SNA
3434         JMP FAKDLR      /END OF FILE - FAKE A $
3435         CIF 10
3436         JMS I IOMON     /CALL USER SERVICE ROUTINES
3437         1               /*FETCH HANDLER*
3438 INHNDL, 0               /LOADING ADDRESS OF HANDLER
3439         HLT             /ERROR RETURN
3440         CDF 10          /V3C
3441         TAD INHNDL      /NORMAL RETURN - HANDLER IN CORE
3442         AND [7600
3443         TAD [-INDEVH    /SEE IF INPUT HANDLER IS IN 7200
3444         SZA CLA
3445         JMS I (PTCH     /IT IS - INCREASE SIZE OF BUFFER
3446                         /AND REMOVE FROM RESIDENCY ANY HANDLERS THERE
3447         TAD INCTL
3448         DCA INCTLA      /DF=10
3449         TAD I INFPTR
3450         AND [7760
3451         SZA
3452         TAD [17
3453         CLL CML RTR
3454         RTR
3455         DCA INCTR
3456         ISZ INFPTR
3457         TAD I INFPTR
3458         DCA INREC       /RESET STARTING BLOCK NUMBER
3459         ISZ INFPTR
3460         DCA INEOF
3461         CDF
3462         JMP INGBUF
3463 \fFAKDLR,        TAD (244
3464         JMS CHARLV      /CALL THE COROUTINE
3465         TAD [215        /WITH $ AND CR
3466         JMS CHARLV      /TO END THE ASSEMBLY.
3467         JMP I (PHASE    /** DIDN'T WORK - MUST BE IN CONDITIONAL - FATAL
3468
3469 CHARLV, 0               /CHARACTER IN AC
3470         AND [177        /AND OFF LEFT 5 BITS
3471         JMP I (LSTCH9   /RETURN TO LSTCH9
3472         PAGE
3473 \f/HANDLER FOR DTORG PSEUDO-OP (TYPESETTING)
3474 /PUNCHES 4 DIGIT BLOCK NUMBER IN 2 FRAMES
3475 /FIRST FRAME HAS CHANNELS 7 AND 8 PUNCHED
3476 /ADDED TO CHECKSUM
3477
3478 DTORGX, JMS I [SPNOR    /IGNORE SPACES
3479         JMS I [EXP      /GET EXPRESSION
3480         TAD PASS        /IS THIS PASS 2?
3481         SNA
3482         JMP DTORG2      /YES
3483 PUNVA1, SPA SNA CLA     /NO - IS THIS PASS 3?
3484         JMP I [LOOKEX   /NO--EXIT TO MAIN--
3485         TAD LININD      /GET LINK SWITCH FROM "EXP"
3486         DCA LINKSW      /YES
3487         TAD [LOOKEX     /FIX PUNONE TO EXIT TO MAIN
3488         DCA I (PUNONE
3489         TAD [211        /OUTPUT TAB
3490         JMS I OERROR
3491         JMP I (DTORG1
3492
3493 DTORG2, TAD VALUE       /PASS 2 - GET BLOCK NUMBER
3494         JMS I [RTL6
3495         RAL
3496         AND [77
3497         TAD (300        /PICK UP CHANNELS 7 AND 8
3498         DCA TEMP
3499         TAD TEMP
3500         TAD CHKSUM      /ADD VALUE TO CHECKSUM
3501         DCA CHKSUM
3502         TAD TEMP
3503         JMS I OCHAR     /OUTPUT BLOCK NUMBER - FIRST FRAME
3504         TAD VALUE
3505         AND [77
3506         JMS I OCHAR     /OUTPUT SECOND FRAME
3507         JMP I [LOOKEX   /--EXIT TO MAIN--
3508
3509 /HANDLER FOR %
3510 /DIVIDE BY REPEATED SUBTRACTION
3511
3512 OP6,    DCA TEMP
3513         TAD VALUE2
3514         CIA
3515         DCA VALUE2
3516         TAD VALUE
3517 OP6A,   CLL
3518         TAD VALUE2      /SUBTRACT DIVISOR FROM DIVIDEND
3519         SNL             /DONE YET?
3520         JMP OP6B        /YES - EXIT
3521         ISZ TEMP        /NO - COUNT ONE MORE SUBTRACTION
3522         JMP OP6A        /SUBTRACT AGAIN
3523 OP6B,   CLA
3524         TAD TEMP        /RESULT IS # OF SUBTRACTIONS
3525         JMP I (OP0+2
3526 \f/HANDLER FOR XLIST PSEUDO-OP
3527
3528 XLISTY, JMS XLISTZ      /ANY EXPRESSION?
3529         JMP XLIST1      /NO
3530         JMS I [EXP      /GET EXPRESSION
3531         TAD VALUE       /USE THE VALUE
3532 XLIST2, DCA XLISTX      /SET SWITCH
3533         DCA I [LINBUF   /XLIST NEVER LISTS!
3534         JMP I [LOOKEX   /--EXIT TO MAIN--
3535
3536 XLIST1, TAD XLISTX
3537         SNA CLA
3538         IAC             /FLIP IT
3539         JMP XLIST2
3540
3541 RELOCY, JMS XLISTZ      /RELOCATE PSEUDO-OP - EXPRESSION?
3542         JMP RELOC1      /NO
3543         JMS I [EXP      /GET IT
3544         TAD VALUE
3545         CIA             /COMPUTE OFFSET OF REL LOC CTR
3546         TAD LOC         /FROM FAKE LOC CTR
3547         TAD OFFSET      /OFFSET IS CUMULATIVE!
3548 RELOC2, DCA OFSBUF      /SET NEW OFFSET - THIS TAKES EFFECT AFTER
3549         STA             /THE LITERALS (IF ANY) ARE DUMPED.
3550         JMP I (STAR0    /FAKE ORIGIN TO NEW LOC,
3551                         /ACTUALLY A NO-OP BECAUSE OF OFFSET
3552 RELOC1, TAD OFFSET      /SET OFSBUF=0, LOC=LOC+OFFSET -
3553         TAD LOC         /THIS CANCELS ALL RELOCATION STUFF.
3554         DCA VALUE
3555         DCA UNDFSW      /JUST IN CASE - "STAR0" CHECKS THIS
3556         JMP RELOC2      /STILL MUST OUTPUT *. TO GET IN SYNCH
3557 \f/HANDLER FOR EJECT PSEUDO-OP
3558
3559 EJECTX, ISZ THISPG
3560         TAD PASS        /IS THIS PASS 3?
3561         SMA SZA CLA
3562         JMP EJECT2      /YES
3563 EJECT1, TAD CHAR        /NO - LOOK FOR NEXT NEGATIVE CHARACTER
3564         SPA CLA
3565         JMP I [LOOKEX   /--EXIT TO MAIN--
3566         JMS I [GETC     /GET NEXT CHARACTER
3567         JMP EJECT1
3568
3569 EJECT2, JMS XLISTZ      /PASS 3 - IS THERE AN EXPRESSION?
3570         JMP EJECT3      /NO - EXIT
3571         JMS I (HEDCLR   /YES - CLEAR HEADING BUFFER
3572         TAD [-HEDLEN
3573         DCA EJECT7      /SET UP FOR 40 NEW CHARACTERS
3574         TAD [HEADER-1
3575         DCA XREG1       /SET HEADER BUFFER POINTER
3576         JMP EJECT4
3577
3578 EJECT6, ISZ EJECT7      /FILLED 40 CHARACTERS YET?
3579         JMP EJECT4      /NO - KEEP FILLING
3580         CLA CMA         /YES - SKIP CHARACTERS TO
3581         DCA EJECT7      /END OF LINE
3582         JMP EJECT5
3583
3584 EJECT4, TAD CHAR        /FILL HEADING BUFFER
3585         DCA I XREG1
3586 EJECT5, CLA CMA
3587         DCA TXTSWT
3588         JMS I [GETC     /GET NEXT CHARACTER
3589         TAD CHAR        /END OF LINE?
3590         SMA CLA
3591         JMP EJECT6      /NO - KEEP FILLING
3592 EJECT3, JMS I [FORMFD   /GENERATE FORM FEED
3593         JMP I [LOOKEX   /--EXIT TO MAIN--
3594 \fPUNVAL,        TAD PASS        /IS THIS PASS 3?
3595         JMP PUNVA1      /IF SO, LIST STUFF
3596
3597
3598 /SEE IF EXPRESSION FOLLOWS XLIST
3599 /SKIP ON EXPRESSION
3600
3601 EJECT7,
3602 XLISTZ, 0
3603         JMS I [SPNOR    /IGNORE TRAILING SPACES
3604         TAD CHAR
3605         TAD [-">        /IS THERE AN EXPRESSION?
3606         SNA CLA
3607         JMP I XLISTZ    /NO--RETURN--
3608         TAD CHAR
3609         SMA CLA
3610         ISZ XLISTZ      /YES - INCREMENT RETURN ADDRESS
3611         JMP I XLISTZ    /--RETURN--
3612
3613
3614 /DUMMY ERROR ROUTINE
3615 /TO SUPPRESS CERTAIN ERROR MESSAGES
3616 /ON PASS 1
3617
3618 PERRO1, 0
3619         ISZ PERRO1      /SKIP ERROR MESSAGE POINTER
3620         JMP I PERRO1    /--RETURN--
3621
3622
3623 /CONSTANTS FOR DECIMAL PRINT
3624
3625         DECIMAL
3626 FORMF8, -1000
3627         -100
3628         -10
3629         0
3630         OCTAL
3631         PAGE
3632 \f/*********************************************************************
3633
3634 INBUF=.                 /INPUT BUFFER
3635
3636 OUBUF=.                 /OUTPUT BUFFER
3637
3638 OUDEVH=.+400            /OUTPUT DEVICE HANDLER
3639
3640 INDEVH=7200             /INPUT DEVICE HANDLER
3641
3642 /**********************************************************************
3643
3644 /       EXPLANATION OF PAL8'S BUFFER ALLOCATION ALGORITHM
3645
3646 /PASS1:
3647
3648 /       THE INPUT BUFFER STARTS AT 5600 AND ENDS AT 7200
3649 /       THE INPUT HANDLER GOES IN 7200-7600.
3650 /       THERE IS NO OUTPUT HANDLER.
3651 /       HOWEVER, IF THE CURRENT INPUT HANDLER DOES NOT
3652 /       LOAD INTO 7200, THEN THE BUFFER SIZE IS INCREASED
3653 /       SO THAT THE INPUT BUFFER IS 5600-7600
3654
3655 /PASS2 AND PASS3:
3656
3657 /       THE OUTPUT BUFFER IS ALWAYS 1 BLOCK LONG, LOCATED
3658 /       AT 5600-6200.
3659 /       THE OUTPUT HANDLER RESIDES IN 6200-6600.
3660 /       THE INPUT HANDLER RESIDES IN 7200-7600.
3661 /       THE INPUT BUFFER NORMALLY RESIDES IN 6600-7200
3662 /       BUT MAY GROW OVER EITHER THE INPUT HANDLER AREA OR
3663 /       THE OUTPUT HANDLER AREA, IF EITHER OR BOTH OF THESE
3664 /       DON'T EXIST.
3665
3666 /WHENEVER A BUFFER GROWS OVER A HANDLER AREA, THE MONITOR
3667 /HANDLER RESIDENCY TABLE IS SEARCHED TO SEE IF THERE
3668 /WERE ANY HANDLERS THERE.  IF ANY HANDLERS WERE THERE IN THE PAST,
3669 /THEY ARE NOW MARKED AS BEING NON-RESIDENT.
3670 \f/MORE ONCE ONLY CODE
3671
3672 OTYPE,  0
3673         DCA TEMP
3674         CDF 10
3675         TAD I TEMP
3676         AND [17         /GET DEVICE NUMBER
3677         TAD (DCB-1
3678         DCA TEMP
3679         TAD I TEMP      /GET DCB ENTRY
3680         CDF
3681         JMP I OTYPE     /--RETURN--
3682
3683 /CHECK TO SEE HOW MUCH CORE EXISTS
3684 /AND STORE SYMBOL TABLE ACCORDINGLY
3685
3686         IFZERO  HASH<
3687 BEGINF, CDF 10          /WAS THE /K OPTION SELECTED TO
3688         TAD I (MPARAM   /CHECK FOR MORE THAN 8K?
3689         CDF 0
3690         RTR
3691 ZK7630, SNL CLA         /YES
3692         JMP I (CKBAT    /NO - CHECK FOR BATCH, USE 8K ONLY
3693         CDF 50
3694         JMS FLD2        /WHAT IS HIGHEST FIELD?
3695         JMP FLD1-1      /5
3696         CDF 40
3697         JMS FLD2
3698         JMP FLD1        /4
3699         CDF 30
3700         JMS FLD2
3701         JMP FLD1+1      /3
3702         CDF 20
3703         JMS FLD2
3704         JMP FLD1+2      /2
3705         JMP OPTIM4      /1
3706 \f       TAD [177        /IF FIELD 5, ALLOW 4095 SYMBOLS
3707 FLD1,   TAD (1740       /OTHERWISE ALLOW 1740*(NR OF FIELDS)
3708         TAD (1740
3709         TAD (1740
3710 OPTIM0, TAD (1740
3711         DCA I (TAGMAX   /SET HIGHEST ADDRESS FOR TAGS
3712         JMP I (BEGING
3713
3714 OPTIM4, TAD I OPTIM1    /OPTIMIZE SEARCH PATTERN
3715         ISZ OPTIM1      /BY SUBSTITUTING CODE IN SEARCH
3716         DCA I OPTIM2    /ROUTINE
3717         ISZ OPTIM2
3718         ISZ OPTIM3
3719         JMP OPTIM4
3720 OPTIM8, TAD I OPTIM5
3721         ISZ OPTIM5
3722         DCA I OPTIM6
3723         ISZ OPTIM6
3724         ISZ OPTIM7
3725         JMP OPTIM8
3726         JMP OPTIM0
3727         >
3728
3729         IFNZRO  HASH<
3730         /SIZE CHECK OUR MACHINE
3731
3732 BEGINF, CDF     10
3733         TAD I   (MPARAM
3734         CDF
3735         RTR             /K TO LINK
3736 ZK7630, SNL CLA         /ALTER FOR COMPLEMENT OF K
3737         TAD     [400    /TAD TO KEEP USR
3738         DCA I   (USROFS
3739         CDF     50
3740         JMS     FLD2
3741         ISZ     HIFLD
3742         CDF     40
3743         JMS     FLD2
3744         ISZ     HIFLD
3745         CDF     30
3746         JMS     FLD2
3747         ISZ     HIFLD
3748         CDF     20
3749         JMS     FLD2
3750         ISZ     HIFLD
3751         TAD I   (7777   /CHECK SOFT CORE SIZE
3752         AND     (70
3753         SNA
3754         JMP     CKSEV   /NOT THERE
3755         CLL RTR
3756         RAR
3757         DCA     HIFLD   /THERE, SET HIFLD WITH IT
3758         TAD     HIFLD   /TAKE MIN(HIFLD,5)
3759         TAD     (7772
3760         SMA CLA         /SMA TO USE HIFLD
3761         TAD     (5      /ELSE USE 5
3762         SZA
3763         DCA     HIFLD   /STORE 5 IF NECESSARY
3764 CKSEV,  CDF     10
3765         TAD I   (MPARAM+2       /LOOK AT /7
3766         CDF
3767         AND     (4
3768         SNA CLA         /SNA IF THERE
3769         JMP I   (CKBAT  /ELSE CHECK FOR BATCH
3770         TAD     (-7     /SET TO PRINT 7 COLUMNS OF STAB
3771         DCA I   (SYMNCL
3772         TAD     (67^6   /SET OFFSET TO FIRST SYMBOL ON NEXT PAGE
3773         DCA I   (SYMOFS
3774         JMP I   (CKBAT  /OK, CHECK FOR BATCH NOW
3775 OPTIM4, SNL             /SNL IF BATCH RUNNING
3776         JMP I   (BEGING /ELSE TAKE DEFAULT TABLE SIZE
3777         TAD     (BPRIME/SET ALTERNATE TABLE SIZE
3778         DCA I   (PRIMES /INTO THE ONCE ONLY CODE
3779         JMP I   (BEGING /NOW HIFLD=# OF HIGHEST USABLE FIELD
3780 HIFLD,  1               /8K MINIMUM
3781         >
3782
3783 /SKIP IF CURRENT DATA FIELD DOES NOT EXIST
3784 FLD2,   0
3785         TAD (FLD3
3786         DCA I (FLD4
3787 FLD3,   CLA
3788         TAD I (FLD4
3789         NOP
3790         CDF
3791         TAD (-FLD3
3792         SZA CLA
3793         JMP FLD5
3794         TAD IOMON
3795         TAD [-200
3796         SNA CLA         /IS FIELD THERE?
3797         JMP I FLD2      /YES--RETURN--
3798         TAD [200
3799         DCA IOMON
3800 FLD5,   ISZ FLD2        /NO-INCREMENT RETURN ADDRESS
3801         JMP I FLD2      /--RETURN--
3802
3803 FLD4,   IOMON
3804 \f/OVERLAY CODE FOR OPTIMAL SYMBOL TABLE SEARCH
3805 /IN 8K
3806         IFZERO  HASH<
3807
3808 OPTIM1, OPTIMA
3809 OPTIM2, SETFLD+1
3810 OPTIM3, -7
3811
3812 OPTIM5, OPTIMB
3813 OPTIM6, GETTG5
3814 OPTIM7, -21
3815
3816 OPTIMA, RELOC SETFLD+1
3817
3818         CLL CMA RTL
3819         TAD STM202
3820         DCA TAGXR
3821         CDF 10
3822         JMP I SETFLD
3823 STM202, -202
3824 SETFL4, 4
3825         RELOC
3826
3827 OPTIMB, RELOC GETTG5
3828
3829         TAD HIGHTG
3830         JMS SETFLD
3831         TAD TAGXR
3832         DCA XREG1
3833         TAD XREG1
3834         TAD SETFL4
3835         DCA XREG2
3836         TAD THISTG
3837         JMS SETFLD
3838 OPTIML, TAD I XREG2
3839         DCA I XREG1
3840         TAD XREG1
3841         CIA
3842         TAD TAGXR
3843         SZA CLA
3844         JMP OPTIML
3845         CDF
3846         RELOC
3847         >
3848 \f/OVERLAY CODE FOR DDT SYMBOL TABLE PRINT
3849
3850 DSWIT2, IFZERO  HASH<
3851         RELOC SYMPR9-2
3852         JMP SYMPRE
3853 SYMPRD, TAD SYM204
3854         JMS I OERROR
3855         TAD [377
3856         JMS I OERROR
3857         JMS SYMPRC
3858         DCA LINCNT
3859         JMP I SYMPRT
3860 SYMPRC, 0
3861         TAD [-200
3862         DCA SYMPR2
3863         TAD [200
3864         JMS I OERROR
3865         ISZ SYMPR2
3866         JMP .-3
3867         JMP I SYMPRC
3868         RELOC
3869         >
3870         IFNZRO  HASH<
3871         RELOC   SYMDDT
3872         ISZ     THISTG
3873         JMP     SYMLUP
3874 SYMXIT, TAD     SYM204
3875         JMS I   OERROR
3876         TAD     [377
3877         JMS I   OERROR
3878         JMS     DDTLDR
3879         DCA     LINCNT
3880         JMP I   SYMPRT
3881 DDTLDR, 0
3882         TAD     [7600
3883         DCA     SYMCCT
3884         TAD     [200
3885         JMS I   OERROR
3886         ISZ     SYMCCT
3887         JMP     .-3
3888         JMP I   DDTLDR
3889 SYM204, 204
3890         RELOC
3891         >
3892 DSWITB= .
3893         PAGE
3894 \fBEGING,        CIF 10
3895         JMS I IOMON     /CALL THE USR
3896         12              /TO FIND OUT DSK:
3897 BEGINJ, TEXT /DSK/
3898         7201            /DUMMY
3899         HLT             /NEVER!
3900 /V3C    TAD BEGINJ+1    /GET DEVICE NUMBER OF DSK:
3901 /V3C    DCA CC7         /AND SET IT
3902         TAD BEGINJ+1
3903         DCA I BEGINL    /AND SET IT INTO "PALBIN"
3904         CDF 10
3905         TAD I CC1       /GET PARAMETER WORD 1
3906         CDF
3907         CLL RTL         /OPTION /B INTO LINK
3908         AND [400        /IS IT /F?
3909 ZF7650, SZA CLA
3910         DCA I CCX1      /YES: /F => NO 0 FILL
3911 ZB7430, SNL             /IS IT /B?
3912         JMP .+3
3913         TAD CCX2
3914         DCA I CCX3      /YES: /B => ! IS SHIFT
3915         CDF 10
3916         TAD I CC1       /GET WORD 1 AGAIN
3917         CDF
3918         AND [200        /IS IT /E?
3919 ZE7640, SNA CLA
3920         JMP .+3
3921         TAD CCX8
3922         DCA I CCX4      /YES: /E => SET 'LG' ERROR
3923         CDF 10
3924         TAD I CCX5      /GET WORD 2 THIS TIME
3925         CDF
3926         RTL
3927 ZO7710, SMA CLA         /IS IT /O?
3928         JMP .+3
3929         DCA I CCX6      /YES: /O => NO 200 ORG
3930         ISZ I CCX7
3931         CDF 10
3932         TAD I CC1       /GET WORD 1 AGAIN
3933         AND CC2         /IS IT /C?
3934         SNA CLA
3935         JMP I CC3       /NO: TRY FOR /L OR /G
3936         TAD I CC4       /CREF FILE SPECIFIED?
3937         SZA CLA
3938         JMP CC5         /YES
3939 CC6,    TAD CC7         /NO: GIVE "CREFLS.TM"
3940         DCA I CC4
3941         ISZ CC6
3942         ISZ CC4
3943         ISZ CC8
3944         JMP CC6
3945 \fCC5,   CDF
3946         CIF 10
3947         CLA IAC
3948         JMS I IOMON     /LOOKUP "CREF.SV"
3949         2
3950 CC13,   CC9             /POINT TO NAME - BACK WITH START
3951 CC8,    -5              /LENGTH GOES HERE
3952         JMP CC16        /NOT FOUND!
3953         TAD CC30
3954         JMS I CC31      /CHECK TYPE FILE
3955         SMA CLA
3956         JMP CC16        /NOT DIRECTORY IS ERROR
3957         TAD CC12
3958         DCA I CC121     /CSWITC=TAD I [7605
3959         TAD CC11
3960         DCA I CC111     /CSWIT1=CLA
3961         TAD CC10
3962         DCA I CC101     /CSWIT2=DCA BINSRT
3963         DCA I CC171     /CMOVE=0
3964         TAD CC13
3965         DCA I CC131     /CHAIN="CREF.SV"
3966         DCA I CC141     /LSWITC=0
3967         TAD CC30
3968         DCA I CC301     /NOPA22=7612
3969         DCA I CC20      /"BEGIAB"=0
3970         TAD CC21
3971         DCA I CC211     /"DIRSW1"=TAD [177
3972         TAD CC22
3973         DCA I CC221     /"PTPSW1"=TAD [232
3974         JMP I .+1
3975         CCC             /KEEP GOING (SIGH)
3976
3977 CC16,   JMS I [ERROR
3978         CF              /OPTION /C ERROR
3979         JMP I CC3       /TRY FOR /L OR /G
3980 \fCC171, SWAPR2+CMOVE
3981 CC141,  LSWITC
3982 CC131,  CHAIN
3983 CC121,  CSWITC
3984 CC12,   TAD I [7605
3985 CC111,  CSWIT1
3986 CC11,   CLA
3987 CC101,  SWAPR2+CSWIT2
3988 CC10,   DCA BINSRT
3989 CC301,  SWAPR2+NOPA22
3990 CC30,   7612
3991 CC31,   OTYPE
3992 CC1,    MPARAM
3993 CC2,    1000
3994 CC3,    BEGINH
3995 CC4,    7612
3996
3997 CCX1,   TEXT4X          /V3C
3998 CCX2,   OP3
3999 CCX3,   OPEXPL
4000 CCX4,   LGERR
4001 CCX5,   MPARAM+1
4002 CCX6,   FIELDY+1
4003 CCX7,   FIELDY+2
4004 CCX8,   JMS I PERROR
4005
4006 CC7,    1
4007         FILENAME CREFLS.TM
4008 CC9,    FILENAME CREF.SV
4009
4010 CC20,   BEGIAB
4011 CC21,   TAD [177
4012 CC211,  SWAPR2+DIRSW1
4013 CC22,   TAD [232
4014 CC221,  SWAPR2+PTPSW1
4015
4016 BEGINL, PALBIN
4017         PAGE
4018 \f/***********************************************************************
4019 /SYMBOL TABLE
4020 /MOVED BY ASSEMBLER TO FIELD 1
4021 /MUST REMAIN IN ALPHABETICAL ORDER
4022 /***********************************************************************
4023
4024 SYMS,   5777                    /TERMINATOR
4025         3777                    /IMPOSSIBLE (LIMITING) SYMBOL
4026         5777
4027         0000
4028         IFNZRO  HASH<           /PSEUDO OPS MUST GO FIRST FOR EXPUNGE
4029         "I-300^45+4000+2000     /I
4030         0
4031         0
4032         0400
4033
4034         "P-300^45+"A-300+4000   /PAUSE
4035         "U-300^45+"S-300
4036         "E-300^45+4000
4037         PAUSEX
4038
4039         "P-300^45+"A-300+4000   /PAGE
4040         "G-300^45+"E-300
4041         4000
4042         PAGEX
4043
4044         "T-300^45+"E-300+4000   /TEXT
4045         "X-300^45+"T-300
4046         4000
4047         TEXTX
4048
4049         "R-300^45+"E-300+4000   /RELOC
4050         "L-300^45+"O-300
4051         "C-300^45+4000
4052         RELOCY
4053
4054         "O-300^45+"C-300+4000   /OCTAL
4055         "T-300^45+"A-300
4056         "L-300^45+4000
4057         OCTALX
4058
4059         "N-300^45+"O-300+4000   /NOPUNCH
4060         "P-300^45+"U-300
4061         "N-300^45+"C-300+4000
4062         NOPUNX
4063
4064
4065         "I-300^45+"F-300+4000   /IFZERO
4066         "Z-300^45+"E-300
4067         "R-300^45+"O-300+4000
4068         IF0
4069 \f       "I-300^45+"F-300+4000   /IFNZRO
4070         "N-300^45+"Z-300
4071         "R-300^45+"O-300+4000
4072         IFN0
4073
4074         "I-300^45+"F-300+4000   /IFNDEF
4075         "N-300^45+"D-300
4076         "E-300^45+"F-300+4000
4077         IFND
4078
4079         "I-300^45+"F-300+4000   /IFDEF
4080         "D-300^45+"E-300
4081         "F-300^45+4000
4082         IFD
4083
4084         "F-300^45+"I-300+4000   /FIXTAB
4085         "X-300^45+"T-300
4086         "A-300^45+"B-300+4000
4087         FIXTBX
4088
4089         "F-300^45+"I-300+4000   /FIXMRI
4090         "X-300^45+"M-300
4091         "R-300^45+"I-300+4000
4092         FIXMRX
4093
4094         "F-300^45+"I-300+4000   /FILENAME
4095         "L-300^45+"E-300
4096         "N-300^45+"A-300+4000
4097         FILENX
4098
4099         "F-300^45+"I-300+4000   /FIELD
4100         "E-300^45+"L-300
4101         "D-300^45+4000
4102         FIELDX
4103
4104         "E-300^45+"X-300+4000   /EXPUNGE
4105         "P-300^45+"U-300
4106         "N-300^45+"G-300+4000
4107         EXPUNX
4108
4109         "E-300^45+"N-300+4000   /ENPUNCH
4110         "P-300^45+"U-300
4111         "N-300^45+"C-300+4000
4112         ENPUNX
4113
4114         "E-300^45+"J-300+4000   /EJECT
4115         "E-300^45+"C-300
4116         "T-300^45+4000
4117         EJECTX
4118 \f       "D-300^45+"T-300+4000   /DTORG
4119         "O-300^45+"R-300
4120         "G-300^45+4000
4121         DTORGX
4122
4123         "D-300^45+"E-300+4000   /DEVICE
4124         "V-300^45+"I-300
4125         "C-300^45+"E-300+4000
4126         DEVICX
4127
4128         "D-300^45+"E-300+4000   /DECIMAL
4129         "C-300^45+"I-300
4130         "M-300^45+"A-300+4000
4131         DECIMX
4132         >
4133         "Z-300^45+"B-300+4000   /ZBLOCK
4134         "L-300^45+"O-300
4135         "C-300^45+"K-300+4000
4136         ZBLOCX
4137
4138         "Z-300^45+4000+2000     /Z
4139         0
4140         0
4141         0000
4142
4143         "X-300^45+"L-300+4000   /XLIST
4144         "I-300^45+"S-300
4145         "T-300^45+4000
4146         XLISTY
4147
4148         "T-300^45+"S-300+4000   /TSK
4149         "K-300^45
4150         0
4151         6045
4152
4153         "T-300^45+"S-300+4000   /TSF
4154         "F-300^45
4155         0
4156         TSF
4157
4158         "T-300^45+"P-300+4000   /TPC
4159         "C-300^45
4160         0
4161         TPC
4162
4163         "T-300^45+"L-300+4000   /TLS
4164         "S-300^45
4165         0
4166         TLS
4167
4168         "T-300^45+"F-300+4000   /TFL
4169         "L-300^45
4170         0
4171         6040
4172 \f       IFZERO  HASH<
4173         "T-300^45+"E-300+4000   /TEXT
4174         "X-300^45+"T-300
4175         4000
4176         TEXTX
4177         >
4178         "T-300^45+"C-300+4000   /TCF
4179         "F-300^45
4180         0
4181         TCF
4182
4183         "T-300^45+"A-300+4000   /TAD
4184         "D-300^45+4000
4185         0
4186         TAD 0
4187
4188         "S-300^45+"Z-300+4000   /SZL
4189         "L-300^45
4190         0
4191         SZL
4192
4193         "S-300^45+"Z-300+4000   /SZA
4194         "A-300^45
4195         0
4196         SZA
4197
4198         "S-300^45+"W-300+4000   /SWP
4199         "P-300^45
4200         0
4201         7521
4202
4203         "S-300^45+"T-300+4000   /STL
4204         "L-300^45
4205         0
4206         STL
4207
4208         "S-300^45+"T-300+4000   /STA
4209         "A-300^45
4210         0
4211         STA
4212
4213         "S-300^45+"R-300+4000   /SRQ
4214         "Q-300^45
4215         0
4216         6003
4217
4218         "S-300^45+"P-300+4000   /SPA
4219         "A-300^45
4220         0
4221         SPA
4222 \f       "S-300^45+"N-300+4000   /SNL
4223         "L-300^45
4224         0
4225         SNL
4226
4227         "S-300^45+"N-300+4000   /SNA
4228         "A-300^45
4229         0
4230         SNA
4231
4232         "S-300^45+"M-300+4000   /SMA
4233         "A-300^45
4234         0
4235         SMA
4236
4237         "S-300^45+"K-300+4000   /SKP
4238         "P-300^45
4239         0
4240         SKP
4241
4242         "S-300^45+"K-300+4000   /SKON
4243         "O-300^45+"N-300
4244         0
4245         6000
4246
4247         "S-300^45+"G-300+4000   /SGT
4248         "T-300^45
4249         0
4250         6006
4251
4252         "R-300^45+"T-300+4000   /RTR
4253         "R-300^45
4254         0
4255         RTR
4256
4257         "R-300^45+"T-300+4000   /RTL
4258         "L-300^45
4259         0
4260         RTL
4261
4262         "R-300^45+"T-300+4000   /RTF
4263         "F-300^45
4264         0
4265         6005
4266
4267         "R-300^45+"S-300+4000   /RSF
4268         "F-300^45
4269         0
4270         RSF
4271 \f       "R-300^45+"R-300+4000   /RRB
4272         "B-300^45
4273         0
4274         RRB
4275
4276         "R-300^45+"P-300+4000   /RPE
4277         "E-300^45
4278         0
4279         6010
4280
4281         "R-300^45+"M-300+4000   /RMF
4282         "F-300^45
4283         0
4284         RMF
4285
4286         "R-300^45+"I-300+4000   /RIF
4287         "F-300^45
4288         0
4289         RIF
4290
4291         "R-300^45+"I-300+4000   /RIB
4292         "B-300^45
4293         0
4294         RIB
4295
4296         "R-300^45+"F-300+4000   /RFC
4297         "C-300^45
4298         0
4299         RFC
4300         IFZERO  HASH<
4301         "R-300^45+"E-300+4000   /RELOC
4302         "L-300^45+"O-300
4303         "C-300^45+4000
4304         RELOCY
4305         >
4306         "R-300^45+"D-300+4000   /RDF
4307         "F-300^45
4308         0
4309         RDF
4310
4311         "R-300^45+"A-300+4000   /RAR
4312         "R-300^45
4313         0
4314         RAR
4315
4316         "R-300^45+"A-300+4000   /RAL
4317         "L-300^45
4318         0
4319         RAL
4320 \f       "P-300^45+"S-300+4000   /PSF
4321         "F-300^45
4322         0
4323         PSF
4324
4325         "P-300^45+"P-300+4000   /PPC
4326         "C-300^45
4327         0
4328         PPC
4329
4330         "P-300^45+"L-300+4000   /PLS
4331         "S-300^45
4332         0
4333         PLS
4334
4335         "P-300^45+"C-300+4000   /PCF
4336         "F-300^45
4337         0
4338         PCF
4339
4340         "P-300^45+"C-300+4000   /PCE
4341         "E-300^45
4342         0
4343         6020
4344         IFZERO  HASH<
4345         "P-300^45+"A-300+4000   /PAUSE
4346         "U-300^45+"S-300
4347         "E-300^45+4000
4348         PAUSEX
4349
4350         "P-300^45+"A-300+4000   /PAGE
4351         "G-300^45+"E-300
4352         4000
4353         PAGEX
4354         >
4355         "O-300^45+"S-300+4000   /OSR
4356         "R-300^45
4357         0
4358         OSR
4359
4360         "O-300^45+"P-300+4000   /OPR
4361         "R-300^45
4362         0
4363         OPR
4364         IFZERO  HASH<
4365         "O-300^45+"C-300+4000   /OCTAL
4366         "T-300^45+"A-300
4367         "L-300^45+4000
4368         OCTALX
4369         >
4370 \f       IFZERO  HASH<
4371         "N-300^45+"O-300+4000   /NOPUNCH
4372         "P-300^45+"U-300
4373         "N-300^45+"C-300+4000
4374         NOPUNX
4375         >
4376         "N-300^45+"O-300+4000   /NOP
4377         "P-300^45
4378         0
4379         NOP
4380
4381         "M-300^45+"Q-300+4000   /MQL
4382         "L-300^45
4383         0
4384         7421
4385
4386         "M-300^45+"Q-300+4000   /MQA
4387         "A-300^45
4388         0
4389         7501
4390
4391         "L-300^45+"A-300+4000   /LAS
4392         "S-300^45
4393         0
4394         LAS
4395
4396         "K-300^45+"S-300+4000   /KSF
4397         "F-300^45
4398         0
4399         KSF
4400
4401         "K-300^45+"R-300+4000   /KRS
4402         "S-300^45
4403         0
4404         KRS
4405
4406         "K-300^45+"R-300+4000   /KRB
4407         "B-300^45
4408         0
4409         KRB
4410
4411         "K-300^45+"I-300+4000   /KIE
4412         "E-300^45
4413         0
4414         6035
4415
4416         "K-300^45+"C-300+4000   /KCF
4417         "F-300^45
4418         0
4419         6030
4420 \f       "K-300^45+"C-300+4000   /KCC
4421         "C-300^45
4422         0
4423         KCC
4424
4425         "J-300^45+"M-300+4000   /JMS
4426         "S-300^45+4000
4427         0
4428         JMS 0
4429
4430         "J-300^45+"M-300+4000   /JMP
4431         "P-300^45+4000
4432         0
4433         JMP 0
4434
4435         "I-300^45+"S-300+4000   /ISZ
4436         "Z-300^45+4000
4437         0
4438         ISZ 0
4439
4440         "I-300^45+"O-300+4000   /IOT
4441         "T-300^45
4442         0
4443         IOT
4444
4445         "I-300^45+"O-300+4000   /ION
4446         "N-300^45
4447         0
4448         ION
4449
4450         "I-300^45+"O-300+4000   /IOF
4451         "F-300^45
4452         0
4453         IOF
4454         IFZERO  HASH<
4455         "I-300^45+"F-300+4000   /IFZERO
4456         "Z-300^45+"E-300
4457         "R-300^45+"O-300+4000
4458         IF0
4459
4460         "I-300^45+"F-300+4000   /IFNZRO
4461         "N-300^45+"Z-300
4462         "R-300^45+"O-300+4000
4463         IFN0
4464
4465         "I-300^45+"F-300+4000   /IFNDEF
4466         "N-300^45+"D-300
4467         "E-300^45+"F-300+4000
4468         IFND
4469         >
4470 \f       IFZERO  HASH<
4471         "I-300^45+"F-300+4000   /IFDEF
4472         "D-300^45+"E-300
4473         "F-300^45+4000
4474         IFD
4475         >
4476         "I-300^45+"A-300+4000   /IAC
4477         "C-300^45
4478         0
4479         IAC
4480         IFZERO  HASH<
4481         "I-300^45+4000+2000     /I
4482         0
4483         0
4484         0400
4485         >
4486         "H-300^45+"L-300+4000   /HLT
4487         "T-300^45
4488         0
4489         HLT
4490
4491         "G-300^45+"T-300+4000   /GTF
4492         "F-300^45
4493         0
4494         6004
4495
4496         "G-300^45+"L-300+4000   /GLK
4497         "K-300^45
4498         0
4499         GLK
4500         IFZERO  HASH<
4501         "F-300^45+"I-300+4000   /FIXTAB
4502         "X-300^45+"T-300
4503         "A-300^45+"B-300+4000
4504         FIXTBX
4505
4506         "F-300^45+"I-300+4000   /FIXMRI
4507         "X-300^45+"M-300
4508         "R-300^45+"I-300+4000
4509         FIXMRX
4510
4511         "F-300^45+"I-300+4000   /FILENAME
4512         "L-300^45+"E-300
4513         "N-300^45+"A-300+4000
4514         FILENX
4515
4516         "F-300^45+"I-300+4000   /FIELD
4517         "E-300^45+"L-300
4518         "D-300^45+4000
4519         FIELDX
4520         >
4521 \f       IFZERO  HASH<
4522         "E-300^45+"X-300+4000   /EXPUNGE
4523         "P-300^45+"U-300
4524         "N-300^45+"G-300+4000
4525         EXPUNX
4526
4527         "E-300^45+"N-300+4000   /ENPUNCH
4528         "P-300^45+"U-300
4529         "N-300^45+"C-300+4000
4530         ENPUNX
4531
4532         "E-300^45+"J-300+4000   /EJECT
4533         "E-300^45+"C-300
4534         "T-300^45+4000
4535         EJECTX
4536
4537         "D-300^45+"T-300+4000   /DTORG
4538         "O-300^45+"R-300
4539         "G-300^45+4000
4540         DTORGX
4541
4542         "D-300^45+"E-300+4000   /DEVICE
4543         "V-300^45+"I-300
4544         "C-300^45+"E-300+4000
4545         DEVICX
4546
4547         "D-300^45+"E-300+4000   /DECIMAL
4548         "C-300^45+"I-300
4549         "M-300^45+"A-300+4000
4550         DECIMX
4551         >
4552         "D-300^45+"C-300+4000   /DCA
4553         "A-300^45+4000
4554         0
4555         DCA 0
4556
4557         "C-300^45+"M-300+4000   /CML
4558         "L-300^45
4559         0
4560         CML
4561
4562         "C-300^45+"M-300+4000   /CMA
4563         "A-300^45
4564         0
4565         CMA
4566
4567         "C-300^45+"L-300+4000   /CLL
4568         "L-300^45
4569         0
4570         CLL
4571 \f       "C-300^45+"L-300+4000   /CLA
4572         "A-300^45
4573         0
4574         CLA
4575
4576         "C-300^45+"I-300+4000   /CIF
4577         "F-300^45
4578         0
4579         CIF
4580
4581         "C-300^45+"I-300+4000   /CIA
4582         "A-300^45
4583         0
4584         CIA
4585
4586         "C-300^45+"D-300+4000   /CDF
4587         "F-300^45
4588         0
4589         CDF
4590
4591         "C-300^45+"A-300+4000   /CAF
4592         "F-300^45
4593         0
4594         6007
4595
4596         "B-300^45+"S-300+4000   /BSW
4597         "W-300^45
4598         0
4599         7002
4600
4601         "A-300^45+"N-300+4000   /AND
4602         "D-300^45+4000
4603         0
4604         AND 0
4605
4606         4001                    /TERMINATOR
4607         0000                    /IMPOSSIBLE (LIMITING) SYMBOL
4608         4000
4609         0000
4610
4611 SYME=.
4612
4613 /**********************************************************************
4614 /TOP OF SYMBOL TABLE
4615 /**********************************************************************
4616 \fSWAP2=.
4617
4618 /**********************************************************************
4619 /CODE UNIQUE TO PASSES 1 AND 2
4620 /SWAPPED IN FOR PASSES 1 AND 2
4621 /OVERLAYED DURING PASS 3        *** NO LITERALS ***
4622
4623         RELOC 1000              /ASSEMBLED INTO 1000-1247
4624
4625         SWAPB2= .
4626         SWAPR2= SWAP2-SWAPB2    /RELOCATION FACTOR FOR THIS CODE
4627
4628 OOPEN,  0
4629         TAD OPEN01      /OPEN BINARY AND LISTING FILES
4630         DCA XOUHND      /SET ADDRESS OF DEVICE HANDLER
4631         TAD OPEN02
4632         DCA XOUBLK
4633         TAD [-5
4634         DCA XOUELE      /SET NEW OUTPUT FILE LENGTH
4635         CDF 10
4636         TAD I OUFPTR
4637         CDF
4638         DCA I XOUBLK
4639         ISZ XOUBLK
4640         ISZ OUFPTR
4641         ISZ XOUELE      /INCREMENT OUTPUT FILE LENGTH
4642         JMP .-7
4643         TAD OPEN02
4644         IAC
4645         DCA XOUBLK      /SET POINTER TO NEW FILENAME
4646         TAD XOUBLK
4647         DCA I OPEN04
4648         CIF 10
4649         JMS I IOMON     /CALL USER SERVICE ROUTINES
4650         13              /*RESET SYSTEM TABLES*
4651         DCA I OPEN05    /DELETE UNCLOSED FILES AND
4652         TAD I OPEN02    /DELETE HANDLERS
4653         AND [17         /GET NEW DEVICE HANDLER #
4654         SNA             /OUTPUT INHIBIT?
4655         JMP ONOFIL      /YES
4656         CIF 10          /NO
4657         JMS I IOMON     /CALL USER SERVICE ROUTINE
4658         1               /*FETCH DEVICE HANDLER*
4659 XOUHND, 0               /LOADING ADDRESS
4660         HLT             /HANDLER NOT AVAILABLE
4661 OUENTR, TAD I OPEN02    /NORMAL RETURN - GET OUTPUT
4662         CIF 10          /DEVICE NUMBER AND FILE LENGTH
4663 \f       JMS I IOMON     /CALL NEW SERVICE ROUTINES
4664         3               /*ENTER OUTUT FILE
4665 XOUBLK, 0               /POINTER TO FILENAME
4666 XOUELE, 0               /FILE LENGTH
4667         JMP OEFAIL      /ERROR RETURN
4668         DCA I OPEN06    /NORMAL RETURN
4669         JMS I OPEN07
4670         TAD XOUHND
4671         TAD [200        /LINK IS CLEAR!!
4672         SNL CLA
4673         TAD [400
4674         TAD OUFDEV
4675         DCA I OUFINP
4676         TAD I OUFINP
4677         CLL RAR
4678         CIA
4679         TAD OU3501
4680         DCA INCTL
4681         ISZ OOPEN
4682         TAD XOUHND
4683         DCA I OPEN09
4684         TAD XOUBLK
4685         DCA I OPEN10
4686         TAD XOUELE
4687         DCA I OPEN11
4688         JMP I OOPEN     /--RETURN--
4689
4690 OEFAIL, TAD I OPEN02
4691         AND [7760
4692         SNA CLA
4693         JMP I OPEN12    /DE**FATAL ERROR**
4694         TAD I OPEN02
4695         AND [17
4696         DCA I OPEN02
4697         JMP OUENTR
4698
4699 ONOFIL, ISZ I OPEN05    /SET OUTPUT INHIBIT SWITCH
4700         JMP I OOPEN     /--RETURN--
4701
4702 OUFPTR, 7600
4703
4704 OPEN01, OUDEVH+1
4705 OPEN02, OUFILE
4706 OPEN04, OUCNAM
4707 OPEN05, OUTINH
4708 OPEN06, OUCCNT
4709 OPEN07, OUSETP
4710 OPEN09, OUHNDL
4711 OPEN10, OUBLK
4712 OPEN11, OUELEN
4713 OPEN12, SYSERR
4714 OU3501, 3501
4715 OUFDEV, OUDEVH
4716 OUFINP, INBUFP
4717 \f/CONTINUATION OF FIXTAB HANDLER
4718
4719 FIXTAY, IFZERO  HASH<
4720         TAD HIGHTG      /SET POINTERS TO TABLE
4721         CMA
4722         >
4723         IFNZRO  HASH<
4724         TAD     TAGMAX
4725         CIA
4726         >
4727         DCA TEMP3
4728         DCA THISTG
4729 FIXTAX, JMS I [FINDTG   /GET A TAG
4730         AC3777
4731         AND TAG1
4732         IFNZRO  HASH<
4733         SZA
4734         >
4735         TAD [4000       /SET BIT 0 OF FIRST WORD TO 1
4736         DCA TAG1        /RETURN IT TO TABLE
4737         JMS I [PUTTAG
4738         ISZ THISTG
4739         ISZ TEMP3       /DONE WITH TABLE YET?
4740         JMP FIXTAX      /NO
4741         JMP I [LOOKEX   /YES--EXIT TO MAIN--
4742
4743 /OUTPUT ONE REGISTER - BINARY
4744 /ENTER WITH CONTENTS IN AC
4745
4746 PUNOUT, 0
4747         DCA PUNOU1
4748         TAD PUNOU1
4749         RTR
4750         RTR
4751         RTR
4752         AND [177
4753         JMS I OCHAR     /OUTPUT FIRST FRAME
4754         TAD PUNOU1
4755         AND [77
4756         JMS I OCHAR     /OUTPUT SECOND FRAME
4757         JMP I PUNOUT    /--RETURN--
4758
4759 PUNOU1,
4760 IOPEN,  0               /SET UP INPUT ROUTINE
4761         CLA CMA         /TO OPEN FILE
4762         DCA I IOPEN1
4763         ISZ I IOPEN2
4764         TAD IOPEN3
4765         DCA I IOPEN4
4766         ISZ I IOPEN5
4767         TAD [LINBUF+120
4768         DCA TXTPTR
4769         JMP I IOPEN     /--RETURN--
4770
4771 IOPEN1, INCHCT
4772 IOPEN2, INEOF
4773 IOPEN3, 7617
4774 IOPEN4, INFPTR
4775 IOPEN5, FORMSW
4776         PAGE
4777 \f/START PASS 2  *** NO LITERALS HERE EITHER ***
4778
4779 START1, TAD [ERROR
4780         DCA PERROR      /RESET PREUDO-ERROR ROUTINE
4781         JMS I ST1OPN    /OPEN PASS 2 OUTPUT FILE
4782         JMP NOPA21      /NO PASS 2 IF PASS 3
4783 NOPA23, TAD I ST1OBL
4784         DCA BINSRT
4785         DCA PUNCHX      /CLEAR PUNCH INHIBIT
4786         JMS START3
4787         JMP I .+1
4788         START2-1
4789
4790 NOPA21, CDF 10
4791         TAD I NOPA22    /IS THERE A PASS 3?
4792         CDF
4793         SNA CLA
4794         JMP NOPA23      /NO - DO PASS 2
4795         ISZ PASS        /SKIP PASS 2
4796         NOP
4797         JMP NOPAS2      /CONTINUE TO PASS 3
4798
4799 NOPA22, 7605
4800
4801 START3, 0               /GENERATE LEADER/TRAILER
4802         TAD LEADER
4803         DCA TXTPTR
4804         TAD [200
4805         JMS I OCHAR
4806         ISZ TXTPTR
4807         JMP .-3
4808         JMP I START3    /--RETURN--
4809
4810 LEADER, -10
4811 \f/END PASS 2
4812
4813 ENDPA2, JMS I [DUMPZ    /DUMP PAGE 0 LITERALS
4814         DCA PUNCHX
4815         CLL             /V3C
4816         TAD CHKSUM      /OUTPUT CHECKSUM
4817         JMS I [PUNOUT   /PUNCH THE CHECKSUM
4818         JMS START3      /GENERATE LEADER/TRAILER
4819         JMS I EN2CLS    /CLOSE PASS 2 OUTPUT FILE
4820 NOPAS2, TAD EN2LSO
4821         DCA OERROR      /SET NEW OUTPUT TO BE LISTING
4822         ISZ I EN2OU1
4823 CMOVE,  JMP CMOVA       /ZEROED IF /C
4824         CDF 10          /MOVE CODE FOR /C OPTION
4825 CMOVB,  TAD I CMOV1
4826         DCA I CMOV2     /MOVE OUTPUT FILE STORAGE
4827         ISZ CMOV1
4828         ISZ CMOV2
4829         ISZ CMOV3
4830         JMP CMOVB       /LOOP
4831 CMOVA,  CDF
4832         JMS I ST1OPN    /OPEN 3RD PASS FILE
4833         DCA I CMOV4     /NO 3RD PASS
4834         TAD I ST1OBL    /GET FILE START
4835 CSWIT2, CLA             /"DCA BINSRT" IF /C
4836         TAD PTPSW1
4837         DCA I EN2PTP    /RESET PAPERTAPE SWITCH
4838         TAD DIRSW1
4839         DCA I EN2DIR    /RESET DIRECTORY SWITCH
4840         JMS I PIOPEN
4841         JMP I .+1
4842         LOADOV          /OVERLAY THIS AREA WITH PASS3 CODE
4843
4844 PIOPEN, IOPEN
4845 DIRSW1, TAD [177
4846 PTPSW1, TAD [232
4847
4848 CMOV1,  7605
4849 CMOV2,  7600
4850 CMOV3,  -12
4851 CMOV4,  NSWITC
4852 EN2CLS, OCLOSE
4853 EN2LSO, LISOUT
4854 EN2OU1, OUTPT1
4855 EN2PTP, PTPSW
4856 EN2DIR, DIRSW
4857 ST1OPN, OOPEN
4858 ST1OBL, OUBLK
4859 SWAPE2, RELOC
4860         IFNZRO  ENDOVL-SWAPE2&4000 <OVLERR,__ERROR__>
4861         PAGE
4862 \f       IFNZRO  HASH<
4863
4864         /ONCE ONLY CODE TO HASH OUT THE PERMANENT SYMBOLS
4865
4866 HSHSMS, 0
4867         JMS I   (7607   /WRITE THE SYMBOL TABLE SORT OVERLAY
4868         4210            /2 PAGES FROM FIELD 1
4869         OUDEVH+400      /FROM HERE
4870         ASWAP+1         /TO HERE
4871         JMP I   (SYSERR/WONDERFUL.
4872         TAD I   (USROFS
4873         SZA CLA         /SZA IF KICKING OUT USR
4874         TAD     (12     /ELSE FUDGE POINTER
4875         TAD I   (HIFLD  /FIRST SET HASH TABLE SIZE
4876         TAD     PRIMES  /ACCORDING TO CORE SIZE
4877         DCA     PRIME
4878         TAD I   PRIME
4879         DCA     PRIME
4880         TAD     PRIME
4881         CIA
4882         DCA I   (MPRIME
4883         TAD I   (USROFS
4884         SZA CLA
4885         JMP     KPUSR   /JMP IF KEEPING USR
4886         CDF     10      /SERVE NOTICE WE'RE OCCUPYING FIELD 1
4887         AC7776
4888         AND I   (JSBITS
4889         DCA I   (JSBITS
4890         TAD     [7700
4891         DCA     IOMON   /AND POINT AT PROPER MONITOR E.P.
4892 KPUSR,  CDF
4893         TAD I   (MPRIME /HOW MANY SLOTS TO WIPE
4894         DCA     LAST3   /TO COUNTER
4895         TAD I   (USROFS
4896         CLL RTL
4897         TAD     (7777   /FUDGE THE INITIAL AUTO XR
4898         JMP     CLRGO   /INTO THE LOOP NOW
4899 CLRLUP, TAD     LAST1
4900         TAD     (-7577
4901         SZA CLA         /SZA IF NEED TO DO NEXT FIELD
4902         JMP     CLCDF0+1/ELSE CLEAR ANOTHER
4903         TAD     (10
4904         TAD     CLCDF0
4905         DCA     CLCDF0  /CDF INSTR GETS BUMPED
4906         STA
4907 CLRGO,  DCA     LAST1   /XRGETS SET
4908 CLCDF0, CDF     10      /INITIALLY CDF 10
4909         DCA I   LAST1
4910         DCA I   LAST1
4911         DCA I   LAST1
4912         DCA I   LAST1
4913         ISZ     LAST3   /SKP IF NO MORE
4914         JMP     CLRLUP  /ELSE DO ANOTHER
4915         CDF             /THE TABLE IS CLEAN
4916         TAD     (HSHRTN
4917         DCA I   [GETTAG
4918         STA
4919         DCA     HIGHTG  /HIGHTG=CURRENT SYMBOL INDEX
4920         TAD     (SYMS+3 /USE THESE AUTO XR'S NOW
4921         DCA     LAST1
4922         TAD     LAST1
4923         DCA     LAST2
4924 HSHLP,  TAD I   LAST1
4925         AND     [1777   /FIRST, STRIP THE TYPE BITS
4926         DCA I   (NAME1
4927         AC3777
4928         AND I   LAST1
4929         DCA I   (NAME2
4930         AC3777
4931         AND I   LAST1
4932         DCA I   (NAME3
4933         ISZ     LAST1   /SKIP THE VALUE
4934         JMP I   (GETTGH /GO FIND IT'S PLACE
4935 HSHRTN, CLA CLL
4936         TAD I   LAST2
4937         DCA I   (NAME1
4938         TAD I   LAST2
4939         DCA I   (NAME2
4940         TAD I   LAST2
4941         DCA I   (NAME3
4942         TAD I   LAST2
4943         DCA     VALUE2
4944         JMS I   (INSRTG /AND STORE IT
4945         TAD     LAST1
4946         TAD     (1-SYME+4
4947         SZA CLA
4948         JMP     HSHLP   /LOOP IF MORE TO GO
4949         JMP I   HSHSMS  /--RETURN--
4950
4951 PRIMES, .
4952         1737    /1 FIELD
4953         3673    /2 FIELDS
4954         5633    /3 FIELDS
4955         7577    /4 FIELDS
4956         7775    /5 FIELDS (THE LAST MOSTELY WASTE)
4957         BPRIMES=.-1     /ALTERNATE TABLE SIZE FOR BATCH COMPATABILITY
4958         1737    /1 FIELD (MEANS NO BATCH)
4959         3133    /2 FIELDS
4960         5075    /3 FIELDS
4961         7035    /4 FIELDS
4962         7775    /5 FIELDS (SOME OF WASTE FOR BATCH)
4963
4964         1335    /STILL ANOTHER ALTERNATE SET IF KEEPING USR
4965         3273
4966         5237
4967         7175
4968         7775
4969
4970         0
4971         2535
4972         4465
4973         6437
4974         7775
4975
4976         PAGE
4977         >
4978 \f/**************************************************************
4979 /PAGE 0 LITERALS
4980 /**************************************************************
4981         IFNZRO  HASH<
4982
4983         /SYMBOL TABLE SORT OVERLAY
4984         /ONLY SWAPPED IF TABLE WILL BE LISTED
4985
4986         /FIRST, SOME EQUATES
4987
4988         PPUTTAG=        [PUTTAG
4989         PFINDTG=        [FINDTG
4990         O1777=          [1777
4991         O7774=          [7774
4992
4993         SXR=    XREG1
4994         TXR=    XREG2
4995         SXR2=   LAST1
4996         TXR2=   LAST2
4997         UXR=    LAST3
4998         DXR=    LAST4
4999
5000         BEG=    LOC
5001         END=    OFFSET
5002         LO=     OFSBUF
5003         HI=     STARSW
5004         MED=    OP
5005
5006         FIELD 1         /SET THE FIELD NOW
5007 \f       *OUDEVH+400     /IT GOES HERE
5008
5009 SORTAB, 0               /FIRST LOC IN PAGE
5010         TAD     TAGMAX
5011         CIA
5012         DCA     TEMP    /TEMP=#CELLS TO SCAN
5013
5014         /DEFLATE TABLE PRIOR TO SORTING AND LISTING IT
5015         /OUT WITH EMPTIES AND PERMANENTS
5016
5017         DCA     HIGHTG  /TARGET POINTER
5018         DCA     TEMP2   /SOURCE POINTER
5019 DEFLP,  TAD     TEMP2
5020         DCA     THISTG
5021         JMS I   PFINDTG /GET THE NEXT STAB CELL
5022         TAD     TAG1
5023         CLL RAL
5024         SNA SZL CLA     /AND THERE BUT NOT FIXED?
5025         JMP     DEFNUL  /NO, DON'T STORE IT
5026         TAD     O1777   /YES,DISCARD THE TYPE BITS NOW
5027         AND     TAG1
5028         DCA     TAG1
5029         AC3777
5030         AND     TAG2
5031         DCA     TAG2
5032         AC3777
5033         AND     TAG3
5034         DCA     TAG3
5035         TAD     HIGHTG
5036         DCA     THISTG
5037         JMS I   PPUTTAG
5038         ISZ     HIGHTG
5039 DEFNUL, ISZ     TEMP2
5040         ISZ     TEMP    /TRY AGAIN
5041         JMP     DEFLP
5042         JMS I   (SORT   /NOW SORT THEM
5043         JMP I   SORTAB  /EXIT TO PRTSTAB
5044 \f       /MOVE A SYMBOL THRU THE TABLE
5045
5046 SMOV,   0
5047         TAD     SXR2    /GET SOURCE DF+XREG
5048         JMS     GETFLD
5049         DCA     SMVCD1
5050         TAD     TXR
5051         DCA     SXR
5052         TAD     TXR2
5053         JMS     GETFLD
5054         DCA     SMVCD2
5055         TAD     O7774
5056         DCA     SSWT
5057 SMVCD1, 0
5058         TAD I   SXR
5059 SMVCD2, 0
5060         DCA I   TXR
5061         ISZ     SSWT
5062         JMP     SMVCD1
5063 SMVCD0, CDF
5064         JMP I   SMOV
5065
5066         /AUXILLIARY FIELD+XREG SETTER
5067
5068 GETFLD, 0
5069         CLL
5070         TAD I   (USROFS /IF KEEPING USR
5071         DCA     TXR     /AC=SYM NUM
5072         DCA     SMVCD2
5073         TAD     TXR
5074         ISZ     SMVCD2
5075         CML
5076         TAD     (-1740
5077         SNL
5078         JMP     .-4
5079         CLL RTL
5080         TAD     (-202   /SETS AS IN SETFLD...
5081         DCA     TXR     /TENTATIVELY SET TXR
5082         TAD     SMVCD2
5083         CLL RTL
5084         RAL
5085         TAD     SMVCD0
5086         JMP I   GETFLD  /EXIT WITH AC SET TO CDF INSTR
5087 \f       /ROUTINE TO EXCHANGE SYMBOLS LO AND HI
5088
5089 SSWT,   0
5090         TAD     HI
5091         JMS     GETFLD
5092         DCA     SWCDF1
5093         TAD     SWCDF1
5094         DCA     SWCDF3
5095         TAD     TXR
5096         DCA     SXR
5097         TAD     SXR
5098         DCA     SXR2    /SXR'S FOR HIGH SYMBOL
5099         TAD     LO
5100         JMS     GETFLD
5101         DCA     SWCDF2
5102         TAD     TXR
5103         DCA     TXR2    /TXR'S FOR LOW SYMBOL
5104         TAD     O7774
5105         DCA     SMOV    /COUNTER
5106
5107 SWCDF1, 0
5108         TAD I   SXR     /GET HI SYM WORD
5109         DCA     GETFLD  /HOLD IT
5110 SWCDF2, 0
5111         TAD I   TXR     /GET LO
5112         DCA     SCOM    /HOLD IT
5113         TAD     GETFLD
5114         DCA I   TXR2    /STORE  HI IN LOW
5115 SWCDF3, 0
5116         TAD     SCOM    /NOW STORE LO
5117         DCA I   SXR2    /IN HI
5118         ISZ     SMOV
5119         JMP     SWCDF1+1
5120         CDF
5121         JMP I   SSWT
5122 \f       /COMPARE SYMBOLS + SET LINK THEREBY
5123
5124 SCOM,   0
5125         DCA     THISTG  /AC=TAG #
5126         JMS I   (SETFLD
5127         TAD I   TAGXR
5128         CLL CIA
5129         TAD     TAG1
5130         SZA CLA
5131         JMP     SCOMRT
5132         TAD I   TAGXR
5133         CLL CIA
5134         TAD     TAG2
5135         SZA CLA
5136         JMP     SCOMRT
5137         TAD I   TAGXR
5138         CLL CIA
5139         TAD     TAG3
5140         SNA CLA
5141         HLT     /NEVER
5142 SCOMRT, CDF
5143         JMP I   SCOM
5144
5145         PAGE
5146
5147
5148
5149
5150
5151
5152
5153
5154 \f       /SORT ROUTINE HERE
5155
5156 SORT,   0
5157         DCA     BEG     /INITIALIZE PARTITION BOUNDS
5158         STA STL
5159         TAD     HIGHTG
5160         DCA     END     /ARE THERE ANY SYMBOLS?
5161         SZL
5162         JMP I   SORT    /NO EXIT WITH LINK SET
5163         TAD     (LITBF1-1+26    /OK, SET STACK NOW
5164         DCA     DXR
5165         TAD     DXR
5166         DCA     UXR
5167
5168 SLOOP,  STA
5169         TAD     LEVEL
5170         DCA     LEVEL
5171 SLOOP2, TAD     BEG
5172         STL CIA
5173         TAD     END
5174         SNA SZL
5175         JMP     OKCOOL  /END.LOS.BEG
5176         CLL RAR
5177         TAD     BEG
5178         DCA     MED     /MED=BEG+(END-BEG)/2
5179         TAD     MED
5180         DCA     THISTG
5181         JMS I   PFINDTG /T=A(MED)
5182         TAD     BEG
5183         DCA     LO      /LO=BEG
5184         TAD     END
5185         DCA     HI      /HI=END
5186         TAD     MED
5187         CIA
5188         TAD     BEG
5189         SNA CLA
5190         JMP     JUSTWO  /BEG.EQ.MED
5191 \f       TAD     LO
5192         DCA     SXR2
5193         TAD     MED
5194         DCA     TXR2
5195         JMS I   (SMOV   /A(MED)=A(LO)
5196 BEGLP,  ISZ     LO
5197         TAD     LO
5198         CLL CIA
5199         TAD     HI
5200         SNL CLA
5201         JMP     DONE    /HI.LOS.LO
5202         TAD     LO
5203         JMS I   (SCOM   /T.GT.A(LO) TO LINK
5204         SZL CLA
5205         JMP     BEGLP   /T.GT.A(LO)
5206         JMP     ENDGO   /T.LT.A(LO)
5207 ENDLP,  TAD     LO
5208         CLL CIA
5209         TAD     HI
5210         SNL CLA
5211         JMP     DONE    /IF HI.LO.LO
5212 ENDGO,  TAD     HI
5213         JMS I   (SCOM
5214         SZL CLA
5215         JMP     SWITCH
5216         STA
5217         TAD     HI
5218         DCA     HI
5219         JMP     ENDLP
5220 SWITCH, JMS I   (SSWT
5221         STA
5222         TAD     HI
5223         DCA     HI
5224         JMP     BEGLP
5225 \fDONE,  TAD     HI
5226         DCA     SXR2
5227         TAD     BEG
5228         DCA     TXR2
5229         JMS I   (SMOV   /A(BEG)=A(HI)
5230         TAD     HI
5231         DCA     THISTG
5232         JMS I   PPUTTAG /A(HI)=T
5233         AC7776
5234         TAD     UXR
5235         DCA     UXR
5236         TAD     UXR
5237         DCA     DXR
5238         TAD     HI
5239         CLL CIA
5240         TAD     MED
5241         SZL CLA
5242         JMP     HIBIGR  /DEFER HIGH FOR LATER
5243         TAD     BEG
5244         DCA I   DXR     /DEFER LO FOR LATER
5245         STA
5246         TAD     HI
5247         DCA I   DXR
5248         TAD     HI
5249         IAC
5250         DCA     BEG
5251         JMP     SLOOP
5252 HIBIGR, TAD     HI
5253         IAC
5254         DCA I   DXR
5255         TAD     END
5256         DCA I   DXR
5257         STA
5258         TAD     LEVEL   /CLUMSY
5259         DCA     LEVEL
5260         CLL STA
5261         TAD     HI
5262         DCA     END
5263         SNL             /PROTECT AGAINST WRAP AROUND
5264         JMP     OKCOOL
5265         JMP     SLOOP2
5266
5267 JUSTWO, TAD     HI
5268         JMS I   (SCOM
5269         SZL CLA
5270         JMS I   (SSWT   /SWITCH IF T.GT.A(HI)
5271 OKCOOL, CLA CLL         /NOW CONSIDER PREV PARTITIONS
5272         TAD I   UXR
5273         DCA     BEG
5274         TAD I UXR
5275         DCA     END
5276         ISZ     LEVEL
5277         JMP     SLOOP2  /REITERATE
5278         JMP I   SORT    /DONE, RETURN WITH A CLEAR LINK
5279 LEVEL,  0
5280         PAGE
5281         >
5282 \f       /ROUTINE TO STORE THE DATE OF THE FORM DD-MMM-YY
5283         /IN THE HEADING
5284
5285         IFZERO  HASH    <
5286         FIELD   1
5287         *OUDEVH+400
5288         >
5289
5290 FMTDAT, 0
5291         TAD I   (MDATE  /PICK UP THE DATE WORD OF THE FORM MMM MDD DDD YYY
5292         CDF             /RUN WITH DF = 0
5293         SNA
5294         JMP     NODATE  /EXIT IF NO DATE
5295         DCA     DATWD   /ELSE STORE DATE WORD
5296         TAD     ("0-1
5297         DCA I   DATPTR  /SET FIRST DIGIT OF DAY
5298         TAD     DATWD   /NOW GET DAY BITS
5299         CLL RTR
5300         RAR
5301         AND     (37
5302         JMS     DIV10   /DO DAY DIGITS NOW
5303         TAD     ("-
5304         DCA I   DATPTR  /STORE DASH
5305         ISZ     DATPTR
5306         TAD     DATWD   /NOW GET MONTH BITS
5307         TAD     (7400   /REDUCE TO ORIGIN 0
5308         AND     (7400
5309         CLL RTL
5310         RTL
5311         RAL
5312         DCA     DIV10
5313         TAD     DIV10
5314         CLL RAR         /GENERATE 1.5*MONTH INDEX
5315         TAD     DIV10
5316         TAD     (MONLST /INDEX MONTH LIST (SIXBIT)
5317         DCA     MONPTR
5318         TAD     (-3
5319         DCA     DIV10   /SET 3 TIMES THRU LOOP
5320         SZL
5321         JMP     MONGO   /IF EVEN START AT RIGHT HALF
5322 MONLP,  TAD I   MONPTR
5323         CLL RTR
5324         RTR
5325         RTR
5326         JMS     MONPUT  /PUT LEFT CHAR
5327 MONGO,  TAD I   MONPTR
5328         JMS     MONPUT  /PUT RIGHT CHAR
5329         ISZ     MONPTR
5330         JMP     MONLP   /LOOP FOR MORE
5331 MONPUT, 0
5332         TAD     (40
5333         AND     (77
5334         TAD     (40     /CONVERT TO 7BIT
5335         DCA I   DATPTR
5336         ISZ     DATPTR
5337         ISZ     DIV10
5338         JMP I   MONPUT  /RETURN TO UNPACK LOOP
5339         TAD     ("-
5340         DCA I   DATPTR  /PUT ANOTHER DASH
5341         ISZ     DATPTR
5342         TAD     ("6
5343         DCA I   DATPTR  /SETUP YEAR TENS DIGIT FOR DIVIDE
5344         TAD I   (BIPCCL
5345         AND     (600    /GET YEAR EXTENSION FROM 600 BITS
5346         CLL RTR
5347         RTR
5348         DCA     DIV10
5349         TAD     DATWD   /NOW GET YEAR
5350         AND     (7      /ISOLATE IT
5351         TAD     DIV10   /ADD EXTENSION
5352         JMS     DIV10   /UNPACK IT
5353 NODATE, CIF CDF         /NOW RETURN
5354         JMP I   FMTDAT
5355
5356 DIV10,  0
5357         ISZ I   DATPTR
5358         TAD     (-12
5359         SMA
5360         JMP     .-3     /REDUCE MON 10.
5361         TAD     (12+"0
5362         ISZ     DATPTR
5363         DCA I   DATPTR  /STORE LOW DIGIT
5364         ISZ     DATPTR
5365         JMP I   DIV10   /--RETURN--
5366
5367 DATPTR, DATE
5368 DATWD,  0
5369 MONPTR, 0
5370
5371         PAGE
5372
5373         $$$$$