File: PAL8.PA of Tape: OS8/OS8-V3D/al-4696c-sa-os8-v3d-6
(Source file text)
/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.
/
/
/
/
/
/
/
/
/
/
/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
/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
/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)
/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)
/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
TEMP, 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
/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--
/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
GETTG2, 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--
GETTG3, 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--
>
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
/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
/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
/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
/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
/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
/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
GETC4, 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--
GETC13, 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
/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
/**********************************************************
/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
/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, "-
/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--
/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
/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
/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
SYMPR0, 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
>
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
SYMGO, 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= .
/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
/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
/**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
HEADER, "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
>
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--
>
/***************************************************************
/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
/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
/*************************************************************
/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
/*************************************************************
/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
BEGIN4, 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
DSWIT3, DSWIT1-DSWITA
DSWIT4, DSWIT2-DSWITB
PAGE
/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
MONLST, 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
/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
CCC, 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
OVLL7, 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
/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
/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--
/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
OCHAR2, 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--
/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
/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--
TEXT9, 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
/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
/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
/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
/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
/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--
OPTABL, OP0 /+
OP1 /-
OP6 /%
OP2 /&
OP5 /(SPACE)
OPEXPL, OP5 /! - CHANGED TO OP3 IF /B ON
OP4 /^
PAGE
/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
/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
/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
/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
ALPHA6, 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
/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.
ADDIND, 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
/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--
MUL, 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
/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
LSTCHR, 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
/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--
/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--
/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
/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***
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
>
/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--
/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
>
/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
/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
/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
/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
/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
/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
FIND03, 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
/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
/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
CONDTM,
/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
/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
/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
/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
/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
FAKDLR, 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
/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
/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
/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--
PUNVAL, 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
/*********************************************************************
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.
/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
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
/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
>
/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
BEGING, 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
CC5, 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
CC171, 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
/***********************************************************************
/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
"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
"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
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
"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
"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
"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
>
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
"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
>
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
>
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
"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
/**********************************************************************
SWAP2=.
/**********************************************************************
/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
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
/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
/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
/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
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
>
/**************************************************************
/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
*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
/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
/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
/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
/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
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
DONE, 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
>
/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
$$$$$