--- /dev/null
+/2 PAL8 ASSEMBLER FOR OS/8 MONITOR VERSION 10
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT (C) 1970,1971,1972,1973,1974,1975 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION. DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f/1-OCT-75 MB/MB/SM/MB/RL/JR/SR
+
+DECIMAL
+
+VERSION= 10
+SUBVERSION= "A
+
+OCTAL
+
+/PAL8 IS AN 8K THREE PASS ASSEMBLER DESIGNED
+/TO BE COMPATIBLE WITH THE OS/8 SYSTEM.
+
+/PASS 1 READS THE INPUT (SOURCE) FILE AND CONSTRUCTS
+/THE SYMBOL TABLE.
+
+/PASS 2 GENERATES THE BINARY (OBJECT) FILE, WHICH
+/MAY BE LOADED WITH THE ABSOLUTE (BINARY) LOADER.
+
+/PASS 3 GENERATES THE OCTAL SYMBOLIC ASSEMBLY
+/LISTING.
+
+/PAL8 IS COMPATIBLE IN MOST RESPECTS WITH PAL III, MACRO-8
+/4K PAL-D, AND 8K PAL-D, AS WELL AS THE CROSS-ASSEMBLER PAL10.
+
+ IFNDEF HASH<HASH=1> /DEFINE FOR HASH SYMBOL TABLE
+/SET HASH=0 TO GET OLD PAL8 WAY OF HANDLING SYMBOL TABLE
+
+/MAINTENANCE RELEASE CHANGES:
+
+/1. INCLUDED JIM ROTH'S HASH TABLE MODIFICATIONS
+/2. ALLOWED /B TO WORK PROPERLY [SEQ #2 PATCH FROM AUG '74 DSN]
+/3. PUT CREFLS.TM ON SYS: NOT DSK: [PATCH SEQ #3, SEP '74 DSN]
+/4. FIXED 7TH LEVEL CHECKSUM BIT [PATCH SEQ #7, MARCH '75 DSN]
+/5. ALLOWED PAL8 TO RESTART BEFORE CD EXECUTED [DSN APR '75, SEQ #8]
+/6. FIXED /F SO IT WORKS [PATCH SEQ #9, DSN APRIL 1975]
+/7. FIXED /W SO IT DOESN'T REMEMBER TOP OF PAGE [DSN OCT '75]
+/8. FIXED BUG RE MULTIPLE NON-RES INPUT HANDLERS
+/9. CHANGED VERSION # TO V10, EDIT 1, 1975 COPYRIGHT
+/10. ADDED DOCUMENTATION ON LOCATION OF HANDLERS AND BUFFERS
+/11. CORE ALLOCATION:
+/ WITHOUT /K, ALL CORE BUT 10000-11777 USED FOR SYMBOLS
+/ WITH /K, USES ALL CORE (AND SWAPS USR BETWEEN PASSES)
+/ UNDER BATCH, N5000-N7777 IS RESERVED FOR BATCH RESIDENT AS WELL
+/12. /7 WITH HASH FEATURES PRINTS 7 COLUMN SYMBOL TABLE
+/13. 14-DEC-75 JR: FIXED TYPO IN /W CODE IN LITERAL DUMP ROUTINE
+
+/JR 14-APR-77 ADDED STANDARD DATE FORMAT TO HEADING
+\f/COMMAND DECODER RULES:
+
+/*BINARY(.BN),LISTING(.LS),CREF(.LS)<SOURCE(.PA),.../OPTIONS
+
+/OPTIONS:
+/B BYTE SHIFT - ! IS 6 BIT SHIFT (!=^100+)
+/C CREF AFTER - "CREFLS.TM" CREATED IF NO CREF
+/D DDT TYPE SYMBOL - ONLY IF LISTING
+/E 'LG' ERROR - LINKS ARE ERRORS
+/F NO TEXT FILL - NO EXTRA 0 FILL IN 'TEXT'
+/G LOAD+GO AFTER - SAME AS /L, BUT /G PASSED TO ABSLDR
+/H NO PAGING - ONLY IF LISTING
+/J JUST WHAT LOADS - INHIBITS LISTING OF UNASSEMBLED CODE
+/K CHECK FOR MORE THAN 8K OF CORE (DEFAULT IS 8K)
+/L LOAD AFTER - "PAL8BN.TM" CREATED IF NO BINARY
+/N NO LISTING - ONLY IF LISTING
+/O NO 200 ORG - NO AUTOMATIC 200 ORIGIN AFTER 'FIELD'
+/S NO SYMBOL TABLE - ONLY IF LISTING
+/T CR-LF NOT FF - ONLY IF LISTING
+/W WIPE LITERALS - INHIBITS REMEMBERING OF LITERAL BOUNDS
+
+/PERMANENT PATCH LOCATIONS FOR THE ABOVE SWITCHES ARE SYMBOLS
+/OF THE FORM Z(SW)(PATCH) - E.G. ZT7640 IS THE LOC TO PATCH TO 7640
+/TO REVERSE THE POLARITY OF THE "T" SWITCH.
+
+/PSEUDO-OPS:
+/DECIMAL RADIX TO BASE 10
+/DEVICE 2 WORD DEVICE CODE
+/DTORG TYPESETTING TAPE ORIGIN
+/EJECT SKIPS TO A NEW PAGE, AND IF ANY TEXT FOLLOWS,
+/ THAT TEXT BECOMES THE NEW HEADER LINE
+/ENPUNCH ENABLE PUNCHING
+/EXPUNGE REMOVE ALL SYMBOLS
+/FIELD SET FIELD
+/FILENAME 4 WORD FILE CODE
+/FIXMRI DEFINE MEMORY REFERENCE INSTRUCTION
+/FIXTAB MAKE ALL SYMBOLS PERMANENT
+/IFDEF CONDITIONAL ON DEFINITION
+/IFNDEF CONDITIONAL ON UNDEFINED
+/IFNZRO CONDITIONAL ON NON-ZERO
+/IFZERO CONDITIONAL ON ZERO
+/NOPUNCH DISABLE PUNCHING
+/OCTAL RADIX TO BASE 8
+/PAGE RE-ORIGIN TO BEGINNING OF NEXT PAGE OR PAGE N
+/PAUSE ALTERNATE END-OF-FILE
+/RELOC ASSEMBLE FOLLOWING CODE AS IF LOC = ARG OF RELOC
+/TEXT 6 BIT TEXT
+/XLIST LISTING INHIBIT UNLESS THE XLIST IS
+/ FOLLOWED BY AN EXPRESSION. THEN IF THE EXPRESSION
+/ IS 0 START LISTING, OR NON-0 THEN INHIBIT LISTING
+/ZBLOCK RESERVE BLOCK OF ZEROS
+\f/SYMBOL LAYOUT:
+
+/ WORD 1 BIT 0=1 PERMANENT SYMBOL
+/ BIT 1=1 "I" OR "Z"
+/ BITS 3-11 CHARS 1 AND 2
+/
+/ WORD 2 BIT 0=1 MEMORY REFERENCE INSTRUCTION
+/ BITS 2-11 CHARS 3 AND 4
+/
+/ WORD 3 BIT 0=1 PSEUDO-OP
+/ BITS 2-11 CHARS 5 AND 6
+/
+/ WORD 4 BITS 0-11 OCTAL VALUE
+/CHARS ARE STORED AS:
+/ A TO Z ARE 01 TO 32
+/ 0 TO 9 ARE 33 TO 44
+/
+/ CHAR1^45+CHAR2
+
+/OPERATORS:
+/+ TWO'S COMPLEMENT ADD
+/- TWO'S COMPLEMENT SUBTRACT
+/& BOOLEAN AND
+/! BOOLEAN INCLUSIVE 'OR' OR BYTE SHIFT
+/ (SPACE) DELIMITER OR INCLUSIVE OR
+/^ MULTIPLY (REPEATED ADDITION)
+/% DIVIDE (REPEATED SUBTRACTION)
+\f/DEFINITIONS
+
+ASWAP= 40 /WATCH THIS SWAP AREA!!
+MDATE= 7666 /MONITOR DATE
+BIPCCL= 7777 /DATE EXTENSION AND BATCH IN PROG FLG IN FIELD 0
+MPARAM= 7643 /COMMAND DECODER OPTION LIST
+DCB= 7760 /DEVICE CONTROL BLOCK
+JSBITS= 7746 /JOB STATUS WORD
+BATOUT= 7400 /BATCH LOG OUTPUT ROUTINE IN BATCH RESIDENT
+LNPRPG= 70 /56 LINES PER PAGE
+HEDLEN= 50 /40 CHARACTERS IN PAGE TITLE
+ /(MUST BE A MULTIPLE OF 8)
+
+AC7776= STA CLL RAL
+AC7775= STA CLL RTL
+AC4000= STL CLA RAR
+AC3777= STA CLL RAR
+AC2000= STL CLA RTR
+AC0002= STL CLA RTL
+
+
+/TABLE OF ERROR MESSAGE DEFINITIONS
+
+
+IZ= "I-240^100+"Z-240 /ILLEGAL PAGE ZERO REFERENCE
+CF= "C-240^100+"F-240 /CREF.SV NOT FOUND
+US= "U-240^100+"S-240 /UNDEFINED SYMBOL
+IP= "I-240^100+"P-240 /ILLEGAL PSEUDO-OP USAGE
+SE= "S-240^100+"E-240 /SYMBOL TABLE EXCEEDED
+ZE= "Z-240^100+"E-240 /PAGE ZERO EXCEEDED
+PE= "P-240^100+"E-240 /CURRENT PAGE EXCEEDED
+IC= "I-240^100+"C-240 /ILLEGAL CHARACTER
+ID= "I-240^100+"D-240 /ILLEGAL DEFINITION
+BE= "B-240^100+"E-240 /PUSH-DOWN OVERFLOW
+DE= "D-240^100+"E-240 /DEVICE ERROR
+DF= "D-240^100+"F-240 /DEVICE FULL
+LD= "L-240^100+"D-240 /ABSLDR.SV NOT FOUND
+IE= "I-240^100+"E-240 /ILLEGAL EQUATE
+PH= "P-240^100+"H-240 /PHASE ERROR
+II= "I-240^100+"I-240 /ILLEGAL INDIRECT
+RD= "R-240^100+"D-240 /REDEFINITION
+UO= "U-240^100+"O-240 /UNDEFINED ORIGIN
+LG= "L-240^100+"G-240 /LINK GENERATED
+
+
+
+/ABBREVIATIONS
+/CR/LF CARRIAGE RETURN/LINE FEED (215,212)
+/F/F FORM FEED (214)
+\f/PAGE ZERO
+
+*0
+FORMF6, 0 /USED IN DECIMAL PRINT ROUTINE
+ERROR5, 0 /USED BY PACKED ASCII PRINT ROUTINE
+PTR, 0 /V3C USED BY
+KNTR, 0 /INPUT ROUTINE
+
+/AUTOINDEX REGISTERS
+/PRESET FOR ONCE ONLY CODE
+
+*10
+PDLXR, PDLST /PUSH-DOWN AUTO INDEX REGISTER
+TAGXR, SWAP1-1 /TAG AUTO INDEX REGISTER
+XREG1, DSWIT1-1 /GENERAL AUTO INDEX REGISTER
+XREG2, DSWIT2-1 /GENERAL AUTO INDEX REGISTER
+
+/NOT USED AS AUTO INDEX REGISTERS
+/EXCEPT DURING ONCE ONLY CODE
+
+LAST1, DATE-1 /LAST DEFINED SYMBOL
+LAST2, SWAP2-1
+LAST3, IFZERO HASH <SYMPRT+4-1>
+ IFNZRO HASH <SYMNWP-1>
+LAST4, IFZERO HASH <SYMPR9-2-1>
+ IFNZRO HASH <SYMDDT-1>
+
+*20
+TAG1, 0 /TAG STORAGE
+TAG2, 0
+TAG3, 0
+
+LITPTR, 200 /LITERAL POINTER
+
+RADIX, 0 /7777 IF DECIMAL MODE
+PUNCHX, 0 /NON-ZERO IF NO PUNCHING
+XLISTX, 0 /NON-ZERO IF NO LISTING
+/*NOTE* PUNCHX AND XLISTX MUST BE TOGETHER
+/AND IN THIS ORDER
+
+LOC, 200 /CURRENT LOCATION
+OFFSET, 0 /LOCATION COUNTER OFFSET FROM "LOC"
+OFSBUF, 0 /LOCATION COUNTER OFFSET BUFFER
+STARSW, 0 /-1 IF NEXT ORIGIN SHOULD BE INHIBITED
+
+OP, 0 /LAST OPERATOR CODE (0-6)
+VALUE, 0 /EXPRESSION VALUE
+VALUE2, 0 /EXPRESSION OPERAND
+
+TXTSWT, 0 /SPACE SWITCH
+TXTPTR, LINBUF+120 /TEXT POINTER
+CHAR, 0 /CURRENT CHARACTER
+
+THISPG, 0 /OVERFLOW PAGE
+EDITPG, 0 /EDITOR PAGE
+\fTEMP, 0 /TEMPORARY REGISTERS
+TEMP1, 0
+TEMP2, 0
+TEMP3, 0
+
+OCHAR, OUTPUT /OUTPUT ROUTINE
+OERROR, OTYPEO /PASS 1=OTYPEO; 2=OTYPEO; 3=LISOUT
+PASS, -2 /-1 IF PASS 1, 0 IF PASS 2, 1 IF PASS 3
+IOMON, 200 /USER SERVICE ROUTINES
+CONDSW, 0 /NUMBER OF NESTED CONDITIONALS
+EXPIND, 0 /0 IF MRI OK HERE
+ /NOT 0 IF MRI NOT OK HERE
+CHKSUM, 0 /BINARY CHECK SUM
+IZIND, 0 /"I" AND "Z" INDICATOR
+ /IF I, LEFT 6 BITS ARE NON-ZERO
+ /IF Z, RIGHT 6 BITS ARE NON-ZERO
+THISTG, 0 /ASSIGNED NUMBER OF CURRENT TAG
+HIGHTG, SYME-SYMS%4-1 /ASSIGNED NUMBER OF LAST TAG
+LINCNT, 0 /LINE COUNT
+ALPHAI, 0 /UNDEFINED TAG INDICATOR
+ /-1 IF UNDEFINED
+GETCI, 0 /NOT=0 IF ONLY CARRIAGE RETURN ENDS LINE
+ /OTHERWISE /,;, OR CARRIAGE RETURN ENDS
+LSTCNT, 0 /TAB COUNTER
+UNDFSW, 0 /UNDEFINED SWITCH
+INCTL, 601 /CONTROL WORD - FOR OS/8 I/O
+LINKSW, 0 /OFF-PAGE LINK SWITCH
+ /0 IF NO LINK GENERATED, 0700 IF LINK
+LININD, 0 /BACK-UP FOR LINKSW
+PERROR, PERRO1 /DUMMY ERROR ROUTINE TO SUPPRESS CERTAIN
+ /MESSAGES DURING PASS 1
+FLDIND, "0 /CURRENT FIELD IN ASCII DIGIT FORM
+BINSRT, 0 /BINARY OR LISTING STARTING
+ERCNT, 0 /ERROR COUNTER
+LINK, 0 /LINK COUNTER
+ IFNZRO HASH<
+TAGMAX, 0 /SET TO PRIME # EQ TO MAX # SYMS
+ >
+ PAGE
+\f/STARTING ADDRESS OF PAL8 (0200)
+/CHAINING ADDRESS (0201)
+
+NAME1, JMP I NAME3 /NAME1-NAME3 USED LATER
+NAME2, JMP I GETTA2 /TO STORE TAGS AS THEY ARE BUILT
+NAME3, BEGIN /V3C
+GETTA2, NOCD /BUILDING SWITCH AND OVERFLOW PROTECT
+
+
+/HANDLERS FOR NOPUNCH AND ENPUNCH PSEUDO-OPS
+
+NOPUNX, CLA IAC /NON-ZERO FOR NO PUNCHING
+ENPUNX, DCA PUNCHX /ZERO FOR PUNCHING
+ JMP I [LOOKEX /--EXIT TO MAIN--
+
+
+/HANDLERS FOR DECIMAL AND OCTAL PSEUDO-OPS
+
+DECIMX, STA /7777 FOR DECIMAL RADIX
+OCTALX, DCA RADIX /ZERO FOR OCTAL RADIX
+ JMP I [LOOKEX /--EXIT TO MAIN--
+\f/GET A TAG ROUTINE
+/PICKS UP A TAG AND SEARCHES FOR IT
+/"THISTG" HAS NUMBER OF TAG
+/"VALUE2" HAS VALUE
+/AC=7777 ON RETURN IF TAG NOT FOUND, 0 IF FOUND
+
+GETTAG, 0
+ DCA NAME1 /CLEAR BUILD AREA
+ DCA NAME2
+ DCA NAME3
+ TAD [NAME1
+ DCA GETTA4 /SET POINTER FOR BUILDING
+ DCA GETTA2 /ZERO SWITCH
+GETTG1, TAD CHAR /GET THE CHARACTER
+ AND [77 /MAKE IT 01-32 OR 60-71
+ TAD (-32 /WAS IT A TO Z?
+ SMA SZA
+ TAD (-25 /NO - MAKE 60-71 INTO 33-44
+ TAD (32 /YES - IT IS NOW 01-32 OR 33-44
+ ISZ GETTA2 /LEFT SIDE?
+ JMP GETTA3 /YES
+ TAD I GETTA4 /NO - RIGHT SIDE
+ DCA I GETTA4 /BUILD THE WORD
+ ISZ GETTA4 /BUMP TO NEXT WORD
+GETTA1, JMS I [GETC /GET NEXT CHARACTER
+ JMS I [TSTALN /IS IT ALPHANUMERIC?
+ JMP GETTG1 /YES - KEEP BUILDING
+ IFZERO HASH<
+ TAD HIGHTG /NO - GET NUMBER OF HIGHEST TAG
+ CLL RAR /DIVIDE BY 2
+ DCA TEMP2 /SAVE DIFFERENCE
+ DCA THISTG /START AT TAG ZERO
+ CLL CML /LINK MUST BE ON INITIALLY
+ DCA TEMP1
+
+
+/GETTA4 IS POINTER TO NAME1-NAME3
+/FOR DEPOSITING TAG AS IT IS BUILT
+
+/TEMP2 IS # OF TAGS TO SKIP BETWEEN CHECKS FOR MATCH
+/DURING BINARY SEARCHING
+\fGETTG2, SZL /IS THISTG HIGHER THAN TAG?
+ JMP GETTG3 /NO-LOWER
+GETTG4, DCA TEMP1 /CLEAR LAST TIME SWITCH
+ SNL
+ ISZ TEMP1 /SET LAST TIME SWITCH TO 1
+ TAD TEMP2 /GET # OF TAGS TO SKIP
+ SNL
+ CIA
+ TAD THISTG /INCREASE OR DECREASE TAG NUMBER
+ DCA THISTG
+ TAD TEMP2 /GET NUMBER
+ CLL RAR /DIVIDE BY 2
+ SNA /IS RESULT 0?
+ ISZ TEMP1 /YES-BUMP LAST TIME SWITCH
+ SNA
+ IAC /IF RESULT WAS 1, MAKE IT 2
+ DCA TEMP2 /SAVE IT FOR NEXT TIME
+ JMS I [FINDTG /GET THE TAG
+ TAD [1777 /MASK
+ AND TAG1 /GET WORD 1
+ CLL CIA
+ TAD NAME1 /DOES IT MATCH?
+ SZA CLA
+ JMP GETTG2 /NO - TRY NEXT TAG
+ AC3777
+ AND TAG2 /YES - GET WORD 2
+ CLL CIA
+ TAD NAME2 /DOES IT MATCH?
+ SZA CLA
+ JMP GETTG2 /NO - TRY NEXT TAG
+ AC3777
+ AND TAG3 /YES - DOES IT MATCH?
+ CLL CIA
+ TAD NAME3
+ SZA CLA
+ JMP GETTG2 /NO - TRY NEXT TAG
+ JMP I GETTAG /YES--RETURN--
+\fGETTG3, AC7776
+ TAD TEMP1 /LAST TIME SWITCH = 2?
+ SZA CLA
+ JMP GETTG4 /NO-KEEP TRYING
+ ISZ THISTG /YES-QUIT SEARCHING
+ DCA VALUE2
+ DCA TAG1
+ DCA TAG2
+ DCA TAG3 /TAG NOT FOUND
+ STA /AC=7777 MEANS NOT FOUND
+ JMP I GETTAG /--RETURN--
+ >
+\f IFNZRO HASH<
+ PRIME=TAGMAX
+
+GETTGH,/JMS I [TLYREF /HACK ONLY
+ TAD NAME1 /HASH OUR NAME
+ CLL RTL
+ TAD NAME2
+ RTL
+ TAD NAME3
+ RTL
+ TAD NAME1
+ JMS PROBE /NOW PROBE THE TABLE
+ TAD NAME1 /RE HASH THE NAME FOR A STEPSIZE
+ CLL RAL
+ RTL
+ TAD NAME2
+ CLL /CALC MODULO PRIME INLINE
+ TAD MPRIME
+ SZL
+ JMP .-3
+ TAD PRIME
+ SNA
+ IAC /STEPSIZE MUST BE NON ZERO!
+ DCA CRPDEL
+PRBLUP, CLL
+ TAD THISTG /BUMP THE POINTER RANDOMLY
+ TAD CRPDEL
+ SZL /PROTECT AGAINST WRAP AROUND
+ TAD MPRIME /PROBABLY UNOPTIMAL SOLUTION
+ JMS PROBE
+ JMP PRBLUP
+
+PROBE, 0
+ CLL
+ TAD MPRIME
+ SZL
+ JMP .-3
+ TAD PRIME
+ DCA THISTG /THISTG MODULO PRIME
+/ JMS I [TLYPRB /HACK ONLY
+ JMS I [FINDTG /GO GET IT
+ TAD [1777 /MASK THE TYPE BITS OUT
+ AND TAG1 /IS THERE ONE?
+ SNA
+ JMP NOTFND /NO EXIT POINTING AT IT
+ CIA /YES, DO A COMPARE
+ TAD NAME1
+ SZA CLA
+ JMP I PROBE
+ AC3777
+ AND TAG2
+ CIA
+ TAD NAME2
+ SZA CLA
+ JMP I PROBE
+ AC3777
+ AND TAG3
+ CIA
+ TAD NAME3
+ SZA CLA
+ JMP I PROBE /FOUND EXIT WITH AC CLEAR
+ JMP I GETTAG
+NOTFND, STA /NOT FOUND EXIT WITH AC SET
+ JMP I GETTAG
+
+CRPDEL, 0
+MPRIME, 0 /INITIALIZED BY ONCE ONLY CODE FOR MACHINE AT HAND
+ >
+
+
+GETTA3, DCA GETTA2 /SAVE CHAR
+ TAD GETTA2
+ CLL RTL /*4
+ RAL /*10
+ TAD GETTA2 /*11
+ RTL /*44
+ TAD GETTA2 /*45
+ DCA I GETTA4 /SET LEFT SIDE
+ TAD GETTA4
+ TAD (-GETTA2
+ SZA CLA /IS THIS AN OVERFLOW (>6) CHAR?
+ STA /NO - SET SWITCH TO RIGHT HALF
+ DCA GETTA2 /YES - LEAVE SWITCH AT LEFT HALF
+ JMP GETTA1
+
+GETTA4, NAME1
+\f/IGNORE SPACES ROUTINE
+
+SPNOR, 0
+ TAD CHAR /GET THE CHARACTER
+ TAD [-240 /IS IT A SPACE?
+ SZA CLA
+ JMP I SPNOR /NO --RETURN--
+ JMS I [GETC /YES - GET NEXT CHARACTER
+ JMP SPNOR+1 /LOOP
+
+
+/HANDLER FOR PAUSE PSEUDO-OP
+/END-OF-TAPE OR END-OF-FILE
+
+PAUSEX, AC4000
+ DCA CHAR /SET END-OF-LINE CHARACTER
+ TAD [LINBUF+120 /REINITIALIZE TEXT POINTER
+ DCA TXTPTR
+ CLA CMA
+ DCA I (INCHCT /INDICATE EMPTY BUFFER
+ ISZ I (INEOF /SET END-OF-FILE
+ JMP I [LOOKEX /--EXIT TO MAIN--
+ PAGE
+\f/OUTPUT 2 CHARACTER ERROR CODE
+
+ERROR1, 0
+ DCA ERROR5
+ TAD ERROR5
+ JMS I [RTL6
+ RAL
+ AND [77
+ TAD [240 /CONVERT SIXBIT TO ASCII
+ JMS I OERROR /OUTPUT FIRST CHAR
+ TAD ERROR5
+ AND [77
+ TAD [240
+ JMS I OERROR /OUTPUT SECOND CHAR
+ JMP I ERROR1 /--RETURN--
+
+/HANDLER FOR FIELD PSEUDO-OP
+
+FIELDX, JMS I [SPNOR /IGNORE SPACES
+ JMS I [DUMPS /DUMP CURRENT PAGE LITERALS
+ JMS I [DUMPZ /DUMP PAGE ZERO LITERALS
+ JMS I [EXP /GET EXPRESSION
+ TAD VALUE /TRIM TO RIGHT 3 BITS
+ AND [7
+ DCA FLDIND /STORE FOR LISTING
+ TAD PASS /IS THIS PASS 2?
+ SZA CLA
+ JMP FIELDY /NO - PREPARE TO EXIT
+ TAD FLDIND /YES - GET FIELD NUMBER
+ CLL RTL
+ RAL /AND CHANNELS 7 AND 8
+ TAD [7700
+ JMS I OCHAR /OUTPUT FIELD SETTING
+FIELDY, JMS I [CLEAN /CLEAN UP THINGS
+ TAD [200 /RESET ORIGIN TO 200
+ JMP STAR1
+
+/CHANGE LAST 2 LOCATIONS TO:
+/ CLA
+/ JMP STAR1+1
+/FOR INDAC GROUP TO OMIT RE-ORIGIN
+\f/HANDLER FOR PAGE PSEUDO-OP
+
+PAGEX, JMS I [DUMPS /DUMP SAME PAGE LITERALS
+ JMS I (XLISTZ /ANY EXPRESSION?
+ JMP PAGEY /NO
+ JMS I [EXP /YES - GET EXPRESSION
+ TAD VALUE
+ JMS I [RTL6
+ RAL /GET PAGE NUMBER
+ JMP STAR3-1
+
+PAGEY, TAD LOC /NO ARGUMENT - FIND NEXT PAGE
+ TAD [177
+ AND [7600
+STAR3, DCA VALUE
+ TAD VALUE /GET START OF PAGE
+STAR1, JMS I [PUNORG /PUNCH ORIGIN
+ JMS I [FINDSP
+ TAD [LITBUF /RESET POINTERS
+ DCA TEMP
+ TAD I TEMP
+ DCA LITPTR /INITIALIZE LITERAL POINTER FOR NEW PAGE
+ DCA LAST1
+ JMP I [PUNVAL /SEE ABOUT DUMPING SOURCE CODE
+
+/HANDLER FOR FIXMRI PSEUDO-OP
+
+FIXMRX, JMS I [SPNOR /IGNORE SPACES
+ JMS I [TSTALP /IS CHARACTER ALPHABETIC?
+ JMP FIXMR1 /YES-CONTINUE
+ JMS I [ICMESG /NO - GENERATE IC MESSAGE, GET NEXT CHAR
+ JMP FIXMRX+1 /KEEP LOOKING FOR ALPHABETIC CH. OR END OF LINE
+FIXMR1, JMS I [GETTAG /PICK UP TAG
+ DCA ALPHAI /STORE UNDEFINED SWITCH
+ SKP
+FIXMR2, JMS I [ICMESG
+ JMS I [SPNOR /IGNORE SPACES
+ TAD CHAR /WAS CHARACTER = ?
+ TAD (-"=
+ SZA CLA
+ JMP FIXMR2 /NO - PRINT IC MESSAGE AND KEEP LOOKING
+ /FALL INTO EQUALS PROCESSOR
+\f/HANDLER FOR =
+
+ AC4000 /FALL INTO HERE FROM FIXMRI
+EQUAL, JMS I [PUSHA /PUSH FIXMRI FLAG
+ JMS I [GETC /GET NEXT CHARACTER
+ TAD I (NAME1 /STORE THE SYMBOL NAME
+ JMS I [PUSHA /ON THE PUSH DOWN LIST
+ TAD I (NAME2
+ JMS I [PUSHA
+ TAD I (NAME3
+ JMS I [PUSHA
+ TAD THISTG /AND ITS PRESENT (OR FUTURE)
+ JMS I [PUSHA /POSITION IN THE SYMTAB
+ TAD ALPHAI
+ JMS I [PUSHA /STORE UNDEFINED INDICATOR
+ JMS I [SPNOR /IGNORE SPACES
+ JMS I [EXP /GET EXPRESSION TO RIGHT OF =
+ TAD I PDLXR
+ DCA ALPHAI /RESTORE UNDEFINED INDICATOR
+ TAD I PDLXR
+ DCA THISTG /RESTORE SYMBOL TABLE POSITION
+ TAD I PDLXR /RESTORE TAG NAME
+ DCA I (NAME3
+ TAD I PDLXR
+ DCA I (NAME2
+ TAD I PDLXR
+ DCA I (NAME1
+ ISZ UNDFSW /WAS ANY PART OF DEFINITION UNDEFINED?
+ JMP EQUAL3 /NO
+ JMS I PERROR /YES - GENERATE IE ERROR MESSAGE
+ IE
+ ISZ PDLXR /CLEAR EXTRA WORD FROM PDL
+ JMP I [PUNVAL /FORGET ABOUT DEFINING TAG
+\f/MORE = PROCESSING
+
+EQUAL3, ISZ ALPHAI /WAS TAG DEFINED BEFORE?
+ JMP .+3 /YES - CHECK FOR ILLEGAL REDEFINITION
+ JMS I [INSRTG /NO - INSERT TAG INTO SYMBOL TABLE
+ JMP EQUAL2 /AND BYPASS ILLEGAL REDEF CHECK
+ JMS I [FINDTG /PUT TAG IN TAG1-TAGE AND VALUE2
+ TAD VALUE
+ CIA
+ TAD VALUE2
+ SZA CLA /WERE DEFINITIONS THE SAME?
+ TAD TAG1 /NO - IS IT A PERMANENT SYMBOL?
+ SMA CLA
+ JMP EQUAL2 /NO - OK TO REDEFINE
+ JMS I [ERROR /YES - GENERATE RD ERROR MESSAGE FIRST
+ RD
+EQUAL2, TAD VALUE /DEFINE OR REDEFINE
+ DCA VALUE2
+ AC3777
+ AND TAG2 /CLEAR OLD FIXMRI BIT
+ TAD I PDLXR /INSERT NEW ONE
+ DCA TAG2
+ JMS I [PUTTAG /STORE TAG
+ JMP I [PUNVAL /SEE ABOUT DUMPING SOURCE CODE
+ PAGE
+\f/ROTATE AC 6 LEFT
+
+RTL6, 0
+ CLL RTL
+ RTL
+ RTL
+ JMP I RTL6 /--RETURN--
+
+
+/GET NEXT CHARACTER ROUTINE
+/READS FROM THE INPUT FILES AND PASSES THE MODIFIED CHARACTERS
+/TO THE PROGRAM
+/IT ALSO PRINTS THE LATEST LINE IF IT HAS NOT BEEN PRINTED
+
+GETC, 0
+ ISZ TXTPTR /POINT TO NEXT CHARACTER
+GETC7, TAD I TXTPTR /GET NEXT CHARACTER
+ SZA /IS IT 0?
+ JMP GETC8 /NO - MORE ARE IN THIS LINE
+ TAD PASS /IS THIS PASS 3?
+ SPA SNA CLA
+ JMP GETC1 /NO
+ TAD [LINBUF /YES
+ DCA TXTPTR /RESET POINTER TO BEGINNING
+ TAD I TXTPTR /GET 1ST CHARACTER
+ SNA /IS IT 0?
+ JMP GETC1 /YES - LINE HAS BEEN PRINTED
+ TAD [-215 /IS IT 215?
+ SNA CLA
+ JMP GETC2 /YES - DO NOT PRINT THE SPACES
+ TAD [211 /NO-OUTPUT 2 TABS
+ JMS I OERROR
+ TAD [211
+ JMS I OERROR
+GETC2, JMS LINPRT /NOW PRINT THE LINE
+GETC1, TAD (-121
+ DCA TXTSWT
+ TAD (LINBUF-1
+ DCA TXTPTR /RESET POINTER
+ ISZ TXTPTR
+GETC6, JMS I (INPUT /GET NEXT CHARACTER
+ JMP GETC4 /215
+ DCA I TXTPTR /STORE THE CHARACTER
+ ISZ TXTSWT /TOO MANY?
+ JMP GETC6-1 /NO
+ CLA CMA /YES
+ DCA TXTSWT
+ JMP GETC6
+\fGETC4, DCA I TXTPTR /SET END
+ ISZ TXTPTR
+ DCA I TXTPTR /SET END OF LINE
+ TAD [LINBUF
+ DCA TXTPTR /RESET POINTER
+ CLA CMA
+ DCA TXTSWT /RESET SWITCH
+ JMP GETC7 /GET THAT CHARACTER
+
+GETC8, TAD [-215 /IS IT A CARRIAGE RETURN?
+ SNA
+ JMP GETC12 /YES-END OF LINE
+ TAD GETCI /NO-
+ TAD (215-"/ /IS IT A /?
+ SNA /YES-
+ JMP GETC13 /"/" IS END
+ TAD ("/-"; /IS IT A ;?
+ SNA /YES-
+ JMP GETC12 /";" IS END
+ TAD (";-211 /IS IT A TAB?
+ SZA
+ TAD (211-240 /OR A SPACE?
+ SZA CLA
+ JMP GETC9 /NO-NOT ANYTHING SPECIAL
+ ISZ TXTSWT /YES-2ND OCCURANCE?
+ JMP GETC+1 /YES - IGNORE
+ TAD [240
+ DCA CHAR /NO - GIVE A SPACE
+ JMP I GETC /--RETURN--
+
+GETC16, ISZ CONDSW /DECREMENT CONDITIONAL COUNTER
+ JMP GETC15
+GETC17, TAD [LINBUF+120
+ DCA TXTPTR
+GETC12, AC4000
+GETC9, TAD I TXTPTR
+ DCA CHAR /STORE CHARACTER
+ CLA CMA
+ DCA TXTSWT /SET THE SWITCH
+ JMP I GETC /--RETURN--
+\fGETC13, TAD CONDSW /CURRENTLY IN CONDITIONALS?
+ SNA
+ JMP GETC17 /NO
+ DCA CONDSW /STORE UPDATED CONDITIONAL LEVEL
+GETC15, ISZ TXTPTR /YES-SCAN LINE FOR < AND >
+ TAD I TXTPTR
+ TAD [-215 /IS CHARACTER A CARRIAGE RETURN?
+ SNA
+ JMP GETC17 /YES
+ TAD (215-"> /NO IS IT A >?
+ SNA
+ JMP GETC16 /YES
+ TAD (">-"< /NO-IS IT <?
+ SNA CLA
+ STA /YES - INCREMENT CONDITIONAL COUNTER
+ JMP GETC13 /NO - KEEP LOOKING
+
+
+/CHAR IS NEGATIVE IF LOGICAL END OF LINE:
+/ CARRIAGE RETURN
+/ /
+/ ;
+
+/CHAR MAY BE ZERO IF PHYSICAL END OF LINE:
+/ CARRIAGE RETURN
+\f/PRINT A LINE OF SOURCE CODE
+
+LINPRT, 0
+ TAD (LINBUF-1
+ DCA XREG1 /SET POINTER TO LINE
+LINPR1, TAD I XREG1 /GET CHARACTER
+ SNA /IS IT END OF LINE?
+ JMP I LINPRT /YES - END LINE
+ JMS I OERROR /NO - OUTPUT CHARACTER
+ DCA I [LINBUF /CLEAR OUT 1ST CHAR IN LINE AS "PRINTED" FLAG
+ JMP LINPR1
+
+/HANDLE PHASE ERROR
+/AND ALL ERROR EXITS TO MONITOR
+
+SYMOFL, CLA
+ TAD (SE /SYMBOL TABLE EXCEEDED MESSAGE
+MONERR, DCA MONER1 /ERROR IS SERIOUS ENOUGH TO
+PHASE, TAD (OTYPEO / CAUSE IMMEDIATE RETURN TO
+ DCA OERROR / MONITOR
+ JMS I [ERROR
+MONER1, PH /STORE ERROR TYPE HERE
+ JMP I [7600 /***EXIT TO MONITOR***
+
+
+/FIND CURRENT PAGE NUMBER
+/EXIT WITH NUMBER IN AC
+
+FINDSP, 0
+ TAD LOC
+ AND [7600
+ JMS I [RTL6
+ JMP I FINDSP /--RETURN--
+ PAGE
+\f/**********************************************************
+/THIS AREA IS SWAPPED OUT DURING PASS 1 AND 2
+/** NO LITERALS IN THIS PAGE, AS THERE IS A PAGE OVERLAYING IT **
+
+SWAP1=.
+
+/PASS 3 LISTING OUTPUT
+
+LISOUT, 0
+ DCA LISOU2
+ TAD XLISTX /IS THIS COVERED BY XLIST?
+ SZA CLA
+ JMP I LISOUT /YES--RETURN--
+ ISZ LISCNT /NO-WAS PREVIOUS CHARACTER A 215?
+ JMP LISOU1 /NO
+ ISZ LINCNT /WAS IT END OF PAGE?
+ JMP LISOU1 /NO
+ ISZ THISPG /YES-START OVERFLOW PAGE
+BEGIAB, JMS CRLF /OUTPUT CARRIAGE RETURN/LINE FEED
+HSWIT1, JMS I [FORMFD /0 IF /H SWITCH OPTION TO SUPRESS PAGING
+ ISZ LINCNT
+LISOU1, TAD LISOU2 /IS CHARACTER A CARRIAGE RETURN?
+ TAD [-215
+ SNA
+ JMP LISOU3 /YES - OUTPUT CR/LF
+ TAD [215 /NO - RESTORE CHARACTER
+ JMS I OCHAR /OUTPUT CHARACTER
+ JMP I LISOUT /--RETURN--
+
+LISOU3, CLA CMA
+ DCA LISCNT /REMEMBER THE 215 FOR NEXT TIME
+ JMS CRLF /OUTPUT CARRIAGE RETURN/LINE FEED
+ JMP I LISOUT /--RETURN--
+
+LISCNT, -1
+LISOU2, 0
+\f/FORM FEED OUTPUT ROUTINES
+
+FORMFD, 0
+ TAD LINCNT /GET LINE COUNTER
+ TAD FORMLN
+ SNA CLA /ARE WE AT TOP OF PAGE?
+ JMP I FORMFD /YES - NO NEED FOR FORM FEED
+ TAD XLISTX /IS THIS COVERED BY XLIST?
+ SZA CLA
+ JMP I FORMFD /YES--RETURN--
+HSWITC, JMP FORMF1 /0 IF /T OR TTY:; JMP FORMF3 IF /H
+ /OUTPUT IF TTY:OR /T OPTION
+ TAD LINCNT
+ TAD [-4
+ DCA LINCNT
+ JMS CRLF /OUTPUT CARRIAGE RETURN/LINE FEED
+ ISZ LINCNT
+ JMP CRLF1 /OUTPUT LINE FEED
+ /CRLF1 WILL RETURN TO
+ /JMP-1 UNTIL LINCNT HAS
+ /BEEN BUMPED SUFFICIENTLY
+ TAD FORMM6
+ DCA LINCNT
+ TAD MINUS /OUTPUT ------
+ JMS I OCHAR
+ ISZ LINCNT /* NEXT 3 LOCS CHANGED IF NO /T OR TTY:
+FORMF1, JMP .-3 /* STA
+ TAD [-4 /* DCA LINCNT /GENERATE ONE FORM FEED
+ DCA LINCNT /* STA /TURN CR INTO FF
+ JMS CRLF /OUTPUT CR/LF OR FF/LF
+ ISZ LINCNT
+ JMP CRLF1 /OUTPUT LINE FEED
+ TAD FORMLN
+ CIA
+ DCA LINCNT
+FORM22, TAD [HEADER-1 /OUTPUT HEADER
+ DCA XREG2
+ DCA LSTCNT
+FORM30, TAD I XREG2 /GET NEXT CHARACTER OF HEADING
+ SNA /IS IT LAST + 1
+ JMP FORM20 /YES
+ JMS I OCHAR /NO-OUTPUT IT
+ TAD LSTCNT
+ TAD [-HEDLEN /DONE "HEDLEN" CHARACTERS YET?
+ SZA CLA
+ JMP FORM30 /NO-CONTINUE
+ TAD FORMHD /YES-START SYSTEM HEADER
+ JMP FORM22 /WHICH STARTS AT HEADER+HEDLEN
+
+FORMLN, LNPRPG
+FORMHD, HEDLEN
+MINUS, "-
+\f/TTY: OR /T OUTPUTS FORM FEED AS
+/CARRIAGE RETURN, MULTIPLE LINE FEEDS TO END OF PAGE
+/------
+/CARRIAGE RETURN, 5 LINE FEEDS
+/HEADER
+/NO OPTIONS TREATS F/F AS
+/F/F, LF, CR/LF
+/HEADER
+
+/ /H OPTION TREATS F/F AS 2 CR/LF
+
+/USER HEADER IS "HEDLEN" CHARACTERS WIDE
+/ASSEMBLER HEADER ENDS WITH 0
+
+
+/OUTPUT PAGE NUMBERS
+
+FORM20, TAD EDITPG /OUTPUT EDITOR PAGE NUMBER
+ JMS FORMF4
+ TAD THISPG /IS THERE PAGE OVERFLOW?
+ SNA CLA
+FORM21, JMP FORMF3 /NO
+ TAD MINUS /YES
+ JMS I OCHAR /OUTPUT -
+ TAD THISPG /OUTPUT NUMBER OF OVERFLOW PAGE
+ JMS FORMF4
+ /OUTPUT IF /H OPTION
+FORMF3, JMS CRLF /OUTPUT 2 CR/LF
+ JMS CRLF
+ JMP I FORMFD /--RETURN--
+\f/DECIMAL PRINT ROUTINE
+
+FORMF4, 0
+ DCA FORMF6 /SAVE NUMBER
+ TAD FORM8F
+ DCA CRLF /POINT TO DIVISION LIST
+FORM12, DCA FORMF7 /START WITH 0
+ JMP .+3
+FORMF5, DCA FORMF6
+ ISZ FORMF7 /ADD 1 TO DIGIT
+ TAD I CRLF /SUBTRACT 1000, 100, OR 10
+ SNA
+ JMP FORM11 /0 IS END OF TABLE - NO MORE DIGITS
+ TAD FORMF6
+ SMA /OVERFLOW
+ JMP FORMF5 /NO-KEEP SUBTRACTING
+ CLA /YES-DIGIT DONE
+ ISZ CRLF /BUMP LIST POINTER
+ TAD FORMF7 /WAS DIGIT A 0?
+ SNA
+ JMP FORM12 /YES
+ TAD ["0 /NO-MAKE IT ASCII
+ JMS I OCHAR /OUTPUT DIGIT
+ AC4000
+ JMP FORM12 /4000 IN AC FORCES SIGNIFICANCE
+
+FORM11, TAD FORMF6 /GET LAST DIGIT (UNITS PLACE)
+ TAD ["0
+ JMS I OCHAR /OUTPUT DIGIT
+ JMP I FORMF4 /--RETURN--
+
+FORMM6, -6
+FORM8F, FORMF8
+\f/OUTPUT CARRIAGE RETURN/LINE FEED
+/ENTER WITH AC=-1 TO GENERATE F/F LF
+
+HEDCL2,
+CRLF, 0
+ TAD [215
+ JMS I OCHAR
+CRLF1, TAD [212 /RE-ENTRY FOR MULTIPLE LINE FEEDS
+ JMS I OCHAR
+ JMP I CRLF /--RETURN--
+
+/CLEAR PAGE HEADING BUFFER
+
+FORMF7,
+HEDCLR, 0
+ TAD [-HEDLEN /SET HEADING BUFFER
+ DCA HEDCL2 /TO TABS
+ TAD [HEADER-1
+ DCA XREG2
+ TAD [211
+ DCA I XREG2
+ ISZ HEDCL2
+ JMP .-3
+ JMP I HEDCLR /--RETURN--
+ PAGE
+\f/SYMBOL TABLE OUTPUT (COLUMNAR)
+ /*CODE TO GENERATE DDT COMPATIBLE*
+ /**SYMBOL TABLE--SUBSTITUTED WITH*
+ /**ONCE ONLY CODE IF NEEDED*******
+ IFZERO HASH<
+
+SYMPRT, 0
+ ISZ EDITPG /NEW PAGE
+ DCA THISPG
+ JMS I [FORMFD
+ TAD SMIN67 /DCA I SYMPR6-1
+ DCA SYMPR7 /JMS SYMPR9+6
+SYMPR8, DCA SYMPR2 /TAD [377 //RUBOUT
+ CLA CMA /JMS I OERROR
+ DCA THISTG /CLA CMA
+ TAD SYMPR2 /DCA THISTG
+ CMA /TAD [215 //CARRIAGE RETURN
+ DCA SYMPR3 /JMS I OERROR
+SYMPR5, ISZ SYMPR3 /JMS SYMPPP
+ JMP SYMPR4 /JMP SYMPR9-1
+ TAD [-4 /JMP SYMPR6+2
+ DCA SYMPR3 /HSWIT1
+SYMPR6, JMS SYMPPP /204 //EOT
+ JMP SYMPRB
+SYMPR1, TAD [1777
+ AND TAG1 /OUTPUT TAG
+ JMS I SDIV45
+ TAD TAG2
+ JMS I SDIV45
+ TAD TAG3
+ JMS I SDIV45
+ TAD [240
+ JMS I OERROR /OUTPUT SPACE
+ TAD VALUE2
+ JMS OCTPRT /OUTPUT OCTAL VALUE
+ ISZ SYMPR3 /JMP SYMPR5-2
+ JMP SYMPR0 /TAD SYMPR6
+SYMPR9, TAD [215 /JMS I OERROR /CARRIAGE RETURN
+ JMS I OERROR /TAD [377 //RUBOUT
+SYMPRB, ISZ SYMPR7 /JMS I OERROR
+ JMP SYMPRA /JMS SYMPR9+6
+HSWIT2, JMS I [FORMFD /DCA LINCNT /0 IF NOT /H
+ TAD SMIN67 /JMP I SYMPRT //--RETURN--
+ DCA SYMPR7 /0
+ TAD SYMOFS /TAD [-200
+SYMPRA, IAC /DCA SYMPR2
+ TAD SYMPR2 /TAD [200 //LEADER-TRAILER
+ JMP SYMPR8 /JMS I OERROR
+
+SYMPR4, JMS SYMPPP /ISZ SYMPR2
+ JMP I SYMPRT /JMP SYMPR4-2 /--RETURN--
+ JMP SYMPR5 /JMP I SYMPR9+6
+
+SDIV45, DIV45
+SMIN67, 1-LNPRPG
+\fSYMPR0, TAD SMIN67
+ DCA SYMPPB
+ JMS SYMPPP /SKIP 67(8) SYMBOLS
+ JMP SYMPR9
+ ISZ SYMPPB
+ JMP .-3
+ JMS I [ERROR1
+ JMS I [ERROR1
+ JMS I [ERROR1
+ JMP SYMPR1 /GO PRINT THE 67TH(8) SYMBOL
+
+SYMPR2= LINKSW
+SYMPR3= UNDFSW
+SYMPR7= ALPHAI
+SYMPPB= CHKSUM
+
+SYMPPP, 0
+ ISZ THISTG
+SYMOFS, 245
+ TAD THISTG
+ CLL CIA
+ TAD HIGHTG
+ SNL CLA
+ JMP I SYMPPP /--RETURN--
+ JMS I [FINDTG
+ AC4000
+ AND TAG1
+ TAD TAG3
+ SPA SZL CLA
+ JMP SYMPPP+1
+ ISZ SYMPPP
+ JMP I SYMPPP /--RETURN--
+/SYMNCL, -4 /DEFAULT IN LIU OF =N OPTION
+/SYMOFS, 245 /OFFSET TO FIRST SYM ON NEXT PAGE
+
+ >
+\f IFNZRO HASH<
+
+SYMPRT, 0
+ ISZ EDITPG
+ DCA THISPG
+ JMS I [FORMFD /OUTPUT A HEADING
+ JMS I SYMHND /NOW READ THE SYMBOL TABLE SORT OVERLAY
+ 0200 /2 PAGES
+SYMSRT, OUDEVH+400 /TO HERE
+ ASWAP+1 /FROM HERE
+ JMP I SYMERR /UGH
+ JMS I SYMSRT /SORT THEM AND SET LINK
+SYMNWP, DCA SYMTAG /POINT TO SYMBOL
+ SZL /LINK OFF IF ANY SYMBOLS TO LIST
+ JMP I SYMPRT /NONE --RETURN--
+ TAD SMIN67 /SET LINE/PAGE COUNT
+ DCA SYMLCT
+SYMPAG, TAD HIGHTG
+ CLL CIA
+ TAD SYMTAG
+ SZL CLA
+ JMP I SYMPRT /NO MORE IF AT HIGHTAG NOW
+ TAD SYMTAG
+ DCA THISTG /PREPARE TO PRINT LEFTMOST SYMBOL
+ TAD SYMNCL /4 PER LINE (DEFAULT)
+ DCA SYMCCT /TO COLLUMS/LINE CNTR
+ JMP SYMGO
+SYMLIN, JMS I [ERROR1
+ JMS I [ERROR1
+ JMS I [ERROR1
+ TAD HIGHTG
+ CLL CIA
+ TAD THISTG
+ SZL CLA
+ JMP SYMNXL /SKIP TO NEXT LINE IF OFF TABLE
+\fSYMGO, JMS I [FINDTG /OK, GET IT
+ TAD TAG1
+ JMS I SDIV45
+ TAD TAG2
+ JMS I SDIV45
+ TAD TAG3
+ JMS I SDIV45
+ TAD [240
+ JMS I OERROR
+ TAD VALUE2 /PRINT VALUE NOW
+ JMS OCTPRT
+SYMDDT, TAD SMIN67
+ CLL CIA
+ TAD THISTG
+ DCA THISTG
+ SZL
+ JMP SYMNXL /SKIP IF WRAP AROUND
+ ISZ SYMCCT /ELSE DO NEXT COLUMN
+ JMP SYMLIN
+SYMNXL, TAD [215
+ JMS I OERROR /CR/LF
+ ISZ SYMTAG /POINT TO NEXT SYMBOL
+ ISZ SYMLCT
+ JMP SYMPAG
+HSWIT2, JMS I [FORMFD
+ TAD SYMTAG
+ CLL
+ TAD SYMOFS /OFFSET TO NEXT SYMBOL
+ JMP SYMNWP /DO THE NEXT PAGE
+
+SDIV45, DIV45
+SMIN67, -67
+SYMERR, SYSERR
+SYMHND, 7607
+SYMOFS, 245 /DEFAULT
+SYMNCL, -4
+ SYMTAG= LINKSW
+ SYMLCT= UNDFSW
+ SYMCCT= ALPHAI
+ ZBLOCK 4 /WASTE SOME SPACE
+ >
+
+
+/END OF AREA WHICH MAY BE SWAPPED OUT
+/DURING PASSES 1 AND 2
+/**********************************************************************
+
+ ENDOVL= .
+\f/OCTAL PRINT ROUTINE
+/ENTER WITH # TO BE OUTPUT IN AC
+/** DO NOT USE TEMPS BELOW THIS LOC!
+
+OCTPRT, 0
+ DCA OCTPR1
+ TAD [-4
+ DCA OCTPR3
+OCTPR2, TAD OCTPR1 /GET EACH DIGIT SEPARATELY
+ CLL RTL
+ RAL
+ DCA OCTPR1
+ TAD OCTPR1
+ RAL
+ AND [7
+ TAD ["0 /MAKE IT INTO AN ASCII CHARACTER
+ JMS I OERROR /OUTPUT IT
+ ISZ OCTPR3
+ JMP OCTPR2
+ JMP I OCTPRT /--RETURN--
+
+OCTPR1, 0
+OCTPR3, 0
+\f/OUTPUT ONE REGISTER
+
+PUNONE, 0
+ TAD PASS /WHICH PASS IS THIS?
+ SNA
+ JMP PUNON2 /PASS 2--OUTPUT BINARY
+ SPA CLA
+ JMP PUNON3 /PASS 1--EXIT
+ TAD FLDIND /GET FIELD NUMBER
+ TAD ["0 /CONVERT TO ASCII
+ JMS I OERROR /PRINT IT
+ TAD LOC /GET LOW ORDER 4 DIGITS (LOC CTR)
+ JMS OCTPRT /PRINT IT TOO
+ TAD OFFSET /IF THIS CODE IS IN A RELOC SECTION,
+ SZA CLA /
+ TAD (1200 /FLAG THE LOCATION COUNTER WITH A *
+DTORG1, JMS I [ERROR1 /OUTPUT 2 SPACES
+ TAD VALUE
+ JMS OCTPRT /OUTPUT CONTENTS
+ TAD I [LINBUF /IS THERE SOURCE CODE TO DUMP?
+ SNA CLA
+ JMP PUNON1 /NO-OUTPUT CARRIAGE RETURN
+ TAD LINKSW /YES-DUMP LINK SWITCH (' ) OR ( )
+ JMS I [ERROR1
+ JMS I [LINPRT /DUMP SOURCE CODE
+ JMP PUNON3 /AND EXIT
+
+PUNON1, TAD LINKSW /NO LINE - OUTPUT LINK SWITCH ANYWAY
+ SZA /IF THERE IS ONE
+ JMS I [ERROR1
+ TAD [215 /OUTPUT CARRIAGE RETURN
+ JMS I OERROR
+PUNON3, DCA LINKSW /CLEAR LINK SWITCH
+ JMP I PUNONE /--RETURN--
+
+/PASS 2-OUTPUT ONE REGISTER
+
+PUNON2, TAD VALUE /GET CONTENTS
+ CLL
+ JMS I [PUNOUT /OUTPUT AS 2 FRAMES
+ JMP PUNON3 /AND EXIT
+ PAGE
+\f/**CURRENT PAGE LITERALS ON THIS PAGE WILL BE LOST**
+/***WHEN OVERLAYED BY PUSHDOWN LIST**
+
+/ARRANGE TO OUTPUT ONE REGISTER
+
+PUNBIN, 0
+ DCA VALUE
+ JMS I [FINDSP /FIND CURRENT PAGE NUMBER
+ TAD [LITBUF
+ DCA TEMP2 /POINT TO NUMBER OR LITERALS
+ TAD LOC
+ AND [177
+ DCA TEMP
+ TAD I TEMP2 /IS PAGE FULL?
+ CIA
+ TAD TEMP
+ ISZ TEMP
+ SPA CLA
+ JMP ONEOK /NO-OK TO ADD ONE MORE REGISTER
+ TAD TEMP /YES-
+ DCA I TEMP2
+ JMS I [FINDSP /FIND CURRENT PAGE NUMBER
+ JMS I PPEZE /GENERATE PE OR ZE ERROR
+ONEOK, JMS I [FINDSP /FIND CURRENT PAGE NUMBER
+ TAD [TPINST
+ DCA TEMP2
+ TAD TEMP /IS THIS ADDRESS HIGHER THAN PREVIOUS
+ CIA /HIGH INSTRUCTION PAGE?
+ TAD I TEMP2
+ SMA CLA
+ JMP PUNMOD /NO
+ TAD TEMP /YES-THIS IS NEW HIGH INSTRUCTION
+ DCA I TEMP2
+
+PUNMOD, JMS I [PUNONE /OUTPUT THIS REGISTER
+ ISZ LOC /GET NEXT LOCATION
+ TAD LOC /IF THE "ISZ" SKIPS IT IS O.K. (A 0)
+ AND [177 /IS THIS FIRST INSTRUCTION ON NEXT PAGE?
+ SZA CLA
+ JMP I PUNBIN /NO--RETURN--
+ JMS I [FINDSP /YES-FIND CURRENT PAGE NUMBER
+ TAD [LITBUF /RESET POINTERS
+ DCA TEMP2
+ TAD I TEMP2
+ DCA LITPTR
+ JMP I PUNBIN /--RETURN--
+
+PPEZE, PEZE
+\fHEADER, "S;"Y;"M;"B;"O;"L;"S
+ 211;211;211;211;211 /FOR /N HEADER
+
+/************************************************************
+/CODE OVERLAYED ON PASS 3
+/BY USER HEADER BUFFER
+
+/CONTINUATION OF EXPUNGE HANDLER
+/ENTER ON PASS 1 ONLY
+
+EXPUNW, IFZERO HASH<
+ DCA TEMP1
+ DCA EXPUN2 /CLEAR NEW HIGH TAG COUNTER
+ TAD HIGHTG
+ CMA
+ DCA TEMP3 /SAVE NUMBER OF SYM TBL ENTRIES
+EXPUNY, TAD TEMP1
+ DCA THISTG
+ JMS I [FINDTG /GET A SYMBOL
+ TAD TAG1 /ONLY SAVE THE SYMBOL IF
+ RTL
+ CLA /IT WAS A PSEUDO-OP, OR
+ TAD TAG3 /THE SYMBOLS I OR Z
+ SNL SMA CLA
+ JMP EXPUA4 /NO-FORGET TAG
+ TAD EXPUN2 /YES-RETURN TAG TO SYMBOL TABLE
+ DCA THISTG
+ JMS I [PUTTAG
+ ISZ EXPUN2
+EXPUA4, ISZ TEMP1
+ ISZ TEMP3 /DONE YET?
+ JMP EXPUNY /NO- TRY NEXT TAG
+ CLA CMA /YES
+ TAD EXPUN2 /RESET HIGH TAG
+ DCA HIGHTG
+ JMP I [LOOKEX /--EXIT TO MAIN--
+
+EXPUN2, 0
+ >
+\f IFNZRO HASH<
+ /HASH TABLE EXPUNGE - DEPENDS ON PSEUDO OPS
+ /BEING HASHED FIRST. SCANS WHOLE TABLE (SLOW AS HELL!)
+
+ DCA THISTG /POINT TO FIRST ENTRY
+ TAD TAGMAX /SET THE COUNT
+ CIA
+ DCA TEMP1
+EXPUNL, JMS I [FINDTG /GO GET ONE
+ TAD TAG1
+ RTL
+ CLA
+ TAD TAG3
+ SPA SZL CLA /PSEUDO OP?
+ JMP EXPUNS /YES, SKIP DELETION
+ DCA TAG1 /NO, WIPE IT
+ DCA TAG2
+ DCA TAG3
+ JMS I [PUTTAG /AND PUT IT BACK
+ STA
+ TAD HIGHTG
+ DCA HIGHTG /DECREMENT SYMBOL COUNT
+EXPUNS, ISZ THISTG /POINT TO NEXT ENTRY
+ ISZ TEMP1 /TALLY COUNT
+ JMP EXPUNL /GET ANOTHER
+ JMP I [LOOKEX /DONE --RETURN--
+ >
+
+/***************************************************************
+\f/ASSEMBLER HEADER BUFFER
+
+ ZBLOCK HEADER+HEDLEN-.
+
+ " ;" ;"P;"A;"L;"8;"-
+ "V;"1;VERSION-12+"0;SUBVERSION
+ "
+DATE, "N;"O;" ;"D;"A;"T;"E;" /GETS SET TO DD-MMM-YY IF DATE PRESENT
+ " ;" ;"P;"A;"G;"E;" ;0
+\f/PUSHDOWN LIST
+/OCCUPIES NEXT 43(8) LOCATIONS
+PDLND=.
+
+
+
+/*********************************************************
+/ONCE ONLY CODE FOR /D OPTION
+/PUT INTO SYMLST FOR DDT COMPATIBLE SYMBOL TABLE
+/OVERLAYED DURING ASSEMBLY BY PUSHDOWN LIST
+
+DSWIT1, IFZERO HASH<
+ RELOC SYMPRT+4
+
+ DCA I SYMPRF
+ JMS SYMPRC
+ TAD [377
+ JMS I OERROR
+ CLA CMA
+ DCA THISTG
+SYMPRE, TAD [215
+ JMS I OERROR
+ JMS SYMPPP
+ JMP SYMPRD
+ JMP SYMPR1
+SYMPRF, HSWIT1
+SYM204, 204
+ RELOC
+
+ >
+ IFNZRO HASH<
+ RELOC SYMNWP
+ DCA THISTG
+ DCA I SYMHSW
+ JMS DDTLDR
+ TAD [377
+ JMS I OERROR
+SYMLUP, TAD [215
+ JMS I OERROR
+ TAD HIGHTG
+ CLL CIA
+ TAD THISTG
+ SZL CLA
+ JMP SYMXIT
+ JMP SYMGO
+SYMHSW, HSWIT1
+ RELOC
+ >
+DSWITA= .
+
+/**********************************************************
+ PAGE
+\f/*************************************************************
+
+/PAL8 TABLES - LOAD OVER INITIALIZATION CODE
+
+PDLST= PDLND+42 /PUSHDOWN LIST 43(8) LOCS LONG
+
+
+LINBUF= PDLST+1 /LINE BUFFER OCCUPIES 122(8) LOCATIONS
+
+LITBUF= LINBUF+122 /LITERAL TABLE IS 40(8) LOCATIONS (ONE PER PAGE)
+ / SHOWING LOWEST PAGE ADDRESS USED FOR LITERALS
+
+TPINST= LITBUF+40 /TOP INSTRUCTION TABLE IS 40(8) LOCTIONS
+ / SHOWING HIGHEST PAGE ADDRESS USED FOR INSTRUCTIONS
+
+LITBF2= TPINST+40-17 /LITERAL BUFFER 2 CONTAINS UP TO 160(8)
+ /PAGE 0 LITERALS, SUBSCRIPTS 20-177
+
+LITBF1= LITBF2+200-100 /LITERAL BUFFER 1 CONTAINS UP TO 100(8)
+ /CURRENT PAGE LITERALS, SUBSCRIPTS 100-177
+
+/*************************************************************
+\f/ONCE ONLY CODE FOR ASSEMBLER START UP
+/OVERLAYED BY BUFFERS
+
+/HANDLES SWITCH OPTIONS
+
+BEGIN, CIF 10
+ JMS I IOMON /CALL USER SERVICE ROUTINES
+ 5 /*COMMAND DECODER*
+ 2001 /DEFAULT INPUT EXTENSION IS .PA
+NOCD, CDF 10 /RETURN
+ TAD I (7604 /IS THERE A BINARY FILE EXTENSION?
+ SNA
+ TAD (216 /NO - DEFAULT EXTENSION IS .BN
+ DCA I (7604 /YES
+ TAD I (7611 /IS THERE A LISTING FILE EXTENSION?
+ SNA
+ TAD (1423 /NO - DEFAULT EXTENSION IS .LS
+ DCA I (7611
+ TAD I (MPARAM+1 /WAS THE /T OPTION SELECTED?
+ CDF
+ AND (20
+ZT7640, SNA CLA
+ JMP BEGINA /NO
+BEGIAA, DCA I (HSWITC /YES - GENERATE CR/LF IN PLACE OF F/F
+ JMP BEGIN2
+
+BEGINA, TAD [7605 /WAS TTY THE PASS 3 DEVICE?
+ JMS I (OTYPE
+ AND (770
+ SNA CLA
+ JMP BEGIAA /YES - GENERATE CR/LF IN PLACE OF F/F
+ DCA I (BEGIAB /NOT /T OR TTY:
+
+BEGIN2, CDF 10
+ TAD I (MPARAM+1 /WAS THE /S OPTION SELECTED?
+ CDF
+ AND (40
+ SZA CLA
+ DCA I (SSWITC /YES -OMIT SYMBOL TABLE
+ CDF 10
+ AC2000
+ AND I (MPARAM+1
+ CDF
+ SNA CLA /WAS THE /N OPTION SELECTED?
+ JMP BEGIN4 /NO
+ TAD BEGSKP /SET SWITCH
+ DCA I (NSWITC /YES -SYMBOL TABLE BUT NO LISTING
+\fBEGIN4, CDF 10
+ TAD I (MPARAM /WAS THE /H OPTION SELECTED?
+ CDF
+ AND (20
+ZH7640, SNA CLA
+ JMP BEGINB /NO
+BEGHSW, TAD I (FORM21 /YES -SUPPRESS LISTING PAGE FORMAT
+ DCA I (HSWITC
+ DCA I (HSWIT1
+BEGSKP, CLA SKP
+BEGINB, DCA I (HSWIT2
+ CDF 10
+ TAD I (MPARAM /WAS THE /D OPTION SELECTED?
+ CDF
+ AND [400
+ZD7640, SNA CLA
+ JMP BEGIN1 /NO
+ TAD I XREG1 /YES -DDT COMPATIBLE SYMBOL TABLE
+ DCA I LAST3 /SUBSTITUTE ALTERNATE CODE
+ ISZ DSWIT3 /INTO SYMBOL TABLE OUTPUT ROUTINE
+ JMP .-3
+ TAD I XREG2
+ DCA I LAST4
+ ISZ DSWIT4
+ JMP .-3
+
+BEGIN1, TAD I (JSBITS /RESET JOB STATUS WORD TO
+ AND (6777 /INDICATE PAL8 NOT RESTARTABLE
+ TAD (1000
+ DCA I (JSBITS
+ CIF CDF 10
+ JMS I (FMTDAT /CALL ROUTINE IN FIELD 1 TO SETUP DATE
+ JMP I (BEGINZ /CONTINUE ON
+\f
+DSWIT3, DSWIT1-DSWITA
+DSWIT4, DSWIT2-DSWITB
+ PAGE
+\f/ONCE ONLY CODE CONTINUED
+/ASSEMBLER INITIALIZATION PROCEDURES
+
+
+BEGINZ, TAD [7600 /WHAT DEVICE FOR BINARY OUTPUT?
+ JMS I (OTYPE
+ SMA CLA
+ TAD (-70 /STAND-ALONE
+ TAD (-10 /DIRECTORY
+ DCA I (SWAPR2+LEADER /SET AMOUNT OF LEADER TRAILER
+ DCA LAST1 /NO DEFINED TAG
+BEGIN5, IFZERO HASH<
+ CDF
+ TAD I BLK1 /MOVE SYMBOL TABLE TO FIELD 1
+ CDF 10
+ DCA I BLK2
+ ISZ BLK1
+ ISZ BLK2
+ ISZ BLK3
+ JMP BEGIN5
+ >
+ CDF
+ DCA I [LINBUF+120 /SET BUFFER POINTERS
+ DCA I (LINBUF+121
+ TAD [7600 /IS PTP BINARY OUTPUT DEVICE?
+ JMS I (OTYPE
+ DCA BLK1
+ TAD BLK1
+ AND (770
+ TAD (-20
+ SNA CLA
+ DCA I (PTPSW /YES - SET PTP SWITCH
+ TAD BLK1 /NO - IS IT A DIRECTORY DEVICE?
+ SPA CLA
+ JMP .+3 /NO
+ TAD (TAD [77 /YES - SET DIRECTORY SWITCH
+ DCA I (DIRSW
+ TAD [7605 /IS PTP GETTING LISTING OUTPUT?
+ JMS I (OTYPE
+ AND (770
+ TAD (-20
+ SNA CLA
+ DCA I (SWAPR2+PTPSW1 /YES - SET PASS 3 PTP SWITCH
+ TAD [7605 /NO - IS DIRECTORY DEVICE GETTING
+ JMS I (OTYPE /LISTING OUTPUT?
+ SPA CLA
+ JMP .+3 /NO
+ TAD (TAD [77 /YES - SET PASS 3 DIRECTORY SWITCH
+ DCA I (SWAPR2+DIRSW1
+ JMP I (BEGINF
+\fMONLST, TEXT /JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC/
+ *.-1
+
+/CONTINUED CHECK OF COMMAND DECODER OPTIONS
+
+BEGINH, CDF 10
+ TAD I (MPARAM /WAS THE /G OR /L OPTION CHOSEN?
+ CDF
+ AND (41
+ SNA CLA
+ JMP I (BEGISW /NO
+ CDF 10 /YES
+ TAD I [7600
+ SZA CLA /WAS THERE A BINARY OUTPUT FILE?
+ JMP YESBIN /YES
+BINLOP, TAD PALBIN /NO - CREATE FILE PAL8BN.TM
+ DCA I PALBIX /ON SYSTEM DEVICE
+ ISZ BINLOP
+ ISZ PALBIX
+ ISZ BINCNT
+ JMP BINLOP
+ CDF
+ TAD (-10 /SET AMOUNT OF LEADER TRAILER
+ DCA I (SWAPR2+LEADER
+\f/SET UP FOR LOAD OR LOAD AND GO
+
+YESBIN, CDF
+ CIF 10
+ CLA IAC
+ JMS I IOMON /CALL USER SERVICE ROUTINES
+ 2 /* LOOKUP PERMANENT FILE *
+LOAD, PLOAD /FILENAME ABSLDR.SV
+BINCNT, -5 /FILE LENGTH
+ JMP NOLOAD /ABSLDR.SV NOT FOUND
+ TAD LOAD /NORMAL RETURN
+ DCA I (CHAIN /SET STARTING BLOCK NUMBER
+ DCA I (LSWITC /FOR CHAIN CALL
+ JMP I (BEGISW
+
+NOLOAD, JMS I [ERROR /GENERATE LD ERROR MESSAGE
+ LD
+ JMP I (BEGISW /ASSEMBLE BUT DO NOT CHAIN TO LOADER
+
+BLK1, SYMS
+BLK2, 7600+SYMS-SYME
+BLK3, SYMS-SYME
+
+PALBIX, 7600
+PALBIN, 1
+ FILENAME PAL8BN.TM
+ PAGE
+\fCCC, TAD I CC231 /FINAL PIECE OF STARTUP ONCE-ONLY CODE
+ SNA
+ TAD CC23
+ DCA I CC231 /"HSWITC"=JMP FORMF1 IF WAS 0
+BEGISW, CDF 10
+ TAD I CCJWD
+ CDF 0
+ AND CCJBIT
+ZJ7640, SNA CLA /WAS /J OPTION SPECIFIED?
+ DCA I CCJLOC /NO - PRINT UNASSEMBLED CONDITIONAL CODE
+ CDF 10
+ TAD I CCWWD
+ CDF 0
+ AND CCWBIT
+ZW7640, SNA CLA /WAS /W OPTION SPECIFIED?
+ JMP D4 /V3C
+D5, TAD I CC231
+ CIA
+ TAD CC23
+ SZA CLA /ARE WE OUTPUTTING FF'S IN LISTING?
+ JMP BEGIS3 /NO
+ TAD CC24 /YES - SUBSTITUTE SOME CODE
+ DCA I CC25
+ TAD CC26
+ DCA I CC27
+ TAD CC24
+ DCA I CC28
+BEGIS3, JMS I OVLL7 /CALL SYSTEM DEVICE
+ 4200 /WRITE 2 PAGES
+ SWAP1 /FORM SWAP1
+ ASWAP /INTO TEMP AREA
+ JMP I OVLL8 /ERROR?!
+ TAD I LAST2 /MOVE PASS 1&2 ONLY CODE
+ DCA I TAGXR /OVER PASS3 SWAPPED OUT CODE
+ ISZ CC29
+ JMP .-3
+ IFNZRO HASH<
+ JMS I CCHSH /FINALLY HASH OUT THE TABLE
+ >
+
+ JMP I .+1
+ START2-1 /OK - NOW GO DO SOME ASSEMBLING!
+D4, DCA I CCWLOC /NO - DON'T WIPE LITERALS AS YOU DUMP THEM
+ DCA I (D3
+ JMP D5 /V3C
+\fOVLL7, 7607
+OVLL8, SYSER3
+
+CC231, HSWITC
+CC23, FORMF1&177+5200
+CC24, STA
+CC25, FORMF1
+CC26, DCA LINCNT
+CC27, FORMF1+1
+CC28, FORMF1+2
+CC29, SWAPB2-SWAPE2
+
+ IFNZRO HASH<
+CCHSH, HSHSMS
+ >
+CCJWD, MPARAM
+CCJBIT, 4
+CCJLOC, IFTST4
+CCWWD, MPARAM+1
+CCWBIT, 2
+CCWLOC, LITHAK
+PLOAD, FILENAME ABSLDR.SV
+
+CKBAT, TAD I CC7777 /GET BATCH FLAG WORD
+ CLL RTL
+ SNL CLA /BATCH RUNNING?
+ JMP I CCOPTM /NO, GO WITH LINK OFF
+ TAD I CC7777
+ AND CC0070 /GET BATCH FIELD
+ TAD CCCIF0 /FORM CIF TO BATCH FIELD
+ DCA OTYPB1 /MODIFY TTY OUTPUT ROUTINE TO GO TO BATCH
+ TAD CCJMSB /LOG INSTEAD
+ DCA OTYPB2
+ TAD OTYPTD
+ DCA OTYPB3
+ JMP I CCOPTM /RETURN TO CORE DETERMINER, LINK SET
+
+CC7777, 7777
+CCOPTM, OPTIM4
+CC0070, 70
+CCCIF0, CIF 0
+CCJMSB, JMS I [BATOUT
+\f/THIS CODE SITS AFTER THE END OF THE LITERAL TABLE
+
+ IFNZRO .-LITBF1-200&4000 <*LITBF1+200>
+
+OTYPEO, 0 /TYPE A CHARACTER, CHECKING FOR ^O AND ^C
+ DCA OTYPEC /SAVE CHAR
+ JMS CTCCHK /CHECK FOR ^C - RETURN CHAR-203 IN AC
+ TAD (-14
+ SNA CLA /^O?
+ JMP I OTYPEO /YES
+OTYPTD, TAD OTYPEC
+OTYPB1, TLS
+OTYPB2, TSF
+OTYPB3, JMP .-1 /WAIT FOR TTY
+ TAD [-215
+OTYPCR, SZA CLA /SET TO CLA DURING "ERRORS DETECTED" STUFF
+ JMP I OTYPEO
+ TAD [212 /IF CHAR WAS CR, TYPE LF
+ JMP OTYPEO+1
+OTYPEC, 0
+
+CTCCHK, 0 /CHECK FOR ^C
+ TAD [200
+ KRS /OR IN KEYBOARD CHAR
+ TAD (-203
+ SNA
+ KSF /3B BUT WAS CHAR REALLY THERE?
+ JMP I CTCCHK /NO ^C - RETURN
+ JMP I [7600 /RETURN TO OS/8
+
+TTLMSG, "E-240^100+"R-240 /ERRORS DETECTED:
+ "R-240^100+"O-240
+ "R-240^100+"S-240
+ "D-240
+ "E-240^100+"T-240
+ "E-240^100+"C-240
+ "T-240^100+"E-240
+ "D-240^100+":-240
+ 0
+
+ "L-240^100+"I-240 /LINKS GENERATED:
+ "N-240^100+"K-240
+ "S-240^100
+ "G-240^100+"E-240
+ "N-240^100+"E-240
+ "R-240^100+"A-240
+ "T-240^100+"E-240
+ "D-240^100+":-240
+ 0
+ PAGE
+\f/OUTPUT A CHARACTER TO OUTPUT DEVICE
+/CALLED BY JMS I OCHAR
+/WITH CHARACTER IN 8-BIT ASCII IN AC
+
+OUTPT1, PUNCHX /PASS 2=PUNCHX; 3=XLISTX
+
+OUTPUT, 0
+ AND [377 /MASK OUT LEFT 4 BITS
+ DCA OUTPT2 /STORE
+ TAD I OUTPT1 /IS THIS PASS 3 AND
+ SNA
+ TAD OUTINH /IS THIS COVERED BY XLIST?
+ SZA CLA
+ JMP I OUTPUT /YES--RETURN--
+ TAD OUTPT2 /NO - GET CHARACTER
+ AND [200
+ SNA CLA
+ TAD OUTPT2 /IF LESS THAN 200, THEN
+ TAD CHKSUM /ADD IT TO CHECKSUM
+ DCA CHKSUM
+ TAD OUTPT2 /GET CHARACTER
+ TAD (-211 /IS IT A TAB?
+ SNA CLA
+ JMP OUTPT3 /YES - OUTPUT SPACES
+ JMS OUTPUX /NO - OUTPUT CHARACTER
+ TAD OUTPT2 /IS IT LINE FEED?
+ TAD (-212
+ SZA CLA
+ JMP I OUTPUT /NO--RETURN--
+ TAD [7773 /YES - RESET LSTCNT
+ DCA LSTCNT
+ JMP I OUTPUT /--RETURN--
+
+\f/OUTPUT SPACES INSTEAD OF TAB
+
+OUTPT3, TAD [240
+ DCA OUTPT2
+ JMS OUTPUX /OUTPUT SPACE
+ TAD LSTCNT /TAB STOPS ARE EVERY 8 SPACES
+ AND [7
+ SZA CLA
+ JMP .-4
+ JMP I OUTPUT /--RETURN--
+
+/OUTPUT THE CHARACTER
+/PACKS CHARACTERS IN STANDARD OS/8 FORMAT
+
+OUTPUX, 0
+ ISZ OUJMP /BUMP 3-WAY SWITCH
+OUJMP, HLT /WILL BE CHANGED - SHOULD NEVER HALT
+ JMP OCHAR1 /CHARACTER #1
+ JMP OCHAR2 /CHARACTER #2
+OCHAR3, TAD OUTPT2 /CHARACTER #3
+ CLL RTL
+ RTL
+ AND [7400
+ TAD I OUPOLD /ADD 4 BITS TO WORD 1
+ DCA I OUPOLD
+ TAD OUTPT2
+ CLL RTR
+ RTR
+ RAR
+ AND [7400
+ TAD I OUPTR /ADD 4 BITS TO WORD 2
+ DCA I OUPTR
+ TAD OUJMPE
+ DCA OUJMP /RESET SWITCH
+ ISZ OUPTR
+ ISZ OUDWCT /BUFFER FULL?
+ JMP OUCHLV /NO
+ TAD [200 /YES
+ JMS I (OUTDMP /DUMP BUFFER
+ JMS OUSETP /RESET POINTERS
+ JMP OUCHLV
+
+\fOCHAR2, TAD OUPTR /SAVE POINTER
+ DCA OUPOLD
+ ISZ OUPTR
+OCHAR1, TAD OUTPT2
+ DCA I OUPTR /SET 8 BIT WORD
+OUCHLV, TAD OUTPT2
+ TAD [40
+ AND [100 /CHECK FOR PRINTABLE CHAR
+ SZA CLA /IF IT IS,
+ ISZ LSTCNT /BUMP TAB COUNT
+OUTINH, 0 /ALWAYS 0 OR 1!
+ JMP I OUTPUX /--RETURN--
+
+OUPOLD, 0
+OUPTR, 0
+OUJMPE, JMP OUJMP
+OUDWCT, 0
+OUTPT2, 0
+
+OUSETP, 0
+ TAD [7600 /SET OUTPUT WORD COUNT
+ DCA OUDWCT /TO 200
+ TAD (OUBUF
+ DCA OUPTR /RESET POINTER
+ TAD OUJMPE
+ DCA OUJMP /RESET SWITCH
+ CLL /MUST CLEAR LINK!!
+ JMP I OUSETP /--RETURN--
+\f/HANDLER FOR DEVICE PSEUDO-OP
+
+DEVICX, JMS I [SPNOR /IGNORE TRAILING SPACES
+ TAD [-5
+ JMP DEVIC1 /PACK 4 CHARACTERS
+
+
+/HANDLER FOR FILENAME PSEUDO-OP
+
+FILENX, JMS I [SPNOR /IGNORE TRAILING SPACES
+ TAD (-7
+ JMS FILE1 /PACK 6 CHARACTERS
+ TAD CHAR
+ TAD [-". /WAS CHARACTER . ?
+ SNA CLA
+ JMS I [GETC /YES-SKIP TO EXTENSION
+ AC7775
+DEVIC1, JMS FILE1 /PACK 2 CHARACTERS
+ JMP I [LOOKEX /--EXIT TO MAIN--
+
+/PACK CHARACTERS
+/NEGATIVE OF # OF CHARACTERS TO BE PACKED IN AC ON ENTRY
+
+FILE1, 0
+ DCA FILE6 /SAVE # OF CHARACTERS TO PACK
+ DCA I (TEXT6 /RESET PACK SWITCH
+FILE4, JMS I [TSTALN /IS CHARACTER IN CHAR ALPHANUMERIC?
+ SKP
+ JMP FILE5 /NO-DONE PACKING
+ ISZ FILE6 /YES-TOO MANY CHARACTERS?
+ JMP FILE3 /NO-O.K.
+ CLA CMA /YES
+ DCA FILE6 /RESET # OF CHARACTERS AND IGNORE
+ JMP FILE2
+
+FILE3, TAD CHAR
+ JMS I (TEXT2 /PACK A CHARACTER
+FILE2, JMS I [GETC /GET A CHARACTER
+ JMP FILE4 /TEST IT
+
+ JMS I (TEXT2 /PACK A ZERO CHAR
+FILE5, ISZ FILE6 /ARE WE DONE?
+ JMP .-2 /NO - PAD WITH ZEROES
+ JMP I FILE1 /YES--RETURN--
+FILE6, 0
+ PAGE
+\f/HANDLER FOR TEXT PSEUDO-OP
+/SPACES ARE IGNORED TO DELIMITER
+/DELIMITER IS FIRST PRINTING CHARACTER
+/OTHER THAN SPACE
+/NON-PRINTING CHARACTERS ARE ILLEGAL
+/A PRINTING CHARACTER HAS EITHER BIT 5
+/OR BIT 6 SET, BUT NOT BOTH
+
+TEXT8, JMS I [GETC /GET NEXT CHARACTER
+TEXTX, CLL CLA CML RAR /AC=4000
+ DCA GETCI /; AND / ARE NOT END OF LINE
+ JMS TEXT1A /CHECK FOR PRINTING CHARACTER
+ JMP TEXT8 /NON PRINTING - IGNORE
+ TAD [-240 /IGNORE SPACES UNTIL DELIMITER
+ SNA /HAS BEEN FOUND
+ JMP TEXT8
+ TAD [240 /RESTORE CHARACTER
+ CIA
+ DCA VALUE2 /STORE NEGATIVE DELIMITER
+ DCA TEXT6 /SET PACKING SWITCH
+TEXT3, JMS I [GETC /GET NEXT CHARACTER
+ JMS TEXT1A /IS IT A PRINTING CHARACTER?
+ JMP TEXT9 /NO - IC
+ TAD VALUE2 /YES - IS IT DELIMITER?
+ SNA CLA
+ JMP TEXT4 /YES - TERMINATE
+ TAD CHAR /NO - PACK AND OUTPUT
+ JMS TEXT2 /PACK IT
+ JMP TEXT3
+
+TEXT4, DCA GETCI /RESET GETCI TO CALL ; AND / END OF LINE
+ JMS I [GETC /SKIP DELIMITER
+TEXT4X, JMS TEXT2 /OUTPUT 0 TO FILE
+ JMS TEXT2
+/CHANGE TEXT4X TO:
+/ NOP
+/FOR NO EXTRA WORD OF ZEROS
+ DCA GETCI /RESET GETCI IN CASE WE HIT CR
+ JMP I [LOOKEX /--EXIT TO MAIN--
+\fTEXT9, JMS I [ERROR /GENERATE IC ERROR MESSAGE
+ IC
+ JMP TEXT3
+
+/SKIP ON PRINTING CHARACTER
+
+TEXT1A, 0
+ TAD CHAR
+ SPA SNA CLA /IS CHARACTER -
+ JMP TEXT4X /YES
+ TAD CHAR
+ TAD [40
+ AND [100
+ SZA CLA /IS THE CHAR PRINTING?
+ ISZ TEXT1A /YES - INCREMENT RETURN
+ TAD CHAR /WITH CHARACTER IN AC
+ JMP I TEXT1A /--RETURN--
+
+/OUTPUT 2 TEXT CHARACTERS (ONE REGISTER)
+/ENTER WITH CHARACTERS IN AC
+
+TEXT2, 0
+ AND [77 /GET RIGHT 6 BITS
+ ISZ TEXT6 /WHICH HALF OF WORD?
+ JMP TEXT5 /LEFT
+ TAD TEXT7 /RIGHT--ADD IN LEFT HALF
+ JMS I [PUNBIN /OUTPUT IT
+ JMP I TEXT2 /--RETURN--
+
+TEXT5, JMS I [RTL6 /GET LEFT HALF OF WORD
+ DCA TEXT7 /SAVE IT
+ CLA CMA /SET SWITCH FOR RIGHT HALF
+ DCA TEXT6
+ JMP I TEXT2 /--RETURN--
+
+TEXT6, 0
+TEXT7, 0
+\f/HANDLER FOR EXPUNGE PSEUDO-OP
+
+EXPUNX, TAD PASS /IS THIS PASS 1
+ SMA CLA
+ JMP I [LOOKEX /NO--EXIT TO MAIN--
+ JMP I (EXPUNW /YES-CONTINUE AT EXPUNW
+
+
+
+/CLOSE OUTPUT FILE
+
+OCLOSE, 0
+ TAD I (OUTINH /OUTPUT INHIBITED?
+ SZA CLA
+ JMP I OCLOSE /YES--RETURN--
+PTPSW, TAD [232 /NO-0 IF PTP: - OUTPUT ^Z
+ JMS I OCHAR
+ JMS I OCHAR /AND ZEROS
+FILLLP, JMS I OCHAR
+DIRSW, TAD [177 /TAD [77 IF NOT DIRECTORY
+ AND I (OUDWCT /FILL OUT BUFFER OR HALF BUFFER
+ SZA CLA /WITH ZEROS
+ JMP FILLLP
+ TAD I (OUDWCT /IS THERE OUTPUT TO BE DUMPED?
+ TAD [200
+ SZA
+ JMS OUTDMP /YES - DUMP IT
+ TAD OUFILE /GET DEVICE NUMBER IN AC
+ CIF 10
+ JMS I IOMON /CALL USER SERVICE ROUTINES
+ 4 /*CLOSE OUTPUT FILE*
+OUCNAM, 0 /POINTER TO FILENAME TO BE DELETED
+OUCCNT, 0 /LENGTH OF NEW PERMANENT FILE
+ JMP SYSER3 /DE**FATAL ERROR**
+ JMP I OCLOSE /--RETURN--
+
+OUFILE, ZBLOCK 5
+\f/OUTPUT DUMP
+/AC CONTAINS CONTROL WORD FOR DUMP
+
+OUTDMP, 0
+ TAD [4000 /BE SURE CONTROL WORD IS
+ DCA OUCTLW /A WRITE OPERATION
+ TAD OUBLK /GET STARTING BLOCK NUMBER
+ TAD OUCCNT /ADD IN COUNT
+ DCA OUREC /SET THIS BLOCK NUMBER
+ TAD OUCTLW
+ TAD [100 /ROUND HALF-BLOCK, IF ANY
+ CLL RTL
+ RTL
+ RTL
+ AND [17 /GET THIS COUNT
+ TAD OUCCNT
+ DCA OUCCNT /ADD TO TOTAL COUNT
+ TAD OUCCNT /IS OUTPUT DEVICE FULL?
+ CLL CML
+ TAD OUELEN /CHECK AGAINST MAXIMUM LENGTH
+ SNL SZA CLA
+ JMP SYSER2 /DF**FATAL ERROR**
+ JMS I OUHNDL /CALL OUTPUT DEVICE HANDLER
+OUCTLW, 0 /CONTROL WORD
+ OUBUF /BEGINNING OF OUTPUT BUFFER
+OUREC, 0 /STARTING BLOCK NUMBER
+SYSER3, CLA SKP /ERROR RETURN
+ JMP I OUTDMP /--RETURN--
+SYSERR, TAD (DE /DE **FATAL ERROR**
+ JMP I [MONERR
+
+OUHNDL, 0
+OUBLK, 0
+OUELEN, 0
+
+SYSER2, TAD (DF /GENERATE DF ERROR MESSAGE
+ JMP I [MONERR /**FATAL ERROR**
+ PAGE
+\f/MAINLINE CODE
+
+LOOKE2, 0 /WAS THIS END OF LINE
+ TAD CHAR / OR END OF CONDITIONAL?
+ TAD [-">
+ SNA
+ JMP CONEND /END OF CONDITIONAL
+ TAD (">
+ SMA CLA
+ JMP I LOOKE2 /NOT END OF LINE--RETURN--
+LOOKE1, JMS I [GETC /GET A CHARACTER
+MAIN, JMS I (CTCCHK /CHECK FOR ^C
+ CLA /** CTCCHK RETURNS AC NON-ZERO!
+ JMS I [SPNOR /IGNORE SPACES
+ TAD CHAR
+ TAD (-"$ /WAS IT $ ?
+ SNA /YES--
+ JMP I (ENDPAS /NO-END THIS PASS
+ TAD ("$-"*
+ SNA CLA /WAS IT * ?
+ JMP STAR /YES-HANDLE *
+ JMS I [TSTALP /NO-WAS IT ALPHABETIC?
+ JMP ALPHA /YES
+ JMS LOOKE2 /NO
+TOEXP, JMS I [EXP /GET REST OF EXPRESSION
+ TAD LININD
+ DCA LINKSW /STORE LINK SWITCH
+ TAD VALUE
+ JMS I [PUNBIN /OUTPUT THE REGISTER
+LOOKEX, JMS I [SPNOR /IGNORE TRAILING SPACES
+ JMS LOOKE2 /IS LINE ENDED?
+ILCHAR, JMS I [ERROR /NO-GENERATE IC ERROR MESSAGE
+ IC
+ JMP CONEN1
+
+CONEND, TAD CONDSW /ARE WE INTO CONDITIONALS?
+ SNA
+ JMP ILCHAR /NO - > IS ILLEGAL
+ IAC /ONE LESS CONDITIONAL
+ DCA CONDSW
+CONEN1, JMS I [GETC /GET NEXT CHARACTER
+ JMP LOOKEX /AND TRY FOR END AGAIN
+\f/HANDLER FOR *
+
+STAR, JMS I [GETC /GET NEXT CHARACTER AFTER *
+ JMS I [SPNOR /IGNORE SPACES
+ JMS I [EXP /GET REST OF EXPRESSION
+STAR0, DCA STARSW /ENTER HERE FROM RELOC WITH AC = -1
+ ISZ UNDFSW /WAS ANYTHING UNDEFINED?
+ JMP .+3
+ JMS I [ERROR /YES-GENERATE UO ERROR MESSAGE
+ UO
+ TAD VALUE /NO
+ DCA OP
+ TAD LOC /IS THIS THE SAME PAGE AS
+ AND [7600 /THE PREVIOUS CODE?
+ CIA
+ TAD OP
+ AND [7600
+ SNA CLA
+ JMP STAR2 /YES-PUNCH ORIGIN
+ JMS I [DUMPS /NO-DUMP LITERALS
+ TAD OFSBUF /SET OFFSET TO NEW VALUE
+ DCA OFFSET /AFTER LITERALS ARE DUMPED.
+ TAD OP /PUNCH NEW ORIGIN, SET "VALUE"
+ JMP I (STAR3 /FOR LISTING, AND SET UP IN NEW PAGE
+
+STAR2, TAD OFSBUF /SET OFFSET TO NEW VALUE
+ DCA OFFSET /
+ TAD OP
+ JMS I [PUNORG /PUNCH ORIGIN
+ DCA LAST1 /CLEAR LAST DEFINED SYMBOL
+ JMP I [PUNVAL
+
+ALPHA, JMS I [GETTAG /PICK UP TAG-IS IT IN TABLE?
+ DCA ALPHAI /STORE UNDEFINED TAG SWITCH
+ TAD TAG3 /IS IT A PSEUDO-OP?
+ SPA CLA
+ JMP I VALUE2 /YES-GO TO ITS HANDLER
+ TAD CHAR /NO
+ TAD (-", /WAS IT TERMINATED BY , ?
+ SNA
+ JMP COMMA /YES-DEFINE THE SYMBOL
+ TAD (",-"= /NO-WAS IT TERMINATED BY = ?
+ SNA CLA
+ JMP I (EQUAL /YES-EQUATE THE SYMBOL
+ AC4000 /NO
+ JMP TOEXP /TREAT AS AN EXPRESSION
+\f/HANDLER FOR ,
+
+COMMA, JMS I [GETC /GET NEXT CHARACTER
+ ISZ ALPHAI /WAS TAG DEFINED PREVIOUSLY?
+ JMP COMMA2 /YES
+ TAD LOC /NO-STORE CURRENT ADDRESS FOR DEFINITION
+ DCA VALUE2
+ JMS I [INSRTG /PUT TAG IN SYMBOL TABLE
+COMMA1, TAD TAG1 /STORE FOR ERROR MESSAGE OUTPUT
+ DCA LAST1
+ TAD TAG2
+ DCA LAST2
+ TAD TAG3
+ DCA LAST3
+ TAD VALUE2
+ DCA LAST4
+ JMP MAIN /--EXIT TO MAIN--
+
+COMMA2, TAD LOC /DO NEW AND OLD DEFINITIONS AGREE?
+ CIA
+ TAD VALUE2
+ SNA CLA
+ JMP COMMA1 /YES-ALLOW REDEFINITION
+ JMS I [ERROR /NO-GENERATE ID ERROR MESSAGE
+ ID
+ JMP MAIN /--EXIT TO MAIN--
+\fOPTABL, OP0 /+
+ OP1 /-
+ OP6 /%
+ OP2 /&
+ OP5 /(SPACE)
+OPEXPL, OP5 /! - CHANGED TO OP3 IF /B ON
+ OP4 /^
+ PAGE
+\f/EXPRESSION PROCESSOR
+/POSSIBLE RECURSIVE ENTRY
+/ENTER WITH CHARACTER IN CHAR
+
+EXP, 0
+ DCA EXPIND /SET INDICATOR (NOT 0 IF NO MRI FOUND)
+ DCA LININD /CLEAR LINK GENERATED SWITCH (' )
+ DCA VALUE /START WITH "VALUE" = 0
+ DCA UNDFSW /CLEAR UNDIFINED SWITCH
+ TAD EXP
+ JMS I [PUSHA /SAVE RETURN ADDRESS
+ DCA OP /OP=0; ADD
+ TAD EXPIND
+ SPA CLA
+ JMP I (EXPINT
+ TAD CHAR /IS CHARACTER A + ?
+ TAD [-"+
+ CLL RTR /PUT THE 2 BIT IN THE LINK
+ SZA CLA /WAS CHAR 53(+) OR 55(-)?
+ JMP EXP1A /NO
+ RAL /YES - OP IS 0 OR 1, DEPENDING
+EXP1, DCA OP
+ JMS I [GETC /GET NEXT CHARACTER
+ ISZ EXPIND /MRI NO LONGER LEGAL ON THIS LINE
+EXP1A, TAD CHAR /IS CHARACTER A . ?
+ TAD [-".
+ SNA
+ JMP PERIOD /YES-GO TO . HANDLER
+ TAD (".-"" /NO-IS IT " ?
+ SNA
+ JMP QUOTE /YES-GO TO " HANDLER
+ TAD (""-"[ /NO-IS IT [ ?
+ CLL
+ SZA
+ TAD ("[-"( /OR (?
+ SNA CLA
+ JMP I (LIT /YES - LITERAL - LINK HOLDS WHICH KIND
+ JMS I [TSTALP /NO-IS IT ALPHABETIC?
+ JMP I (ALPHA1 /YES-HANDLE SYMBOL
+ JMS I [TSTNUM /NO-IS IT NUMERIC?
+ JMP NUMBER /YES-HANDLE NUMBER
+
+EXP2, JMS ENDCHK /NO-CHECK FOR END
+ JMP EXP1A /NOGO - TRY AGAIN
+ TAD OP
+ TAD [-4 /IS OP SPACE (4)
+ SNA CLA
+ JMP I (EXPXIT /YES-EXIT
+ JMS I [ERROR
+ IC /GIVE IC MESSAGE ON ILLEGAL OPERATOR
+ JMP I (EXPINT /EXIT ANYWAY
+\f/END OF EXPRESSION CHECK
+/SKIP IF OK
+
+ENDCHK, 0
+ TAD CHAR
+ TAD (-"] /IS CHARACTER A ] ?
+ SZA /YES-SKIP A EXIT
+ TAD ("]-") /IS CHARACTER A ) ?
+ SZA /YES-SKIP A EXIT
+ TAD (")-"> /IS CHARACTER A > ?
+ SZA /YES-SKIP AND EXIT
+ TAD (">-"< /IS CHARACTER A < ?
+ SNA
+ JMP ENDCH1 /YES-SKIP AND EXIT
+ TAD ("<
+ SPA CLA /IS IT END-OF-LINE?
+ JMP ENDCH1 /YES-SKIP AND EXIT
+ JMS I [ICMESG /NO - GENERATE IC MESSAGE AND GET NEXT CHAR
+ JMP I ENDCHK /--RETURN--
+
+ENDCH1, ISZ ENDCHK /INCREMENT RETURN ADDRESS
+ JMP I ENDCHK /--RETURN--
+
+NUMBER, DCA TEMP
+NUMBE2, TAD RADIX /IS THE CURRENT RADIX OCTAL?
+ SNA CLA
+ TAD CHAR /YES-IS THE DIGIT GREATER THAN 7?
+ TAD (-"8
+ SMA CLA
+ JMP NUMBE3 /YES-ILLEGAL CHARACTER
+ TAD TEMP /NO-ADD IT TO THE PREVIOUS
+ CLL RAL /ACCUMULATED VALUE
+ CLL RAL
+ DCA TEMP2
+ TAD RADIX /IS RADIX OCTAL?
+ AND TEMP /NO
+ TAD TEMP2 /YES
+ CLL RAL
+ TAD CHAR
+ TAD (-"0
+ DCA TEMP
+ JMS I [GETC /GET NEXT CHARACTER
+NUMBE4, JMS I [TSTNUM /IS IT NUMERIC?
+ JMP NUMBE2 /YES-CONTINUE ACCUMULATING NUMBER
+ TAD TEMP /NO-STORE NUMBER
+NUMBE1, DCA VALUE2
+NUMBE5, TAD OP /GO COMBINE IT VIA LAST OPERATION
+ TAD (OPTABL
+ DCA TEMP /FIND THE OPERATOR HANDLER
+ TAD I TEMP
+ DCA TEMP
+ JMP I TEMP /GO TO THE HANDLER
+\f/8 OR 9 FOUND DURING OCTAL RADIX
+
+NUMBE3, JMS I [ICMESG /GENERATE IC ERROR MESSAGE AND
+ JMP NUMBE4 /IGNORE CHARACTER
+
+
+/HANDLER FOR .
+
+PERIOD, JMS I [GETC /GET NEXT CHARACTER
+ TAD LOC /MAKE CURRENT LOCATION
+ JMP NUMBE1 /INTO VALUE OF NUMBER
+
+/HANDLER FOR "
+
+QUOTE, ISZ TXTPTR
+ TAD I TXTPTR /GET CHARACTER FROM TEXT BUFFER
+ TAD [-215 /WAS IT CARRIAGE RETURN?
+ SNA CLA
+ JMP QUOTE1 /YES-IT IS IC-IGNORE "
+ TAD I TXTPTR /NO-PUT ASCII CODE INTO
+ DCA VALUE2 /VALUE WORD
+ JMS I [GETC /GET NEXT CHARACTER
+ JMP NUMBE5 /RETURN TO EXPRESSION PROCESSOR
+
+/CARRIAGE RETURN FOUND IN SINGLE CHARACTER TEXT
+
+QUOTE1, JMS I [ERROR /GENERATE IC ERROR MESSAGE
+ IC
+ CLA CMA
+ DCA CHAR
+ JMP I (EXPXIT
+ PAGE
+\f/COME HERE IF FIRST THING IN EXPRESSION IS ALPHA CHARACTER
+
+ALPHA1, JMS I [GETTAG /PICK UP TAG
+ DCA ALPHAI /STORE UNDEFINED INDICATOR
+ALPHA3, TAD TAG3 /IS IT A PSEUDO-OP?
+ SMA CLA
+ JMP .+3
+ JMS I [ERROR /YES-GENERATE IP ERROR MESSAGE
+ IP
+ ISZ ALPHAI /NO-WAS IT UNDEFINED?
+ JMP ALPHA0
+ ISZ UNDFSW /YES-SET UNDEFINED SWITCH
+ TAD PASS /IS THIS PASS 1?
+ SPA CLA
+ JMP ALPHA0 /YES-SUPPRESS ERROR MAESSAGE
+ JMS I [ERROR /NO-GENERATE US ERROR MESSAGE
+ US
+ALPHA0, TAD TAG2 /NO-WAS IT A MEMORY REFERENCE INSTRUCTION?
+ SPA CLA
+ TAD CHAR /YES-GET TERMINATING CHARACTER
+ TAD [-240 /WAS IT SPACE?
+ SZA CLA
+ JMP I (NUMBE5 /NOT MEMREF FOLLOWED BY SPACE
+ JMS I [SPNOR /YES-IGNORE SPACES
+ TAD CHAR
+ SPA CLA
+ JMP I (NUMBE5
+ TAD EXPIND /IS MEMORY REFERENCE INSTRUCTION OK?
+ SZA CLA
+ JMP I (NUMBE5 /NO-
+ DCA IZIND /YES-CLEAR I AND Z INDICATOR
+ TAD VALUE2 /STORE MRI ON PUSHDOWN LIST
+ JMS I [PUSHA
+\fALPHA6, TAD IZIND
+ JMS I [PUSHA /PUSH THE I AND Z INDICATOR
+ JMS I [TSTALP /WAS TERMINATING CHARACTER ALPHABETIC?
+ SKP
+ JMP ALPHA4 /NO-
+ JMS I [GETTAG /YES-PICK UP TAG
+ DCA ALPHAI /STORE UNDEFINED INDICATOR
+ AC2000
+ AND TAG1 /WAS IT AN I OR Z?
+ SNA CLA
+ JMP ALPHA5 /NO
+ TAD VALUE2 /YES-WAS IT I?
+ SNA
+ IAC /NO - SET LOW ORDER
+ TAD I PDLXR /GET OLD IZIND FROM PDL
+ DCA IZIND /SET NEW IZIND
+ JMS I [SPNOR /IGNORE SPACES
+ JMP ALPHA6
+
+EXPINT, TAD EXPIND
+ TAD [4000
+ DCA EXPIND
+ JMP ALPHA3
+
+ALPHA5, AC4000
+ALPHA4, IAC
+ JMS I [EXP /GET REST OF EXPRESSION
+ TAD I PDLXR /RETRIEVE MRI
+ DCA IZIND
+ TAD I PDLXR
+ DCA VALUE2
+ /FALL INTO NEXT PAGE
+\f/COMBINE ADDRESS WITH MEMORY REFERENCE INSTRUCTION
+
+ TAD VALUE /GET ADDRESS
+ AND [7600
+ SNA /IS IT PAGE 0?
+ JMP FIX4 /YES
+ CIA /NO-IS IT ON CURRENT PAGE?
+ TAD LOC
+ AND [7600
+ SNA CLA
+ JMP FIX2 /YES
+ TAD VALUE /NO-SET UP LINK
+ JMS I (FINDS
+ DCA VALUE
+ TAD FIXMD0 /SET ' IN LISTING
+ DCA LININD
+ ISZ LINK /BUMP NUMBER OF LINKS GENERATED
+FIXMD0, 0700 /PROTECTION FOR ISZ
+LGERR, SKP /JMS I PERROR IF /E SPECIFIED
+ LG
+ JMS ADDIND /SET INDIRECT BIT IN INSTRUCTION
+FIX2, TAD [200 /SET CURRENT PAGE BIT
+ TAD VALUE2
+ DCA VALUE2
+ TAD IZIND
+ AND [77 /WAS Z SPECIFIED?
+ SNA CLA
+ JMP FIX4 /NO
+ JMS I [ERROR /YES - ILLEGAL REFERENCE
+ IZ /TO PAGE 0
+FIX4, TAD IZIND /WAS THERE AN I?
+ AND [7700
+ SZA CLA
+ JMS ADDIND /YES - ADD INDIRECT BIT TO INSTRUCTION
+ TAD VALUE /GET ADDRESS
+ AND [177
+ TAD VALUE2 /GET OP CODE
+ DCA VALUE /STORE
+POPJ, TAD I PDLXR
+ DCA TEMP /POP A WORD OFF THE STACK
+ JMP I TEMP /JUMP THROUGH IT.
+\fADDIND, 0 /ROUTINE TO ADD INDIRECT BIT TO AN INSTR
+ TAD VALUE2
+ CMA
+ AND [400
+ SZA /WAS THERE ONE ALREADY?
+ JMP .+3 /NO
+ JMS I [ERROR /YES - ILLEGAL INDIRECT
+ II
+ TAD VALUE2
+ DCA VALUE2
+ JMP I ADDIND
+
+/ ALLOWS MULTIPLE NON-RESIDENT INPUT HANDLERS TO NOT BOMB
+
+PTCH, 0 /RUNS IN DF 10
+ TAD (7647 /POINT TO DEVICE
+ DCA PTR /HANDLER RESIDENCY TABLE
+ TAD [-17 /IT HAS 15 ENTRIES
+ DCA KNTR /V3C
+KLOOP, TAD I PTR /GET HANDLER ENTRY POINT
+ AND [7600 /LOOK AT PAGE IT'S ON
+ TAD [-INDEVH /IS IT ON THE PAGE WE PUT BUFFER OVER?
+ SNA CLA /WELL?
+ DCA I PTR /YES IT IS, WIPE IT FROM RESIDENCY
+ ISZ PTR /LOOK AT NEXT ENTRY
+ ISZ KNTR /ANY MORE ENTRIES?
+ JMP KLOOP /YES, MIGHT HAVE TO WIPE SEVERAL GUYS
+ TAD [200 /INCREASE INPUT BUFFER SIZE
+ JMP I PTCH /V3C
+ PAGE
+\f/COMBINE CURRENT VALUE WITH PREVIOUS VALUE
+/ACCORDING TO LAST OPERATOR
+
+OP0, TAD VALUE2 /HANDLER FOR +
+ TAD VALUE /** OP0+1 AND OP0+2 JUMPED TO **
+ DCA VALUE
+EXP3, TAD CHAR /GET LAST OPERATOR
+ TAD [-"+ /WAS IT A + OR - ?
+ CLL RTR
+ SNA
+ JMP PLSMIN /YES - LINK=0 FOR +, 1 FOR -
+ RTL
+ TAD ("+-"%
+ CLL RAR
+ SNA /IS THE CHAR % OR &?
+ JMP DIVAND /YES - LINK=0 FOR %, 1 FOR &
+ RAL
+ TAD ("%-240
+ CLL RAR
+ SNA /IS THE CHAR SPACE OR !?
+ JMP BLKEXP /YES - LINK=0 FOR SPACE, 1 FOR !
+ RAL
+ TAD (240-"^
+ SNA CLA /IS THE CHAR ^?
+ JMP MUL /YES - LINK IRRELEVANT
+ JMS I (ENDCHK /NO-SEE IF END OF LINE FOUND
+ JMP EXP3 /NO-TRY AGAIN
+EXPXIT, TAD UNDFSW /EXIT FROM EXP
+ SNA CLA /RESTORE EXIT POINT
+ JMP I (POPJ /--EXIT VIA POPJ--
+ CLA CMA
+ DCA UNDFSW /SET UNDEFINED SWITCH
+ DCA VALUE /RESULT IS 0
+ JMP I (POPJ /--EXIT VIA POPJ--
+\fMUL, CLL IAC /LINK DOESN'T COUNT FOR ^
+BLKEXP, IAC /** BLANK ASSUMED TO BE 4 ELSEWHERE **
+DIVAND, IAC
+PLSMIN, RAL
+ JMP I (EXP1 /GET REST OF EXPRESSION
+
+/HANDLER FOR &
+
+OP2, TAD VALUE
+ AND VALUE2
+ JMP OP0+2
+
+
+/HANDLER FOR ^
+/MULTIPLY BY REPEATED ADDITION
+
+OP4, TAD VALUE
+ CIA
+ DCA TEMP
+ TAD VALUE2
+ ISZ TEMP
+ JMP .-2
+ JMP OP0+2
+
+OP1, TAD VALUE2 /- OPERATOR
+ CIA
+ JMP I (OP0+1 /JUMP INTO ADD OPERATOR
+
+/OPTIONAL HANDLER FOR ! AS 6 BIT LEFT SHIFT AND THEN OR:
+
+OP3, TAD VALUE
+ JMS I [RTL6
+ AND [7700 /ISOLATE 6 BITS AND FALL INTO "OR"
+ DCA VALUE /V3C
+
+/HANDLER FOR ! AND SPACE AS INCLUSIVE OR
+
+OP5, TAD VALUE
+ CMA
+ AND VALUE2
+ JMP I (OP0+1
+\f/CHARACTER INPUT CHECK
+/ENTER WITH CHARACTER IN AC
+
+LSTCH9, SZA /IGNORE NULL (0)
+ TAD (-177
+ SZA /IGNORE RUBOUT (377)
+ TAD (177-13
+ SZA /IGNORE VERTICAL TAB (213)
+ IAC
+ SNA
+ JMP I (INPUT+1 /IGNORE LINE FEED (212)
+ TAD [12-32 /WAS IT ^Z (END-OF-FILE=232)?
+ SNA
+ JMP I (ENDCHR /YES - GET NEXT FILE
+ TAD (32-15 /NO - WAS IT CARRIAGE RETURN?
+ SNA
+ JMP LSTCHR /YES - LAST CHARACTER OF LINE
+ IAC /NO
+ SNA /WAS IT FORM FEED (214)?
+ JMP FORCHR /YES - HANDLER FORM FEED
+ ISZ I (INPUT
+ TAD (14+200
+ DCA LSTCH5 /STORE CHARACTER
+ TAD PASS /IS THIS PASS 3?
+ SPA SNA CLA
+ JMP LSTCH4 /NO -
+ ISZ LSTCH6 /YES - FILLING HEADER AREA?
+ JMP LSTCH3 /YES
+ CLA CMA /NO - RESET SWITCH
+ DCA LSTCH6
+LSTCH4, TAD I (INPUT
+ DCA TEMP
+ TAD LSTCH5 /GET CHARACTER IN AC
+ JMP I TEMP /-EXIT FROM INPUT-
+
+LSTCH3, ISZ LSTCH7 /FILLING HEADER
+ TAD LSTCH5 /STORE CHARACTER IN HEADER AREA
+ DCA I LSTCH7
+ JMP LSTCH4
+
+LSTCH5, 0
+LSTCH6, -HEDLEN
+LSTCH7, HEADER-1
+\fLSTCHR, TAD FORMSW /CARRIAGE RETURN WAS FOUND
+ SNA CLA /HAS THERE BEEN A FORM FEED?
+ JMP LSTCH1 /NO -
+ DCA FORMSW /YES - CLEAR FORM FEED SWITCH
+ ISZ EDITPG /GO TO NEXT EDITOR PAGE
+ DCA THISPG /CLEAR OVERFLOW PAGE
+ TAD PASS /IS THIS PASS 3?
+ SMA SZA CLA
+ JMS I [FORMFD /YES - GENERATE FORM FEED
+LSTCH1, TAD [215 /NO - CARRIAGE RETURN IS CHARACTER
+ DCA LSTCH5
+ JMP LSTCH4-2 /EXIT
+
+FORCHR, ISZ FORMSW /SET FORM FEED SWITCH
+ JMP I (INPUT+1 /GET ANOTHER CHARACTER
+
+FORMSW, 1
+ PAGE
+\f/ERROR MESSAGE OUTPUT
+
+DUMPS1,
+ERROR, 0
+ CLA
+ ISZ ERCNT /COUNT THE ERRORS
+ERPLUS, "+ /PROTECTION
+ TAD I ERROR /GET ERROR MESSAGE
+ ISZ ERROR /INCREMENT RETURN ADDRESS
+ JMS I [ERROR1 /OUTPUT 2 CHARACTER ERROR MESSAGE
+ TAD (JMP I [7600 /PUT EXIT TO MONITOR
+CSWIT1, DCA I (LSWITC /IN SWITCH - "CLA" IF /C
+ TAD PASS /IS THIS PASS 3?
+ SMA SZA CLA
+ JMP ERROR4 /YES - CARRIAGE RETURN/LINE FEED
+ JMS I [ERROR1 /NO - OUTPUT 2 SPACES
+ TAD [1777 /IS THERE A TAG SAVED?
+ AND LAST1
+ SNA
+ JMP ERROR3 /NO
+ JMS I (DIV45 /YES - OUTPUT FIRST 2 CHARACTERS
+ TAD LAST2 /OUTPUT SECOND 2 CHARACTERS
+ JMS I (DIV45
+ TAD LAST3
+ JMS I (DIV45 /OUTPUT THIRD 2 CHARACTERS
+ TAD LAST4 /IS ERROR LOCATION SAME AS LAST TAG?
+ CIA
+ TAD LOC
+ SNA CLA
+ JMP ERROR4 /YES - CARRIAGE RETURN
+ TAD ERPLUS
+ JMS I OERROR
+ TAD LAST4
+ CIA
+ERROR3, TAD LOC /OUTPUT 4 DIGIT ADDRESS OR INCREMENT
+ JMS I (OCTPRT
+ERROR4, TAD [215 /OUTPUT CARRIAGE RETURN/LINE FEED
+ JMS I OERROR
+ JMP I ERROR /--RETURN--
+\f/RESET LITERAL TABLES AND POINTERS
+
+DUMPS5,
+CLEAN, 0
+ TAD (LITBUF-1
+ DCA XREG1 /SET LITERAL TABLE POINTER
+ TAD (TPINST-1
+ DCA XREG2 /SET TOP INST. TABLE POINTER
+ TAD (-40
+ DCA TEMP
+ TAD [200
+ DCA I XREG1 /SET LITERAL TABLE ENTRIES TO 200
+ DCA I XREG2 /SET TOP INST. TABLE ENTRIES TO 0
+ ISZ TEMP
+ JMP .-4
+ DCA LAST1 /CLEAR LAST DEFINED TAG
+ JMP I CLEAN /--RETURN--
+
+/DUMP CURRENT PAGE LITERALS
+
+DUMPS, 0
+ JMS I [FINDSP
+ SNA /IF THIS IS PAGE 0,
+ JMP I DUMPS /--RETURN--
+ TAD [LITBUF
+ DCA DUMPS1
+ TAD LITPTR
+ CIA CLL
+ TAD I DUMPS1
+ DCA DUMPS2 /STORE NUMBER OF LITERALS ON THIS PAGE
+ SZL /ARE THERE ANY?
+ JMP D2 /V3C
+ DCA STARSW /FORCE ORIGIN PUNCH IF RELOC JUST INVOKED
+ TAD LOC
+ AND [7600
+ TAD I DUMPS1
+ JMS I [PUNORG /OUTPUT ORIGIN
+ TAD I DUMPS1
+ TAD [LITBF1
+DUMPS3, DCA DUMPS5
+ TAD I [LINBUF /SAVE LINBUF
+ JMS I [PUSHA
+ DCA I [LINBUF
+DUMPS6, TAD I DUMPS5
+ DCA VALUE
+JMSPUN, JMS I [PUNONE /OUTPUT ONE REGISTER
+ ISZ LOC
+ ISZ DUMPS5
+LITHAK, ISZ I DUMPS1 /DESTROY RECORD OF CURRENT PAGE LITERALS -
+ /ZEROED IF NO /W OPTION SPECIFIED
+ ISZ DUMPS2
+ JMP DUMPS6
+ TAD I PDLXR
+ DCA I [LINBUF /RESTORE LINBUF
+D2, TAD DUMPS1 /WIPE REMEMBRANCE OF TOP OF PAGE (JR)
+ TAD (40 /V3C
+ DCA DUMPS5
+D3, DCA I DUMPS5
+ JMP I DUMPS /--RETURN--
+\f/HANDLER FOR ZBLOCK PSEUDO-OP
+/RESERVES AS MANY WORDS OF ZERO
+/AS VALUE OF EXPRESSION
+
+ZBLOCX, JMS I [SPNOR /IGNORE SPACES
+ JMS I [EXP /GET THE EXPRESSION
+ TAD VALUE
+ CMA /PROTECT AGAINST ZERO CASE
+ DCA TEMP3 /STORE NEGATIVE AS COUNTER
+ JMP ZBLOCZ /JUMP INTO LOOP
+ZBLOCY, JMS I [PUNBIN /OUTPUT ONE WORD OF ZERO
+ TAD PASS /IS THIS PASS 3?
+ SMA SZA CLA
+ DCA I (PUNMOD /YES - PREVENT OUTPUT
+ZBLOCZ, ISZ TEMP3 /NO - DONE YET?
+ JMP ZBLOCY /NO - CONTINUE
+ TAD JMSPUN /YES - RESTORE PUNMOD
+ DCA I (PUNMOD
+ JMP I [LOOKEX /--EXIT TO MAIN--
+
+/DUMP PAGE 0 LITERALS
+
+DUMPS2,
+DUMPZ, 0
+ TAD DUMPZ /RESET EXIT FROM DUMPS
+ DCA DUMPS
+ TAD [200
+ CIA CLL
+ TAD I [LITBUF /STORE THE NUMBER OF LITERALS ON PAGE 0
+ DCA DUMPS2
+ SZL /ARE THERE ANY?
+ JMP I DUMPS /NO - ** DUMPZ IS DESTROYED **
+ TAD I [LITBUF
+ JMS I [PUNORG /OUTPUT ORIGIN
+ TAD I [LITBUF /SET VALUES FOR DUMPS
+ TAD (LITBF2
+ JMP DUMPS3
+ PAGE
+\f/ENTER A TAG INTO SYMBOL TABLE
+
+ IFZERO HASH<
+INSRTG, 0
+ TAD VALUE2 /SAVE VALUE 2
+ JMS I [PUSHA
+ ISZ HIGHTG /COUNT IN THIS TAG
+ TAD TAGMAX
+ CLL CIA /GET LIMIT OF SYMBOL STORAGE
+ TAD HIGHTG /IS THERE ROOM FOR ONE MORE?
+ SZL
+ JMP I (SYMOFL /NO - SE**FATAL ERROR**
+ TAD TAGMAX /YES - IS USR IN CORE?
+ TAD (-1340
+ SZL CLA
+ JMP GETTG5 /YES
+ TAD [7700 /NO - RESET ADDRESS TO
+ DCA IOMON /USR NON-RESIDENT
+ AC7776
+ AND I (JSBITS /RESET JOB STATUS WORD TO
+ DCA I (JSBITS /SAVE CORE WHEN USR CALLED
+GETTG5, TAD THISTG /SEARCH SYMBOL TABLE
+ DCA TEMP2
+ TAD HIGHTG
+ IAC
+ DCA THISTG
+GETTG8, AC7776
+ TAD THISTG
+ DCA THISTG
+ JMS I [FINDTG /GET NEXT TAG FROM SYMBOL TABLE
+ ISZ THISTG
+ TAD THISTG
+ CIA
+ TAD TEMP2 /DOES NEW TAG GO WHERE PREVIOUS TAG WAS?
+ SNA CLA
+ JMP GETTG9 /YES-PUT IT THERE AND EXIT
+ JMS I [PUTTAG /NO-REPLACE RETRIEVED TAG WHERE PREVIOUS TAG WAS
+ JMP GETTG8
+
+/THE ABOVE CODE WILL BE OPTIMIZED AT INITIALIZATION
+/IF THE ASSEMBLER IS TO BE RESTRICTED TO 8K OF CORE
+
+GETTG9, TAD I (NAME1 /GET CURRENT TAG
+ DCA TAG1 /PUT IT IN TAG1-TAG3
+ TAD I (NAME2
+ DCA TAG2
+ TAD I (NAME3
+ DCA TAG3
+ TAD I PDLXR /RESTORE VALUE 2
+ DCA VALUE2
+ JMS I [PUTTAG /PUT TAG1 - TAG3 INTO SYMBOL TABLE
+ JMP I INSRTG /--RETURN--
+
+TAGMAX, 1740 /12K=3740, ...
+ >
+
+/ IFNZRO HASH< /***HACK ONLY***
+/TLYREF, 0 /TALLY REFS TO SYMBOL TABLE
+/ ISZ NREFL
+/ JMP I TLYREF
+/ ISZ NREFH
+/ JMP I TLYREF
+/ JMP I TLYREF
+/TLYPRB, 0 /TALLY PROBES INTO TABLE
+/ JMS I [FINDTG /FUDGE, OUT OF ROOM
+/ ISZ NPROBL
+/ JMP I TLYPRB
+/ ISZ NPROBH
+/ JMP I TLYPRB
+/ JMP I TLYPRB
+/NREFH, 0
+/NREFL, 0
+/NPROBH, 0
+/NPROBL, 0
+/ > /***HACK ONLY***
+\f IFNZRO HASH<
+
+ /INSERT A TAG INTO THE HASH TABLE
+
+INSRTG, 0
+ ISZ HIGHTG /BUMP SYM NUM (SKIPS ON 0)
+ TAD HIGHTG
+ STL CMA
+ TAD TAGMAX
+ SNA SZL CLA /STILL ROOM FOR AT LEAST 2 MORE?
+ JMP I (SYMOFL /NO SE** FATAL ERROR**
+ TAD I (NAME1
+ DCA TAG1
+ TAD I (NAME2
+ DCA TAG2
+ TAD I (NAME3
+ DCA TAG3
+ JMS I [PUTTAG /NOW ACTUALLY INSERT IT
+ JMP I INSRTG
+ >
+\f/OUTPUT 2 CHARACTER WORD
+/FROM SYMBOL TABLE FORMAT
+/DIVIDE BY 45(8)
+
+DIV45, 0
+ RAL
+ CLL RAR /CLEAR SIGN BIT
+DIV45A, ISZ DIV45C
+ TAD (-45
+ SMA
+ JMP DIV45A
+ TAD (45
+ JMS DIV45E
+ DCA DIV45B
+ STA
+ TAD DIV45C
+ JMS DIV45E
+ JMS I [RTL6
+ TAD DIV45B
+ JMS I [ERROR1 /OUTPUT 2 CHARACTERS
+ DCA DIV45C /CLEAR DIV45C FOR NEXT GO-ROUND
+ JMP I DIV45 /--RETURN--
+
+DIV45B, 0
+DIV45C, 0 /** MUST BE 0 WHEN DIV45 IS ENTERED **
+
+DIV45E, 0
+ SNA
+ JMP I DIV45E
+ TAD (-33
+ SMA
+ TAD (20-40-33
+ TAD (33+40
+ JMP I DIV45E /--RETURN--
+\f/HANDLER FOR FIXTAB PSEUDO-OP
+
+FIXTBX, TAD PASS /IS THIS PASS 1?
+ SMA CLA
+ JMP I [LOOKEX /NO--EXIT TO MAIN--
+ JMP I (FIXTAY /YES--DO FIXTAB
+
+/SET FIELD
+
+SETFLD, 0
+ CLA CLL /SETFLD CALLED WITH AC RANDOM
+ DCA SETFL1 /INITIALIZE FIELD
+ IFNZRO HASH<
+ TAD USROFS /FUDGE FOR KEEPING USR AROUND
+ >
+ TAD THISTG
+SETFLP, ISZ SETFL1
+ CML
+ TAD (-1740 /PUT 1740 SYMBOLS IN EACH FIELD
+ SNL /IS THE DIVIDE THROUGH?
+ JMP SETFLP /NO - CONTINUE
+ IFZERO HASH<
+ CLL CMA RTL /AC CONTAINED REM-1740; THIS MAKES IT INTO
+ TAD (-1 /7573-4*REM WHICH IS THE ADDRESS WE WANT
+ >
+ IFNZRO HASH<
+ CLL RTL /AC GETS 0201 TO 7775
+ TAD (-202 /AC GETS 7777 TO 7573 FOR TAGXR
+ >
+ DCA TAGXR /TO STICK INTO AN AUTO-XR
+ TAD SETFL1
+ CLL RTL
+ RAL
+ TAD SETFL2
+ DCA SETFL1
+SETFL1, HLT
+ JMP I SETFLD /--RETURN--
+ IFNZRO HASH<
+USROFS, 0 /GETS 400 IF KEEPING USR
+ >
+\f/FIND TAG
+/GET TAG FROM SYMBOL TABLE
+/PUT IT INTO TAG1-TAG3
+/WITH ITS VALUE IN VALUE2
+
+FINDTG, 0
+ TAD THISTG
+ JMS SETFLD
+ TAD I TAGXR
+ DCA TAG1
+ TAD I TAGXR
+ DCA TAG2
+ TAD I TAGXR
+ DCA TAG3
+ TAD I TAGXR
+ DCA VALUE2
+SETFL2, CDF
+ JMP I FINDTG /--RETURN--
+
+/OPTIMIZATION MAY CHANGE SETFLD TO
+/REMOVE CLA ON ENTRY
+ PAGE
+\f/BEGINNING OF PASS CODE
+
+ JMS I (IOPEN /SET INPUT ROUTINE TO OPEN FILE
+START2, ISZ PASS /SET UP COUNTERS AND POINTERS
+ DCA XLISTX /CLEAR XLIST SWITCH
+ DCA FLDIND /SET FIELD TO 0
+ DCA CONDSW
+ DCA EDITPG
+ DCA LINK
+ DCA RADIX
+ DCA ERCNT
+ DCA GETCI
+ DCA PUNCHX
+ DCA I [LINBUF
+ TAD (PDLST
+ DCA PDLXR
+ JMS I [CLEAN
+ TAD [200
+ DCA LITPTR
+ TAD [200
+ JMS I [PUNORG
+ JMP I (LOOKE1 /--EXIT TO MAIN--
+
+/HANDLER FOR $
+
+ENDPAS, JMS I [DUMPS /DUMP CURRENT PAGE LITERALS
+ DCA OFSBUF /CLEAR OFFSET FOR NEXT PASS
+ TAD PASS /WHAT PASS IS ENDING?
+ SNA
+ JMP I (ENDPA2 /PASS 2
+ SPA CLA
+ JMP I (START1 /PASS 1
+ TAD I [LINBUF /PASS 3
+ SNA CLA /ANYTHING TO PRINT?
+ JMP ENDPA1-1 /NO
+ TAD [211 /YES - TAB OVER TWICE
+ JMS I OERROR
+ TAD [211
+ JMS I OERROR
+ JMS I [LINPRT /PRINT LINE
+ JMS I [DUMPZ /DUMP PAGE 0 LITERALS
+ENDPA1, DCA XLISTX
+/OUTPUT SYMBOL TABLE
+SSWITC, JMS I (SYMPRT /(0 IF /S)
+ TAD I (FORM21
+ DCA I (FORM22
+ JMS I [FORMFD /OUTPUT FORM FEED
+ERMSGS, TAD ERCNT
+ JMS OUTTTL /PRINT "ERRORS DETECTED: N"
+ TAD LINK
+ JMS OUTTTL /PRINT "LINKS GENERATED: N"
+FINLFF, JMS I [FORMFD /PRINT FINAL FF (ZEROED IF NO PASS 3)
+ JMS I (OCLOSE /AND CLOSE THE OUTPUT FILE
+\f/CREF AND LOAD-AND-GO OPTIONS
+/****FINAL EXIT TO MONITOR****
+LSWITC, JMP I [7605 /0 IF /L OR /G OR /C
+ TAD (7616
+ DCA XREG1
+ CDF 10
+CSWITC, TAD I [7600 /"TAD I [7605" IF /C
+ AND [17
+ DCA I XREG1 /SET BINARY DEVICE
+ TAD BINSRT
+
+/EXIT FROM PAL8 BY CHAINING
+/TO NEXT PROGRAM
+/SHOULD BE ABSLDR OR CREF
+
+ DCA I XREG1 /SET STARTING BLOCK
+ DCA I XREG1 /SET 0 TERMINATOR
+ CDF
+ TAD I (JSBITS /SET BIT 11 OF JOB STATUS WORD
+ RAR /SO 10000-11777 IS NOT SAVED
+ CLL CML RAL
+ DCA I (JSBITS
+ CIF 10
+ JMS I IOMON /CALL USER SERVICE ROUTINES
+ 6 /*CHAIN TO NEXT PROGRAM*
+CHAIN, 0 /STARTING BLOCK OF NEXT PROGRAM
+
+OUTTTL, 0
+ DCA LAST1 /SAVE NUMBER TO BE PRINTED
+OUTTLL, TAD I TTLPTR /GET A WORD OF MESSAGE
+ ISZ TTLPTR
+ SNA /END?
+ JMP PRTTTL /YES
+ JMS I [ERROR1 /NO - PRINT IT
+ JMP OUTTLL /AND LOOP
+PRTTTL, TAD [240 /PRINT A SPACE
+ JMS I OCHAR
+ TAD LAST1
+ JMS I (FORMF4 /PRINT NUMBER IN DECIMAL
+ JMS I (CRLF /PRINT CR AND 2 LF'S (1 IF PASS 3)
+ JMP I OUTTTL /AND RETURN
+
+TTLPTR, TTLMSG
+\f/COME HERE TO LOAD THE PASS 3 OVERLAY AT THE END OF PASS 2
+
+LOADOV, JMS I (7607 /CALL SYSTEM DEVICE HANDLER
+ 0200 /SWAP IN CODE UNIQUE TO PASS 3
+ SWAP1 /BUFFER ADDRESS
+ ASWAP /STARTING BLOCK NUMBER
+ JMP I (SYSER3 /DE**FATAL ERROR**
+NSWITC, JMP START2 /(0 IF NO LIST FILE, SKP IF /N) START PASS3
+ JMP ERMSG1
+ JMP ENDPA1
+
+ERMSG1, TAD (OTYPEO /COME HERE IF NO PASS 3 OUTPUT FILE
+ DCA OCHAR
+ TAD (OTYPEO
+ DCA OERROR
+ TAD [7600
+ DCA I (OTYPCR /INHIBIT AUTO-LF ON CARRIAGE RETURN
+ DCA FINLFF /KILL LAST FORM FEED
+ JMP ERMSGS
+
+/ADD BITS TO PUNCH ORIGIN
+
+PUNORG, 0
+ DCA LOC
+ TAD PASS /IS THIS PASS 2?
+ SZA CLA
+ JMP I PUNORG /NO--RETURN--
+ TAD LOC /YES - OUTPUT ORIGIN SETTING
+ TAD OFFSET /"LOC" MAY BE FICTITIOUS - MAKE IT REAL
+ CLL CML
+ ISZ STARSW /INHIBIT PUNCHING ORIGIN IF NECESSARY
+ JMS I [PUNOUT
+ CLA
+ DCA STARSW /RESET SWITCH
+ JMP I PUNORG /--RETURN--
+ PAGE
+\f\f/EVALUATE LITERAL
+
+LIT, STA RAL /-2 IF PAGE 0 LITERAL, -1 IF CUR PAGE
+ DCA FINDS1 /SAVE FLAG
+ JMS I [GETC /GET NEXT CHARACTER
+ JMS I [SPNOR /IGNORE SPACES
+ TAD EXPIND /STORE IMPORTANT VALUES PRIOR TO
+ JMS I [PUSHA /ENTRANCE INTO EXP
+ TAD OP
+ JMS I [PUSHA
+ TAD VALUE
+ JMS I [PUSHA
+ TAD FINDS1
+ JMS I [PUSHA
+ JMS I [EXP /GET EXPRESSION
+ TAD VALUE /FIND LITERAL IN TABLE
+ ISZ I PDLXR /PAGE 0?
+ JMP .+3
+ JMS FINDS /NO
+ SKP
+ JMS FIND0 /YES
+ DCA VALUE2 /STORE ADDRESS
+ TAD I PDLXR
+ DCA VALUE
+ TAD I PDLXR /RESTORE SAVED VALUES
+ DCA OP
+ TAD I PDLXR
+ DCA EXPIND
+ TAD CHAR /IGNORE ) OR ]
+ TAD (-")
+ SZA
+ TAD (")-"]
+ SNA CLA
+ JMS I [GETC /GET NEXT CHARACTER
+ JMP I (NUMBE5 /RETURN TO EXPRESSION PROCESSOR
+
+
+PEZE, 0 /SUBR TO ISSUE PE OR ZE MESSAGE
+ SNA CLA /WHICH ONE?
+ JMP .+4 /PAGE 0
+ JMS I PERROR
+ PE
+ JMP I PEZE
+ JMS I PERROR
+ ZE
+ JMP I PEZE
+\f/FIND LITERAL ON CURRENT PAGE
+
+FINDS, 0
+ DCA FINDS1
+ TAD LOC
+ AND [7600
+ SNA /IS THIS PAGE 0?
+ JMP FIND01 /YES
+ DCA FINDS2 /NO - SAVE PAGE NUMBER
+ TAD [LITBF1
+ DCA FIND0
+ TAD [7700 /ALLOW 100(8) CURRENT PAGE LITERALS
+ DCA FORMF6
+ TAD LITPTR /GET PG ADDR OF 1ST LITERAL IN BUFFER
+FIND02, DCA FINDS3
+ TAD FINDS2
+ JMS I [RTL6
+ TAD [LITBUF
+ DCA TEMP
+ TAD FIND0 /COMPUTE ACTUAL CORE ADDRESS OF LITERAL
+ TAD I TEMP
+ DCA TEMP2
+ TAD FINDS3 /COMPUTE THE NUMBER OF ENTRIES
+ CIA
+ TAD I TEMP /IN THE LITERAL BUFFER
+ SNA
+ JMP FINDS6 /NONE
+ DCA FINDS3
+FINDS4, TAD I TEMP2 /GET LITERAL FROM TABLE
+ CIA
+ TAD FINDS1 /AND CURRENT LITERAL
+ SNA CLA /DO THEY MATCH?
+ JMP FINDS5 /YES
+ ISZ TEMP2 /NO - BUMP COUNTERS
+ ISZ FINDS3
+ JMP FINDS4 /TRY AGAIN
+FINDS6, TAD FINDS2
+ JMS I [RTL6
+ TAD [TPINST
+ DCA FINDS3
+ TAD I TEMP /DOES THIS OVERFLOW PAGE?
+ CIA
+ TAD I FINDS3
+ SPA CLA
+ JMP FINDS7 /NO
+
+\fFIND03, TAD FINDS2 /PAGE FULL - WHICH PAGE?
+ JMS PEZE /GENERATE PE OR ZE MESSAGE
+ CLA CMA
+ JMP FINDS9
+FINDS7, CLA CMA
+ TAD I TEMP /IS PAGE FULL?
+ AND FORMF6
+ SNA CLA
+ JMP FIND03 /YES - OUTPUT ERROR MESSAGE
+ CLA CMA
+ TAD I TEMP /NO
+ DCA I TEMP
+FINDS9, TAD I TEMP
+ TAD FIND0
+ DCA TEMP2
+ TAD FINDS1
+ DCA I TEMP2
+FINDS5, TAD FIND0 /GET ADDRESS OF LITERAL
+ CIA
+ TAD TEMP2
+ TAD FINDS2
+ JMP I FINDS /--RETURN--
+
+
+/FIND LITERAL ON PAGE 0
+
+FIND0, 0
+ DCA FINDS1
+ TAD FIND0 /RESET EXIT FROM FINDS
+ DCA FINDS
+FIND01, DCA FINDS2 /SET POINTERS
+ TAD (LITBF2
+ DCA FIND0
+ TAD [7760 /ALLOW 160(8) PAGE 0 LITERALS
+ DCA FORMF6
+ TAD [200
+ JMP FIND02
+
+FINDS1, 0
+FINDS2, 0
+FINDS3, 0
+ PAGE
+\f/HANDLER FOR IFZERO PSEUDO-OP
+
+IF0, TAD (10 /IFTST1, SNA CLA
+
+/HANDLER FOR IFNZERO PSEUDO-OP
+
+IFN0, TAD IFSZA /IFTST1, SZA CLA
+ DCA IFTST1
+ JMS I [SPNOR /IGNORE SPACES
+ JMS I [EXP /GET EXPRESSION
+IFTST3, TAD CHAR /GET LAST CHARACTER
+ TAD (-"<
+ SNA CLA /IS IT <?
+ JMP IFTST2 /YES
+ JMS ICMESG /PRINT IC MESSAGE AND GET NEXT CHAR
+IFTST9, JMS I [SPNOR /IGNORE SPACES
+ JMP IFTST3 /TRY AGAIN
+
+IFTST2, JMS I [GETC /GET NEXT CHARACTER
+ TAD CONDSW
+ CIA
+ DCA CONDTM /SET NUMBER OF NESTED CONDITIONALS
+ CLA CMA /DECREMENT NUMBER OF NESTED CONDITIONALS
+ TAD CONDSW
+ DCA CONDSW
+ TAD VALUE
+IFTST1, HLT /SZA CLA OR SNA CLA
+ JMP I (MAIN /--EXIT TO MAIN--
+IFTST5, TAD CONDSW /DONE WITH ALL CONDITIONALS IN NEST?
+ TAD CONDTM
+ SMA CLA
+ JMP I (MAIN /YES --EXIT TO MAIN--
+ TAD CHAR
+ TAD (-"< /NO - GET NEXT CHARACTER
+ SNA /IS IT <?
+ JMP IFTST6 /YES - HANDLE NEXT CONDITIONAL
+ TAD ("<-"> /NO - IS IT >?
+IFSZA, SZA CLA
+ JMP IFTST4 /NO - FINISH THIS CONDITIONAL
+ AC7776
+IFTST6, CMA
+ TAD CONDSW
+ DCA CONDSW
+IFTST4, DCA I [LINBUF /INHIBIT LISTING OF UNASSEMBLED CODE -
+ /ZEROED IF /J OPTION NOT SPECIFIED
+ JMS I [GETC /GET NEXT CHARACTER
+ JMP IFTST5
+\f/HANDLER FOR IFDEF PSEUDO-OP
+
+IFD, TAD (10 /IFTST1, SNA CLA
+
+/HANDLER FOR IFNDEF PSEUDO-OP
+
+IFND, TAD IFSZA /IFTST1, SZA CLA
+ DCA IFTST1
+IFTST7, JMS I [SPNOR /IGNORE SPACES
+ JMS I [TSTALP /IS NEXT CHARACTER ALPHABETIC
+ JMP IFTST8 /YES
+ JMS ICMESG /PRINT IC MESSAGE AND GET NEXT CHAR
+ JMP IFTST7 /KEEP TRYING
+
+IFTST8, JMS I [GETTAG /PICK UP TAG
+ DCA VALUE /STORE UNDEFINED INDICATOR
+ TAD TAG3 /WAS IT A PSEUDO-OP?
+ SMA CLA
+ JMP IFTST9 /NO
+ JMS I [ERROR /YES - GENERATE IP ERROR MESSAGE
+ IP
+ JMP IFTST9
+
+ICMESG, 0
+ JMS I [ERROR
+ IC /IC COMES OUT ON ALL PASSES
+ TAD CHAR
+ SPA CLA
+ JMP I [LOOKEX /END OF LINE - GO AWAY
+ JMS I [GETC /GET NEXT CHAR
+ JMP I ICMESG
+\fCONDTM,
+
+/PUT TAG IN SYMBOL TABLE
+
+PUTTAG, 0
+ TAD THISTG
+ JMS I (SETFLD /SET FIELD
+ TAD TAG1
+ DCA I TAGXR
+ TAD TAG2
+ DCA I TAGXR
+ TAD TAG3
+ DCA I TAGXR
+ TAD VALUE2
+ DCA I TAGXR
+ CDF
+ JMP I PUTTAG /--RETURN--
+
+
+/PUSHDOWN ROUTINE
+/PUT NEW ENTRY ON PUSHDOWN STACK
+
+PUSHA, 0
+ DCA TEMP
+ CLA CMA
+ TAD PDLXR
+ DCA PDLXR
+ TAD PDLXR
+ TAD (-PDLND
+ SPA CLA /IS LIST TOO FULL?
+ JMP PUSHA1 /BE**FATAL ERROR**
+ TAD TEMP /NO - MAKE ENTRY
+ DCA I PDLXR
+ CLA CMA
+ TAD PDLXR
+ DCA PDLXR
+ JMP I PUSHA /--RETURN--
+
+PUSHA1, TAD (BE
+ JMP I [MONERR /PUSHDOWN OVERFLOW IS FATAL ERROR
+\f/TEST NUMERIC ROUTINE
+/CALL WITH CHARACTER TO TEST IN "CHAR"
+/SKIPS IF THE CHARACTER IS NOT NUMERIC
+
+TSTNUM, 0
+ TAD CHAR /GET THE CHARACTER
+ TAD (-"9-1
+ CLL
+ TAD ("9-"0+1
+ SNL CLA /CHECK FOR RANGE 0-9
+ ISZ TSTNUM /OUT OF RANGE
+ JMP I TSTNUM /--RETURN--
+
+/TEST ALPHANUMERIC ROUTINE
+/CALL WITH CHARACTER IN "CHAR"
+/SKIPS IF CHARACTER IS NOT ALPHANUMERIC
+
+TSTALN, 0
+ JMS I [TSTNUM /IS IT NUMERIC
+ JMP I TSTALN /YES--RETURN--
+ JMS I [TSTALP /IS IT ALPHABETIC
+ JMP I TSTALN /YES--RETURN--
+ ISZ TSTALN /NEITHER
+ JMP I TSTALN /--RETURN--
+
+/TEST ALPHABETIC ROUTINE
+/CALL WITH CHARACTER IN "CHAR"
+/SKIPS IF NOT ALPHABETIC
+
+TSTALP, 0
+ TAD CHAR
+ TAD (-"Z-1
+ CLL
+ TAD ("Z-"A+1
+ SNL CLA /CHECK FOR RANGE A-Z
+ ISZ TSTALP /OUT OF RANGE
+ JMP I TSTALP /--RETURN--
+ PAGE
+\f/INPUT ROUTINE
+/UNPACKS CHARACTERS FROM BUFFER
+
+INPUT, 0
+ ISZ INCHCT /ARE THERE CHARACTERS LEFT IN BUFFER?
+ JMP I CHARLV /YES - FETCH ONE
+ TAD INEOF /NO - WAS OLD FILE ENDED?
+ SZA CLA
+ JMP ENDCHR /YES - START NEW FILE
+INGBUF, TAD INCTLA /NO
+ AND [7600
+ JMS I [RTL6
+ TAD INCTR
+ SNL
+ DCA INCTR
+ SZL
+ ISZ INEOF
+ CLL CML CMA RTR /SET CONTROL WORD
+ RTR
+ RTR
+ TAD INCTLA
+ DCA INCTLW
+ JMS I INHNDL /CALL INPUT DEVICE HANDLER
+INCTLW, 0 /CONTROL WORD
+INBUFP, INBUF /INPUT BUFFER ADDRESS
+INREC, 0 /STARTING BLOCK NUMBER
+ JMP INERRX /ERROR RETURN
+INBREC, TAD INCTLA /NORMAL RETURN
+ AND [7600
+ JMS I [RTL6
+ TAD INREC
+ DCA INREC /RESET STARTING BLOCK NUMBER
+ TAD INCTLW
+ AND [7600
+ CLL RAL
+ TAD INCTLW
+ AND [7600
+ CIA
+ DCA INCHCT /SET CHARACTER COUNT
+ TAD INBUFP
+ DCA INPTR /SET BUFFER POINTER
+\f/CHARACTERS ARE FOUND IN BUFFER
+/IN STANDARD OS/8 PACKING
+/WORD 1: AAA A11 111 111
+/WORD 2: BBB B22 222 222
+/WHICH REPRESENTS 3 CHARACTERS
+/CHARACTER 1: 11 111 111
+/CHARACTER 2: 22 222 222
+/CHARACTER 3: AA AAB BBB
+
+
+ICHAR1, TAD I INPTR /PICK UP CHARACTER WORD 1
+ JMS CHARLV /CHECK RIGHT 8 BITS
+ICHAR2, TAD I INPTR /PICK UP WORD 1
+ ISZ INPTR /(INCREMENT POINTER TO WORD 2)
+ AND [7400 /WITH WORD 1 IN AC
+ DCA INCTLW /RETRIEVE LEFT 4 BITS AND SAVE
+ TAD I INPTR /PICK UP WORD 2
+ JMS CHARLV /CHECK RIGHT 8 BITS
+ICHAR3, TAD I INPTR /PICK UP WORD 2
+ ISZ INPTR /(POINT TO NEXT WORD 1)
+ AND [7400 /WITH WORD 2 IN AC
+ CLL RTR /RETRIEVE LEFT 4 BITS
+ RTR
+ TAD INCTLW /PUT BOTH SETS OF 4 BITS TOGETHER
+ RTR
+ RTR
+ JMS CHARLV /CHECK CHARACTER
+ JMP ICHAR1 /TRY NEXT SET OF 2 WORDS
+
+INERRX, ISZ INEOF
+ SMA CLA /EOF OR FATAL ERROR?
+ JMP INBREC /EOF - UNPACK THIS BUFFER
+ JMP I (SYSERR /FATAL - GENERATE DE ERROR MESSAGE
+
+INCHCT, -1
+INEOF, 1
+INPTR, 0
+INCTR, 0
+INCTLA, 0
+INFPTR, 7617
+\f/START NEW FILE
+
+ENDCHR, ISZ I (FORMSW /^Z OR EOF SIMULATES FORM FEED
+ TAD PASS /IS THIS PASS 3?
+ SPA SNA CLA
+ JMP NXTFLE /NO
+ JMS I (HEDCLR /YES - CLEAR HEADING BUFFER
+ TAD [-HEDLEN
+ DCA I (LSTCH6
+ TAD [HEADER-1
+ DCA I (LSTCH7
+ DCA LSTCNT
+NXTFLE, TAD (INDEVH+1 /SET ADDRESS OF DEVICE HANDLER
+ DCA INHNDL
+ CDF 10
+ TAD I INFPTR
+ CDF
+ SNA
+ JMP FAKDLR /END OF FILE - FAKE A $
+ CIF 10
+ JMS I IOMON /CALL USER SERVICE ROUTINES
+ 1 /*FETCH HANDLER*
+INHNDL, 0 /LOADING ADDRESS OF HANDLER
+ HLT /ERROR RETURN
+ CDF 10 /V3C
+ TAD INHNDL /NORMAL RETURN - HANDLER IN CORE
+ AND [7600
+ TAD [-INDEVH /SEE IF INPUT HANDLER IS IN 7200
+ SZA CLA
+ JMS I (PTCH /IT IS - INCREASE SIZE OF BUFFER
+ /AND REMOVE FROM RESIDENCY ANY HANDLERS THERE
+ TAD INCTL
+ DCA INCTLA /DF=10
+ TAD I INFPTR
+ AND [7760
+ SZA
+ TAD [17
+ CLL CML RTR
+ RTR
+ DCA INCTR
+ ISZ INFPTR
+ TAD I INFPTR
+ DCA INREC /RESET STARTING BLOCK NUMBER
+ ISZ INFPTR
+ DCA INEOF
+ CDF
+ JMP INGBUF
+\fFAKDLR, TAD (244
+ JMS CHARLV /CALL THE COROUTINE
+ TAD [215 /WITH $ AND CR
+ JMS CHARLV /TO END THE ASSEMBLY.
+ JMP I (PHASE /** DIDN'T WORK - MUST BE IN CONDITIONAL - FATAL
+
+CHARLV, 0 /CHARACTER IN AC
+ AND [177 /AND OFF LEFT 5 BITS
+ JMP I (LSTCH9 /RETURN TO LSTCH9
+ PAGE
+\f/HANDLER FOR DTORG PSEUDO-OP (TYPESETTING)
+/PUNCHES 4 DIGIT BLOCK NUMBER IN 2 FRAMES
+/FIRST FRAME HAS CHANNELS 7 AND 8 PUNCHED
+/ADDED TO CHECKSUM
+
+DTORGX, JMS I [SPNOR /IGNORE SPACES
+ JMS I [EXP /GET EXPRESSION
+ TAD PASS /IS THIS PASS 2?
+ SNA
+ JMP DTORG2 /YES
+PUNVA1, SPA SNA CLA /NO - IS THIS PASS 3?
+ JMP I [LOOKEX /NO--EXIT TO MAIN--
+ TAD LININD /GET LINK SWITCH FROM "EXP"
+ DCA LINKSW /YES
+ TAD [LOOKEX /FIX PUNONE TO EXIT TO MAIN
+ DCA I (PUNONE
+ TAD [211 /OUTPUT TAB
+ JMS I OERROR
+ JMP I (DTORG1
+
+DTORG2, TAD VALUE /PASS 2 - GET BLOCK NUMBER
+ JMS I [RTL6
+ RAL
+ AND [77
+ TAD (300 /PICK UP CHANNELS 7 AND 8
+ DCA TEMP
+ TAD TEMP
+ TAD CHKSUM /ADD VALUE TO CHECKSUM
+ DCA CHKSUM
+ TAD TEMP
+ JMS I OCHAR /OUTPUT BLOCK NUMBER - FIRST FRAME
+ TAD VALUE
+ AND [77
+ JMS I OCHAR /OUTPUT SECOND FRAME
+ JMP I [LOOKEX /--EXIT TO MAIN--
+
+/HANDLER FOR %
+/DIVIDE BY REPEATED SUBTRACTION
+
+OP6, DCA TEMP
+ TAD VALUE2
+ CIA
+ DCA VALUE2
+ TAD VALUE
+OP6A, CLL
+ TAD VALUE2 /SUBTRACT DIVISOR FROM DIVIDEND
+ SNL /DONE YET?
+ JMP OP6B /YES - EXIT
+ ISZ TEMP /NO - COUNT ONE MORE SUBTRACTION
+ JMP OP6A /SUBTRACT AGAIN
+OP6B, CLA
+ TAD TEMP /RESULT IS # OF SUBTRACTIONS
+ JMP I (OP0+2
+\f/HANDLER FOR XLIST PSEUDO-OP
+
+XLISTY, JMS XLISTZ /ANY EXPRESSION?
+ JMP XLIST1 /NO
+ JMS I [EXP /GET EXPRESSION
+ TAD VALUE /USE THE VALUE
+XLIST2, DCA XLISTX /SET SWITCH
+ DCA I [LINBUF /XLIST NEVER LISTS!
+ JMP I [LOOKEX /--EXIT TO MAIN--
+
+XLIST1, TAD XLISTX
+ SNA CLA
+ IAC /FLIP IT
+ JMP XLIST2
+
+RELOCY, JMS XLISTZ /RELOCATE PSEUDO-OP - EXPRESSION?
+ JMP RELOC1 /NO
+ JMS I [EXP /GET IT
+ TAD VALUE
+ CIA /COMPUTE OFFSET OF REL LOC CTR
+ TAD LOC /FROM FAKE LOC CTR
+ TAD OFFSET /OFFSET IS CUMULATIVE!
+RELOC2, DCA OFSBUF /SET NEW OFFSET - THIS TAKES EFFECT AFTER
+ STA /THE LITERALS (IF ANY) ARE DUMPED.
+ JMP I (STAR0 /FAKE ORIGIN TO NEW LOC,
+ /ACTUALLY A NO-OP BECAUSE OF OFFSET
+RELOC1, TAD OFFSET /SET OFSBUF=0, LOC=LOC+OFFSET -
+ TAD LOC /THIS CANCELS ALL RELOCATION STUFF.
+ DCA VALUE
+ DCA UNDFSW /JUST IN CASE - "STAR0" CHECKS THIS
+ JMP RELOC2 /STILL MUST OUTPUT *. TO GET IN SYNCH
+\f/HANDLER FOR EJECT PSEUDO-OP
+
+EJECTX, ISZ THISPG
+ TAD PASS /IS THIS PASS 3?
+ SMA SZA CLA
+ JMP EJECT2 /YES
+EJECT1, TAD CHAR /NO - LOOK FOR NEXT NEGATIVE CHARACTER
+ SPA CLA
+ JMP I [LOOKEX /--EXIT TO MAIN--
+ JMS I [GETC /GET NEXT CHARACTER
+ JMP EJECT1
+
+EJECT2, JMS XLISTZ /PASS 3 - IS THERE AN EXPRESSION?
+ JMP EJECT3 /NO - EXIT
+ JMS I (HEDCLR /YES - CLEAR HEADING BUFFER
+ TAD [-HEDLEN
+ DCA EJECT7 /SET UP FOR 40 NEW CHARACTERS
+ TAD [HEADER-1
+ DCA XREG1 /SET HEADER BUFFER POINTER
+ JMP EJECT4
+
+EJECT6, ISZ EJECT7 /FILLED 40 CHARACTERS YET?
+ JMP EJECT4 /NO - KEEP FILLING
+ CLA CMA /YES - SKIP CHARACTERS TO
+ DCA EJECT7 /END OF LINE
+ JMP EJECT5
+
+EJECT4, TAD CHAR /FILL HEADING BUFFER
+ DCA I XREG1
+EJECT5, CLA CMA
+ DCA TXTSWT
+ JMS I [GETC /GET NEXT CHARACTER
+ TAD CHAR /END OF LINE?
+ SMA CLA
+ JMP EJECT6 /NO - KEEP FILLING
+EJECT3, JMS I [FORMFD /GENERATE FORM FEED
+ JMP I [LOOKEX /--EXIT TO MAIN--
+\fPUNVAL, TAD PASS /IS THIS PASS 3?
+ JMP PUNVA1 /IF SO, LIST STUFF
+
+
+/SEE IF EXPRESSION FOLLOWS XLIST
+/SKIP ON EXPRESSION
+
+EJECT7,
+XLISTZ, 0
+ JMS I [SPNOR /IGNORE TRAILING SPACES
+ TAD CHAR
+ TAD [-"> /IS THERE AN EXPRESSION?
+ SNA CLA
+ JMP I XLISTZ /NO--RETURN--
+ TAD CHAR
+ SMA CLA
+ ISZ XLISTZ /YES - INCREMENT RETURN ADDRESS
+ JMP I XLISTZ /--RETURN--
+
+
+/DUMMY ERROR ROUTINE
+/TO SUPPRESS CERTAIN ERROR MESSAGES
+/ON PASS 1
+
+PERRO1, 0
+ ISZ PERRO1 /SKIP ERROR MESSAGE POINTER
+ JMP I PERRO1 /--RETURN--
+
+
+/CONSTANTS FOR DECIMAL PRINT
+
+ DECIMAL
+FORMF8, -1000
+ -100
+ -10
+ 0
+ OCTAL
+ PAGE
+\f/*********************************************************************
+
+INBUF=. /INPUT BUFFER
+
+OUBUF=. /OUTPUT BUFFER
+
+OUDEVH=.+400 /OUTPUT DEVICE HANDLER
+
+INDEVH=7200 /INPUT DEVICE HANDLER
+
+/**********************************************************************
+
+/ EXPLANATION OF PAL8'S BUFFER ALLOCATION ALGORITHM
+
+/PASS1:
+
+/ THE INPUT BUFFER STARTS AT 5600 AND ENDS AT 7200
+/ THE INPUT HANDLER GOES IN 7200-7600.
+/ THERE IS NO OUTPUT HANDLER.
+/ HOWEVER, IF THE CURRENT INPUT HANDLER DOES NOT
+/ LOAD INTO 7200, THEN THE BUFFER SIZE IS INCREASED
+/ SO THAT THE INPUT BUFFER IS 5600-7600
+
+/PASS2 AND PASS3:
+
+/ THE OUTPUT BUFFER IS ALWAYS 1 BLOCK LONG, LOCATED
+/ AT 5600-6200.
+/ THE OUTPUT HANDLER RESIDES IN 6200-6600.
+/ THE INPUT HANDLER RESIDES IN 7200-7600.
+/ THE INPUT BUFFER NORMALLY RESIDES IN 6600-7200
+/ BUT MAY GROW OVER EITHER THE INPUT HANDLER AREA OR
+/ THE OUTPUT HANDLER AREA, IF EITHER OR BOTH OF THESE
+/ DON'T EXIST.
+
+/WHENEVER A BUFFER GROWS OVER A HANDLER AREA, THE MONITOR
+/HANDLER RESIDENCY TABLE IS SEARCHED TO SEE IF THERE
+/WERE ANY HANDLERS THERE. IF ANY HANDLERS WERE THERE IN THE PAST,
+/THEY ARE NOW MARKED AS BEING NON-RESIDENT.
+\f/MORE ONCE ONLY CODE
+
+OTYPE, 0
+ DCA TEMP
+ CDF 10
+ TAD I TEMP
+ AND [17 /GET DEVICE NUMBER
+ TAD (DCB-1
+ DCA TEMP
+ TAD I TEMP /GET DCB ENTRY
+ CDF
+ JMP I OTYPE /--RETURN--
+
+/CHECK TO SEE HOW MUCH CORE EXISTS
+/AND STORE SYMBOL TABLE ACCORDINGLY
+
+ IFZERO HASH<
+BEGINF, CDF 10 /WAS THE /K OPTION SELECTED TO
+ TAD I (MPARAM /CHECK FOR MORE THAN 8K?
+ CDF 0
+ RTR
+ZK7630, SNL CLA /YES
+ JMP I (CKBAT /NO - CHECK FOR BATCH, USE 8K ONLY
+ CDF 50
+ JMS FLD2 /WHAT IS HIGHEST FIELD?
+ JMP FLD1-1 /5
+ CDF 40
+ JMS FLD2
+ JMP FLD1 /4
+ CDF 30
+ JMS FLD2
+ JMP FLD1+1 /3
+ CDF 20
+ JMS FLD2
+ JMP FLD1+2 /2
+ JMP OPTIM4 /1
+\f TAD [177 /IF FIELD 5, ALLOW 4095 SYMBOLS
+FLD1, TAD (1740 /OTHERWISE ALLOW 1740*(NR OF FIELDS)
+ TAD (1740
+ TAD (1740
+OPTIM0, TAD (1740
+ DCA I (TAGMAX /SET HIGHEST ADDRESS FOR TAGS
+ JMP I (BEGING
+
+OPTIM4, TAD I OPTIM1 /OPTIMIZE SEARCH PATTERN
+ ISZ OPTIM1 /BY SUBSTITUTING CODE IN SEARCH
+ DCA I OPTIM2 /ROUTINE
+ ISZ OPTIM2
+ ISZ OPTIM3
+ JMP OPTIM4
+OPTIM8, TAD I OPTIM5
+ ISZ OPTIM5
+ DCA I OPTIM6
+ ISZ OPTIM6
+ ISZ OPTIM7
+ JMP OPTIM8
+ JMP OPTIM0
+ >
+
+ IFNZRO HASH<
+ /SIZE CHECK OUR MACHINE
+
+BEGINF, CDF 10
+ TAD I (MPARAM
+ CDF
+ RTR /K TO LINK
+ZK7630, SNL CLA /ALTER FOR COMPLEMENT OF K
+ TAD [400 /TAD TO KEEP USR
+ DCA I (USROFS
+ CDF 50
+ JMS FLD2
+ ISZ HIFLD
+ CDF 40
+ JMS FLD2
+ ISZ HIFLD
+ CDF 30
+ JMS FLD2
+ ISZ HIFLD
+ CDF 20
+ JMS FLD2
+ ISZ HIFLD
+ TAD I (7777 /CHECK SOFT CORE SIZE
+ AND (70
+ SNA
+ JMP CKSEV /NOT THERE
+ CLL RTR
+ RAR
+ DCA HIFLD /THERE, SET HIFLD WITH IT
+ TAD HIFLD /TAKE MIN(HIFLD,5)
+ TAD (7772
+ SMA CLA /SMA TO USE HIFLD
+ TAD (5 /ELSE USE 5
+ SZA
+ DCA HIFLD /STORE 5 IF NECESSARY
+CKSEV, CDF 10
+ TAD I (MPARAM+2 /LOOK AT /7
+ CDF
+ AND (4
+ SNA CLA /SNA IF THERE
+ JMP I (CKBAT /ELSE CHECK FOR BATCH
+ TAD (-7 /SET TO PRINT 7 COLUMNS OF STAB
+ DCA I (SYMNCL
+ TAD (67^6 /SET OFFSET TO FIRST SYMBOL ON NEXT PAGE
+ DCA I (SYMOFS
+ JMP I (CKBAT /OK, CHECK FOR BATCH NOW
+OPTIM4, SNL /SNL IF BATCH RUNNING
+ JMP I (BEGING /ELSE TAKE DEFAULT TABLE SIZE
+ TAD (BPRIME/SET ALTERNATE TABLE SIZE
+ DCA I (PRIMES /INTO THE ONCE ONLY CODE
+ JMP I (BEGING /NOW HIFLD=# OF HIGHEST USABLE FIELD
+HIFLD, 1 /8K MINIMUM
+ >
+
+/SKIP IF CURRENT DATA FIELD DOES NOT EXIST
+FLD2, 0
+ TAD (FLD3
+ DCA I (FLD4
+FLD3, CLA
+ TAD I (FLD4
+ NOP
+ CDF
+ TAD (-FLD3
+ SZA CLA
+ JMP FLD5
+ TAD IOMON
+ TAD [-200
+ SNA CLA /IS FIELD THERE?
+ JMP I FLD2 /YES--RETURN--
+ TAD [200
+ DCA IOMON
+FLD5, ISZ FLD2 /NO-INCREMENT RETURN ADDRESS
+ JMP I FLD2 /--RETURN--
+
+FLD4, IOMON
+\f/OVERLAY CODE FOR OPTIMAL SYMBOL TABLE SEARCH
+/IN 8K
+ IFZERO HASH<
+
+OPTIM1, OPTIMA
+OPTIM2, SETFLD+1
+OPTIM3, -7
+
+OPTIM5, OPTIMB
+OPTIM6, GETTG5
+OPTIM7, -21
+
+OPTIMA, RELOC SETFLD+1
+
+ CLL CMA RTL
+ TAD STM202
+ DCA TAGXR
+ CDF 10
+ JMP I SETFLD
+STM202, -202
+SETFL4, 4
+ RELOC
+
+OPTIMB, RELOC GETTG5
+
+ TAD HIGHTG
+ JMS SETFLD
+ TAD TAGXR
+ DCA XREG1
+ TAD XREG1
+ TAD SETFL4
+ DCA XREG2
+ TAD THISTG
+ JMS SETFLD
+OPTIML, TAD I XREG2
+ DCA I XREG1
+ TAD XREG1
+ CIA
+ TAD TAGXR
+ SZA CLA
+ JMP OPTIML
+ CDF
+ RELOC
+ >
+\f/OVERLAY CODE FOR DDT SYMBOL TABLE PRINT
+
+DSWIT2, IFZERO HASH<
+ RELOC SYMPR9-2
+ JMP SYMPRE
+SYMPRD, TAD SYM204
+ JMS I OERROR
+ TAD [377
+ JMS I OERROR
+ JMS SYMPRC
+ DCA LINCNT
+ JMP I SYMPRT
+SYMPRC, 0
+ TAD [-200
+ DCA SYMPR2
+ TAD [200
+ JMS I OERROR
+ ISZ SYMPR2
+ JMP .-3
+ JMP I SYMPRC
+ RELOC
+ >
+ IFNZRO HASH<
+ RELOC SYMDDT
+ ISZ THISTG
+ JMP SYMLUP
+SYMXIT, TAD SYM204
+ JMS I OERROR
+ TAD [377
+ JMS I OERROR
+ JMS DDTLDR
+ DCA LINCNT
+ JMP I SYMPRT
+DDTLDR, 0
+ TAD [7600
+ DCA SYMCCT
+ TAD [200
+ JMS I OERROR
+ ISZ SYMCCT
+ JMP .-3
+ JMP I DDTLDR
+SYM204, 204
+ RELOC
+ >
+DSWITB= .
+ PAGE
+\fBEGING, CIF 10
+ JMS I IOMON /CALL THE USR
+ 12 /TO FIND OUT DSK:
+BEGINJ, TEXT /DSK/
+ 7201 /DUMMY
+ HLT /NEVER!
+/V3C TAD BEGINJ+1 /GET DEVICE NUMBER OF DSK:
+/V3C DCA CC7 /AND SET IT
+ TAD BEGINJ+1
+ DCA I BEGINL /AND SET IT INTO "PALBIN"
+ CDF 10
+ TAD I CC1 /GET PARAMETER WORD 1
+ CDF
+ CLL RTL /OPTION /B INTO LINK
+ AND [400 /IS IT /F?
+ZF7650, SZA CLA
+ DCA I CCX1 /YES: /F => NO 0 FILL
+ZB7430, SNL /IS IT /B?
+ JMP .+3
+ TAD CCX2
+ DCA I CCX3 /YES: /B => ! IS SHIFT
+ CDF 10
+ TAD I CC1 /GET WORD 1 AGAIN
+ CDF
+ AND [200 /IS IT /E?
+ZE7640, SNA CLA
+ JMP .+3
+ TAD CCX8
+ DCA I CCX4 /YES: /E => SET 'LG' ERROR
+ CDF 10
+ TAD I CCX5 /GET WORD 2 THIS TIME
+ CDF
+ RTL
+ZO7710, SMA CLA /IS IT /O?
+ JMP .+3
+ DCA I CCX6 /YES: /O => NO 200 ORG
+ ISZ I CCX7
+ CDF 10
+ TAD I CC1 /GET WORD 1 AGAIN
+ AND CC2 /IS IT /C?
+ SNA CLA
+ JMP I CC3 /NO: TRY FOR /L OR /G
+ TAD I CC4 /CREF FILE SPECIFIED?
+ SZA CLA
+ JMP CC5 /YES
+CC6, TAD CC7 /NO: GIVE "CREFLS.TM"
+ DCA I CC4
+ ISZ CC6
+ ISZ CC4
+ ISZ CC8
+ JMP CC6
+\fCC5, CDF
+ CIF 10
+ CLA IAC
+ JMS I IOMON /LOOKUP "CREF.SV"
+ 2
+CC13, CC9 /POINT TO NAME - BACK WITH START
+CC8, -5 /LENGTH GOES HERE
+ JMP CC16 /NOT FOUND!
+ TAD CC30
+ JMS I CC31 /CHECK TYPE FILE
+ SMA CLA
+ JMP CC16 /NOT DIRECTORY IS ERROR
+ TAD CC12
+ DCA I CC121 /CSWITC=TAD I [7605
+ TAD CC11
+ DCA I CC111 /CSWIT1=CLA
+ TAD CC10
+ DCA I CC101 /CSWIT2=DCA BINSRT
+ DCA I CC171 /CMOVE=0
+ TAD CC13
+ DCA I CC131 /CHAIN="CREF.SV"
+ DCA I CC141 /LSWITC=0
+ TAD CC30
+ DCA I CC301 /NOPA22=7612
+ DCA I CC20 /"BEGIAB"=0
+ TAD CC21
+ DCA I CC211 /"DIRSW1"=TAD [177
+ TAD CC22
+ DCA I CC221 /"PTPSW1"=TAD [232
+ JMP I .+1
+ CCC /KEEP GOING (SIGH)
+
+CC16, JMS I [ERROR
+ CF /OPTION /C ERROR
+ JMP I CC3 /TRY FOR /L OR /G
+\fCC171, SWAPR2+CMOVE
+CC141, LSWITC
+CC131, CHAIN
+CC121, CSWITC
+CC12, TAD I [7605
+CC111, CSWIT1
+CC11, CLA
+CC101, SWAPR2+CSWIT2
+CC10, DCA BINSRT
+CC301, SWAPR2+NOPA22
+CC30, 7612
+CC31, OTYPE
+CC1, MPARAM
+CC2, 1000
+CC3, BEGINH
+CC4, 7612
+
+CCX1, TEXT4X /V3C
+CCX2, OP3
+CCX3, OPEXPL
+CCX4, LGERR
+CCX5, MPARAM+1
+CCX6, FIELDY+1
+CCX7, FIELDY+2
+CCX8, JMS I PERROR
+
+CC7, 1
+ FILENAME CREFLS.TM
+CC9, FILENAME CREF.SV
+
+CC20, BEGIAB
+CC21, TAD [177
+CC211, SWAPR2+DIRSW1
+CC22, TAD [232
+CC221, SWAPR2+PTPSW1
+
+BEGINL, PALBIN
+ PAGE
+\f/***********************************************************************
+/SYMBOL TABLE
+/MOVED BY ASSEMBLER TO FIELD 1
+/MUST REMAIN IN ALPHABETICAL ORDER
+/***********************************************************************
+
+SYMS, 5777 /TERMINATOR
+ 3777 /IMPOSSIBLE (LIMITING) SYMBOL
+ 5777
+ 0000
+ IFNZRO HASH< /PSEUDO OPS MUST GO FIRST FOR EXPUNGE
+ "I-300^45+4000+2000 /I
+ 0
+ 0
+ 0400
+
+ "P-300^45+"A-300+4000 /PAUSE
+ "U-300^45+"S-300
+ "E-300^45+4000
+ PAUSEX
+
+ "P-300^45+"A-300+4000 /PAGE
+ "G-300^45+"E-300
+ 4000
+ PAGEX
+
+ "T-300^45+"E-300+4000 /TEXT
+ "X-300^45+"T-300
+ 4000
+ TEXTX
+
+ "R-300^45+"E-300+4000 /RELOC
+ "L-300^45+"O-300
+ "C-300^45+4000
+ RELOCY
+
+ "O-300^45+"C-300+4000 /OCTAL
+ "T-300^45+"A-300
+ "L-300^45+4000
+ OCTALX
+
+ "N-300^45+"O-300+4000 /NOPUNCH
+ "P-300^45+"U-300
+ "N-300^45+"C-300+4000
+ NOPUNX
+
+
+ "I-300^45+"F-300+4000 /IFZERO
+ "Z-300^45+"E-300
+ "R-300^45+"O-300+4000
+ IF0
+\f "I-300^45+"F-300+4000 /IFNZRO
+ "N-300^45+"Z-300
+ "R-300^45+"O-300+4000
+ IFN0
+
+ "I-300^45+"F-300+4000 /IFNDEF
+ "N-300^45+"D-300
+ "E-300^45+"F-300+4000
+ IFND
+
+ "I-300^45+"F-300+4000 /IFDEF
+ "D-300^45+"E-300
+ "F-300^45+4000
+ IFD
+
+ "F-300^45+"I-300+4000 /FIXTAB
+ "X-300^45+"T-300
+ "A-300^45+"B-300+4000
+ FIXTBX
+
+ "F-300^45+"I-300+4000 /FIXMRI
+ "X-300^45+"M-300
+ "R-300^45+"I-300+4000
+ FIXMRX
+
+ "F-300^45+"I-300+4000 /FILENAME
+ "L-300^45+"E-300
+ "N-300^45+"A-300+4000
+ FILENX
+
+ "F-300^45+"I-300+4000 /FIELD
+ "E-300^45+"L-300
+ "D-300^45+4000
+ FIELDX
+
+ "E-300^45+"X-300+4000 /EXPUNGE
+ "P-300^45+"U-300
+ "N-300^45+"G-300+4000
+ EXPUNX
+
+ "E-300^45+"N-300+4000 /ENPUNCH
+ "P-300^45+"U-300
+ "N-300^45+"C-300+4000
+ ENPUNX
+
+ "E-300^45+"J-300+4000 /EJECT
+ "E-300^45+"C-300
+ "T-300^45+4000
+ EJECTX
+\f "D-300^45+"T-300+4000 /DTORG
+ "O-300^45+"R-300
+ "G-300^45+4000
+ DTORGX
+
+ "D-300^45+"E-300+4000 /DEVICE
+ "V-300^45+"I-300
+ "C-300^45+"E-300+4000
+ DEVICX
+
+ "D-300^45+"E-300+4000 /DECIMAL
+ "C-300^45+"I-300
+ "M-300^45+"A-300+4000
+ DECIMX
+ >
+ "Z-300^45+"B-300+4000 /ZBLOCK
+ "L-300^45+"O-300
+ "C-300^45+"K-300+4000
+ ZBLOCX
+
+ "Z-300^45+4000+2000 /Z
+ 0
+ 0
+ 0000
+
+ "X-300^45+"L-300+4000 /XLIST
+ "I-300^45+"S-300
+ "T-300^45+4000
+ XLISTY
+
+ "T-300^45+"S-300+4000 /TSK
+ "K-300^45
+ 0
+ 6045
+
+ "T-300^45+"S-300+4000 /TSF
+ "F-300^45
+ 0
+ TSF
+
+ "T-300^45+"P-300+4000 /TPC
+ "C-300^45
+ 0
+ TPC
+
+ "T-300^45+"L-300+4000 /TLS
+ "S-300^45
+ 0
+ TLS
+
+ "T-300^45+"F-300+4000 /TFL
+ "L-300^45
+ 0
+ 6040
+\f IFZERO HASH<
+ "T-300^45+"E-300+4000 /TEXT
+ "X-300^45+"T-300
+ 4000
+ TEXTX
+ >
+ "T-300^45+"C-300+4000 /TCF
+ "F-300^45
+ 0
+ TCF
+
+ "T-300^45+"A-300+4000 /TAD
+ "D-300^45+4000
+ 0
+ TAD 0
+
+ "S-300^45+"Z-300+4000 /SZL
+ "L-300^45
+ 0
+ SZL
+
+ "S-300^45+"Z-300+4000 /SZA
+ "A-300^45
+ 0
+ SZA
+
+ "S-300^45+"W-300+4000 /SWP
+ "P-300^45
+ 0
+ 7521
+
+ "S-300^45+"T-300+4000 /STL
+ "L-300^45
+ 0
+ STL
+
+ "S-300^45+"T-300+4000 /STA
+ "A-300^45
+ 0
+ STA
+
+ "S-300^45+"R-300+4000 /SRQ
+ "Q-300^45
+ 0
+ 6003
+
+ "S-300^45+"P-300+4000 /SPA
+ "A-300^45
+ 0
+ SPA
+\f "S-300^45+"N-300+4000 /SNL
+ "L-300^45
+ 0
+ SNL
+
+ "S-300^45+"N-300+4000 /SNA
+ "A-300^45
+ 0
+ SNA
+
+ "S-300^45+"M-300+4000 /SMA
+ "A-300^45
+ 0
+ SMA
+
+ "S-300^45+"K-300+4000 /SKP
+ "P-300^45
+ 0
+ SKP
+
+ "S-300^45+"K-300+4000 /SKON
+ "O-300^45+"N-300
+ 0
+ 6000
+
+ "S-300^45+"G-300+4000 /SGT
+ "T-300^45
+ 0
+ 6006
+
+ "R-300^45+"T-300+4000 /RTR
+ "R-300^45
+ 0
+ RTR
+
+ "R-300^45+"T-300+4000 /RTL
+ "L-300^45
+ 0
+ RTL
+
+ "R-300^45+"T-300+4000 /RTF
+ "F-300^45
+ 0
+ 6005
+
+ "R-300^45+"S-300+4000 /RSF
+ "F-300^45
+ 0
+ RSF
+\f "R-300^45+"R-300+4000 /RRB
+ "B-300^45
+ 0
+ RRB
+
+ "R-300^45+"P-300+4000 /RPE
+ "E-300^45
+ 0
+ 6010
+
+ "R-300^45+"M-300+4000 /RMF
+ "F-300^45
+ 0
+ RMF
+
+ "R-300^45+"I-300+4000 /RIF
+ "F-300^45
+ 0
+ RIF
+
+ "R-300^45+"I-300+4000 /RIB
+ "B-300^45
+ 0
+ RIB
+
+ "R-300^45+"F-300+4000 /RFC
+ "C-300^45
+ 0
+ RFC
+ IFZERO HASH<
+ "R-300^45+"E-300+4000 /RELOC
+ "L-300^45+"O-300
+ "C-300^45+4000
+ RELOCY
+ >
+ "R-300^45+"D-300+4000 /RDF
+ "F-300^45
+ 0
+ RDF
+
+ "R-300^45+"A-300+4000 /RAR
+ "R-300^45
+ 0
+ RAR
+
+ "R-300^45+"A-300+4000 /RAL
+ "L-300^45
+ 0
+ RAL
+\f "P-300^45+"S-300+4000 /PSF
+ "F-300^45
+ 0
+ PSF
+
+ "P-300^45+"P-300+4000 /PPC
+ "C-300^45
+ 0
+ PPC
+
+ "P-300^45+"L-300+4000 /PLS
+ "S-300^45
+ 0
+ PLS
+
+ "P-300^45+"C-300+4000 /PCF
+ "F-300^45
+ 0
+ PCF
+
+ "P-300^45+"C-300+4000 /PCE
+ "E-300^45
+ 0
+ 6020
+ IFZERO HASH<
+ "P-300^45+"A-300+4000 /PAUSE
+ "U-300^45+"S-300
+ "E-300^45+4000
+ PAUSEX
+
+ "P-300^45+"A-300+4000 /PAGE
+ "G-300^45+"E-300
+ 4000
+ PAGEX
+ >
+ "O-300^45+"S-300+4000 /OSR
+ "R-300^45
+ 0
+ OSR
+
+ "O-300^45+"P-300+4000 /OPR
+ "R-300^45
+ 0
+ OPR
+ IFZERO HASH<
+ "O-300^45+"C-300+4000 /OCTAL
+ "T-300^45+"A-300
+ "L-300^45+4000
+ OCTALX
+ >
+\f IFZERO HASH<
+ "N-300^45+"O-300+4000 /NOPUNCH
+ "P-300^45+"U-300
+ "N-300^45+"C-300+4000
+ NOPUNX
+ >
+ "N-300^45+"O-300+4000 /NOP
+ "P-300^45
+ 0
+ NOP
+
+ "M-300^45+"Q-300+4000 /MQL
+ "L-300^45
+ 0
+ 7421
+
+ "M-300^45+"Q-300+4000 /MQA
+ "A-300^45
+ 0
+ 7501
+
+ "L-300^45+"A-300+4000 /LAS
+ "S-300^45
+ 0
+ LAS
+
+ "K-300^45+"S-300+4000 /KSF
+ "F-300^45
+ 0
+ KSF
+
+ "K-300^45+"R-300+4000 /KRS
+ "S-300^45
+ 0
+ KRS
+
+ "K-300^45+"R-300+4000 /KRB
+ "B-300^45
+ 0
+ KRB
+
+ "K-300^45+"I-300+4000 /KIE
+ "E-300^45
+ 0
+ 6035
+
+ "K-300^45+"C-300+4000 /KCF
+ "F-300^45
+ 0
+ 6030
+\f "K-300^45+"C-300+4000 /KCC
+ "C-300^45
+ 0
+ KCC
+
+ "J-300^45+"M-300+4000 /JMS
+ "S-300^45+4000
+ 0
+ JMS 0
+
+ "J-300^45+"M-300+4000 /JMP
+ "P-300^45+4000
+ 0
+ JMP 0
+
+ "I-300^45+"S-300+4000 /ISZ
+ "Z-300^45+4000
+ 0
+ ISZ 0
+
+ "I-300^45+"O-300+4000 /IOT
+ "T-300^45
+ 0
+ IOT
+
+ "I-300^45+"O-300+4000 /ION
+ "N-300^45
+ 0
+ ION
+
+ "I-300^45+"O-300+4000 /IOF
+ "F-300^45
+ 0
+ IOF
+ IFZERO HASH<
+ "I-300^45+"F-300+4000 /IFZERO
+ "Z-300^45+"E-300
+ "R-300^45+"O-300+4000
+ IF0
+
+ "I-300^45+"F-300+4000 /IFNZRO
+ "N-300^45+"Z-300
+ "R-300^45+"O-300+4000
+ IFN0
+
+ "I-300^45+"F-300+4000 /IFNDEF
+ "N-300^45+"D-300
+ "E-300^45+"F-300+4000
+ IFND
+ >
+\f IFZERO HASH<
+ "I-300^45+"F-300+4000 /IFDEF
+ "D-300^45+"E-300
+ "F-300^45+4000
+ IFD
+ >
+ "I-300^45+"A-300+4000 /IAC
+ "C-300^45
+ 0
+ IAC
+ IFZERO HASH<
+ "I-300^45+4000+2000 /I
+ 0
+ 0
+ 0400
+ >
+ "H-300^45+"L-300+4000 /HLT
+ "T-300^45
+ 0
+ HLT
+
+ "G-300^45+"T-300+4000 /GTF
+ "F-300^45
+ 0
+ 6004
+
+ "G-300^45+"L-300+4000 /GLK
+ "K-300^45
+ 0
+ GLK
+ IFZERO HASH<
+ "F-300^45+"I-300+4000 /FIXTAB
+ "X-300^45+"T-300
+ "A-300^45+"B-300+4000
+ FIXTBX
+
+ "F-300^45+"I-300+4000 /FIXMRI
+ "X-300^45+"M-300
+ "R-300^45+"I-300+4000
+ FIXMRX
+
+ "F-300^45+"I-300+4000 /FILENAME
+ "L-300^45+"E-300
+ "N-300^45+"A-300+4000
+ FILENX
+
+ "F-300^45+"I-300+4000 /FIELD
+ "E-300^45+"L-300
+ "D-300^45+4000
+ FIELDX
+ >
+\f IFZERO HASH<
+ "E-300^45+"X-300+4000 /EXPUNGE
+ "P-300^45+"U-300
+ "N-300^45+"G-300+4000
+ EXPUNX
+
+ "E-300^45+"N-300+4000 /ENPUNCH
+ "P-300^45+"U-300
+ "N-300^45+"C-300+4000
+ ENPUNX
+
+ "E-300^45+"J-300+4000 /EJECT
+ "E-300^45+"C-300
+ "T-300^45+4000
+ EJECTX
+
+ "D-300^45+"T-300+4000 /DTORG
+ "O-300^45+"R-300
+ "G-300^45+4000
+ DTORGX
+
+ "D-300^45+"E-300+4000 /DEVICE
+ "V-300^45+"I-300
+ "C-300^45+"E-300+4000
+ DEVICX
+
+ "D-300^45+"E-300+4000 /DECIMAL
+ "C-300^45+"I-300
+ "M-300^45+"A-300+4000
+ DECIMX
+ >
+ "D-300^45+"C-300+4000 /DCA
+ "A-300^45+4000
+ 0
+ DCA 0
+
+ "C-300^45+"M-300+4000 /CML
+ "L-300^45
+ 0
+ CML
+
+ "C-300^45+"M-300+4000 /CMA
+ "A-300^45
+ 0
+ CMA
+
+ "C-300^45+"L-300+4000 /CLL
+ "L-300^45
+ 0
+ CLL
+\f "C-300^45+"L-300+4000 /CLA
+ "A-300^45
+ 0
+ CLA
+
+ "C-300^45+"I-300+4000 /CIF
+ "F-300^45
+ 0
+ CIF
+
+ "C-300^45+"I-300+4000 /CIA
+ "A-300^45
+ 0
+ CIA
+
+ "C-300^45+"D-300+4000 /CDF
+ "F-300^45
+ 0
+ CDF
+
+ "C-300^45+"A-300+4000 /CAF
+ "F-300^45
+ 0
+ 6007
+
+ "B-300^45+"S-300+4000 /BSW
+ "W-300^45
+ 0
+ 7002
+
+ "A-300^45+"N-300+4000 /AND
+ "D-300^45+4000
+ 0
+ AND 0
+
+ 4001 /TERMINATOR
+ 0000 /IMPOSSIBLE (LIMITING) SYMBOL
+ 4000
+ 0000
+
+SYME=.
+
+/**********************************************************************
+/TOP OF SYMBOL TABLE
+/**********************************************************************
+\fSWAP2=.
+
+/**********************************************************************
+/CODE UNIQUE TO PASSES 1 AND 2
+/SWAPPED IN FOR PASSES 1 AND 2
+/OVERLAYED DURING PASS 3 *** NO LITERALS ***
+
+ RELOC 1000 /ASSEMBLED INTO 1000-1247
+
+ SWAPB2= .
+ SWAPR2= SWAP2-SWAPB2 /RELOCATION FACTOR FOR THIS CODE
+
+OOPEN, 0
+ TAD OPEN01 /OPEN BINARY AND LISTING FILES
+ DCA XOUHND /SET ADDRESS OF DEVICE HANDLER
+ TAD OPEN02
+ DCA XOUBLK
+ TAD [-5
+ DCA XOUELE /SET NEW OUTPUT FILE LENGTH
+ CDF 10
+ TAD I OUFPTR
+ CDF
+ DCA I XOUBLK
+ ISZ XOUBLK
+ ISZ OUFPTR
+ ISZ XOUELE /INCREMENT OUTPUT FILE LENGTH
+ JMP .-7
+ TAD OPEN02
+ IAC
+ DCA XOUBLK /SET POINTER TO NEW FILENAME
+ TAD XOUBLK
+ DCA I OPEN04
+ CIF 10
+ JMS I IOMON /CALL USER SERVICE ROUTINES
+ 13 /*RESET SYSTEM TABLES*
+ DCA I OPEN05 /DELETE UNCLOSED FILES AND
+ TAD I OPEN02 /DELETE HANDLERS
+ AND [17 /GET NEW DEVICE HANDLER #
+ SNA /OUTPUT INHIBIT?
+ JMP ONOFIL /YES
+ CIF 10 /NO
+ JMS I IOMON /CALL USER SERVICE ROUTINE
+ 1 /*FETCH DEVICE HANDLER*
+XOUHND, 0 /LOADING ADDRESS
+ HLT /HANDLER NOT AVAILABLE
+OUENTR, TAD I OPEN02 /NORMAL RETURN - GET OUTPUT
+ CIF 10 /DEVICE NUMBER AND FILE LENGTH
+\f JMS I IOMON /CALL NEW SERVICE ROUTINES
+ 3 /*ENTER OUTUT FILE
+XOUBLK, 0 /POINTER TO FILENAME
+XOUELE, 0 /FILE LENGTH
+ JMP OEFAIL /ERROR RETURN
+ DCA I OPEN06 /NORMAL RETURN
+ JMS I OPEN07
+ TAD XOUHND
+ TAD [200 /LINK IS CLEAR!!
+ SNL CLA
+ TAD [400
+ TAD OUFDEV
+ DCA I OUFINP
+ TAD I OUFINP
+ CLL RAR
+ CIA
+ TAD OU3501
+ DCA INCTL
+ ISZ OOPEN
+ TAD XOUHND
+ DCA I OPEN09
+ TAD XOUBLK
+ DCA I OPEN10
+ TAD XOUELE
+ DCA I OPEN11
+ JMP I OOPEN /--RETURN--
+
+OEFAIL, TAD I OPEN02
+ AND [7760
+ SNA CLA
+ JMP I OPEN12 /DE**FATAL ERROR**
+ TAD I OPEN02
+ AND [17
+ DCA I OPEN02
+ JMP OUENTR
+
+ONOFIL, ISZ I OPEN05 /SET OUTPUT INHIBIT SWITCH
+ JMP I OOPEN /--RETURN--
+
+OUFPTR, 7600
+
+OPEN01, OUDEVH+1
+OPEN02, OUFILE
+OPEN04, OUCNAM
+OPEN05, OUTINH
+OPEN06, OUCCNT
+OPEN07, OUSETP
+OPEN09, OUHNDL
+OPEN10, OUBLK
+OPEN11, OUELEN
+OPEN12, SYSERR
+OU3501, 3501
+OUFDEV, OUDEVH
+OUFINP, INBUFP
+\f/CONTINUATION OF FIXTAB HANDLER
+
+FIXTAY, IFZERO HASH<
+ TAD HIGHTG /SET POINTERS TO TABLE
+ CMA
+ >
+ IFNZRO HASH<
+ TAD TAGMAX
+ CIA
+ >
+ DCA TEMP3
+ DCA THISTG
+FIXTAX, JMS I [FINDTG /GET A TAG
+ AC3777
+ AND TAG1
+ IFNZRO HASH<
+ SZA
+ >
+ TAD [4000 /SET BIT 0 OF FIRST WORD TO 1
+ DCA TAG1 /RETURN IT TO TABLE
+ JMS I [PUTTAG
+ ISZ THISTG
+ ISZ TEMP3 /DONE WITH TABLE YET?
+ JMP FIXTAX /NO
+ JMP I [LOOKEX /YES--EXIT TO MAIN--
+
+/OUTPUT ONE REGISTER - BINARY
+/ENTER WITH CONTENTS IN AC
+
+PUNOUT, 0
+ DCA PUNOU1
+ TAD PUNOU1
+ RTR
+ RTR
+ RTR
+ AND [177
+ JMS I OCHAR /OUTPUT FIRST FRAME
+ TAD PUNOU1
+ AND [77
+ JMS I OCHAR /OUTPUT SECOND FRAME
+ JMP I PUNOUT /--RETURN--
+
+PUNOU1,
+IOPEN, 0 /SET UP INPUT ROUTINE
+ CLA CMA /TO OPEN FILE
+ DCA I IOPEN1
+ ISZ I IOPEN2
+ TAD IOPEN3
+ DCA I IOPEN4
+ ISZ I IOPEN5
+ TAD [LINBUF+120
+ DCA TXTPTR
+ JMP I IOPEN /--RETURN--
+
+IOPEN1, INCHCT
+IOPEN2, INEOF
+IOPEN3, 7617
+IOPEN4, INFPTR
+IOPEN5, FORMSW
+ PAGE
+\f/START PASS 2 *** NO LITERALS HERE EITHER ***
+
+START1, TAD [ERROR
+ DCA PERROR /RESET PREUDO-ERROR ROUTINE
+ JMS I ST1OPN /OPEN PASS 2 OUTPUT FILE
+ JMP NOPA21 /NO PASS 2 IF PASS 3
+NOPA23, TAD I ST1OBL
+ DCA BINSRT
+ DCA PUNCHX /CLEAR PUNCH INHIBIT
+ JMS START3
+ JMP I .+1
+ START2-1
+
+NOPA21, CDF 10
+ TAD I NOPA22 /IS THERE A PASS 3?
+ CDF
+ SNA CLA
+ JMP NOPA23 /NO - DO PASS 2
+ ISZ PASS /SKIP PASS 2
+ NOP
+ JMP NOPAS2 /CONTINUE TO PASS 3
+
+NOPA22, 7605
+
+START3, 0 /GENERATE LEADER/TRAILER
+ TAD LEADER
+ DCA TXTPTR
+ TAD [200
+ JMS I OCHAR
+ ISZ TXTPTR
+ JMP .-3
+ JMP I START3 /--RETURN--
+
+LEADER, -10
+\f/END PASS 2
+
+ENDPA2, JMS I [DUMPZ /DUMP PAGE 0 LITERALS
+ DCA PUNCHX
+ CLL /V3C
+ TAD CHKSUM /OUTPUT CHECKSUM
+ JMS I [PUNOUT /PUNCH THE CHECKSUM
+ JMS START3 /GENERATE LEADER/TRAILER
+ JMS I EN2CLS /CLOSE PASS 2 OUTPUT FILE
+NOPAS2, TAD EN2LSO
+ DCA OERROR /SET NEW OUTPUT TO BE LISTING
+ ISZ I EN2OU1
+CMOVE, JMP CMOVA /ZEROED IF /C
+ CDF 10 /MOVE CODE FOR /C OPTION
+CMOVB, TAD I CMOV1
+ DCA I CMOV2 /MOVE OUTPUT FILE STORAGE
+ ISZ CMOV1
+ ISZ CMOV2
+ ISZ CMOV3
+ JMP CMOVB /LOOP
+CMOVA, CDF
+ JMS I ST1OPN /OPEN 3RD PASS FILE
+ DCA I CMOV4 /NO 3RD PASS
+ TAD I ST1OBL /GET FILE START
+CSWIT2, CLA /"DCA BINSRT" IF /C
+ TAD PTPSW1
+ DCA I EN2PTP /RESET PAPERTAPE SWITCH
+ TAD DIRSW1
+ DCA I EN2DIR /RESET DIRECTORY SWITCH
+ JMS I PIOPEN
+ JMP I .+1
+ LOADOV /OVERLAY THIS AREA WITH PASS3 CODE
+
+PIOPEN, IOPEN
+DIRSW1, TAD [177
+PTPSW1, TAD [232
+
+CMOV1, 7605
+CMOV2, 7600
+CMOV3, -12
+CMOV4, NSWITC
+EN2CLS, OCLOSE
+EN2LSO, LISOUT
+EN2OU1, OUTPT1
+EN2PTP, PTPSW
+EN2DIR, DIRSW
+ST1OPN, OOPEN
+ST1OBL, OUBLK
+SWAPE2, RELOC
+ IFNZRO ENDOVL-SWAPE2&4000 <OVLERR,__ERROR__>
+ PAGE
+\f IFNZRO HASH<
+
+ /ONCE ONLY CODE TO HASH OUT THE PERMANENT SYMBOLS
+
+HSHSMS, 0
+ JMS I (7607 /WRITE THE SYMBOL TABLE SORT OVERLAY
+ 4210 /2 PAGES FROM FIELD 1
+ OUDEVH+400 /FROM HERE
+ ASWAP+1 /TO HERE
+ JMP I (SYSERR/WONDERFUL.
+ TAD I (USROFS
+ SZA CLA /SZA IF KICKING OUT USR
+ TAD (12 /ELSE FUDGE POINTER
+ TAD I (HIFLD /FIRST SET HASH TABLE SIZE
+ TAD PRIMES /ACCORDING TO CORE SIZE
+ DCA PRIME
+ TAD I PRIME
+ DCA PRIME
+ TAD PRIME
+ CIA
+ DCA I (MPRIME
+ TAD I (USROFS
+ SZA CLA
+ JMP KPUSR /JMP IF KEEPING USR
+ CDF 10 /SERVE NOTICE WE'RE OCCUPYING FIELD 1
+ AC7776
+ AND I (JSBITS
+ DCA I (JSBITS
+ TAD [7700
+ DCA IOMON /AND POINT AT PROPER MONITOR E.P.
+KPUSR, CDF
+ TAD I (MPRIME /HOW MANY SLOTS TO WIPE
+ DCA LAST3 /TO COUNTER
+ TAD I (USROFS
+ CLL RTL
+ TAD (7777 /FUDGE THE INITIAL AUTO XR
+ JMP CLRGO /INTO THE LOOP NOW
+CLRLUP, TAD LAST1
+ TAD (-7577
+ SZA CLA /SZA IF NEED TO DO NEXT FIELD
+ JMP CLCDF0+1/ELSE CLEAR ANOTHER
+ TAD (10
+ TAD CLCDF0
+ DCA CLCDF0 /CDF INSTR GETS BUMPED
+ STA
+CLRGO, DCA LAST1 /XRGETS SET
+CLCDF0, CDF 10 /INITIALLY CDF 10
+ DCA I LAST1
+ DCA I LAST1
+ DCA I LAST1
+ DCA I LAST1
+ ISZ LAST3 /SKP IF NO MORE
+ JMP CLRLUP /ELSE DO ANOTHER
+ CDF /THE TABLE IS CLEAN
+ TAD (HSHRTN
+ DCA I [GETTAG
+ STA
+ DCA HIGHTG /HIGHTG=CURRENT SYMBOL INDEX
+ TAD (SYMS+3 /USE THESE AUTO XR'S NOW
+ DCA LAST1
+ TAD LAST1
+ DCA LAST2
+HSHLP, TAD I LAST1
+ AND [1777 /FIRST, STRIP THE TYPE BITS
+ DCA I (NAME1
+ AC3777
+ AND I LAST1
+ DCA I (NAME2
+ AC3777
+ AND I LAST1
+ DCA I (NAME3
+ ISZ LAST1 /SKIP THE VALUE
+ JMP I (GETTGH /GO FIND IT'S PLACE
+HSHRTN, CLA CLL
+ TAD I LAST2
+ DCA I (NAME1
+ TAD I LAST2
+ DCA I (NAME2
+ TAD I LAST2
+ DCA I (NAME3
+ TAD I LAST2
+ DCA VALUE2
+ JMS I (INSRTG /AND STORE IT
+ TAD LAST1
+ TAD (1-SYME+4
+ SZA CLA
+ JMP HSHLP /LOOP IF MORE TO GO
+ JMP I HSHSMS /--RETURN--
+
+PRIMES, .
+ 1737 /1 FIELD
+ 3673 /2 FIELDS
+ 5633 /3 FIELDS
+ 7577 /4 FIELDS
+ 7775 /5 FIELDS (THE LAST MOSTELY WASTE)
+ BPRIMES=.-1 /ALTERNATE TABLE SIZE FOR BATCH COMPATABILITY
+ 1737 /1 FIELD (MEANS NO BATCH)
+ 3133 /2 FIELDS
+ 5075 /3 FIELDS
+ 7035 /4 FIELDS
+ 7775 /5 FIELDS (SOME OF WASTE FOR BATCH)
+
+ 1335 /STILL ANOTHER ALTERNATE SET IF KEEPING USR
+ 3273
+ 5237
+ 7175
+ 7775
+
+ 0
+ 2535
+ 4465
+ 6437
+ 7775
+
+ PAGE
+ >
+\f/**************************************************************
+/PAGE 0 LITERALS
+/**************************************************************
+ IFNZRO HASH<
+
+ /SYMBOL TABLE SORT OVERLAY
+ /ONLY SWAPPED IF TABLE WILL BE LISTED
+
+ /FIRST, SOME EQUATES
+
+ PPUTTAG= [PUTTAG
+ PFINDTG= [FINDTG
+ O1777= [1777
+ O7774= [7774
+
+ SXR= XREG1
+ TXR= XREG2
+ SXR2= LAST1
+ TXR2= LAST2
+ UXR= LAST3
+ DXR= LAST4
+
+ BEG= LOC
+ END= OFFSET
+ LO= OFSBUF
+ HI= STARSW
+ MED= OP
+
+ FIELD 1 /SET THE FIELD NOW
+\f *OUDEVH+400 /IT GOES HERE
+
+SORTAB, 0 /FIRST LOC IN PAGE
+ TAD TAGMAX
+ CIA
+ DCA TEMP /TEMP=#CELLS TO SCAN
+
+ /DEFLATE TABLE PRIOR TO SORTING AND LISTING IT
+ /OUT WITH EMPTIES AND PERMANENTS
+
+ DCA HIGHTG /TARGET POINTER
+ DCA TEMP2 /SOURCE POINTER
+DEFLP, TAD TEMP2
+ DCA THISTG
+ JMS I PFINDTG /GET THE NEXT STAB CELL
+ TAD TAG1
+ CLL RAL
+ SNA SZL CLA /AND THERE BUT NOT FIXED?
+ JMP DEFNUL /NO, DON'T STORE IT
+ TAD O1777 /YES,DISCARD THE TYPE BITS NOW
+ AND TAG1
+ DCA TAG1
+ AC3777
+ AND TAG2
+ DCA TAG2
+ AC3777
+ AND TAG3
+ DCA TAG3
+ TAD HIGHTG
+ DCA THISTG
+ JMS I PPUTTAG
+ ISZ HIGHTG
+DEFNUL, ISZ TEMP2
+ ISZ TEMP /TRY AGAIN
+ JMP DEFLP
+ JMS I (SORT /NOW SORT THEM
+ JMP I SORTAB /EXIT TO PRTSTAB
+\f /MOVE A SYMBOL THRU THE TABLE
+
+SMOV, 0
+ TAD SXR2 /GET SOURCE DF+XREG
+ JMS GETFLD
+ DCA SMVCD1
+ TAD TXR
+ DCA SXR
+ TAD TXR2
+ JMS GETFLD
+ DCA SMVCD2
+ TAD O7774
+ DCA SSWT
+SMVCD1, 0
+ TAD I SXR
+SMVCD2, 0
+ DCA I TXR
+ ISZ SSWT
+ JMP SMVCD1
+SMVCD0, CDF
+ JMP I SMOV
+
+ /AUXILLIARY FIELD+XREG SETTER
+
+GETFLD, 0
+ CLL
+ TAD I (USROFS /IF KEEPING USR
+ DCA TXR /AC=SYM NUM
+ DCA SMVCD2
+ TAD TXR
+ ISZ SMVCD2
+ CML
+ TAD (-1740
+ SNL
+ JMP .-4
+ CLL RTL
+ TAD (-202 /SETS AS IN SETFLD...
+ DCA TXR /TENTATIVELY SET TXR
+ TAD SMVCD2
+ CLL RTL
+ RAL
+ TAD SMVCD0
+ JMP I GETFLD /EXIT WITH AC SET TO CDF INSTR
+\f /ROUTINE TO EXCHANGE SYMBOLS LO AND HI
+
+SSWT, 0
+ TAD HI
+ JMS GETFLD
+ DCA SWCDF1
+ TAD SWCDF1
+ DCA SWCDF3
+ TAD TXR
+ DCA SXR
+ TAD SXR
+ DCA SXR2 /SXR'S FOR HIGH SYMBOL
+ TAD LO
+ JMS GETFLD
+ DCA SWCDF2
+ TAD TXR
+ DCA TXR2 /TXR'S FOR LOW SYMBOL
+ TAD O7774
+ DCA SMOV /COUNTER
+
+SWCDF1, 0
+ TAD I SXR /GET HI SYM WORD
+ DCA GETFLD /HOLD IT
+SWCDF2, 0
+ TAD I TXR /GET LO
+ DCA SCOM /HOLD IT
+ TAD GETFLD
+ DCA I TXR2 /STORE HI IN LOW
+SWCDF3, 0
+ TAD SCOM /NOW STORE LO
+ DCA I SXR2 /IN HI
+ ISZ SMOV
+ JMP SWCDF1+1
+ CDF
+ JMP I SSWT
+\f /COMPARE SYMBOLS + SET LINK THEREBY
+
+SCOM, 0
+ DCA THISTG /AC=TAG #
+ JMS I (SETFLD
+ TAD I TAGXR
+ CLL CIA
+ TAD TAG1
+ SZA CLA
+ JMP SCOMRT
+ TAD I TAGXR
+ CLL CIA
+ TAD TAG2
+ SZA CLA
+ JMP SCOMRT
+ TAD I TAGXR
+ CLL CIA
+ TAD TAG3
+ SNA CLA
+ HLT /NEVER
+SCOMRT, CDF
+ JMP I SCOM
+
+ PAGE
+
+
+
+
+
+
+
+
+\f /SORT ROUTINE HERE
+
+SORT, 0
+ DCA BEG /INITIALIZE PARTITION BOUNDS
+ STA STL
+ TAD HIGHTG
+ DCA END /ARE THERE ANY SYMBOLS?
+ SZL
+ JMP I SORT /NO EXIT WITH LINK SET
+ TAD (LITBF1-1+26 /OK, SET STACK NOW
+ DCA DXR
+ TAD DXR
+ DCA UXR
+
+SLOOP, STA
+ TAD LEVEL
+ DCA LEVEL
+SLOOP2, TAD BEG
+ STL CIA
+ TAD END
+ SNA SZL
+ JMP OKCOOL /END.LOS.BEG
+ CLL RAR
+ TAD BEG
+ DCA MED /MED=BEG+(END-BEG)/2
+ TAD MED
+ DCA THISTG
+ JMS I PFINDTG /T=A(MED)
+ TAD BEG
+ DCA LO /LO=BEG
+ TAD END
+ DCA HI /HI=END
+ TAD MED
+ CIA
+ TAD BEG
+ SNA CLA
+ JMP JUSTWO /BEG.EQ.MED
+\f TAD LO
+ DCA SXR2
+ TAD MED
+ DCA TXR2
+ JMS I (SMOV /A(MED)=A(LO)
+BEGLP, ISZ LO
+ TAD LO
+ CLL CIA
+ TAD HI
+ SNL CLA
+ JMP DONE /HI.LOS.LO
+ TAD LO
+ JMS I (SCOM /T.GT.A(LO) TO LINK
+ SZL CLA
+ JMP BEGLP /T.GT.A(LO)
+ JMP ENDGO /T.LT.A(LO)
+ENDLP, TAD LO
+ CLL CIA
+ TAD HI
+ SNL CLA
+ JMP DONE /IF HI.LO.LO
+ENDGO, TAD HI
+ JMS I (SCOM
+ SZL CLA
+ JMP SWITCH
+ STA
+ TAD HI
+ DCA HI
+ JMP ENDLP
+SWITCH, JMS I (SSWT
+ STA
+ TAD HI
+ DCA HI
+ JMP BEGLP
+\fDONE, TAD HI
+ DCA SXR2
+ TAD BEG
+ DCA TXR2
+ JMS I (SMOV /A(BEG)=A(HI)
+ TAD HI
+ DCA THISTG
+ JMS I PPUTTAG /A(HI)=T
+ AC7776
+ TAD UXR
+ DCA UXR
+ TAD UXR
+ DCA DXR
+ TAD HI
+ CLL CIA
+ TAD MED
+ SZL CLA
+ JMP HIBIGR /DEFER HIGH FOR LATER
+ TAD BEG
+ DCA I DXR /DEFER LO FOR LATER
+ STA
+ TAD HI
+ DCA I DXR
+ TAD HI
+ IAC
+ DCA BEG
+ JMP SLOOP
+HIBIGR, TAD HI
+ IAC
+ DCA I DXR
+ TAD END
+ DCA I DXR
+ STA
+ TAD LEVEL /CLUMSY
+ DCA LEVEL
+ CLL STA
+ TAD HI
+ DCA END
+ SNL /PROTECT AGAINST WRAP AROUND
+ JMP OKCOOL
+ JMP SLOOP2
+
+JUSTWO, TAD HI
+ JMS I (SCOM
+ SZL CLA
+ JMS I (SSWT /SWITCH IF T.GT.A(HI)
+OKCOOL, CLA CLL /NOW CONSIDER PREV PARTITIONS
+ TAD I UXR
+ DCA BEG
+ TAD I UXR
+ DCA END
+ ISZ LEVEL
+ JMP SLOOP2 /REITERATE
+ JMP I SORT /DONE, RETURN WITH A CLEAR LINK
+LEVEL, 0
+ PAGE
+ >
+\f /ROUTINE TO STORE THE DATE OF THE FORM DD-MMM-YY
+ /IN THE HEADING
+
+ IFZERO HASH <
+ FIELD 1
+ *OUDEVH+400
+ >
+
+FMTDAT, 0
+ TAD I (MDATE /PICK UP THE DATE WORD OF THE FORM MMM MDD DDD YYY
+ CDF /RUN WITH DF = 0
+ SNA
+ JMP NODATE /EXIT IF NO DATE
+ DCA DATWD /ELSE STORE DATE WORD
+ TAD ("0-1
+ DCA I DATPTR /SET FIRST DIGIT OF DAY
+ TAD DATWD /NOW GET DAY BITS
+ CLL RTR
+ RAR
+ AND (37
+ JMS DIV10 /DO DAY DIGITS NOW
+ TAD ("-
+ DCA I DATPTR /STORE DASH
+ ISZ DATPTR
+ TAD DATWD /NOW GET MONTH BITS
+ TAD (7400 /REDUCE TO ORIGIN 0
+ AND (7400
+ CLL RTL
+ RTL
+ RAL
+ DCA DIV10
+ TAD DIV10
+ CLL RAR /GENERATE 1.5*MONTH INDEX
+ TAD DIV10
+ TAD (MONLST /INDEX MONTH LIST (SIXBIT)
+ DCA MONPTR
+ TAD (-3
+ DCA DIV10 /SET 3 TIMES THRU LOOP
+ SZL
+ JMP MONGO /IF EVEN START AT RIGHT HALF
+MONLP, TAD I MONPTR
+ CLL RTR
+ RTR
+ RTR
+ JMS MONPUT /PUT LEFT CHAR
+MONGO, TAD I MONPTR
+ JMS MONPUT /PUT RIGHT CHAR
+ ISZ MONPTR
+ JMP MONLP /LOOP FOR MORE
+MONPUT, 0
+ TAD (40
+ AND (77
+ TAD (40 /CONVERT TO 7BIT
+ DCA I DATPTR
+ ISZ DATPTR
+ ISZ DIV10
+ JMP I MONPUT /RETURN TO UNPACK LOOP
+ TAD ("-
+ DCA I DATPTR /PUT ANOTHER DASH
+ ISZ DATPTR
+ TAD ("6
+ DCA I DATPTR /SETUP YEAR TENS DIGIT FOR DIVIDE
+ TAD I (BIPCCL
+ AND (600 /GET YEAR EXTENSION FROM 600 BITS
+ CLL RTR
+ RTR
+ DCA DIV10
+ TAD DATWD /NOW GET YEAR
+ AND (7 /ISOLATE IT
+ TAD DIV10 /ADD EXTENSION
+ JMS DIV10 /UNPACK IT
+NODATE, CIF CDF /NOW RETURN
+ JMP I FMTDAT
+
+DIV10, 0
+ ISZ I DATPTR
+ TAD (-12
+ SMA
+ JMP .-3 /REDUCE MON 10.
+ TAD (12+"0
+ ISZ DATPTR
+ DCA I DATPTR /STORE LOW DIGIT
+ ISZ DATPTR
+ JMP I DIV10 /--RETURN--
+
+DATPTR, DATE
+DATWD, 0
+MONPTR, 0
+
+ PAGE
+
+ $$$$$
projects / pdp8.git / blobdiff