File: SABR.PA of Tape: OS8/OS8-Latest/new-11
(Source file text)
/SABR ASSEMBLER V40
/
/
/
/
/
/ VERSION SABR.17
/ OCTOBER 26, 1971
/ C. MCCOMAS
/ R. LARY
/ B. CLOGHER
/
/FIXES TO SABR FOR V18 J.K 1975
/
/ .LITERAL POOL OVERFLOW
/ .INCORRECT LINE NUMBER WITH ERROR MESSAGE
/ .VERSION 40 WVDM
/
/ASSEMBLY, LOAD AND SAVE INSTRUCTIONS
/
/ .PAL SABR.PA
/ .PAL SPATCH.PA
/
/ .LO SABR$SPATCH$
/
/ .SA SYS SABR
/
/
FIELD 1
/
/
/ DEFINE LOCATIONS OF MONITOR SUBROUTINES
/
DISPL=10
CDFSK=35+DISPL
CDZSK=41+DISPL
DUMS=57+DISPL
LINK=23+DISPL
OBIS=45+DISPL
OPIS=52+DISPL
RTN=30+DISPL
*1
USE, 0
VAL, 0
SYMBOL, 0 /PTR TO CURRENT USE WORD IN MST
M7, -7
AS0, S0
OTP, CORE1-1 /OCC. TAB. PTR (NEXT FREE WORD BELOW)
STT, STTP /PTR TO 1ST FREE WORD OF SYM. TAB.
/(KEEP STT AFTER OTP FOR INITA)
X0, 0 /LINE BUFFER INDEX
X1, 0 /TEMP AUTOS
X2, 0
X3, 0 /HSR BUFFER INDEX
K2, 2
K4, 4
K3, 3
K130, 130
K30, 30
/ INDIRRECT REFERENCES
/
ICPLFS, CPLFS /CHECK FOR AND PROCESS COLLECTION LFS
CPGESI, CPGES
CTYPE, L61 /CHARACTER TYPEOUT ROUTINE
CRLF, L73
DUMMY, DUM /DUMMY ROUTINE
GETCHR, L65 /ROUTINE TO READ NEXT CHAR
GETSYM, GTSYM /ROUTINE TO INPUT AND DECODE NEXT SYMBOL
INI, INILPT
LFSCHK, LFSCK /CHECK FOR A LFS
OBSYM, OBNSYM /OBTAIN SYMBOL FROM MST
DCIL1, RDL1
NULLP, NULL
OTYPE, L62 /OCTAL TYPEOUT ROUTINE
OUTBIN, OUTBN /ROUTINE TO OUTPUT COMP WORD AND REL BITS
OUTSKP, OUTSK /ROUTINE TO OUTPUT A SKIP INSTRUCTION
POPEXP, POPEX
PRSYMP, PRSYM
PUNCH, L63 /BINARY PUNCH ROUTINE
RDIL, DCIL /READ AND DECODE ONE INPUT LINE
RECTI, RECT
L55I, L55
SKIPL, L72 /SKIPS UNTIL A RETURN OR SEMICOLON
SLITAB, SLTAB /SEARCH LITERAL TABLE
SPSTAB, SPSTB /SEARCH PAGE SYMBOL TABLE
SREST, L66 /ROUTINE TO SEARCH EXTERNAL SYMBOL TABLE
STCE, SETCT
TEST, TSCHR /ROUTINE TO TEST CHARACTERS FOR EQUALITY
TYPE, L64 /TTY TYPE ROUTINE
WLNP, WLN
WRITEP, WRITE
/
/ IMPORTANT VARIABLES
/
ACTR, 0 /ASSEMBLY COUNTER
BSSSW, 0 /BSS 0 IN PROCESS SWITCH
CHR, 0 /LOC TO HOLD CURRENT CHARACTER
CSUM, 0 /BINARY CHECK SUM
EQVOPR, EQUTB /EQUIVALENCE TABLE OUTPUT POINTER
EQVIPR, EQUTB /EQ. TB. INPUT PTR.
ILC, 0 /CURRENT LOCATION
LFSPTR, 0 /POINTER TO LFS TABLE ENTRY
LINE, 0 /NO OF LINES SINCE LAST LFS
LITSZE, 0 /SIZE OF LIT TAB (ASM PHASE)
LTSZE, 0 /SAME FOR COLL. PHASE
LSTSKP, 0 /LAST INSTRUCTION SKIP INDICATOR
LSTBNK, 0 /LAST INSTRUCTION BANK INDICATOR
OBACTR, 0 /OFF BANK INSTRUCTION ADDITION COUNTER
OPSCTR, 0 /OFF PAGE SYMBOL COUNTER
/***** KEEP ITEMS SO INCLOSED IN THE GIVEN ORDER FOR INITA
HICOM, 0177
PAG, 0200 /CURRENT PAGE BITS
ESTSIZ, 0 /HOLDS SIZE OF EXTERNAL SYMBOL TABLE
EQVBIT, 0
APMSW, 0 /AUTOMATIC PAGING MODE SWITCH
TEM7, 1 /SPECIAL VARIABLE USED BY ASME5
CPSW, 1
DSW, 0
FORFLG, 0 /FORTR PSUEDO-OP FLAG
/POS NON-0 MEANS IGNORE DATA
SCOLON, 0
/*****
PASS, 0
PGEESC, 0 /HOLDS SIZE OF PAGE ESCAPE REQUIRED FOR CUR PAGE
PUPGE, 0
PHASE, 0 /PHASE SWITCH
PSTCPR, 0 /PAGE SYMBOL TABLE CODE POINTER
PSTSPR, 0 /PAGE SYMBOL TABLE SYMBOL POINTER
PSTSZE, 0 /SIZE OF PST
PTCPR, 0 /PAGE TABLE CODE POINTER
PTOPR, 0 /PAGE TABLE OP CODE POINTER
PTSPR, 0 /PAGE TABLE SYMBOL POINTER
PTSZE, 0 /SIZE OF PT
TEM1, 0
TEM2, 0
TEM3, 0
TEM4, 0
TEM5, 0
PTSIZ=PTSZE /KEYPUNCHING ERROR
LITSIZ=LITSZE /KEYPUNCHING ERROR
/
/LISTING VARIABLES
LFLG, 0 /0 IF NULL LINE
EFLG, 0 /ERROR FLAG, 6BIT CHAR. IN LEFT HALF
VFLG, 0 /0 IF NO VALUE TO OUTPUT
AFLG, 0 /DITTO FOR ADDRESS
CODE, 0 /RELOCATION CODE
ADDRES, 0 /INSTR. ADDRESS
VALUE, 0 /INSTR. VALUE
/LINE INFO
LFS, 0 /KEEP THIS LIST ORDERED AS GIVEN
OP, 0 /TO AGREE WITH TLFS LIST
IB, 0
AFS, 0
UMIC, 0
NSGN, 0
EXP, 0
SK, 0
CURSKP=SK
BANK, 0
S0, 0
S1, 0
S2, 0
S3, 0
/ FREQUENTLY USED CONSTANTS
/
K5, 5
K7, 0007
K10, 0010
K20, 0020
K40, 0040
K77, 0077
K100, 100
K177, 0177
K200, 0200
K240, 240
K400=L55I
K600=GETSYM
K3000=LFSCHK
K1000=INI
K4000=PRSYMP
K7600, 7600
M200=K7600
M254, -254
LINAX, LINBUF-1
M2, -2
M3, -3
K2000=RDIL
M3000=STCE
M7600=K200
/
/ CORE LAYOUT POINTERS
/
PTOPTB=K200 /PAGE OP CODE TABLE 1 IN BANK 1
BSEEST=K100 /BASE OF EXTERNAL SYMBOL TABLE IN BANK 1
MST=K2000 /BASE MAIN SYM. TAB IN BANK1
LFSBSE=K600 /BASE OF LOCATION FIELD SYMBOL TABLE IN BANK 1
LITBSE=L55I /BASE OF ASSEMBLY PHASE LITERAL TABLE IN BANK 1
PSTBSE, PSTB /BASE OF PAGE SYMBOL TABLE IN BANK 0
PTBSE, PTB /BASE OF PAGE TABLE IN BANK 0
LTBSE=K1000 /BASE OF COLL. PHASE LIT. TABLE IN BANK 1
PTB=7176
PSTB=6776
IERROR=JMP I . /ERROR MESSAGES
ERRI
CERROR=JMP I .
ERRC
SERROR=JMP I .
ERRS
*0200
/
/ MAIN CONTROL LOGIC
/
START, CLA
JMS I INITIO
DCA PASS
DCA I ICALSW
JMS I INITAP
RSTRT, JMS I INI /INITIALIZE PAGE TABLE POINTERS
SKP
RSTRT1, JMS I INCPTI /INCREMENT PAGE TABLE POINTERS
JMS I RDIL /INPUT AND DECODE ONE LINE
JMS I CKCSWP /CK FOR MISSING ARG
DCA BSSSW /ALSO CLR BSS IS PROGRESS SW
JMS I STCE /SET COUNTERS FOR CURRENT LINE
TAD OP /OP CODE
CDF 00
DCA I PTOPR /TO PT OP CODE WORD
CDF 10
TAD SK /OR IN SKIP BIT
SZA CLA
TAD K40 /SKIP INST
TAD I PTCPR /IN CASE LFS BIT IN ALREADY
DCA TEM1
TAD IB /OR IN INDIRECT BIT
SZA CLA
TAD K400 /YES
TAD TEM1
DCA TEM1 /FOR NEW PT CODE WORD
TAD EXP /DO WE HAVE A PAR?
SZA CLA
JMP RSTRT5 /YES
TAD UMIC /A MICRO INST?
SNA CLA
JMP RSTRT4 /NO AN MRI
TAD K4 /OR IN OPERATE BIT
JMP COMP /EXIT TO COMPUTE PAGE SIZE
/
/ PAR FOR AN OP CODE
/
RSTRT5, TAD K10 /PLACE PAR BIT ON PAGE TABLE
TAD TEM1
DCA TEM1
RSTRT4, TAD M2
TAD AFS /IS AFS A CONSTANT
SZA
JMP .+6 /NO
TAD K20 /YES ... CONSTANT BIT
RSTRT2, TAD TEM1 /+PT CODE WORD
DCA TEM1 /FOR NEW PT CODE WORD
TAD S0 /ACTUAL BINARY CONSTANT
JMP COMPGO /EXIT TO COMPUTE PAGE SIZE
IAC
SZA CLA /IS AFS A LITERAL
JMP .+3 /NO
TAD K2 /YES ... LITERAL BIT
JMP RSTRT2 /SAVE AS CONSTANT FROM THIS POINT
TAD AFS /PLACE AFS ON PST
COMPGO, DCA I PTSPR
TAD NSGN /CK FOR # REF
SZA CLA
TAD K2000 /YES
COMP, TAD TEM1 /GET ALL THE BITS
DCA I PTCPR /TO THE CODE WORD
/
/ NOW COMPUTE THE CURRENT PAGE SIZE
/
TAD LFS /IS THERE AN LFS
SZA CLA
JMS I RECTI /YES ... EXIT TO RECOUNT PAGE
JMS I CPGESI /COMPUTE ACTUAL PAGE SIZE
TAD M200 /SUBTRACT PHYSICAL PAGE SIZE
SPA SNA CLA /IS SIZE .GT. PHYSICAL SIZE
JMP RSTRT6 /NO ... GET NEXT
JMS I PSHINI /YES ... PUSH CURRENT INPUT LINE
TAD PUPGE /RESTORE LAST PAGE ESCAPE
DCA PGEESC
CLA CMA /DECREMENT PAGE TABLE SIZE
TAD PTSZE
DCA PTSZE
/
/ ASSEMBLE THE CURRENT PAGE
/
JMS I L55I /ASSEMBLE CURRENT PAGE
JMS I UDPG
JMS I FIXI /FIX ILC IF PASS 2
JMS I POPINI /POP LAST INPUT LINE
JMS I INI /INITIALIZE PT POINTERS
DCA I RECTI /CLR RECOUNT FLAG FOR CPLFS
JMP RSTRT1+2 /EXIT TO PROCESS POPPED LINE
/
RSTRT6, TAD PGEESC /SAVE CURRENT PAGE ESCAPE
DCA PUPGE /IN CASE NEXT LINE OVERFLOWS PAGE
TAD PASS
SZA CLA
JMS I LASMP
JMP RSTRT1
LASMP, ASM02
INITAP, INITA
ICALSW, CALLSW
INCPTI, INCPT
POPINI, POPIN
PSHINI, PUSHIN
FIXI, FIXILC
CKCSWP, CKCSW
/ PAGE PSEUDO OPERATION
/
PPAGE, JMS I SKIPL
CLA CMA /DECREMENT PAGE TABLE SIZE
TAD PTSZE
SNA /WATCH FOR ZERO
JMP .+3
DCA PTSZE /FOR NEW PAGE TABLE SIZE
JMS I L55I /ASSEMBLE CURRENT PAGE
JMS I UDPG
JMP RORGX /INITIALIZE AND INPUT ANOTHER LINE
/
/ REORG PSEUDO OPERATOIN
/
PRORG, JMS I GETSYM /GET NEXT INPUT ITEM
NOP /NOTHING THERE
SKP /SYMBOL
SKP CLA /CONSTANT
IERROR /LITERAL
JMS I SKIPL
TAD S0 /NEW RELOCATABLE ORIGIN
AND K7600 /MASK OFF PAGE DISPLACEMENT BITS
SNA /ARE WE TRYING TO REORIGIN BELOW 200
IERROR /YES ... NOT ALLOWED
DCA RORG1 /SAVE NEW ORIGIN
CLA CMA /DECREMENT PAGE TABLE SIZE
TAD PTSZE
SNA /IS THIS THE BEGINNING OF A PAGE
JMP .+3 /YES
DCA PTSZE
JMS I L55I
TAD RORG1 /NEW ORIGIN
DCA PAG /TO PROPER LOCATION
RORGX, JMS I FIXI
TAD RSTRTX /RETURN AT RSTRT INSTEAD OF RDL1
DCA DCIL1
JMP I NULLP /RE-INITIALIZE AND GO
RORG1, 0
RSTRTX, RSTRT
UDPG, UDPAGE
INITIO, IOINIT
*0400
/
/ ROUTINE TO CAUSE CURRENT PAGE TO BE ASSEMBLED
/THIS ROUTINE ACTS AS THE DRIVER FOR THE ASSEMBLY
/PROCESS. MOST OF THE ACTUAL ASSEMBLY WORK
/IS DONE BY ASMBL,A1,A2,& ASM02.
/FUNCTION:(PASS1)
/ CALL ASMBL TWICE. THE FIRST TIME
/ (ACTR=0) PROHIBIT OUTPUT BY CONVERTING
/ "JMS OUTBIN" TO "JMS DUMMY". BUT
/ ALSO CONVERT "JMS DUMMY" TO "JMS OUTBN"
/ SO THAT OUTPUTTING OF OCCURANCES
/ WILL OCCUR IN FIRST CALL TO ASMBL.
/ IN GENERAL, IN THE FIRST RUN THRU ASMBL
/ NOTHING HAPPENS EXCEPT THAT TAGS ARE
/ DEFINED (BY LFSCK). AS THE TAGS ARE
/ DEFINED LFSCK ALSO CAUSES THE
/ OCC.TAB. TO BE SEARCHED FOR PREVIOUSLY
/ UNRESOLVED FORWARD REFERENCES TO THIS
/ TAG. IF FOUND, RELOCATABLE POINTERS TO
/ THE TAG ARE OUTPUT AT ALL REQUIRED
/ ADDRESSES DURING PHASE1 OF ASMBL.
/ AFTER THE 1ST ASMBL, OUTBIN & DUMMY ARE
/ SWITCHED BACK TO NORMAL & ASMBL
/ IS CALLED AGAIN. DURING 2ND ASMBL
/ THE TAG DEFN. SECTION OF LFSCK IS
/ BY-PASSED & ALL CODE EXCEPT OCCURANCES
/ IS OUTPUT.
/ (PASS2)
/ DURING THE LISTING PASS MOST OF THE
/ ASSEMBLY IS DONE ON A LINE-BY-LINE
/ BASIS BY ASM02 SO L55 HAS LITTLE
/ TO DO. IT JUST CALLS A2 TO
/ OUTPUT THE LITERAL POOL & THEN
/ A1 TO INIT. ASSEMBLY OF THE NEXT
/ PAGE.
/
L55, 0
JMP I L55B /CHANGED FROM V16 TO FIX LISTING BUG
L55C, TAD PASS
SZA CLA
JMP L55L
JMS I L55A /CHECK COMMON PUNCHED
TAD L56 /SET DUMMY ROUTINE TO OUTPUT
DCA DUMMY
TAD L56+1 /SET OUTPUT ROUTINE TO DUMMY
DCA OUTBIN
DCA ACTR /CLEAR ASSEMBLY COUNTER
TAD EQVOPR /SAVE FOR 2ND ASSEMBL
DCA TEM55
JMS I ASSMBL /ASSEMBLE PAGE FIRST TIME
TAD L56 /RESTORE OUTPUT ROUTINE
DCA OUTBIN
TAD L56+1 /RESTORE DUMMY ROUTINE
DCA DUMMY
ISZ ACTR /SET ASSEMBLY COUNTER
TAD TEM55 /RESTORE AS BEFORE 1ST ASSEMBL
DCA EQVOPR
JMS I ASSMBL /ASSEMBLE AND OUTPUT THIS TIME
JMP I L55 /RETURN
L56, OUTBN
DUM
ASSMBL, ASMBL
L55A, HCBPS
L55B, EQVFIX
TEM55, 0
L55L, JMS I A2P
JMS I A1P /INITIALIZE NEXT PAGE
JMP I L55
A2P, A2
A1P, A1
/
/COLLECTION PHASE ROUTINE
/RECOUNT THE CURRENT PAGE BECAUSE OF AN LFS
/CALL WITH AC=0, LEAVES AC=0
/FUNCTION:WHEN A NEW TAG IS DEFINED ON PAGE
/ OPSCTR & OBACTR MAY NEED TO BE
/ REDUCED. CPLFS TAKES CARE OF OPSCTR
/ BUT OBACTR REQUIRES REVIEWING THE
/ ENTIRE PAGE.
/OPERATION: (1) CALL CLNPST TO CLEAR BITS 1-9
/ OF ALL PST CODE WORDS-WIPES OUT
/ SHARE OF OBACTR DUE TO EACH SYM.
/ (2) RE-INIT PAGE & CLR OBACTR
/ (3) FETCH ITEM FROM PAGE TABLE
/ (4) SET ALL INSTR.TYPE FLAGS ACCORDINGLY
/ (5) CALL SETC
/ (6) INC PAGE TABLE PTRS TO NEXT ITEM
/ & LOOP BACK TO (3)
/ CONTINUE THRU ENTIRE TABLE.
/
RECT, 0
TAD PSTSZE /ANYTHING ON PST?
SZA
JMP I CLENUP /YES, CLEAN PST CODES
RECRET, JMS I INISS /DO INITS.
DCA OBACTR /ZERO OFF BANK ADDITION COUNTER
TAD PTSZE /SIZE OF PT
CIA
DCA RECT1 /TO INDEX LOCATION
/
/ THIS IS THE RECOUNT LOOP
/
RECT2, CDF 00
TAD I PTOPR /OP CODE FROM PT
CDF 10
DCA OP
TAD I PTCPR /CK FOR SKIP INST
AND K40
DCA SK
TAD I PTCPR /CK FOR # REF
AND K2000
DCA NSGN
TAD I PTCPR /PT CODE WORD
AND K4 /IS IT AN OPERATE INSTRUCTION
DCA UMIC
TAD I PTCPR /CK FOR PAR EXP
AND K10
DCA EXP
TAD I PTCPR /PAGE TABLE CODE WORD
AND K400 /MASK OFF INDIRECT BIT
DCA IB /PLACE IT IN PROPER LOCATION
TAD I PTCPR /PT CODE WORD
AND K20 /IS AFS A CONSTANT
CLL RTR
SZA
JMP .+3 /YES
TAD I PTCPR /PT CODE WORD
AND K2 /IS AFS A LITERAL
CLL RAR
SNA
TAD I PTSPR /ADDRESS FIELD SYMBOL
DCA AFS
TAD I PTSPR /ACTUAL LITERAL
DCA S0 /TO LITERAL LOCATION
/
/ AREA WHICH CALLS COUNT ROUTINE
/
RECT3, TAD I PTCPR /PT CODE WORD
AND K201 /IS THERE A TAG OR AN EQUIVALENCED TAG?
SNA CLA
JMP .+3 /NO
CLA CMA /YES ... SET BANK UNKNOWN
DCA BANK
JMS I STCE /CALL COUNT ROUTINE
ISZ RECT1 /OVER YET
SKP /NO
JMP I RECT /EXIT
JMS I ISZPT1
JMP RECT2 /GO GET NEXT LINE
RECT1=L55
INISS, INISUB
CLENUP, CLNPST
K201, 201
ISZPT1, ISZPT
PAUS1, PPAUS1
/
/ END PSEUDO OPERATION
/
PEND, TAD FORFLG /IF FLAG ON, TURN OFF &
SMA SZA CLA /GO TO RDL1
JMP I PAUS1 /GO TURN OFF FORTR P-OP
CLA CMA /DECREMENT PT SIZE
TAD PTSZE
SNA /ARE WE AT THE BEGINNING OF A PAGE
JMP PCSM /YES
DCA PTSZE /NO ... NEW PAGE TABLE SIZE
TAD PAG /CHECK FOR OVERFLOW INTO 7600 PAGE
TAD K200
SNA CLA
SERROR /OVERFLOW-ERROR S
ISZ APMSW /LEAVE AUTO PAGING MODE FOR LAST PAGE
JMS L55 /ASSEMBLE CURRENT PAGE
PCSM, JMS I OUTBIN /OUTPUT CKSUM
CSUM
10
TAD PASS
SZA CLA
JMP ENDEND
JMS I LEAD /OUTPUT TRAILER CODE
JMS I PRSYMP /TYPE OUT SYMBOL TABLE
ISZ PASS
JMS I INITAI
JMS I A1P
HLT
JMP I REE
ENDEND, JMS I WLNP /LIST THE "END" STATMT
HLT CLA
JMP I K200 /RESTART AT 200
REE, RSTRT
INITAI, INITA
LEAD, LEADER
*600
/READ INPUT ITEM
/ IGNORES SPACES & TABS TO 1ST CHAR OF ITEM
/ASSUMES AC=0
/CALLING SEQ: JMS I GETSYM
/ NULL RETURN (IF NO ITEM FOUND BEFORE CR ; / *
/ SYMBOL RET. (WITH SYM PACKED IN S1-S3
/ AND S0=SYMBOL LENGTH)
/ CONST. RET. (WITH VALUE IN S0)
/ LITERAL RET. (WITH VALUE IN S0)
/SYNTAX: LITERALS: (000 NUMERIC LIT.
/ (-000 NEG.
/ (K000 OCTAL
/ (D000 DECIMAL
/ ("A ASCII LIT.
/ (-"A NEGATIVE ASCII
/ CONSTANTS: 000,-000,"A,OR -"A
/ NOTE: AFTER A VALID QUOTE ANY ASCII CHAR MAY APPEAR
/ AND WILL BE STORED AS THE CONST OR LIT VALUE.
/ THIS INCLUDES CR ; / * SO THESE DO NOT
/ TERMINATE A LINE AFTER A QUOTE.
/ALL EXITS LEAVE AC=0
/NOTE: TO PROVIDE A CHECK OF THE PUNCTUATION
/CHAR. FOLLOWING PREVIOUSLY READ SYMBOL, GTSYM
/DECREMENTS THE LINE PTR BEFORE STARTING
/THE READ. IF THIS IS NOT WANTED
/CALL TO GTSYM MUST BE PRECEDED
/BY "ISZ X0"
GTSYM, 0
CMA /DECREMENT CHARACTER PTR
TAD X0
DCA X0
TAD DSW /SAVE NUMERIC MODE
DCA TEM4
CMA /SIGN=-1 FOR POSITIVE
ITM4, DCA SIGN /SIGN=0 TO FORCE NEGATION
ITM2, JMS I RC /READ 1ST CHAR
JMP ITM5 /DIGIT: GET NUMERIC CONST
JMP ITM3 /ALPHA: GET SYMBOL
JMS I TEST /SORT LEADING PUNCT.
SL2-1
BL2-SL2
CERROR /ILLEGAL CHAR
/
/READ IN A SYMBOL
/ASSUMES 1ST CHAR ALREADY READ IN & SAVED IN CHR
/LEAVES SYMBOL PACKED IN 6BIT CHAR PAIRS IN S1-S3
/ S0=NUMBER OF CHAR PAIRS ACTUALLY USED
ITM3, ISZ SIGN /CK FOR -SYMBOL
CERROR /YES
DCA S0 /CLR FOR SYM LENGTH COUNT
DCA TEM1 /CLR FOR CHAR COUNT
DCA TEM3 /SET PTR FOR LEFT BYTE
TAD AS0 /AUTO-INDEX STORAGE IN S1-S3
DCA X2
RSM2, ISZ TEM1 /COUNT CHAR
TAD TEM1 /ARE MORE THAN 6 CHARS IN?
TAD M7
SMA CLA
JMP RSM1 /YES, IGNORE
TAD CHR /NO, GET ASCII
AND K77 /MASK TO 6BIT
ISZ TEM3 /WHICH BYTE?
JMP RSM3 /LEFT
TAD TEM2 /ADD ON LEFT HALF
DCA I X2 /STORE CHAR PAIR IN S1-S3
JMP RSM1
RSM3, RTL CLL /MOVE 6BIT TO LEFT BYTE
RTL
RTL
DCA TEM2 /SAVE WHILE WAITING ON RT BYTE
CMA /SET PTR FOR RT BYTE
DCA TEM3
ISZ S0 /COUNT 1 SYMBOL WORD
RSM1, JMS I RC /READ NEXT CHAR
JMP RSM2 /DIGIT
JMP RSM2 /ALPHA
ISZ TEM3 /PUNCT=END OF SYM: CHECK BYTE PTR
JMP .+3 /NOTHING IN TEM2
TAD TEM2 /SAVE THE ODD CHAR
DCA I X2
TAD I IFCTP /SKIP SYM TAB IF IF-COUNT NOT UP
SMA CLA
JMS I SRS /LOOK IT UP IN SYM TAB. & ENTER IF NEC.
JMP ITM14 /EXIT
/READ DIGIT STRING
/ASSUMES 1ST DIGIT ALREADY READ AND ASCII SAVED IN CHR
/ SGN=-1 IF NUM. IS TO BE NEGATED
/ DSW=0 FOR OCTAL CONVERSION, 1 FOR DECIMAL
/LEAVES AC=OCTAL VALUE OF DIGIT STRING (NEG IF SGN=-1)
/ CHR=ASCII FOR TERMINAL PUNCTUATION
ITM5, DCA TEM1 /CLEAR FOR ACCUMULATION
RDS1, TAD CHR /REDUCE CHR TO OCTAL VALUE
TAD M260A
DCA TEM2
TAD DSW /OCTAL OR DECIMAL CONVERSION?
SZA CLA /OCTAL, CK FOR 8 OR 9
JMP MUL1 /DECIMAL, 8 OR 9 IS OK
TAD TEM2 /VALUE = 8 OR 9?
TAD M7
SMA SZA CLA /NO, GO ON
CERROR /YES
/MULT. PREV. VAL. BY CONV. FACTOR
TAD TEM1
CLL RTL /ARG *4
JMP MUL1+3
MUL1, TAD TEM1
CLL RTL /ARG * 4
TAD TEM1 /PLUS ARG=ARG*5
RAL /*2
TAD TEM2 /ADD NEW DIGIT
DCA TEM1 /SAVE ACCUMULATED VALUE
JMS I RC /READ NEXT CHAR.
JMP RDS1 /DIGIT
CERROR /ALPHA
TAD TEM1 /PUNCT.; GET TOTAL
ITM6, ISZ SIGN /IS NEGATE SW. SET?
CIA /YES
DCA S0 /STORE CONST VALUE
TAD TEM4 /RESTORE NUMERIC MODE
DCA DSW
JMP ITM13 /EXIT
ITM7, JMS I GETCHR /READ ALPHA CONST.
SNA
IERROR /NOTHING THERE
DCA TEM1
JMS I GETCHR /READ NEXT CHAR FOR BENEFIT OF SKIPL
CLA
TAD TEM1
JMP ITM6
ITM8, JMS I CKIFP /MOVE PTR TO LITERAL EXIT
ITM9, JMS I RC /READ 1ST CHAR OF LIT.
JMP ITM5 /DIGIT: NUMERIC LIT.
NOP /ALPHA: MUST BE K OR D
JMS I TEST /LOOK FOR K,D,",-
SL3-1
BL3-SL3
CERROR /ILLEGAL CHAR
ITM10, DCA SIGN /SET FLAG FOR NEG. LIT.
JMP ITM9
ITM11, IAC /FORCE DECIMAL LIT.
ITM12, DCA DSW /FORCE OCTAL LIT.
JMP ITM9
ITM13, JMS I CKIFP /CONST. EXIT
ITM14, JMS I CKIFP /SYMBOL EXIT
ITM15, JMP I GTSYM /NULL EXIT
M260A, -260
SRS, SRSYM
RC, RCH
SIGN, 0
IFCTP, IFCTR
CKIFP, CKIF
AERROR=JMP I .
ERRA
CALLSP, CALLSW
/
/CHECK FOR TOO FEW ARGS
/AERROR IF CALLSW MINUS
/
CKCSW, 0
TAD I CALLSP /CK
SMA CLA
JMP I CKCSW /OK
ISZ I CALLSP /COUNT MISSING ARG
NOP
AERROR /FLAG
/
/CHECK FOR TOO MANY ARGS
/AERROR IF CALLSW POSITIVE
/
CKCLS, 0
TAD I CALLSP /DO WE WANT THIS ARG?
SMA CLA
AERROR /NO, ARG COUNT OVERFLOW
ISZ I CALLSP /YES, COUNT THIS ARG
NOP
JMP I CKCLS
*1000
/
/ ROUTINE TO INITIALIZE POINTERS FOR THE COLLECTION OF A PAGE
/
INILPT, 0
CLA IAC
DCA PTSZE /SET PAGE TABLE SIZE
DCA PSTSZE /ZERO PAGE SYMBOL TABLE SIZE
DCA LTSZE /ZERO LITERAL TABLE SIZE (COLL. PHASE)
DCA LITSZE /& ASMBLY PHASE LIT TABL
DCA OPSCTR /ZERO OFF PAGE SYMBOL COUNTER
DCA PHASE /SET PHASE SWITCH TO COLLECTION
JMS INISUB
CLA CMA
DCA I BNKSV
CLA IAC
DCA I LSTSKK
TAD EQVBIT /ANY EQUIV. LEFT FROM LAST PAGE?
SZA
JMP EQSAV /YES, SKIP TABLE REINIT & SAVE BIT
DCA EQVIPR /NO, RE-INIT EQ. TAB. PTRS
DCA EQVOPR
EQSAV, DCA I PTCPR /INITIALIZE PAGE TABLE CODE WORD
DCA I PTSPR /INITIALIZE PAGE TABLE SYMBOL WORD
CDF 00
DCA I PTOPR /INITIALIZE PT OP CODE WORD
CDF 10
TAD LFSBSE /INITIALIZE LFS TABLE POINTER
DCA LFSPTR
DCA OBACTR /ZERO OFF BANK ADDITION COUNTER
TAD RDL1X /RESTORE IN CASE OF REORG OR PAGE PSUEDO
DCA DCIL1
JMP I INILPT /RETURN
RDL1X, RDL1
BNKSV, BNKSAV
LSTSKK, SKPSAV
M211, -211
/
/GENERAL PAGE TABLE INITALIZATION
/DOES PARTS OF INITALIZ. COMMON TO SEVERAL
/ROUTINES
/
INISUB, 0
TAD PTBSE /INITIALIZE PAGE TABLE CODE POINTER
DCA PTCPR
TAD PTBSE /INITIALIZE PAGE TABLE SYMBOL POINTER
IAC
DCA PTSPR
TAD PTOPTB /INITIALIZE PT OP CODE POINTER
DCA PTOPR
CLA CMA /SET LAST BANK UNKNOWN
DCA LSTBNK
CLA IAC /SET LAST INSTRUCTION SKIP INDICATOR ON
DCA LSTSKP
CLA CMA /SET CURRENT BANK UNKNOWN
DCA BANK
JMP I INISUB
/
/SUBR. TO WRITE A LINE
/MAY BE USED ONLY DURING PASS 2 (LISTING)
/FUNCTION:TYPES (OR PUNCHES) EACH LINE OF SOURCE
/ WITH PROPER ASSEMBLY ADDR. & CODES
/ AT BEGINNING OF LINE (OR SPACES IF
/ THESE ARE OMITTED).
/LINE FORMAT:
/ADDR VALU RC CONTENTS OF LINE BUFFER
/ERROR FLAGS TYPED BETWEEN ADDR & VALU
/COLUMNS. RC=RELOCATION CODE. THE LINE
/BUFFER IS IN FIELD 1 AT "LINBUF."
/
WLN, 0
TAD LFLG /NULL LINE?
SNA CLA
JMP WLN3 /YES
TAD AFLG
SZA CLA
JMP .+4
JMS I CTYPE /IF AFLG=0 TYPE 4 SPACES
JMS I CTYPE
JMP .+3
TAD ADDRES /OTHERWISE TYPE 4 DIGITS
JMS I OTYPE
TAD EFLG /TYPE ERR. FLAG & SPACE
JMS I CTYPE
TAD VFLG /SAME TREATMENT FOR VALUE
SZA CLA /AS FOR ADDRES
JMP .+4
JMS I CTYPE
JMS I CTYPE
JMP .+3
TAD VALUE
JMS I OTYPE
TAD K240 /SPACE
JMS I TYPE
TAD CODE /2 DIGITS OR 2 SPACES
JMS I CTYPE
CDF 00
TAD I LINEB /IS THERE ANY LINE TO TYPE?
CDF 10
SNA CLA
JMP WLN3 /NO, EXIT
JMS I CTYPE /2 SPACES
TAD K240 /3RD SPACE
JMS I TYPE
TAD LINAX /INDEX LINE BUFFER
DCA X1
DCA CHARCT /CLR COUNTER
WLN1, CDF 00
TAD I X1 /GET CHAR
CDF 10
SNA
JMP WLN3 /END OF LINE
DCA CHR
TAD CHR /CK FOR TAB
TAD M211
SNA CLA
JMP WLN2 /YES
ISZ CHARCT /COUNT 1 CHAR
TAD CHR /OUTPUT IT
JMS I TYPE
JMP WLN1
WLN2, TAD K240 /SIMULATE TAB
ISZ CHARCT
JMS I TYPE
TAD CHARCT
AND K7
SZA CLA
JMP WLN2 /CONTINUE TAB
JMP WLN1
WLN3, JMS I CRLF
DCA VFLG
DCA EFLG
DCA AFLG
DCA CODE
CDF 00
DCA I LINEB
CDF 10
JMP I WLN
LINEB, LINBUF
CHARCT=TEM5
/
/PATCH FOR SETCT
/NOT USED BY ANY OTHER PART OF PROGRAM
/(ADDED AT V15)
/
/FUNCTION: SET BANK=1 AFTER A "CALL"
/(MUST BE DONE FOR BENEFIT OF RECT ROUTINE)
/
SETCAL, 0
TAD I PTCPR /CK FOR CALL CONST.
AND K100
SNA CLA
JMP .+3 /NO
IAC /YES, BANK TO CURRENT
DCA BANK
TAD EXP /DO 2 INSTRUCTIONS THAT
TAD UMIC /WERE KNOCKED OUT OF SETCT
JMP I SETCAL
*1200
/
/ ASSEMBLY PHASE PAR
/
/PPAR1 IS ACTUALLY A PART OF THE BASIC ASSEMBLY
/ROUTINE ASM02.
/IT ASSEMBLES ALL PARAMETERS
/TYPES ARE: RC=00 ABSOLUTE CONSTANT
/ RC=01 RELOCATABLE ADDRESS
/ RC=05 CDF TO CURRENT FIELD
/ RC=06 CALL CONSTANT (#ARGS+EXT.SYM.#)
/ ALSO LITERALS USED IN ARG STATEMENTS
/ SUCH LITS. ARE PUT IN LIT. POOL
/ AND RC=01 ADDRESS OF LIT. PUT WHERE
/ THE ARG STATEMT OCCURS.
/ADDRESS PARAMETERS ARE ACUALLY TAKEN
/CAR OF BY SUBR. PPAR3S.
/
/
PPAR1, DCA PPARY /CLR OUTPUT CODE
TAD I PTCPR /CK FOR LITERAL ARG OR PARAM.
AND K2
SZA CLA
JMP PARLIT /YES
TAD I PTCPR /PT CODE WORD
AND K20 /IS IT PAR CONSTANT
SNA CLA
JMP PPAR3 /NO
TAD I PTSPR /YES ... ACTUAL CONSTANT
DCA TEM1 /TO DIRECTLY ADDRESSABLE LOC
TAD I PTCPR /IS THIS A SPECIAL CONSTANT USED BY CALL
AND K100
SNA CLA
JMP .+5
IAC /YES, SET BANK TO CURRENT (NEW IN V15)
DCA BANK
IAC /& FORCE CODE=06
JMP .+5
TAD I PTCPR /IS THIS A CDF INSTRUCTION TO THIS BANK
AND K1000
SNA CLA
JMP .+3
TAD K5
DCA PPARY
JMS I WRITEP
JMS I OUTBIN /OUTPUT IT
TEM1 /NO RELOCATION
PPARY, 0
SKP
PPAR3, JMS PPAR3S /DO ALL WORK
JMP I PPAR5-1
SERALI, SRALT
PARLIT, TAD I PTSPR /PUT LIT ON TAB.
DCA S1
IAC
DCA S0
JMS I SERALI
AND K177 /GET PAGE ADDRESS
TAD PAG /+ PAGE BITS
DCA TEM1
ISZ PPARY /CODE FOR RELOCATABLE ADDR.
JMP PPARY-3
/
/ SUBROUTINE TO ASSEMBLE PAR SYMBOL
/
/ASSEMBLE ADDRESS PARAMETER
/SYMBOL MAY BE ABSOLUTE OR RELOCATABLE
/NORMAL OR # REF.
/IF SYMBOL IS YET UNDEFINED, AN ENTRY IS
/MADE FOR IT & THE CURRENT ADDRESS IN THE
/OCCURANCE TABLE.
/
/
PPAR3S, 0
DCA PPARX /CLR OUTPUT CODE
TAD ACTR /WHCH TIME ARE WE ASSEMBLING THIS PAGE
/NOTE: ACTR REMAINS 1 DURING PASS 2
SNA CLA
JMP I PPAR3S /FIRST TIME JUST RETURN
TAD I PTSPR /SYMBOL
DCA AFS /TO DIRRECTLY ADDRESSABLE LOCATION
JMS I OBSYM /GET IT FROM MST
AFS
TAD USE /MST USE WORD
AND K400 /IS IT DEFINED YET
SNA CLA
JMP PPAR4 /NO ... OCCURANCE
TAD USE /MST USE WORD
AND K3000 /IS SYMBOL ABSOLUTE
SZA CLA
ISZ PPARX /OUTPUT RELOCATABLE
JMS I NSCHKI
TAD VAL /INCREMENT IF # REF.
PPAR6, DCA TEM1
JMS I WRITEP
JMS I OUTBIN
TEM1
PPARX, 0
JMP I PPAR3S /RETURN
PPAR4, TAD AFS /SYMBOL
DCA I PPAR5 /TO SUBROUTINE LOCATION
TAD ILC /CUR LOC
DCA I PPAR5+1 /TO SUBROUTINE LOC
JMS I NSCHKI
CLL RTL
DCA I PPAR5+3 /SET ATEM2 FOR NORMAL OR # REFERENCE
JMS I PPAR5+2 /CREATE AN OCCURANCE
JMP PPAR6 /OUTPUT ZERO WORD FOR LOADER
ASM01
PPAR5, ATEM3
ATEM4
L53B
ATEM2
NSCHKI, NSCHK
/
/TWO CHARACTER TYPEOUT
/FROM PACKED ASCII PAIR
/CALL WITH 6-BIT PAIR IN AC
/L61A ACTS AS SUBR FOR L61
/
L61, 0
DCA TEM1 /SAVE CHARACTERS
TAD TEM1
RTR /SHIFT HIGH 6 BITS TO LOW
RTR
RTR
JMS L61A /MASK AND TYPE FIRST CHARACTER
TAD TEM1
JMS L61A /MASK AND TYPE SECOND CHARACTER
JMP I L61 /RETURN
L61A, 0
AND K77 /MASK CHAR TO 6 BITS
SNA /ZERO MEANS SPACE
JMP L61B
JMP I L61CP /HAVE DO SOME OF THIS WORK ON ANOTHER PAGE
L61D, JMS I TYPE /TYPE CHAR
JMP I L61A /RETURN
L61B, TAD K240 /SPACE
JMP L61D
L61CP, L61C
/
/ ROUTINE TO TEST CHARACTERS AND TAKE SELECTIVE EXITS
/
/ CALL IS
/ JMS I TEST
/ SORT LIST ADDR -1
/ BRANCH LIST ADDR - SORT LIST ADDR
/ RETURN IF ALL TESTS UNSUCCESSFUL
/ ASSUMES AC=0 & CHAR TO LOOK FOR IS IN CHR
/SORT ENDS UNSUCCESSFULLY AT
/NEGATIVE NUMBER FOLLOWING SORT LIST
/IF SORT IS SUCCESSFUL, A BRANCH IS
/TAKEN VIA BR. LIST ITEM CORRESPONDING
/TO MATCHING SORT LIST ITEM.
/
TSCHR, 0
CLA
TAD I TSCHR /GET SORT LIST ADDR -1
DCA X1 /AUTO-INDEX SORT LIST
ISZ TSCHR /MOVE ARG PTR
CDF 00
TSCHR2, TAD I X1 /GET SORT LIST ITEM
SPA
JMP TSCHR3 /NEG = END OF SORT LIST
CIA /COMPARE ITEM WITH CHR
TAD CHR
SZA CLA /0 = MATCH FOUND
JMP TSCHR2 /NO MATCH, TRY NEXT ITEM
TAD X1 /GET ADDR. OF MATCH
CDF 10
TAD I TSCHR /+BR. LIST ADDR - SORT LIST ADDR
DCA TSCHR /= PTR TO BR. LIST ITEM
CDF 00
TAD I TSCHR /GET BR. LIST ITEM
DCA TSCHR /= BRANCH PTR FOR THE MATCH
SKP
TSCHR3, ISZ TSCHR /NO MATCH ON LIST
CLA CLL
CDF 10
JMP I TSCHR / RETURN UNSUCCESSFUL
*1400
/
/ CALL PSEUDO OPERATION
/
PCALL, JMS I GETSYM /GET NEXT INPUT ITEM
NOP /NOTHING THERE
SKP /SYMBOL
TAD CHR /CONSTANT
TAD M254 /LITERAL
SZA CLA /IS BREAK CHARACTER A COMMA
JMP CALERR /NO ... ERROR
TAD S0 /SAVE ARG COUNT
DCA ARGCT
ISZ X0 /PROHIBIT FLAGGING THE COMMA
JMS I GETSYM /GET SUBROUTINE NAME
SKP /NONE THERE
JMP .+3 /SYMBOL
NOP /CONSTANT
CALERR, IERROR /LITERAL
JMS I SKIPL
JMS I SREST /SEARCH EXTERNAL SYMBOL TABLE AND OUTPUT TV DEF
DCA PCALL1 /SAVE EXTERNAL SYMBOL NUMBER
TAD LFS
DCA I CALLFS
TAD ARGCT /SET ARG COUNT IN DYNAMIC LOCATION
CIA
DCA CALLSW /SET CALL - ARG IN PROCESS SWITCH & COUNTER
TAD ARGCT /COUNT OF ARGS
RAL CLL /*2
TAD ARGCT /*3 IN CASE USING LITERAL ARGS
TAD K2 /+2
JMS I PARG2 /CAN THE CURRENT PAGE HOLD IT
SKP /YES
JMS I INI /NO ... INITIALIZE PT PTRS ... HAD TO ASSEMBLE PAG
TAD I CALLFS
DCA LFS
JMS I ICPLFS /PROCESS COLLECTION LFS
TAD I PTCPR /PT CODE WORD
TAD K30 /ADD CONSTANT BIT & PAR BIT
DCA I PTCPR /TO PT CODE WORD
TAD PARG6 /PLACE JMS LINK INSTRUCTION
DCA I PTSPR /AS CONSTANT
JMS PARG5 /INC PT PTRS & ASSMBL IF PASS 2
TAD K130 /CORRECT BIT PATTERN FOR CALL
DCA I PTCPR /TO PT CODE WORD
IAC /A CALL FORCES BANK TO CURRENT
DCA LSTBNK /(NEW IN V15)
IAC
DCA BANK
TAD ARGCT /COUNT OF ARGS
CLL RTL /TO HIGH ORDER AC
RTL
RTL
TAD PCALL1 /OR IN EXTERNAL SYMBOL NUMBER
DCA I PTSPR /PLACE IN PT SYMBOL WORD
JMP ARGPP0 /COMMON EXIT
/
/ ARG PSEUDO OPERATION
/
PARG, JMS I GETSYM /GET NEXT INPUT ITEM
IERROR /NOTHING THERE
JMP PARGSM /SYMBOL
JMP PARGCN /CONSTANT CODE IS 2
JMS I SKIPL /FIXES BUG IN V16
JMS I SLITAB /PUT LIT ON TABLE
CMA /LIT CODE IS 1
PARGCN, TAD K2
SKP
PARGSM, TAD SYMBOL /PAR ADDRESS
DCA AFS
JMS I SKIPL
JMS I CKCLSP /CK FOR TOO MANY ARGS
/
/ ROUTINE TO PUT A CDF IN THE PAGE TABLE
/
TAD K30 /PT CODE WORD
DCA I PTCPR /TO PT
JMS I ICPLFS /PROCESS ANY LFS
TAD K6201 /CDF
DCA I PTSPR /TO PT SYMBOL WORD
TAD M2
TAD AFS /IS AFS A CONSTANT
SNA
JMP ARGPP4 /YES
IAC /IS AFS A LITERAL
SNA CLA
JMP ARGPP5 /YES
JMS I OBSYM /NO ... SYMBOL ... GET ITS POINTERS TO MST
AFS
TAD USE /AFS MST USE WORD
AND K40 /IS IT A COMMON SYMBOL
SNA CLA
JMS CDFCHG /NO
JMS ARGPP2 /INCREMENT PT PTRS AND PUT OUT A PAR
TAD AFS
DCA I PTSPR /PLACE SYMBOL IN PT SYMBOL WORD
ARGPP0, JMS PARG5 /INC PT PTRS &ASSMBL IF PASS 2
JMP I POPEXP /EXIT TO GET NEXT LINE
/
ARGPP5, JMS CDFCHG
JMS ARGPP2 /INCREMENT PTRS AND PUT OUT A PAR
TAD K2 /SET LITERAL BIT
JMP .+3 /SAVE AS CONSTANT FROM HERE
/
ARGPP4, JMS ARGPP2 /INCREMENT PTRS AND PUT OUT A PAR
TAD K20 /SET CONSTANT BIT
TAD I PTCPR /PT CODE WORD
DCA I PTCPR /FOR PROPER WORD
TAD S0 /PLACE CONSTANT IN PROPER LOCATION
DCA I PTSPR
JMP ARGPP0
/
/ ROUTINE TO INCREMENT POINTERS AND SET UP FOR A PAR IN THE PAGE TABLE
/
ARGPP2, 0
JMS PARG5 /INC PT PTRS & ASSMBL IF PASS 2
TAD K10
DCA I PTCPR
JMP I ARGPP2 /RETURN
K6201, CDF 10
ASMIF1, 0
TAD PASS
SZA CLA
JMS I ASM02S /ASSMBL NOW IF LISTING PASS
JMS I INC
JMP I ASMIF1
ASM02S, ASM02
INC, INCPT
ARGCT, 0
CALLFS=PRSYMP /TEMP
CALLSW, 0
PARG2, IFFSUB
CKCLSP, CKCLS
PARG5=ASMIF1
PARG6, JMS LINK
M10, -10
/ROUTINE TO CHANGE CDF 10 TO CDF *
CDFCHG, 0
TAD I PTCPR
TAD K1000 /SET CDF * BIT IN P.T.
DCA I PTCPR
TAD I PTSPR /CHANGE 6211
TAD M10 /TO 6201
DCA I PTSPR
JMP I CDFCHG
PCALL1=CDFCHG /TEMP
*1600
/
/ COMMN PSEUDO OPERATION
/
PCOMMN, JMS I GETSYM /GET ADDRESS FIELD SYMBOL
NOP /NOTHING THERE
SKP /SYMBOL THERE
SKP CLA /CONSTANT
IERROR /LITERAL
JMS I SKIPL
TAD LFS
SNA CLA /IS THERE AN LFS
JMP COMMN2 /NO ... JUST INCREMENT COUNTERS
JMS I OBSYM /GET POINTERS TO LFS
LFS
TAD USE /MST USE WORD
AND K3 /SAVE SYMBOL LENGTH
TAD K440 /ADD CORRECT BITS
DCA USE /FOR NEW MST USE WORD
TAD S0 /NO OF COMMON LOCATIONS
SNA CLA /ARE THERE ZERO
JMP COMMN1 /YES ... EQUIVALENCE OUTPUT
TAD HICOM /NO ... HIGHEST COMMON LOCATION USED
TAD S0 /+SIZE OF THIS BLOCK
DCA TEM1 /FOR TENTATIVE NEW HIGHEST
TAD TEM1 /ACTUAL ADDRESS
AND K7600 /ARE WE OVERFLOWING ONTO THE LAST PAGE
TAD M7600
SZL CLA
SERROR /YES ... ERROR
TAD HICOM /LAST COMMON ASSIGNMENT
IAC /+1
DCA VAL /GIVES NEW ADDRESS
TAD TEM1 /NEW HIGHEST COMMON LOCATION
DCA HICOM /TO PROPER LOC
COMMN0, TAD VAL
JMP I NULLP /GO GET NEXT LINE
/
/ EQUIVALENCE GENERATED COMMON OUTPUT
/
COMMN1, TAD HICOM /PLACE LAST COMMON ASSIGNMENT
IAC /+1
DCA VAL /IN MST AS ADDRESS
JMP COMMN0 /EXIT
/
/ NON LOCATION FIELD SYMBOL COMMON ASSIGNMENT
/
COMMN2, TAD HICOM /LAST HIGHEST
TAD S0 /+CUR ASSIGNMENT
DCA HICOM /FOR NEW HIGHEST
TAD HICOM /NEW HIGHEST
AND K7600 /ARE WE OVERFLOWING ONTO THE LAST PAGE
TAD M7600
SZL CLA
SERROR /YES ... ERROR
JMP COMMN0 /NO ... EXIT
K440, 0440
/TEXT PSUEDO-OP
PTEXT, TAD FORFLG
SMA SZA CLA
JMP I DCIL1
JMS I GETCHR /LOOK FOR STRING START
JMS I TEST
SL1-1
BL1-SL1
TAD CHR /SAVE OPENING DELINEATOR
CIA
DCA DELIN
DCA TEXCTR /CLR CHAR CTR
TAD X0 /SAVE AUTO-INDEX TO START OF STR
DCA TEXSUB
TEX1, JMS I GETCHR /LOOK FOR END OF STRING
SNA
TEXERR, IERROR /TOO SOON END OF LINE
TAD DELIN
SNA CLA
JMP TEX2 /THE END OF THE LINE
ISZ TEXCTR /KEEP STRING TALLY
JMP TEX1
TEX2, JMS I GETCHR /MOVE LINE PTR TO CHAR. AFTER DELINEATOR
CLA
JMS I SKIPL
JMS I PUSH /SAVE INFO FOR A MINUTE
TAD TEXCTR
IAC
CLL RAR /DIV BY 2
JMS I IFFS /SEE IF STR WILL FIT ON PAGE
SKP CLA
JMS I INI /HAD TO ASSMBL: RE-INIT PT
JMS I POP /POP LINE INFO
JMS I ICPLFS /PROCESS LFS
TAD TEXCTR
CIA
DCA TEXCTR
TAD TEXSUB /RE-INIT STRING INDEX
DCA X0
DCA BYTE /SET FOR LEFT BYTE
TEX5, JMS I GETCHR
AND K77 /EXTRACT 6 BIT
ISZ BYTE
SKP
JMP TEX4 /RIGHT BYTE
CLL RTL
RTL /MOVE LEFT
RTL
DCA TXSV
CMA /SET PTR TO RT BYTE
DCA BYTE
SKP
TEX4, JMS TEXSUB
ISZ TEXCTR
JMP TEX5 /NOT DONE
ISZ BYTE /CK FOR ODD CHAR LEFT OVER
SKP /NO
JMS TEXSUB /YES
JMP I POPEXP
TEXSUB, 0
TAD TXSV /COMBINE LEFT & RT BYTES
DCA I PTSPR
TAD K30 /PAR CONST BITS
TAD I PTCPR
DCA I PTCPR
TAD X0 /SAVE INDEX
DCA TXSV
JMS I ASIF /INC PTRS & ASSMBL IF PASS 2
TAD TXSV /RESTOR INDEX
DCA X0
JMP I TEXSUB
PUSH, PUSHIN
POP, POPIN
ASIF, ASMIF1
IFFS, IFFSUB
DELIN, 0
TEXCTR, 0
TXSV=S3
BYTE=DELIN
/
/WRITE LINE IF IN PASS 2
/
WLNIF1, 0
TAD PASS /WHICH PASS?
SZA CLA
JMS I WLNP /LISTING
JMP I WLNIF1
/
*2000
/READ & DECODE 1 LINE
/IGNORES NULL LINES & COMMENT LINES
/ EXP=NON-0 IF NO OPERATION ON LINE (CONST, LIT,
/ OR ADDRESS ONLY)
/ SK=NON-0 IF SKIP INSTR.
/ UMIC=NON-0 IF OP CODE IS 6 OR 7
/ IB=NON-0 IF INSTR IS INDIRECT
/ NSGN=NON-0 IF AFS IS # SYMBOL
/ OP=OP CODE
/ LFS=PTR TO LFS IN SYM. TAB., IF ANY
/*** AFS=2 IF CONSTANT PARAMETER OR CONST. AFS***
/*** AFS=1 IF LITERAL PARAMETER OR LIT. AFS***
/ AFS=SYM. TAB. PTR. TO ADDRESS PARAMETER OR AFS
/
DCIL, 0
RDL1, JMS I RLNP /READ IN A LINE
DCA LFS /CLR STORAGE FOR LINE INFO
DCA EXP
DCA OP
DCA SK
DCA IB
DCA NSGN
DCA UMIC
DCA I RECTI /CLR RECOUNT FLAG FOR CPLFS
ISZ LINE /INC LINE COUNT
ISZ X0 /DO NOT BACK UP X0
JMS I GETSYM /READ 1ST ITEM
JMP RDL11 /NULL LINE OR COMMENT
JMP RDL7 /SYMBOL - POSSIBLE LFS
JMP .+3 /SET AFS=2 FOR CONSTANT
RDL3, JMS I SLITAB /PUT LIT ON TAB
CMA /AFS=1 FOR LITERAL
RDL2, TAD K2
ISZ EXP /SET PARAMETER EXPRESSION FLAG
RDL5, DCA AFS
JMS I SKIPL /SKIP TO END OF LINE
JMP I DCIL /RETURN
RDL7, TAD CHR /CK FOR COMMA
TAD M254
SZA CLA
JMP RDL9 /NO, SHOULD BE SPACE,TAB,CR,OR ;
JMS I WHATPP
SKP
IERROR /OP SYMBOL AS TAG
TAD SYMBOL /NO, ENTER PTR TO LFS
DCA LFS
ISZ X0 /PROHIBIT FLAGGING COMMA
JMS I GETSYM /GET ITEM AFTER LFS
JMP I PB0 /NULL AFTER LFS IS BSS0
JMP RDL9 /SYMBOL-OP OR PARAMETER
JMP RDL2 /CONSTANT
JMP RDL3 /LITERAL
RDL9, JMS I WHATPP
JMP RDL4 /NO-MUST BE ADDRESS PARAMETER
TAD USE /IS SYMBOLE A PSUEDO-OP
AND K40
SZA CLA /NO
JMP RDL18 /YES
TAD USE /IS SYMBOL AN MRI?
AND K400
SNA CLA
JMP RDL14 /NO-OPR OR I/O INSTR.
TAD USE /MRI-PUT OP SKIP BIT
AND K20 /INTO SKIP FLAG
DCA SK
TAD VAL
DCA OP
SKP
RDL10, ISZ IB / SET INDIRECT FLAG
JMS I GETSYM /READ SYMBOL AFTER MRI
IERROR /NOTHING THERE
JMP RDL12 /SYMBOL
IAC /AFS=2 FOR CONST. AFS
IAC /AFS=1 FOR LIT.AFS
JMP RDL5 /SKIP TO END OF LINE
RDL12, TAD SYMBOL /CK FOR I
CIA
TAD IBTI /SYM. ADDR-I ADDR
SNA CLA /NOT I
JMP RDL10 /IT IS I
JMS I WHATPP
JMP .+3
IERROR /AFS NOT USER SYMBOL
RDL4, ISZ EXP /ENTER HERE ON ADDRESS PAR.
TAD CHR /CK FOR #
TAD M243
SZA CLA
JMP .+4
ISZ NSGN /YES
JMS I GETCHR /PREVENT FLAGGING #
CLA
TAD SYMBOL /SET PTR TO AFS
JMP RDL5
RDL13, JMS I WHATPP
IERROR /ELIM USER SYM
TAD USE /CK FOR OPR OR I/O INST.
AND K4440 /ELIM. MRI, PSUEDO
SZA CLA /OK
IERROR /ILLEGAL SYMBOL
RDL14, TAD USE /COMPARE NEW MICRO-GRP
AND K300 /WITH OLD, IF ANY
SNA
JMP RDL16 /GRP0 OK WITH ANYTHING
DCA TEM1 /NEW IS NOT 0
TAD MGRP /CK OLD MGP, IF ANY
SNA /THERE IS ONE
JMP RDL15 /0 OK WITH ANY NEW
CIA /COMPARE OLD
TAD TEM1 /WITH NEW
SZA CLA /SAME-OK
IERROR /ILLEGAL COMBINATION
RDL15, TAD TEM1 /MICRO-GRP=NEW
DCA MGRP
RDL16, TAD VAL /OR NEW VALUE INTO OLD OP
CMA /NOT A
AND OP /AND B
TAD VAL /+A
DCA OP /=A OR B
TAD USE /GET NEW SKIP BIT
AND K20
SZA CLA /NON-SKIP
ISZ SK /SET SKIP FLAG
JMS I GETSYM /GET NEXT INSTR OF STRING
JMP RDL17 /NONE THERE - END OF SRTING
JMP RDL13 /SYMBOL (AS EXPECTED)
NOP /CONST, ILLEGAL
IERROR /LIT ILLEGAL
RDL17, ISZ UMIC /SET MICRO INST FLAG
JMP RDL5 /SKIP TO END OF LINE
IBTI, II
MGRP=UMIC
RLNP, RLN
PB0, PBSS2
K4440, 440
K300, 300
WHATPP, WHATYP
M243, -243
/NULL LINE OR COMMENT
RDL11, JMS I SKIPL
JMP I NULLP
/PSUEDO-OP
RDL18, TAD VAL /GET PSUEDO-OP ADDRESS
DCA TEM1 /STORE PTR
JMP I TEM1 /TO PROPER PSUEDO-OP HANDLER
*2200
/
/END OF LINE PROCESSOR FOR COLLECTION PHASE
/LOOKS FOR SEMI-COLON BEFORE A SLASH
/STAR OR SLASH OR 000 (CR) MEANS NORMAL
/END OF LINE. SEMI-COLON MEANS WE MUST
/SAVE CURRENT ADDRESS IN LINE BUFFER FOR
/START OF "NEXT" LINE.
/THIS ROUTINE ALSO HAS THE IMPORTANT
/FUNCTION OF WATCHING THE FORTR PSUEDO-OP
/FLAG. IF FLAG IS ON L72 CAUSES LINE
/TO BE TREATED AS NON-EXISTENT. L72 MUST
/BE CALLED FOR EVER INSTR. LINE OR PSUEDO-OP
/LINE (EXCEPT END, PAUSE, FORTR) BEFORE
/ACTUAL PROCESSING OF THAT LINE BEGINS.
/
L72, 0
SKP
JMS I GETCHR
JMS I TEST
SL6-1
BL7-SL6
IERROR
L72S, TAD X0
DCA SCOLON
L72X, TAD FORFLG /IF FLG=1 WE ARE SKIPPING
SMA SZA CLA /1ST HALF OF FORTRAN OUTPUT
JMP I DCIL1
JMP I L72
/KLUDGE TO RESET ILC BECAUSE A1 COMES BEFORE UDPAGE IN PASS 2
FIXILC, 0
TAD PASS
SNA CLA
JMP I FIXILC
TAD PAG
DCA ILC
JMP I FIXILC
/
/COLLECTION PHASE ROUTINE
/SEARCH PAGE SYMBOL TABLE FOR SYMBOL
/CALLING SEQUENCE: (ASSUMES SYM.ID.IS IN "SYMBOL")
/ JMS SPSTB
/ RETURN IF NOT FOUND (HAD TO ENTER IT)
/ RETURN IF FOUND
/THE SEARCH IS AT L31; ENTERING DONE BY L32.
/
SPSTB, 0
TAD PSTSZE /SIZE OF PST
SZA /IS IT EMPTY
JMP L31 /NO
L32, TAD PSTSZE /IS PST FULL?
TAD PSTMAX
SMA CLA
SERROR /YES
TAD PSTSZE /SIZE OF PST*2
RAL CLL
TAD PSTBSE /+BASE
DCA PSTSPR /GIVES POINTER TO SYMBOL
ISZ PSTSZE / INCREMENT COUNTER
TAD SYMBOL /PHYSICALLY MOVE SYMBOL
DCA I PSTSPR
TAD PSTSPR
IAC /ADD 1
DCA PSTCPR /FOR CODE WORD POINTER
TAD PASS
SNA CLA
JMP L32A /ASSEMBLY: JUST ZERO CODE WORD
JMS I OBSYM /LISTING
SYMBOL
TAD VAL /CK IF SYM IS ON PAGE FORWARD REF.
AND K7600 /EXTRACT PAGE BITS
CIA
TAD PAG
SZA CLA
JMP L32A /NOT ON PAGE
TAD K4000 /ON PAGE: SET DEFINED BIT
ISZ SPSTB /& SET FOR "FOUND" RETURN
L32A, DCA I PSTCPR
JMP I SPSTB /NOT FOUND
/
L31, CIA /PLACE - COUNT OF TABLE
DCA TEM1 /IN INDEX LOC
TAD PSTBSE /PLACE TABLE BASE
DCA TEM2 /IN ADDRESS LOC
L31B, TAD I TEM2 /-SYMBOL
CIA
TAD SYMBOL /+ REQUESTED SYMBOL
SNA CLA
JMP L31A /FOUND
ISZ TEM2 /NOT FOUNE ... INCREMENT ADDRESS
ISZ TEM2
ISZ TEM1 /OVER
JMP L31B /NO ... TRY AGAIN
JMP L32 /YES ... PLACE ON TABLE
L31A, ISZ SPSTB /FOUND ... INDEX FOR EXIT
TAD TEM2 /POINTER TO SYMBOL
DCA PSTSPR /TO PROPER LOC
TAD PSTSPR /SYMBOL POINTER
IAC /+1
DCA PSTCPR /GIVES CODE POINTER
JMP I SPSTB /EXIT
/
PSTMAX, -100 /MUST BE (PSTB-PTB)/2
/
/OUTPUT 6 CHARACTER ASCII NAME
/TO BINARY TAPE
/FOR EXTERNAL SYMBOL DEFN.
/USED BY LFSCK (FOR RC=03) & 666 (FOR RC=17)
/OUTPUT GOES VIA TYPE PTR, BUT PTR IS
/CHANGED TO L66E SO CHAR CAN BE PUNCHED
/& ADDED TO CK.SUM INSTEAD OF TYPED.
/668 IS USED ONLY IN PAS1-
/ASSEMBLY PHASE1
/
L68, 0
TAD PASS
SZA CLA
JMP I L68 /EXIT IF LISTING
TAD L66B /FOOL OUTPUT ROUTINE
DCA TYPE /SO IT THINKS PUNCH IS TTY
DCA S1
DCA S2
DCA S3
TAD AS0
DCA X1
TAD SYMBOL /MST SYMBOL ADDRESS - 1
DCA X2 /TO AUTO X2
TAD USE /MST USE WORD
AND K3 /SYMBOL LENGTH
CIA
DCA TEM4 /-WORDS TO LOC
CDF 00
TAD I X2 /OBTAIN SYMBOL
CDF 10
DCA I X1
ISZ TEM4
JMP .-5
TAD AS0
DCA X2
TAD M3
DCA TEM4
TAD I X2
JMS I CTYPE /PUNCH IT EXPANDED
ISZ TEM4 /MORE
JMP .-3 /YES
TAD L66D /RESTORE TYPE ROUTINE
DCA TYPE
JMP I L68
/
/ DUMMY TYPE ROUTINE FOR EST TV DEFINITION
/
T8=SPSTB /SCRATCH LOC
L66E, 0
DCA T8 /SAVE CHAR
TAD T8
TAD CSUM /ADD CHAR TO BINARY CHECK SUM
DCA CSUM
TAD T8
JMS I PUNCH /OUTPUT CHAR ON BINARY TAPE
JMP I L66E /RETURN
L66B, L66E
L66D, L64
/
/INITIALIZATION THAT WONT FIT IN "INITA"
/
INITMR, 0
DCA I VALPTP
DCA I LLFSP
DCA LINE
JMP I INITMR
VALPTP, VALPTR
LLFSP, LLFS
*2400
/
/COLLECTION PHASE ROUTINE.
/SEARCH LITERAL TABLE FOR VALUE IN S0.
/PLACES LITERAL ON TABLE IS NOT THERE.
/OTHERWISE DOES NOTHING.
/
SLTAB, 0
CLA
TAD LTSZE /SIZE OF TABLE
SZA /IS TABLE EMPTY
JMP SLITB1 /NO ... SEARCH IT
TAD LTBSE /BASE COLL. PHASE LIT. TABLE)
TAD LTSZE /+DISPLACEMENT
DCA TEM1 /GIVES ADDRESS POINTER
TAD S0 /PHYSICALLY MOVE LITERAL
CDF 00
DCA I TEM1
ISZ LTSZE /INCREMENT COUNT
CDF 10
JMP I SLTAB /RETURN
SLITB1, CIA /PLACE - COUNT
DCA TEM1
CMA
TAD LTBSE /LTBSE-1
DCA X1 /TO AUTO X1
SLITB2, CDF 00
TAD I X1 /-TABLE
CDF 10
CIA
TAD S0 /+REQUESTED LITERAL
SNA CLA /SAME
JMP I SLTAB /YES, RETURN
ISZ TEM1 /MORE SYMBOLS TO TEST
JMP SLITB2 /YES
JMP SLTAB+5 /NO
/
/COLLECTION PHASE EQUIVALENCE PROCESSOR
/(FORMERLY CALLED BSS0 PROCESSOR)
/ENTERS SYMBOL ID. IN EQ. TAB
/
PBSS2, JMS I SKIPL
TAD LFS /LOCATION FIELD SYMBOL
SNA CLA /IS THERE ANY
JMP I NULLP /NO
CDF 00
TAD BSSSW /ARE WE PROCESSING A BSS 0 SEQUENCE
SZA CLA
JMP .+5 /YES ... SKIP INITIALIZING
TAD EQVIPR /NO ... INITIALIZE
DCA CTPTR /SET INPUT POINTER TO COUNT LOCATION
DCA I CTPTR /ZERO COUNT
ISZ EQVIPR /INCREMENT INPUT POINTER
TAD LFS /LOCATION FIELD SYMBOL
DCA I EQVIPR /PLACE LFS ON EQUIVALENCE TABLE
ISZ I CTPTR /INCREMENT COUNT
CDF 10
JMS I ICPLFS /PROCESS IT FOR COLLECTION
CLA CMA /REMOVE LFS FROM LFS TABLE
TAD LFSPTR
DCA LFSPTR
ISZ BSSSW /SET BSS 0 IN PROGRSS SWITCH
CMA /REMOVE EXTRA LFS BIT
TAD I PTCPR
AND K7577X /REMOVE EXTRA BSS0 BIT
TAD K200 /PLACE BSS0 BIT ON PT
DCA I PTCPR
TAD PSTCPR /SAVE PST ADDRESS IN CASE NEXT LINE OVERFLOWS
DCA EQVBIT
ISZ EQVIPR /INCREMENT POINTER
JMP I NULLP /EXIT FOR NEXT LINE
CTPTR, EQUTB
LFSBSI, LFSBSS
K7577X, 7577
/
/ASSEMBLY PHASE EQUIVALENCE PROCESSOR
/EXTRACTS ENTIRE GROUP OF TAGS EQUIVALENCED
/TO SAME ADDRESS FROM TABLE & DEFINES
/THEM BY USING LFSCK FROM LFSBSS ON.
/
ANUMCK, 0
TAD I PTCPR /PT CODE WORD
AND K200 /MASK OUT BSS 0 BIT
SNA CLA /IS IT A BSS 0 SYMBOL
JMP I ANUMCK /NO ... EXIT
CMA
DCA BANK /BANK UNKNOWN
TAD AANUM7 /CHEAT RETURN ADDRESS
DCA I LFSCHK /SO IT LOOKS LIKE A JMS FROM SOMEWHERE ELSE
JMS GNEQ /GET COUNT
CIA /NEGATE
DCA OPICTR /SAVE IN INDEX LOC
JMS GNEQ /GET SYMBOL
JMP I LFSBSI /PROCESS SYMBOL
ANUM7, JMS I SPSTAB /SET DEFINED BIT ON PST IN CASE
NOP /THIS WAS CARRIED OVER
JMS I PSTD /THE LAST PAGE
ISZ OPICTR /ANY MORE ?
JMP ANUM7-2 /YES
JMP I ANUMCK /EXIT
PSTD, PSTDEF
AANUM7, ANUM7
/
/ ROUTINE TO GET NEXT ITEM OFF EQUIVALENCE TABLE
/
GNEQ, 0
CDF 00
TAD I EQVOPR
ISZ EQVOPR
CDF 10
JMP I GNEQ
/
/SUBR. TO LIST A LINE IF IN PASS 2
/
/CALLING SEQUENCE: JMS I WRITEP
/ JMS I OUTBIN
/ LOCATION OF WORD TO OUTPUT
/ CONSTANT=RELOC. CODE
/ RETURN
/(CALL TO OUTBN MUST ALWAYS FOLLOW CALL
/TO WRITE.)
/ASSUMES CURRENT PC IS IN "ILC"
/SETS FLAGS FOR PROPER LISTING
/& CALLS WLN TO DO THE DRUDGE WORK.
/
WRITE, 0
TAD PASS
SNA CLA
JMP I WRITE /PASS 1
ISZ WRITE
TAD I WRITE /ADDRESS OF VALUE
DCA VALUE
TAD I VALUE /GET VALUE
DCA VALUE
ISZ VFLG
ISZ WRITE
TAD I WRITE /GET RELOC. CODE
DCA CODE
TAD CODE
SNA
JMP WRITE2
RTR /CONVERT TO 6BIT
RAR
AND K7
TAD K60
CLL RTL
RTL
RTL
DCA ADDRES /TEM SAVE
TAD CODE
AND K7
TAD K60
TAD ADDRES
DCA CODE
WRITE2, TAD ILC /CURRENT ADDRESS
DCA ADDRES
ISZ AFLG
ISZ LFLG
JMS I WLNP /LIST
ISZ WRITE
JMP I WRITE
K60, 60
OPICTR=WRITE
CDZSKP, JMS CDZSK
*2600
/
/ BLOCK PSEUDO OPERATOR
/
PBSS, JMS I GETSYM /GET NEXT INPUT ITEM
JMP I PBSS2I /NOTHING THERE (BSS 0)
SKP /SYMBOL
SKP CLA /CONSTANT
IERROR /LITERAL
JMS I SKIPL
JMS I IPSHIN /SAVE ALL CURRENT INFO
JMP I PBSS4I /CHECK BLOCK SIZE
PBSS5, JMS IFFSUB /CAN THIS FIT IN CORE
SKP CLA /YES
JMS I INI /NO ... INITIALIZE PT POINTERS
JMS I IPOPIN /POP CURRENT INFORMATION
DCA BSSSW /CLEAR BSS0 SWITCH
JMS I ICPLFS /PROCESS CURRENT LFS
TAD S0 /-BLOCK CONSTANT
CIA
DCA TEM12 /TO INDEX LOCATION
PBSS1, TAD K30 /PAR CONSTANT PT BIT STRUCTURE
TAD I PTCPR /DONT LOSE LFS AND BSS 0 INFORMATION
DCA I PTCPR
JMS I ASMIF /DO THEM INDIVIDUALLY IF PASS 2
ISZ TEM12 /MORE
JMP PBSS1 /YES
JMP I POPEXP /EXIT TO GET NEXT LINE
PBSS2I, PBSS2
TEM12, 0 /RESRV STORAGE CTR
PBSS4I, PBSS4
/
/ CPAGE PSEUDO OPERATION
/
PIFF, JMS I GETSYM /GET NEXT INPUT ITEM
NOP /NONE THERE
SKP /SYMBOL
SKP CLA /CONSTANT
IERROR /LITERAL
JMS I SKIPL
JMS I WLNIF /LIST IF PASS 2
TAD S0 /BINARY CONSTANT
JMS IFFSUB /USE GLOBAL IFF SUBROUTINE
JMP I DCIL1 /DIDNT HAVE TO ASSEMBLE PAGE
JMP I RSTRTI /GO INITIALIZE
/
/ IFF SUBROUTINE
/ CALL IS TAD PAGE INCREMENT
/ JMS IFFSUB
/ OK RETURN
/ HAD TO ASSEMBLE PAGE RETURN
/FUNCTION: TO SEE IF GIVEN NO. OF WORDS
/WILL FIT ON CUR. PAGE; IF SO, RETURN
/AT OK RET.; OTHERWISE ASSEMBLE PAGE WE
/HAVE NOW & INIT A NEW PAGE & RET. AT
/SECOND RET. LOC.
/IFFSUB IS USED BY CPAGE,BLOCK &
/SEVERAL OTHER P-OPS
/
/
IFFSUB, 0
DCA TEM1 /SAVE INCREMENT
JMS I ICPGES /COMPUTE PAGE SIZE
TAD TEM1 /ADD INCREMENT
TAD M201 /IS TOTAL .GT. PAGE SIZE (1 EXTRA BECAUSE
SPA SNA CLA /PTSZE INCREMENTED BEFORE PSUEDO-OP
JMP I IFFSUB /NO ... RETURN
CLA CMA /YES ... DECREMENT PAGE TABLE SIZE
TAD PTSIZ
SNA /WATCH FOR AN EMPTY PAGE
JMP .+4 /LEAVE THINGS ALONE IF PAGE EMPTY
DCA PTSIZ
JMS I L55I /ASSEMBLE THE PAGE
JMS I UPDATE
JMS I FIXIL
ISZ IFFSUB /INCREMENT FOR EXIT
JMP I IFFSUB /RETURN
IPSHIN, PUSHIN
IPOPIN, POPIN
WLNIF, WLNIF1
ASMIF, ASMIF1
RSTRTI, RSTRT
UPDATE, UDPAGE
ICPGES=CPGESI
M201, -201
FIXIL, FIXILC
/ ERROR ROUTINE
/
K6200, 6200
FATAL, 0
ERRE, TAD K6200 /0500
ERRS, ISZ FATAL /SET FATAL ERROR SWITCH
TAD K600 /2300
JMP .+3
ERRM, TAD LFS
DCA I LLFSI
TAD K400 /1500
ERRI, TAD K600 /1100
ERRC, TAD K200 /0300
ERRA, TAD K100 /0100
DCA EFLG
TAD PASS
SZA CLA
JMP ERREX /LISTING PASS
JMS I CRLF /TYPE CRLF
TAD EFLG /TYPE E#
JMS I CTYPE
TAD AT
JMS I CTYPE
JMS I CTYPE /TYPE 2 SPACES
TAD I LLFSI
DCA INDEX
CDF 00
TAD I INDEX
ISZ INDEX
AND K3
CMA
DCA COUNT
TAD M3 /SET 6 CHAR PRINT CTR
DCA MSCTR
ISZ COUNT
SKP /NOT DONE YET WITH SYMBOL
JMP ERR1 /DONE : SEE IF SPACES NEEDED
CDF 00
TAD I INDEX
CDF 10
ISZ INDEX
JMS I CTYPE /TYPE THE LETTERS OR SPACES
ISZ MSCTR
JMP .-11
ERR11, TAD SPPLUS /TYPE SPACE +
JMS I TYPE
TAD LINE /TYPE LINS FROM LAST LFS
JMS I OTYPE
JMS I CRLF
ERREX, TAD FATAL /FATAL ERROR?
SNA CLA
JMP .+3 /NO
HLT
JMP I K200 /IF YES GO TO START AFTER HALT
TAD PHASE /WHAT PHASE ARE WE IN
SZA CLA
JMP I ERR2 /ASSEMBLY
JMP I NULLP /COLLECTION
ERR2, ASM02R
LLFSI, LLFS
INDEX=S1
COUNT=S2
MSCTR=S3
AT, 0124
SPPLUS, 253
ERR1, JMS I CTYPE /FILL OUT THE REST WITH SPACES
ISZ MSCTR
JMP .-2
JMP ERR11
*3000
/
/ASSEMBLY PHASE ROUTINE TO CHECK FOR A
/LOC. TAG (LFS) & PROCESS IF FOUND.
/FUNCTION: (ASMBLY PHASE 1 - ACTR=0)
/ (1) DEFINE TAG
/ (2) OUTPUT VALUE AT PAST OCCURANCES OF
/ FORWARD REF. TO THIS TAG
/ (3) CONDENSE OCC. TAB IF POSSIBLE.
/
/ (ASMBLY PHASE 2 - ACTR=1
/ (THIS INCLUDES ALL OF PASS 2 AS
/ ACTR STAYS=1 IN PASS 2)
/ (1) OUTPUT EXT. SYM. DEFN. ON REL-TAPE
/
LFSCK, 0
TAD I PTCPR /PT CODE WORD
RAR
SNL CLA /IS THERE A LFS
JMP I LFSCK /NO ... RETURN
CMA
DCA BANK /BANK UNKNOWN
TAD PASS /MOVE BACK PTR IF IN LISTING PASS
CIA
TAD LFSPTR
DCA LFSPTR
CDF 00
TAD I LFSPTR /ACTUAL LFS
CDF 10
ISZ LFSPTR
LFSBSS, DCA LFS
JMS I OBSYM /OBTAIN LFS FROM MST
LFS
TAD ACTR /WHICH TIME ARE WE ASSEMBLING THIS PAGE
/ACTR REMAINS 1 DURING PASS2
SZA CLA
JMP L67 /SECOND TIME: NO TEST
TAD USE /CK FOR MULTI DEF.
AND K400
SZA CLA
MERROR /YES
JMP LFSCK1
L67, TAD USE /MST USE WORD
AND K200 /(L67 HAS NO EFFECT IN PASS 2)
SNA CLA /IS IT AN ENTRY
JMP LFSCK1 /NO
/
/ EXTERNAL SYMBOL DEFINITION
/
JMS I OUTBIN /OUTPUT BINARY DEFINITION
ILC
3
JMS I L68I /PUNCH SYMBOL ON TAPE
LFSCK1, TAD ILC /CUR ILC
DCA VAL /PLACE ON MST AS DEFINITION
TAD USE /SYMBOL TABLE USE WORD
AND K7377 /MASK OUT DEFINED BIT
TAD K400 /ADD IN DEFINED BIT
DCA USE /SYMBOL IS NOW DEFINED IN MST
/
/ NOW LETS SEARCH OCCURANCE TABLE TO SEE IF WE
/ CAN CLEAR OFF A FEW
/
TAD OTP /SIZE OF OCCURANCE TABLE
CMA
TAD TOPCOR
SNA
JMP I LFSCK /RETURN IF EMPTY
CIA
DCA TEM1 /PLACE - SIZE IN INDEX LOC
TAD OTP /PLACE TABLE BASE IN TEM2
DCA TEM2 /TEM2=PTR TO SYMBOL
CDF 00
L51, DCA L51FLG /CLR # SWITCH
ISZ TEM2
CMA /CK 1ST WORD FOR # FLAG
TAD I TEM2
SZA CLA
JMP .+4 /NO
ISZ L51FLG /YES, SET SWITCH
ISZ TEM2 /MOVE PTR & CTR
ISZ TEM1 /PAST EXTRA WORD
TAD I TEM2 /- OCCURRING SYMBOL
CIA
TAD SYMBOL /+SYMBOL JUST DEFINED
SNA CLA /ARE THEY EQUAL
JMP .+7
ISZ TEM2
L51E, ISZ TEM1 /NO ... ARE THERE MORE
ISZ TEM1 /(2 WORDS PER OCCURRANCE)
JMP L51 /YES
CDF 10
JMP I LFSCK /NO ... RETURN
/
/ AN OCCURANCE FOUND ... OUTPUT IT
/
ISZ TEM2
TAD I TEM2 /ACTUAL ADDRESS
CDF 10
DCA TEM4
JMS I DUMMY /OUTPUT ADDRESS AS ORIGIN
TEM4
4
TAD VAL
TAD L51FLG /ADD 1 IF # REF
DCA TEM4
JMS I DUMMY /OUTPUT SYMBOL VALUE AS RELOCATABLE DEF
TEM4
1
CDF 00
/
/ NOW MOVE OCCURANCE TABLE UP 2
/
L51G, TAD OTP
DCA TEM4 /SAVE
TAD TEM2
DCA OTP /RESET
TAD L51FLG
TAD K2
CIA
TAD TEM2
CIA
TAD TEM4
SNA
JMP L51E /NOTHING TO MOVE
DCA TEM3 /CTR FOR MOVE UP
TAD TEM3
CIA
TAD TEM4
DCA TEM4 /TO PTR
L51J, TAD I TEM4
DCA I OTP
CMA
TAD TEM4
DCA TEM4
CMA
TAD OTP
DCA OTP
ISZ TEM3
JMP L51J
JMP L51E
L68I, L68
K7377, 7377
TOPCOR, CORE1
MERROR=JMP I .
ERRM
/
/ PUNCH ROUTINE
/
L63, 0
PLS /SELECT IT
PSF /WAIT FOR PUNCH
JMP .-1
CLA /EXIT WITH CLEAR AC
JMP I L63
/
/UPDATE "PAGE" TO NEXT CORE PAGE
/I.E., PAGE =PAGE+200
/
UDPAGE, 0
CLA
TAD PAG /OLD PAGE SETTING
TAD K200 /+SIZE OF ONE PAGE
DCA PAG /FOR NEW PAGE SETTING
JMP I UDPAGE /EXIT
L51FLG=UDPAGE
*3200
/
/ SUBROUTINE TO OUTPUT ASSEMBLY PHASE LITERAL
/ TABLE AND REMEMBER OCCURANCES
/
OAPLT, 0
TAD ACTR /SKIP IT THE 1ST TIME
SNA CLA
JMP I OAPLT
JMS I SAVLNI /PREVENT ANY LINE TYPEOUT
TAD LITSIZ /SIZE OF TABLE
SNA
JMP I OAPLT /RETURN IF NONE
CIA
DCA ATEM1 /PLACE - SIZE IN LOC
CLA CMA
TAD LITBSE /BASE - 1
DCA X2 /TO AUTO 12
TAD APMSW /ARE WE IN AUTO PAGING MODE
SZA CLA
JMP .+3 /NO ... OK
TAD PGEESC /YES ... SUBRTACT SIZE OF PAGE ESCAPE
RAR CLL /DIVIDED BY 2
TAD LITSIZ /& SUBTR. LITSIZ
CIA
DCA LITPTR /TEM SAVE
TAD LITPTR
TAD PAG /INITIALIZE PAGE ADDRESS
TAD K200
DCA ILC
TAD LITSIZ /INIT LIT TBL PTR
CLL RAL /(MULT BY 2)
TAD LITBSE
DCA LITPTR
IAC
SKP
/
L52, ISZ ILC /INC PAGE LOC
TAD M3 /DECREMENT LIT TBL PTR
TAD LITPTR
DCA LITPTR
CDF 00
TAD I LITPTR /CODE
DCA ATEM2
ISZ LITPTR
TAD I LITPTR /SYMBOL OR LITERAL
DCA ATEM3
CDF 10
CLA CMA
TAD ATEM2 /IS CODE 1 ... LITERAL
SZA CLA
JMP L53 /NO ... SYMBOL
JMS I ILC4P /YES ... OUTPUT PAGE ADDRESS AS ORIGIN
JMS I WRITEP
JMS I OUTBIN /OUTPUT LITERAL WITH NO RELOCATION
ATEM3
0
L52A, ISZ ATEM1 /MORE
JMP L52 /YES
ISZ ILC /SET FOR ESCAPE
JMP I OAPLT /NO ... RETURN
L53, JMS I OBSYM /OBTAIN SYMBOL FROM MST
ATEM3
TAD USE /MST USE WORD
AND K400 /IS SYMBOL DEFINED
SNA CLA
JMP L53A /NO ... OCCURANCE
JMS I ILC4P /YES ... OUTPUT ORIGIN
TAD ATEM2
AND K4
SZA CLA
IAC /ITS A #
TAD VAL /ACTUAL VALUE
DCA ATEM3 /TO DIRRECTLY ADDRESSABLE LOC
JMS I WRITEP
JMS I OUTBIN /OUTPUT VALUE
ATEM3
1 /RELOCATABLE
JMP L52A /TRY MORE
L53A, TAD ILC
DCA ATEM4
JMS L53B /PLACE ON OCCURANCE TALBE
JMP L52A /TRY MORE
/
/ SUBROUTINE TO CREATE AN OCCURANCE IN OCCURANCE TABLE
/
L53B, 0
TAD OTP
CIA CLL
IAC /ALLOW FOR # FLAG
TAD STT /+TOP OF MST
SZL CLA /OVERFLOW?
SERROR /YES ... OUT OF CORE
TAD M2
TAD OTP /OT SIZE - 2
DCA OTP /GIVES ADDRESS ON OCCUR TABLE
TAD OTP
DCA X1
CDF 00
TAD ATEM3 /SYMBOL
DCA I X1 /TO OCCUR TABLE
TAD ATEM4 /PAGE ADDRESS
DCA I X1 /TO OCCUR TABLE
TAD ATEM2 /CK FOR #
AND K4
SNA CLA
JMP .+6 /NO
IAC /SET FLAG WORD
DCA I OTP
CMA /MOVE DOWN PTR
TAD OTP /PAST EXTRA WORD
DCA OTP
CDF 10
JMP I L53B /TRY MORE
/
ATEM1, 0
ATEM2, 0
ATEM3, 0
ATEM4, 0
SAVLNI, SAVLIN
LITPTR, 0
PFORT, ISZ FORFLG /SET TO 1 FOR 1ST PASS THRU FORTRAN CODE
NOP /END PSUEDO SETS IT TO -1 TO NULLIFY
JMS I SKIPL /SO BACK TO 0 FOR 2ND PASS
JMP I NULLP
/
/DO SOME WORK FOR L61A
/
L61C, DCA TEM2 /SAVE 6-BIT CODE
TAD TEM2
AND K40
SNA CLA
TAD K100 /ADD CORRECT LEADING BITS
TAD K200
TAD TEM2 /ADD CHAR BITS
JMP I L61DP
L61DP, L61D
ILC4P, ILC4
*3400
/
/ ROUTINE TO PUNCH WORD AND RELOCATION BITS ON TAPE
/ CALL IS
/ JMS OUTBN
/ ADDRESS OF WORD
/ BITS
/
OUTBN, 0
CLA CLL
TAD I OUTBN /ADDRESS OF WORD
DCA OUT1
ISZ OUTBN
TAD I OUTBN /RELOCATION BITS
RTL /SHIFT LEFT 4
RTL
DCA OUT2 /SAVE
TAD PASS
SZA CLA
JMP OUTEX
TAD I OUT1 /ACTUAL WORD
DCA OUT1 /MUST DO THIS SINCE WE DO A JMS OUTBN;CSUM;10
TAD OUT1 /AT LOC. PCSM, AND OTHERWISE CSUM WOULD CHANGE AFTER CALL TO SUM.
RTL /ROTATE HIGH 4 BITS TO LOW
RTL
RAL
AND K17 /MASK
TAD OUT2 /ADD REL BITS
JMS SUM /ADD TO CHECK SUM
JMS I PUNCH /PUNCH IT
TAD OUT1 /REMAINDER OF WORD
AND K377 /MASK TO 8 BITS
JMS SUM /ADD TO CHECK SUM
JMS I PUNCH /PUNCH IT
OUTEX, ISZ OUTBN /INDEX FOR EXIT
JMP I OUTBN /RETURN
SUM, 0
DCA TSUM
TAD CSUM
TAD TSUM
DCA CSUM
TAD TSUM
JMP I SUM
TSUM=NSGN
OUT1=IB
OUT2=TEM5
K377, 377
K17, 17
/
/ ROUTINE TO SEARCH ASSEMBLY PHASE LITERAL TABLE
/ FOR 2 WORD ENTRY IN S0-S1
/ PLACES ON TABLE IF NOT THERE
/ RETURNS PAGE ADDRESS IN AC
/
SRALT, 0
CLA
DCA TEM2 /ZERO SEARCH COUNTER
CDF 00
TAD LITSIZ /NO OF ENTRYS
SZA
JMP L40 /NON ZERO ... SEARCH
L39, TAD LITSIZ /NO OF ENTRYS - 1
RAL CLL /MULTIPLY BY 2
TAD LITBSE /ADD BASE OF TABLE
DCA TEM1 /GIVES ADDRESS OF NEW ENTRY
ISZ LITSIZ /INCREMENT COUNT
TAD S0 /FIRST WORD
DCA I TEM1 /TO TABLE
ISZ TEM1 /INCREMENT ADDRESS
TAD S1 /SECOND WORD
DCA I TEM1 /TO TABLE
TAD LITSIZ /ENTRY NO
/ COMPUTE PAGE ADDRESS FROM DISPLACEMENT IN TABLE
/ AND STATUS OF AUTOMATIC PAGING MODE SWITCH AND SIZE OF PAGE
/ ESCAPE REQUIRED
/
L40A, DCA TEM1 /SAVE LOCATION IN TABLE
TAD PASS
SZA CLA
JMP L40C /LISTING
TAD APMSW /ARE WE IN AUTOMATIC PAGING MODE?
SNA CLA
TAD PGEESC /YES - COUNT ESCAPE WORDS
L40DR, CLL RAR /(OVER 2)
L40D, TAD TEM1 /NO ... COMPUTE PAGE ADDRESS
CIA /BY STRAIGNT COMPLEMENTATION METHOD
AND K377 /MASK
CDF 10
JMP I SRALT /EXIT
/FOR AUTO PAGING MODE
L40, CIA
DCA TEM1 /- NO OF ENTRYS TO LOC
CLA CMA
TAD LITBSE /BASE OF TABLE - 1
DCA X1 /TO AUTO 10
L41, ISZ TEM2 /INCREMENT SEARCH COUNTER
TAD I X1 /- FIRST WORD FROM TABLE
CIA
TAD S0 /+FIRST COMP WORD
SZA CLA
JMP L40B /NO MATCH
TAD I X1 /-SECOND TABLE WORD
CIA
TAD S1
SZA CLA
JMP .+4 /NO MATCH
TAD TEM2 /MATCH ... CTR TO AC
JMP L40A /RETURN
L40B, ISZ X1 /INCREMENT FOR NO SECOND COMPARISON
ISZ TEM1 /OVER
JMP L41 /NO ... TRY MORE
JMP L39 /YES ... PLACE ON TABLE
L40C, CDF 10
TAD I REDUCP /GET PAGE ESC COMPUTED BY A1
JMP L40DR
REDUCP, REDUCE
/
/ HAS COMMON BEEN PUNCHED YET SUBROUTINE
/IF IT HAS ALREADY BEEN PUNCHED, EXIT
/IF NOT, PUNCH IT & SET FLAG
/THIS ROUTINE IS CALLED ONLY ONCE PER PROGRAM
/BUT IT COULD BE CALLED FROM ANY OF SEVERAL PLACES
/
HCBPS, 0
TAD CPSW /COMMON PUNCHED SWITCH
SNA CLA /HAS IT BEEN PUNCHED
JMP I HCBPS /YES ... RETURN
DCA CPSW /NO ... CLEAR SWITCH
JMS I OUTBIN /AND PUNCH HIGHEST COMMON ASSIGNED
HICOM
12
JMP I HCBPS /EXIT
DUMSUB, JMS DUMS
/
/INCREMENT PAGE TABLE PTRS
/TO PREPARE FOR NEXT INSTRUCTION (OR PARAMETER)
/
INCPT, 0
ISZ PTSZE /INCREMENT PAGE TABLE SIZE
JMS I ISZPT2
DCA EQVBIT /CLR
DCA I PTCPR /INITIALIZE PAGE TABLE CODE WORD
DCA I PTSPR /INITIALIZE PAGE TABLE SYMBOL WORD
CDF 00
DCA I PTOPR /INITIALIZE PT OP CODE POINTER
CDF 10
TAD CURSKP /MOVE CURRENT SKIP INSTRUCTION INDICATOR
DCA LSTSKP /TO LAST INSTRUCTION SKIP INDICATOR
TAD BANK /MOVE CURRENT BANK
DCA LSTBNK /TO LAST BANK
JMP I INCPT /RETURN
ISZPT2, ISZPT
//
//FOLLOWING CODE MOVED HERE TO MAKE ROOM FOR V03 IN ASME3
ASMEXT, JMS I OUTSKP /YES, OUTPUT SKP
TAD ILC /GET PG.LOC.PTR.
AND K177
TAD K5204 /OUTPUT JMP .+4
DCA TEM1
JMP I .+1
REEASM
K5204, 5204
*3600
/ ABSYM PSEUDO OPERATOR
/
PABSYM, TAD K400
JMS DEFSUB
CLA
JMP DEF1
/SKPDF & OPDEF PSUEDO-OPS
SKPDEX, TAD K20 /PUT IN SKIP BIT
OPDEX, TAD K3010 /STANDARD OP BITS
JMS DEFSUB
CLL
AND K7000 /CK TYPE OF INST
TAD K2000
SNA CLA
JMP DEF1 /IOT
SNL
JMP DEF3 /MRI
TAD S0 /OPR, BUT WHICH GRP?
AND K401
CLL RAR
SNA CLA
JMP DEF2 /GRP1
SZL
TAD K100 /GRP3
TAD K200 /GRP2
DEF1, TAD TEM5
DCA USE
TAD S0
DCA VAL
TAD VAL
JMP I NULLP
DEF2, TAD K100
JMP DEF1
DEF3, TAD K400
JMP DEF1
K401, 401
K3010, 3010
/
/UTILITY FOR PABSYM & OPDEX
/CALL WITH MST CODE WORD EXCEPT BITS 10-11
/IN AC. EXITS WITH SYMBOL VALUE
/AS DEF. BY SOURCE TAPE IN S0 & IN AC.
/
DEFSUB, 0
DCA TEM5
JMS I GETSYM /GET THE SYMBOL NAME
JMP DEFERR /NULL
JMP .+3 /SYMBOL
K7000, NOP
JMP DEFERR /CONST. OR LIT.
TAD S0 /ADD IN SYM LENGTH
TAD TEM5
DCA TEM5
JMS I GETSYM /GET VALUE
NOP /NULL
SKP /SYMBOL
K7410, SKP /CONST
DEFERR, IERROR /LIT.
JMS I SKIPL
TAD S0 /VALUE
JMP I DEFSUB
/
/OCTAL TYPEOUT
/CALLING SEQUENCE: TAD (OCTAL#)
/ JMS L62
/ RET. AC=0
/
L62, 0
CLL RAL /PUSH THRU LINK
DCA TEM1
TAD M4 /SET CTR
DCA TEM2
L62A, TAD TEM1
RTL
RAL
DCA TEM1
TAD TEM1
AND K7
TAD K260
JMS I TYPE
ISZ TEM2
JMP L62A
JMP I L62
M4, -4
K260, 0260
/
/DUMMY OUTPUT ROUTINE
/REPLACES OUTBN DURING ASMBLY PHASE 1
/CALLING SEQUENCE: JMS DUMMY
/ ADDR. OF ARG
/ RELOC. CONST.
/ RETURN
/NOTE: SAME CALLING SEQ. AS OUTBN
/
DUM, 0
CLA CLL
ISZ DUM /INDEX FOR PROPER EXIT
ISZ DUM /INDEX FOR PROPER EXIT
JMP I DUM
/
/ ROUTINE TO SEARCH EXTERNAL SYMBOL TABLE
/ FOR CUR SYMBOL - RETURNS EXTERNAL SYMBOL
/ NUMBER IN AC - PLACES SYMBOL ON TABLE
/ AND OUTPUTS BIN CODE FOR TV IF NOT ON TABLE
/
L66, 0
TAD ESTSIZ /IS TABLE FULL?
TAD M100
M100, SMA CLA
SERROR /YES
TAD ESTSIZ /SIZE OF EST
SZA /IS TABLE EMPTY
JMP L66A1 /NO ... SEARCH IT
L66A3, CLA CMA /YES ... PLACE SYMBOL ON IT
ISZ ESTSIZ /INCREMENT TABLE SIZE
TAD BSEEST /BASE
TAD ESTSIZ /+SIZE
DCA TEM1 /GIVES ADDRESS OF NEW ENTRY
TAD SYMBOL /PHYSICALLY PLACE ON TABLE
CDF 00
DCA I TEM1
CDF 10
TAD USE /MST CODE WORD
AND K403A /SAVE LENGTH AND DEFINITION BIT
TAD K2000 /ADD EXTERNAL BITS
DCA USE
JMP L66A /GO TO PUNCH TV DEF
L66A1, CIA
DCA TEM2 /PLACE -SIZE IN INDEX LOC
DCA TEM3 /ZERO COUNT
CLA CMA
TAD BSEEST /BASE OF EST - 1
DCA X1 /TO AUTO X1
L66A2, ISZ TEM3 /INCREMENT COUNT LOC
CDF 00
TAD I X1 /-TABLE SYMBOL
CDF 10
CIA
TAD SYMBOL /+ CUR SYMBOL
SNA CLA /COMPARE
JMP .+4 /SAVE
ISZ TEM2 /NOT SAME ... ANY MORE
JMP L66A2 /YES ... KEEP TRYING
JMP L66A3 /NO ... PLACE ON TABLE
TAD TEM3 /PLACE COUNT IN AC
JMP I L66 /RETURN
/
/ OUTPUT BINARY EXTERNAL SYMBOL
/
HCBPS
L66A, JMS I .-1 /CHECK TO SEE IF COMMON HAS BEEN PUNCHED
JMS I OUTBIN /TV DEF FOR 1 SYMBOL
K1
17
JMS I L62A1 /PUNCH ASCII CHARS
TAD ESTSIZ /EST NO TO AC
JMP I L66 /RETURN
L62A1, L68
K403A, 403
K1, 1
*4000
/
/SYMBOL TABLE LISTING ROUTINE
/TYPES TABLE FROM "STTP" UP
/WITH NAME-VALUE-FLAG
/POSSIBLE FLAGS ARE: EXT, COM, UNDF, ABS, OP
/FLAGS TYPED BY "STFT"
/TABLE LISTED ALPHABETICALLY WITH NUMERIC
/CHARACTERS .GT. ALPHABETIC
/
PRSYM, 0
DCA PFLG /CLR PRSYM-PASS FLAG
TAD I LSTDEP
SNA CLA
JMP .+3
TAD PUNCH /LIST ON H.S. PUNCH
DCA TYPE
JMS I CRLF
PRS1, TAD PST /INIT SPTR AT TOP OF PERM. S.T.
DCA SPTR
TAD M3 /FILL S1,S2,S3 WITH 7777'S (MAX)
DCA ALEN
TAD APTR
DCA X1
CMA
DCA I X1
ISZ ALEN
JMP .-3
TAD K3 /AND LENGTH=3
DCA ALEN
DCA FOUND /CLR EXIT FLAG
PRS2, TAD STT /HAS SEARCH HIT END OF TABLE?
CIA
TAD SPTR
SNA CLA
JMP PRS7 /YES, USE THE A-SYM WE HAVE
JMS I OBSYM /NO, GET NEXT MST ENTRY
SPTR
TAD BCODE /EXTRACT LENGTH
AND K3
DCA BLEN
TAD BPTR /INDEX NEW ENTRY
DCA X2
TAD BLEN /SET ENTRY CTR
CIA
DCA BCTR
TAD ALEN /SET A-SYM CTR
CIA
DCA AACTR
TAD APTR /INDEX A-SYM
DCA X1
TAD PFLG /IS THIS THE FIRST TIME THRU THE TABLE?
SZA CLA
JMP PRS3 /NO
TAD BCODE /YES, CLR ENTRY BIT 0
AND K3777 /(THE HAS-BEEN-PRINTED FLAG)
DCA BCODE
PRS3, TAD BCODE /HAS THIS SYMBOL BEEN PRINTED ALREADY?
SPA CLA
JMP PRS6 /YES, IGNORE IT
PRS4, TAD I X1 /NO, COMRARE A-SYM WORD
CIA CLL
CDF 00
TAD I X2 /WITH B-SYM WORD
CDF 10
SNA
JMP .+4 /MATCH SO FAR
SNL CLA
JMP PRS5 /A-SYM WORD IS BIGGER-- USE B-SYM
JMP PRS6 /VICE-VERSA
ISZ AACTR /IS A-SYM DONE?
SKP /NO
JMP PRS6 /YES, STICK WITH A-SYM
ISZ BCTR /IS B-SYM DONE
JMP PRS4 /NO, TRY NEXT WORD
PRS5, ISZ FOUND /YES, B-SYM IS NEW A-SYM
/SET CONTINUE FLAG
TAD BPTR /INDEX B-SYM
DCA X2
TAD APTR /CLR STORAGE FOR NEW A-SYM
DCA X1
DCA I X1
DCA I X1
DCA I X1
TAD APTR /RESET A-SYM INDEX
DCA X1
TAD BLEN /CTR FOR TRANSFER
CIA
DCA ALEN
CDF 00
TAD I X2 /MOVE B-SYM TO A-SYM
CDF 10
DCA I X1
ISZ ALEN
JMP .-5
TAD BLEN /NEW LENGTH
DCA ALEN
TAD BVAL /NEW VALUE
DCA AVAL
TAD BPTR /NEW PTR
DCA ASAV
PRS6, TAD BPTR /MOVE SPTR TO NEXT MST ENTRY
TAD BLEN
TAD K2
DCA SPTR
JMP PRS2 /CONTINUE SEARCH
PRS7, TAD FOUND /HAS ANOTHER SYMBOL BEEN FOUND?
SNA CLA
JMP PRS8 /NO, EXIT
JMS I OBSYM /YES
ASAV
TAD USE
TAD K4000
DCA USE /SET HAS-BEEN-PRINTED BIT
ISZ PFLG /SET PASS FLAG
JMS I CRLF /POSITION PRINT
TAD APTR /INDEX SYMBOL
DCA X1
TAD M3 /SET CTR
DCA ALEN
TAD I X1 /PRINT SYMBOL
JMS I CTYPE
ISZ ALEN
JMP .-3
JMS I CTYPE /PRINT 2 SPACES
TAD AVAL /PRINT VALUE
JMS I OTYPE
TAD USE /MOVE TYPE BITS TO LOW AC
RTL /& DEF. BIT TO LINK
RTL
JMS I STFTI /TYPE FLAGS IF ANY
JMP PRS1 /LOOK FOR ANOTHER SYMBOL TO PRINT
PRS8, JMS I CRLF
JMS I CRLF
JMP I PRSYM
STFTI, STFT
ASAV=UMIC
PFLG=TEM3
PST, STTP /TOP OF PERMANENT SYMBOL TABLE
ALEN=S0
APTR=AS0
BPTR=SYMBOL
BVAL=VAL
BCODE=USE
FOUND=TEM4
SPTR=TEM5
BLEN=LFS
BCTR=OP
AACTR=IB
AVAL=AFS
K3777, 3777
LSTDEP, LSTDEV
*4200
/
/ROUTINE TO PUSH DOWN CUR.LINE FOR NEXT PAGE.
/SAVES ENTIRE LIST OF VITAL INFO
/(LFS, OP, IB,...,BANK, S0) IN TEMP.LOCS
/(TLFS, TOP, TIB,..., TS0)
/BOTH LISTS MUST BE KEPT IN SPECIFIED
/ORDER.
/IF THERE IS AN LFS ON LINE MUST MARK IT
/NO-LONGER-DEFINED-ON-PAGE IN PST.
/
PUSHIN, 0
TAD LFS /IS THERE AN LFS
SNA CLA
JMP PSHIN2 /NO
JMS I OBSYM
LFS
JMS I SPSTAB /GET ITS POINTERS TO THE PAGE SYMBOL TABLE
NOP
TAD I PSTCPR /KILL THE DEFINED BIT
AND K3777A
DCA I PSTCPR /SET PAGE SYMBOL TABLE CODE WORD OFF PAGE
PSHIN2, JMS PUSHER
LFS-1
TLFS-1
JMP I PUSHIN /RETURN
/
/ ROUTINE TO POP UP A PUSHED DOWN INSTRUCTION
/
POPIN, 0
CLA
JMS PUSHER
TLFS-1
LFS-1
JMP I POPIN /RETURN
TLFS, 0 /KEEP THIS LIST ORDERED AS GIVEN
TOP, 0
TIB, 0
TAFS, 0
TUMIC, 0
TNSGN, 0
TEXP, 0
TSKZ, 0
TBANK, 0
TS0, 0
/
/TRANSFER ANY LIST OF 10 (12 OCTAL) ITEMS
/FROM ONE LIST TO ANOTHER
/CALL SEQ.: JMS PUSHER
/ ADDR-1 OF FROM-LIST
/ ADDR-1 OF TO-LIST
/ RET.
/
PUSHER, 0
TAD M12A
DCA TEM1 /CTR
TAD I PUSHER
DCA X1 /INDEX FROM LIST
ISZ PUSHER
TAD I PUSHER
DCA X2 /INDEX TO LIST
TAD I X1
DCA I X2
ISZ TEM1
JMP .-3
ISZ PUSHER
JMP I PUSHER
M12A, -12
K3777A, 3777
/RETRN PSUEDO-OP
/
PRTN, JMS I GETSYM /GET NEXT INPUT ITEM
SKP /NOTHING
JMP .+3 /SYMBOL
NOP /CONSTANT
IERROR /LITERAL
JMS I SKIPL
JMS I SREST /PLACE SYMBOL ON EXTERNAL SYMBOL TABLE
DCA PRTN0 /SAVE SYMBOL ID
JMS PUSHIN /PUSH LFS INFO IN CASE OF PAGE ASSEMBLY
TAD K2 /SET AC TO 2
JMS I PRTN1 /ARE THERE 2 LOCATIONS ON THIS PAGE
SKP CLA /YES
JMS I INI /NO ... HAD TO ASSEMBLE PAGE ... INITIALIZE PT
JMS POPIN /POP LFS INFO FROM PAGE PUSH LIST
JMS I ICPLFS /PROCESS ANY LFS
TAD I PTCPR /PT CODE WORD WITH POSSIBLE LFS BIT
TAD K30 /ADD SPECIAL RELOCATION BIT
DCA I PTCPR /PLACE PROPER CODE WORD ON PT
TAD DOTRTN
DCA I PTSPR /PLACE JMS .RTN INSTRUCTION IN PT SYMBOL WORD
JMS I PRTN3 /INCREMENT PT POINTERS
TAD K130 /PROPER BIT PATTERN
DCA I PTCPR /TO PT CODE WORD
TAD PRTN0 /PLACE EXTERNAL SYMBOL NUMBER ON PT
DCA I PTSPR /AS SYMBOL WORD
JMS I PRTN3 /INCREMENT PT POINTERS
JMP I POPEXP /EXIT FOR NEXT LINE
DOTRTN, JMS RTN
PRTN0, 0
PRTN1, IFFSUB
PRTN3, ASMIF1
/
/ @PAUSE@ PSEUDO OPERATION
/
PPAUSE, JMS I WLNIFI /LIST IF PASS 2
CLA HLT /WAIT FOR OPERATOR ACTION
RFC /SELECT READER
JMS I INITRP
JMS I SKIPL
PPAUS1, CMA /WE REACH THIS ONLY IF FORFLG. LE. 0(ALSO COME FROM *PEND*)
DCA FORFLG /SHUT OFF FORTR IN CASE GUY
/HAS STARTED HIS TAPE IN
/THE MIDDLE
JMP I DCIL1 /RETURN FOR NEXT LINE
WLNIFI, WLNIF1
/
/OVERAL ASSEMBLY INITIALIZATION
/
INITA, 0
CDF 10
DCA I FATALP
JMS I CRLF
JMS I CRLF
TAD PEB
DCA I PEPTRP
JMS PUSHER /INIT HICOM, PAGE, ESTSIZ, EQVBIT & APMSW ETC
K777-1
HICOM-1
JMS I INITRP
TAD PASS
SZA CLA
JMP I INITA
DCA SYMBOL /PROTECT FROM RUSVL
JMS I INITMP
DCA CSUM
TAD K10 /SET PUSH CTR=-2
JMS PUSHER /INIT OTP & STP
OTPR-1
OTP-1
JMS I LEADI
JMP I INITA
OTPR, CORE1-1 /KEEP STTR IMMEDIATELY AFTER OTPR
STTR, STTP
/***** KEEP ITEMS SO INCLOSED IN GIVEN ORDER
K777, 177
200
0
0
0
1
1
0
0
0
/******************
INITRP, INITR
FATALP, FATAL
PEPTRP, PEPTR
LEADI, LEADER
PEB, PEBSE
INITMP, INITMR
*4400
/
/ ROUTINE TO SEARCH SYMBOL TABLE FOR SYMBOL IN S0-S3
/ PLACES SYMBOL ON TABLE IF NOT THERE
/ CALL IS
/ JMS SRSYM
/ NOT FOUND EXIT
/ FOUND EXIT
/RETURNS WITH SYMBOL CODE BITS IN "USE"
/SYMBOL VALUE (0 IF NOT DEFINED)
/IN "VAL"
/& PTR TO SYM.TAB. ENTRY IN "SYMBOL"
/THE LATTER ADDRESS IS REFERRED TO HERE IN
/AS THE SYMBOL "ID"
/SRSYM CALL RUSVL TO STORE USE & VAL
/OF LAST REFERENCED SYMBOL IN MST
/IN CASE THEY HAVE BEEN CHANGED
/IN THE MEANWHILE.
/
SRSYM, 0
JMS RUSVL
TAD MST /START AT SYM. TAB. BASE
SRS1, DCA SYMBOL /SET PTR. TO NEXT ENTRY
TAD STT /COMPARE PTR. WITH SYM. TAB. TOP
CIA
TAD SYMBOL
SNA CLA /CONTINUE SEARCH
JMP SRS2 /NAME NOT IN TABLE ENTER IT
CDF 00
TAD I SYMBOL /GET ENTRY CODE WORD
CDF 10
AND K3 /EXTRACT SYMBOL LENGTH
DCA TEM2
TAD TEM2
CIA /NEGATE FOR COMPARE & CTR.
DCA TEM1
TAD TEM1 /COMPARE ENTRY & LOOK-UP SYMBOL LENGTHS
TAD S0
SZA CLA /SAME LENGTH; COMPARE LETTERS
JMP SRS5 /NOT SAME; GO TO NEXT ENTRY
TAD AS0 /AUTO-INDEX LOOP-UP SYMBOL
DCA X1
TAD SYMBOL /AUTO-INDEX TABLE ENTRY
DCA X2
SRS3, CDF 00
TAD I X2 /GET TABLE ENTRY CHAR. PAIR
CIA
CDF 10
TAD I X1 /COMPARE LOOK-UP SYMBOL CHAR. PAIR
SZA CLA /SAME
JMP SRS5 /NO MATCH
ISZ TEM1 /CK SYM. LEN. CTR.
JMP SRS3 /NOT DONE, TRY NEXT CHAR. PAIR
SRS4, JMS SUSVL /GET USE & VAL WORDS
JMP I SRSYM
SRS5, TAD SYMBOL /PTR TO LAST ENTRY
TAD K2 /+2 FOR USE & VAL WORDS
TAD TEM2 /+ENTRY SYMBOL LENGTH
JMP SRS1 /=PTR TO NEXT ENTRY
/
/CURRENT SYMBOL NOT ON TABLE ... PLACE IT THERE
/
SRS2, TAD OTP /WILL NEW ENTRY FIT BELOW
CIA CLL /OCCURANCE TABLE?
TAD SYMBOL
TAD S0
SZL CLA /0 LINK=YES
SERROR /NO, SYMBOL TABLE OVERFLOW
TAD S0 /ENTRY CODE WORD = SYM. LEN.
TAD K1000 /+REL BIT
CDF 00
DCA I STT /PUT CODE IN 1ST WORD OF NEW ENTRY
TAD STT /AUTO-INDEX ENTRY
DCA X2
TAD AS0 /AUTO-INDEX SYMBOL TO BE STORED
DCA X1
TAD S0 /SET SYM. LEN. CTR.
CIA
DCA TEM1
ERS1, CDF 10
TAD I X1 /MOVE SYMBOL CHAR. PAIR TO TABLE
CDF 00
DCA I X2
ISZ TEM1 /CK. CTR.
JMP ERS1 /NOT DONE
DCA I X2 /CLR VALUE WORD
TAD STT /SAVE PTR TO NEW ENTRY
DCA SYMBOL
TAD X2 /RESET PTR. TO SYM. TAB. TOP
IAC
DCA STT
CDF 10
JMP SRS4
/
/OBTAIN GIVEN SYMBOL'S VITAL INFO FROM MST
/CALL SEQ: JMS OBNSYM
/ ADDRESS OF SYMBOL ID
/ RET.
/OBNSYM LEAVES SYMBOL ID IN "SYMBOL",
/ SYMBOL CODE WORD IN USE,
/ SYMBOL VALUE IN VAL.
/OBNSYM CALLS RUSVL BEFORE ACTION
/FOR SAME REASON AS SRSYM DOES.
/
OBNSYM, 0
JMS RUSVL
TAD I OBNSYM /ADDRESS OF SYMBOL
DCA TEM1
TAD I TEM1 /ACTUAL SYMBOL
DCA SYMBOL
ISZ OBNSYM /INDEX FOR EXIT
JMS SUSVL /SET UP USE AND VALUE WORDS
JMP I OBNSYM /RETURN WHEN FOUND
/
/ ROUTINE TO SET UP USE AND VALUE WORDS
/
SUSVL, 0
CDF 00 /OFF TO BANK 1
TAD I SYMBOL /MST USE WORD FROM BANK 1
DCA USE /TO BANK 0 USE LOCATION
TAD USE
AND K3
IAC
TAD SYMBOL
DCA VALPTR
TAD I VALPTR /MST VALUE WORD FROM BANK 1
DCA VAL /TO BANK 0 VALUE LOCATION
CDF 10 /RESTORE DATA FIELD
JMP I SUSVL /RETURN
RUSVL, 0
CDF 00
TAD USE
DCA I SYMBOL
TAD VAL
DCA I VALPTR
CDF 10
JMP I RUSVL
VALPTR, 0 /PTR TO CURRENT VAL WORD IN MST
/
/READ A CHARACTER
/ IGNORES LF, FF, RO, LEADER
/ ALSO CHECKS CHAR AS TO TYPE
/CALLING SEQ: JMS RCH
/ RETURN IF CHAR IS A DIGIT
/ RETURN IF CHAR IS ALPHABETIC
/ RETURN FOR ALL OTHER (PUNCT,ETC)
/LEAVES AC==0
/ CHR=ASCII VALUE OF INPUT CHARACTER
/CALLS SRT
RCH, 0
JMS I GETCHR /GET 1 CHAR
SNA
JMP RCH3 /0=END OF LINE
TAD M260
SPA
JMP RCH3 /TAKE PUNCT.EXIT (200-257)
TAD M12
SPA
JMP RCH4 /TAKE DIGIT EXIT (260-271)
TAD M7
SPA
JMP RCH3 /TAKE PUNCT, EXIT (272-300)
TAD M37A
SMA
RCH3, ISZ RCH /PUNCT, EXIT (337-376)
ISZ RCH /ALPHA EXIT (301-336)
RCH4, CLA /DIGIT EXIT
JMP I RCH
M260, -260
M12, -12
M37A, -36
/FORCE BUFFER FILL ON FIRST READ
INITR, 0
TAD MBE
DCA X3
JMP I INITR
MBE=LINAX /=LAST WORD OF DATA BUFFER
*4600
/SUBR TO READ 1 LINE INTO LINE BUFFER
RLN, 0
DCA LFLG /CLR NON-NULL LINE FLAG
TAD SCOLON /IF LAST LINE ENDED WITH ;
SZA /NO NEED TO READ ANOTHER
JMP RLN4
TAD LINAX /INIT STORAGE AUTO-INDEX
DCA X2
RLN2, JMS FETCH /GET A CHARACTER
JMS I TEST /IS IT A CR,TAB,SP,FF,LF?
SL7-1 /IF SO GO TO RLN15,3,3,2,2
BL6-SL7
ISZ LFLG /OTHERWISE A NON-NULL LINE
RLN3, JMS I STOREP /OTHERWISE PUT IT IN THE BUFFER
TAD X2 /IS BUFFER FULL?
TAD LINEND
SZA CLA
JMP RLN2 /NO
CMA
TAD X2
DCA X2 /IF SO MOVE BACK PTR
JMP RLN2
RLN15, DCA CHR /TERMINATE LINE WITH 0
JMS I STOREP
DCA AFLG
DCA EFLG
DCA VFLG
DCA CODE
TAD LINAX /INIT LINE INDEX
RLN4, DCA X0
DCA SCOLON /CLR
JMP I RLN
STOREP, STORE
LINEND, -LINBUF-107
/SUBROUTINE TO READ 1 CHARACTER VIA INPUT DEVICE
/IGNORES 200'S & 377'S
FETCH, 0
JMS R
AND K177
TAD K200 /FORCE FULL 8BIT ASCII
DCA CHR
TAD CHR
TAD M200
SZA
TAD M177
SNA CLA
JMP FETCH+1
JMP I FETCH
M177, -177
/SUBR TO GET NEXT CHAR FROM HSR BUFFER
/REFILL BUFFER WHEN X3 REACHES END OF BUFFER
R, 0
CDF 00
TAD X3
TAD BUFEND /CK FOR END OF BUFFER
SNA CLA
JMP RG /REFILL
R1, TAD I X3 /GET NEXT CHAR
CDF 10
JMP I R
RG, TAD BUF /INDEX THE BUFFER
DCA X3
RG1, JMS I INDEV
DCA I X3
TAD X3 /CK FOR FULL
TAD BUFEND
SZA CLA
JMP RG1 /NOT FULL
RG3, TAD BUF /RESET PTR
DCA X3
JMP R1
INDEV, HSR
BUF, DATA-1
BUFEND, 1-LINBUF
/GET 1 CHAR FROM LINE BUFFER
L65, 0
CDF 00
TAD I X0
CDF 10
DCA CHR
TAD CHR
JMP I L65
/
/ ROUTINE TO PUNCH LEADER TRAILER CODE
/
LEADER, 0
TAD K7600
DCA TEM1
TAD K200
JMS I PUNCH
ISZ TEM1
JMP .-3
JMP I LEADER
/
/ ROUTINE TO TYPE RETURN-LINE FEED
/
0215
0212
L73, 0
CLA
TAD L73-2
JMS I TYPE
TAD L73-1
JMS I TYPE
JMP I L73
/DECIM & OCTAL PSUEDO-OPS
PDEC, JMS I SKIPL
IAC /SET ARITHMETIC CONVERSION TO DECIMAL
SKP
POCT, JMS I SKIPL
DCA DSW /SET ARITHMETIC CONVERSION TO OCTAL
JMP I NULLP /GO GET NEXT INPUT LINE
/
/ROUTINE TO STOP NEXT LINE FROM BEING LISTED
/THO IT IS ALREADY IN THE BUFR.
/E.G., STOP LISTING OF PUSHED DOWN LINE
/WHILE ASSEMBLING LIT. POOL
/
SAVLIN, 0
CDF 00
TAD I LINEB2 /SAVE 1ST CHAR OF LINE
SNA /IF ANY
JMP .+3 /THERE ISNT ANY
DCA SAVEIT
DCA I LINEB2 /CLR TO PREVENT TYPEOUT
CDF 10
JMP I SAVLIN
/
/REENABLE LISTING OF LINE WHICH SAVLIN
/PREVENTED
/
RELINE, 0
CDF 00
TAD SAVEIT /RESTORE 1ST CHAR OF LINE
DCA I LINEB2
CDF 10
JMP I RELINE
SAVEIT, 0
LINEB2, LINBUF
/ROUTINE TO LIST NULL, COMMENT OR PSUEDO-OP LINE
NULL, DCA VALUE /IF ANY GIVEN
TAD VALUE /SET TYPEOUT FLAG IF NON-0
DCA VFLG
JMS I WLIF /LIST IF PASS 2
JMP I DCIL1 /GO BACK TO RDL1 FOR NEXT LINE
WLIF, WLNIF1
/
/ TYPE ROUTINE
/
L64, 0
TLS /SELECT IT
TSF /WAIT FOR TTY
JMP .-1
CLA /EXIT WITH CLEAR AC
JMP I L64
*5000
/
/ ROUTINE TO SET THE CORRECT COUNTERS FOR THE CURRENT
/ OP CODE AND ADDRESS FIELD SYMBOL
/
/THIS IS A MAJOR ROUTINE. IT IS CALLED ONCE
/FOR EVERY NORMAL (MRI,OPR,IOT) INSTR. COLLECTED.
/IT IS ALSO CALLED DURING PAGE
/RECOUNTING, ONCE FOR EVERY ITEM ON THE
/PAGE TABLE.
/CALLING SEQ: AC=0,JMS,RET WITH AC=0
/FUNCTION: DETERMINE THE TYPE OF LINE BEING
/READ AND SET THE VARIOUS PAGE COUNTERS
/AND FLAGS ACCORDINGLY.
/A FLOW CHART OF TYPES & FLAG SETTINGS IS GIVEN BELOW.
/CONSIDERABLE OVERLAPPING IS USED TO ACHIEVE
/THE MIN. CORE USAGE. THIS IS SOMETIMES AT THE
/EXPENSE OF LOGICAL CLARITY.
/ALL POSSIBLE CONDITIONS EXIT VIA SETC00
/SETC00:(1) IF LAST INSTR. WAS A SKIP & LAST BANK
/ IS NOT= CUR.BANK, BANK=-1.
/ (2) IF CUR. INSTR. IS A SKIP, PGEESC=4
/ OTHERWISE PGEESC=2.
/ (3) LASTSKIP CONDITION= CUR. SKIP CONDITION
/ (4) LAST BANK= CUR. BANK
/
/FLOW OF INSTR. TYPES
/SETCT: IF (PARAMETER OR MICRO-INSTR.) SETC00
/ IF (LITERAL AFS) SETC02
/ IF(CONSTANT AFS) SETC01
/ CALL OBNSYM(AFS)
/ IF (INSTR. IS INDIRECT) SETC07
/ IF (AFS IS IN COMMON) SETCO4
/ IF (ABSOLUTE AFS) SETC05
/ CALL SPSTB (AFS) /SEARCH PST FOR AFS
/ CALL SETSUB
/ IF (AFS NOT BEFORE ON PST) SETC06
/ IF (AFS WAS IN PST BUT NOT DEF. ON PAGE)SETC12
/ IF (OP CODE=JMS) BANK=1
/ GO TO SETC00 /ON PAGE MR1
/SETC01:IF (CONST.AFS ON PG.0)J2
/ IF (INSTR. IS INDIRECT) ERROR
/ CALL SLTAB(CONST. AFS) /PUT CONST. IN LIT.TAB.
/J1: IF (BANK NOT=1) SETC13
/ GO TO SETC00
/ J2* IF( INSTR.INDIR.) J1 /PG.0 INDIRECT
/ GO TO SETC00 /PG.0 DIRECT
/SETC04:IF(BANK NOT 0) CALL INCOBA /INC OBACTR
/ CALL NUMSGN
/ S0=RESULT+COMMON ADDR.
/SETC02:CALL SLTAB(S0) /LIT.OR. COMMN. ADDR. TO LIT. TAB.
/ GO TO SETC00
/ IF (AFS NOT PREV. ON PST) SETC11
/ IF (AFS WAS ON PST BUT NOT DEF. ON PAGE) SETC11
/ GO TO J3
/SETC10:CALL NUMSGN
/ IF (ABS.AFS ON PAGE 0) J3
/SETC11:AC=1 /FORCE BANK=1
/SETC09:AC=AC+1 /FORCE BANK=0
/SETC08:AC=AC-2 /FORCE BANK=-1
/ CALL INCOBA /INC OBACTR
/ AC=BANK /(BANK OFFSET BY -1)
/ GO TO SETC13 /(TAKEN CARE OF AT SETC13)
/SETC12:IF (NEW PST CODE BITS 10-11=OLD SAME (IN TEM 3)) J3
/SETC06:INC OPSCTR /OFF PAGE SYMBOL
/J3: IF (BANK=1) SETC00
/ INC AC
/ CALL INCOBA
/J4: IF (THERE HAS NOT BEEN A PST SEARCH) SETC00
/ ADD CHANGE IN OBACTR (OBACTR-OLDOBA) TO PST CODE BITS 3-9
/ GO TO SETC00
/
/NOTE: CONDITION AT J4 IS TESTED BY SETSUB HEADER
/WORD (OBFLG). THIS IS ALWAYS CLEARED
/WHEN SETCT STARTS AND WILL NOT CHANGE
/UNLESS THERE IS A CALL TO SPSTB BECAUSE
/A CALL TO SETSUB ALWAYS FOLLOWS CALL TO
/SPSTB IN SETCT.
/
SETCT, 0
JMS I ICPLFS /CHECK FOR AND PROCESS ANY LFS
DCA OBFLG /CLR
/NEXT 2 LINES MOVED TO
/SETCAL (AS OF V15) TO MAKE ROOM FOR FOLLOWING INSTR. & PTR
/ TAD EXP /IS IT PAR OR A MICRO INST?
/ TAD UMIC
JMS I SETCAP
SZA CLA
JMP I SET00I /YES
CLA CLL CMA RAL
TAD AFS
SNA /IS AFS A CONSTANT
JMP SETC01 /YES
IAC
SNA CLA /IS AFS A LITERAL
JMP I SET02I /YES
JMS I OBSYM /NO ... GET POINTERS TO AFS
AFS
TAD IB /INDIRECT BIT
SZA CLA /IS IT SET
JMP SETC07 /YES
JMS USETST /TEST FOR OFF BANK OR ABSOLUTE
SETC04 /OFF BANK
SETC05 /ABSOLUTE
JMS I SPSTAB /IS AFS ON PST
CMA /NOT FOUND
JMS SETSUB
JMP I SET06I /NO ... MUST BE OFF PAGE
TAD I PSTCPR /YES ... PST CODE WORD
SMA CLA /IS AFS ON PAGE
JMP I SET12I /NO
JMP I SET00I
/
/ INDIRECT MEMORY REFERANCE INSTRUCTION
SETC07, TAD USE /AFS MST USE WORD
AND K20 /IS AFS DUMMY
SZA CLA
JMP I SET08I /YES
JMS USETST /TEST OFF BANK OR ABSOLUTE
SETC09 /OFF BANK
SETC10 /ABSOLUTE
JMS I SPSTAB /IS AFS ON PST
CMA /NOT FOUND
JMS SETSUB
JMP I SET11I /NO
TAD I PSTCPR /YES ... PST CODE WORD
SMA CLA /IS AFS ON PAGE
JMP I SET11I /NO
JMP I SET6P1 /YES
/
/ CONSTANT FOR AN ADDRESS FIELD SYMBOL
/
SETC01, TAD S0 /ACTUAL BINARY CONSTANT
AND K7600 /IS CONSTANT ON PAGE ZERO
SNA CLA
JMP SET01A /YES
TAD IB /NO ... IS IT INDIRECT
SZA CLA
IERROR /YES ... ERROR
JMS I SLITAB /IS CONSTANT ON LITERAL TABLE
/IF NOT SUBROUTINE PUTS IT THERE
TAD OP
SPA CLA /IF OPCODE IS JMS OR JMP THEN BANK IS IRRELEVANT
JMP I SET00I
SET01B, CLA CMA
TAD BANK /BANK SETTING
SNA CLA /IS IT SET TO THE CURRENT BANK
JMP I SET00I /YES ... NO PROBLEMS
JMP I SET00J /EXIT TO; COMMON AREA
/
SET01A, TAD IB /IS INDIRECT BIT SET
SZA CLA
JMP SET01B /YES
JMP I SET00I /NO
SET00I, SETC00
SET02I, SETC02
SET00J, SETC13
SET00B, JMP I SETCT /OFF PAGE RETURN
SET06I, SETC06
SET08I, SETC08
SET11I, SETC11
SET12I, SETC12
SET6P1, SETC6A
SETCAP, SETCAL
/ROUTINE TO TEST MST USE WORD TO DETERMINE WHETHER A SYMBOL IS
/OFF-BANK OR ABSOLUTE
USETST, 0
TAD USE
AND K40
SZA CLA /IS IT OFF BANK?
JMP USESUC /YES- RETURN INDIRECT THROUGH FIRST ARG
TAD USE
AND K3000
ISZ USETST
SNA CLA /IS IT ABSOLUTE?
JMP USESUC /YES- RETURN INDIRECT THROUGH SECOND ARG
ISZ USETST
JMP I USETST /NEITHER - RETURN TO CALL+3
USESUC, TAD I USETST
DCA USETST
JMP I USETST /TAKE PROPER BRANCH
/
/SETSUB IS A UTILITY USED BY SETCT ONLY.
/USED ONLY IMMEDIATELY AFTER A PST SEARCH.
/CALLING SEQUENCE: JMS SPSTB
/ CMA /SPSTB MAY SKIP
/ JMS SETSUB
/ RETURN IF SPSTB SKIPPED OVER CMA
/ RETURN IF SPSTB DID NOT SKIP
/HAS SEVERAL FUNCTIONS:
/(1) SAVE COPY OF OLD VALUE OF OBACTR BEFORE
/CHANGING STARTS- SO IT MAY BE USED AT SETC13.
/(2) IF INSTR IS INDIRECT, THAT'S IT- EXIT
/(3) OTHERWISE SAVE OLD VALUE OF PST CODE BITS 10-11
/FOR LATER USE AT SETC12. WARNING: THIS
/IS SAVED IN TEM3, SO TEM3 IS NOT
/TEMPORARY FOR A FEW MINUTES.
/(4) SET PST CODE BIT 10 IF THIS IS A #REF,
/OR BIT 11 IF IT IS A NORMAL REF.
/ALGORITHM IS A.OR.B=(.NOT.A.AND.B)+A
/
SETSUB, 0
DCA TEM1 /0=FOUND, -1=NOT
TAD OBACTR /SAVE FOR SETC11,12,6,13
DCA I OLDOBP
TAD IB /OMIT CHANGING PST BITS IF INDIRECT
SZA CLA
JMP SETSX
TAD I PSTCPR /SAVE OLD CODE
AND K3
DCA TEM3
TAD NSGN
SZA CLA
IAC /#
IAC
DCA TEM2
TAD TEM2 /OR INTO CODE
CMA
AND I PSTCPR
TAD TEM2
DCA I PSTCPR
SETSX, ISZ TEM1 /FOUND?
ISZ SETSUB /YES
JMP I SETSUB
OLDOBP, OLDOBA
OBFLG=SETSUB
/SUBR TO STORE CHARACTER IN LINE BUFFER
/ASSUMES X1 SET
/CHAR MAY BE IN AC OR IN CHR
STORE, 0
SNA
TAD CHR
CDF 00
DCA I X2
CDF 10
JMP I STORE
/
/ROUTINE TO CHECK NSGN FOR SETCT
/USED ONLY BY SETCT ROUTINE.
/CALLING SEQUENCE: AC=0
/ JMS NUMSGN
/ RETURN WITH AC=0 IF
/ NSGN=0,AC=1 IF NSGN
/ NOT=0.
/NOTE:NSGN MAY BE NON-0 AND NOT=1. THIS
/IS THE REASON FOR NUMSGN.
/
NUMSGN, 0
TAD NSGN
SZA CLA
IAC
JMP I NUMSGN
*5200
/
/ AFS ABSOLUTE
/
SETC05, JMS I NUMSGP
TAD VAL /ABSOLUTE SYMBOL VALUE
AND K7600 /MASK OUT PAGE BITS
SNA CLA /IS ABSOLUTE SYMBOL ON PAGE ZERO
JMP SETC00 /YES ... EXIT
JMS I NUMSGP
TAD VAL /NO ... ABSOLUTE SYMBOL VALUE
DCA S0 /TO LITERAL TABLE SEARCH LOCATION
JMS I SLITAB /SEARCH LITERAL TABLE FOR VALUE
/IF NOT THERE ROUTINE PLACES IT THERE
JMP SETC06+1 /EXIT
/
/ INDIRECT ABSOLUTE
/
SETC10, JMS I NUMSGP
TAD VAL /ACTUAL AFS VALUE
AND K7600
SNA CLA /IS ADDRESS FIELD SYMBOL ON PAGE ZERO
JMP SETC6A /YES
/
/ INDIRECT DUMMY ADDRESS FIELD SYMBOL
/
SETC08, TAD M2 /SET BANK UNKNOWN
/
/ OFF PAGE INDIRECT
/
SETC11, IAC /SET BANK TO CURRENT
/
/ OFF BANK INDIRECT - SET BANK TO 0
/
SETC09,
JMS INCOBA /SET BANK & INCR. OBACTR
TAD BANK
JMP SETC13+1 /EXIT TO COMMON AREA
/
/ ADDRESS FIELD SYMBOL NOT ON PAGE SYMBOL TABLE.
/
SETC12, TAD I PSTCPR /HAS NEW TYPE REF BEEN ADDED?
AND K3
CIA
TAD TEM3
SZA CLA /YES
SETC06, ISZ OPSCTR /INCREMENT OFF PAGE SYMBOL COUNTER
TAD OP
SPA CLA /DON'T WORRY ABOUT BANK FOR JMS'S AND JMP'S
JMP SETC00 /WHICH ARE NOT EXPLICITLY INDIRECT
SETC6A, TAD BANK
SMA SZA CLA
JMP SETC00 /YES ... EXIT TO COMMON AREA
SETC13, IAC
JMS INCOBA /SET BANK TO CUR. & INC OBACTR
TAD I OBFLGP /WAS THERE A PST SEARCH?
SNA CLA
JMP SETC00 /NO
TAD OLDOBA /YES GET CHANGE IN OBACTR
CIA
TAD OBACTR
CLL RTL /IN BITS 1-9
TAD I PSTCPR /ADD TO PST CODE
DCA I PSTCPR
/
/ COMMON AREA
/
SETC00, JMS CMNSET /SET BANK=1 AFTER JMS
JMS I SETCMN /UPDATE BANK AND LSTSKP
SZA CLA /IS CURRENT INSTRUCTION A SKIP?
TAD K2 /YES ... PAGE ESCAPE = 4
TAD K2 /NO ... PAGE ESCAPE = 2
DCA PGEESC
JMP I .+1 /RETURN
SET00B
SETCMN, ASMCMN
/ROUTINE TO SET BANK TO CURRENT AFTER A JMS
CMNSET, 0
TAD OP
TAD K4000
SZA CLA /WAS OP A JMS?
JMP I CMNSET /NO
IAC
DCA BANK
JMP I CMNSET
OLDOBA, 0
OBFLGP, OBFLG
/
/ DIRECT OFF BANK REFERANCE
/
SETC04, TAD BANK /BANK INDICATOR
SZA CLA /IS BANK SET TO OFF
JMS INCOBA /NO, SET BANK TO COMMN & INC OBACTR
JMS I NUMSGP
TAD VAL /YES ... ACTUAL BANK 0 ADDRESS
DCA S0 /TO CONSTANT - LITERAL LOCATION
/
/ LITERAL FOR AN AFS
/
SETC02, JMS I SLITAB /PLACE LITERAL ON LITERAL TABLE
JMP I SET1AP
/
/ COLLECTION ROUTINE TO CHECK FOR AND PROCESS AN LFS
/
/CALLING SEQUENCE: AC=0
/ JMS CPLFS
/ RETURN WITH AC=0
/FUNCTION: USED DURING COLLECTION PHASE
/ EXCEPT WHEN RECOUNTING A PAGE.
/ IF TAG OCCURS ON CURRENT LINE, CPLFS
/ LOCATES (OR ENTERS) IT IN PAGE SYM.TAB.
/ AND SETS THE DEFINED-ON-PAGE BIT IN
/ THE PST CODE WORD.
/ ALSO SETS BANK CONDITION TO UNKNOWN
/ SINCE USER CODE CAN JUMP TO TAG
/ FROM ANYWHERE. ALSO SAVE
/ TAG IN LLFS & RESET LINE COUNT
/ IN CASE WE GET A MULT.DEF. ERROR
/ IN PASS1 WE MUST ALSO DO THE
/ FOLLOWING IF THE SYMBOL IS ALREADY
/ IN THE PST WHEN WE GO LOOK FOR
/ IT: (1) REDUCE THE OFF-PAGE SYM.
/ CTR. BECAUSE OFF-PAGE POINTER (FOR
/ EITHER NORMAL OR # REFERENCES) ARE
/ NO LONGER NEEDED. (2) REDUCE
/ OBACTR BY THE NO. OF EXTRA WORDS
/ OF CODE DUE TO THIS SYMBOL.
/SUBRS. CALLED: OBNSYM(LFS),SPSTB,PSTDEF
/
CPLFS, 0
TAD I RECTI /ARE WE RECOUNTING?
SZA CLA
JMP I CPLFS /YES ... RETURN
TAD LFS
SNA
JMP I CPLFS /NONE THERE
CDF 00
DCA I LFSPTR /PLACE ON LFS TABLE
ISZ LFSPTR /INCREMENT LFS TABLE POINTER
CDF 10
ISZ I PTCPR /SET LFS BIT ON PAGE TABLE
JMS I OBSYM
LFS
JMS I SPSTAB /IS IT ON THE PAGE SYMBOL TABLE
JMP CPLFS3 /NO ... SKIP DECREMENTING
DCA TEM1 /CLR
TAD PASS /SKIP DECREMENTING IF PASS 2
SNA CLA
TAD I PSTCPR /CK USE
AND K3
CLL RAR
SZL
ISZ TEM1 /NORMAL
SZA CLA
ISZ TEM1 /#
TAD TEM1 /SUBTRACT
CIA
TAD OPSCTR
DCA OPSCTR
TAD I PSTCPR /EXTRACT SHARE OF OBACTR DUE
AND C3774 /TO THIS SYMBOL
CLL RTR /MOVE TO LOW ORDER
CIA /SUB. FROM OBACTR
TAD OBACTR
DCA OBACTR
CPLFS3, JMS I PSTDEP
CLA CMA CLL /SET BANK UNKNOWN (THE CLL IS USED ELSEWHERE)
DCA BANK
TAD LFS /SAVE IN CASE OF ERROR
DCA LLFS
DCA LINE /ZERO LINE COUNT FROM LAST LFS
JMP I CPLFS
C3774, 3774
NUMSGP, NUMSGN
PSTDEP, PSTDEF
LLFS, 0
/
/UTILITY FOR SETC04,SETC08,SETC13
/NOT USED ELSEWHERE
/CALLING SEQUENCE: DESIRED BANK SETTING IN AC
/ JMS INCOBA
/ RETURN WITH AC=0
/FUNCTION:(1) SET BANK AS SPECIFIED
/ (2) INCREMENT OFF-BANK ADDITION CTR
/ BY 1 OR 2: 2 IF PREVIOUS INSTR.
/ WAS A SKIP-TYPE, 1 OTHERWISE.
/
INCOBA, 0
DCA BANK
TAD LSTSKP /LAST INSTRUCTION SKIP INDICATOR
SZA CLA /WAS LAST INSTRUCTION A SKIP INSTRUCTION
ISZ OBACTR /+ OLD VALUE OF OFF BANK ADDITION COUNTER
ISZ OBACTR /FOR NEW VALUE OF OFF BANK ADDITION COUNTER
JMP I INCOBA
SET1AP, SET01A
*5400
/
/ ROUTINE TO ASSEMBLE THE PAGE HELD IN THE CURRENT SET OF TABLES
/THIS IS THE MAIN PASS1 ASSEMBLY ROUTINE
/(NOT USED BY PASS2)
/ASMBL GOES THRU ENTIRE PAGE TABLE
/FLOW: (1) CALL A1 TO INIT. PAGE ASSEMBLY
/ (2) GET ITEM OFF P.T.
/ (3) CALL ASM02 TO ASSEMBLE ITEM
/ (4) LOOP BACK TO (2) TIL DONE WITH PAGE
/ (5) CALL A2 TO ASM. LITERALS
/ASMBL IS CALLED TWICE BY L55 FOR
/EACH PAGE OF CODE.
/
ASMBL, 0
JMS A1
JMS I ILC4PT /OUTPUT PAGE ORIGIN
JMS I INIS /DO INITS.
TAD PTSZE /PLACE - SIZE OF PAGE TABLE
CIA
DCA INDX1 /IN AN INDEX LOCATION
TAD LFSBSE /SET UP LFS TABLE POINTER
DCA LFSPTR
CLA CMA
DCA PHASE /SET PHASE SWITCH TO ASSEMBLY
JMS I ASM02I /SKIP INCREMENTING POINTERS THE FIRST TIME
JMS I ISSI /INCREMENT PAGE TABLE POINTERS
ISZ INDX1 /OVER YET
JMP .-3
JMS A2
JMP I ASMBL
ISSI, ISZPT
/
/ASSEMBLY ROUTINE TO FINISH OFF A PAGE
/(1) PUTS OUT PAGE ESCAPE
/(2) LITERAL POOL (BY CALLING OAPLT)
/(3) GET READY FOR NEXT PAGE
/
A2, 0
JMS I SAVLNP /STOP NEXT LINE LISTING
TAD APMSW /ARE WE IN AUTOMATIC PAGING MODE
SZA CLA
JMP A2NONA /NO ... DONT SEND PAGE ESCAPE
TAD PGEESC /SIZE OF PAGE ESCAPE REQUIRED
RTR /2 BIT TO LINK
SZL CLA
JMP ASM01A /2 INSTRUCTION PAGE ESCAPE
/4 INSTRUCTION PAGE ESCAPE
JMS I WRITEP
JMS I OUTBIN /JMP NEXT TO LAST LOC ON THIS PAGE
K5376
0
ISZ ILC /FOR BENEFIT OF "WRITE"
CLA CMA
JMS A2SUBR /OUTPUT JMP AND LITERAL TABLE
JMS I OUTSKP /OUTPUT 2 SKIP INSTRUCTIONS
JMS I OUTSKP
JMP ASM01B /RETURN
/
ASM01A, JMS A2SUBR /OUTPUT JMP AND LITERAL TABLE
JMS I WRITEP
JMS I OUTBIN /PLACE A NOP IN THE LAST LOCATION
K7000
0
ASM01B, JMS I RELNP /RESTORE NEXT LINE FOR LISTING
TAD ACTR /REMAINS 1 DURING PASS 2
SZA CLA
JMP I A2 /EXIT IF LISTING OR 2ND ASSEMBLY
TAD PUPGE /SAVE ESCAPE ON PUSH DOWN LIST
CDF 00
DCA I PEPTR
CDF 10
ISZ PEPTR /MOVE STACK PTR
JMP I A2 /RETURN
A2NONA, JMS I OUAPLT
DCA PUPGE /CLR
JMP ASM01B
/SUBROUTINE TO ELIMINATE SOME COMMON CODE
/
A2SUBR, 0
TAD K177
TAD PAG
DCA A2TEMP /SET ILC IN CASE NO LITERALS
JMS I WRITEP
JMS I OUTBIN
K5377
0
JMS I OUAPLT /OUTPUT LITERAL TABLE
TAD A2TEMP
DCA ILC /SET ILC TO 176 OR 177 IN PAGE
JMS I ILC4PT
JMP I A2SUBR /RETURN
A2TEMP, 0
ILC4PT, ILC4
ASM02I, ASM02
INDX1, 0
INIS, INISUB
OUAPLT, OAPLT
SAVLNP, SAVLIN
RELNP, RELINE
PEPTR, PEBSE
REDUCE, 0
CDFSKP, JMS CDFSK
/
/INITIALIZE A PAGE ASSEMBLY
/
A1, 0
TAD PAG /MOVE PAGE TO ILC
DCA ILC
DCA LITSIZ /ZERO LITERAL TABLE SIZE
TAD PASS
SNA CLA
JMP I A1 /EXIT IF PASS 1
CDF 00
TAD I PEPTR /GET NEXT PAGE ESC FROM STACK
CDF 10
ISZ PEPTR /MOVE PTR
DCA REDUCE
JMP I A1
/
/ DUMMY PSEUDO OP
/
PDUMMY, JMS I GETSYM /GET NEXT INPUT ITEM
SKP /NOTHING THERE
JMP .+3 /SYMTOL
NOP /CONSTANT
IERROR /LITERAL
JMS I SKIPL
TAD USE /MST USE WORD
AND K3403 /SAVE SYMBOL LENGTH, TYPE BITS, AND DEF BIT
TAD K20 /ADD CORRECT MST BIT FOR DUMMY
DCA USE /FOR CORRECT CODE WORD
JMP I NULLP /EXIT TO GET NEXT LINE
K3403, 3403
/
/COMPUTE CURRENT PAGE SIZE
/ENTER WITH AC=0
/EXIT WITH PAGE SIZE IN AC
/
CPGES, 0
TAD APMSW /OMIT PGEESC IF NON-AUTO PAGING
SNA CLA
TAD PGEESC /+SIZE OF ESCAPE REQUIRED
TAD PTSZE /SIZE OF PAGE TABLE
TAD LTSZE /+SIZE OF LITERAL TABLE
TAD OPSCTR /+OFF PAGE SYMBOL COUNTER
TAD OBACTR /+OFF BANK ADDITION COUNTER
DCA PSTDEF /STORE IN TEM.
TAD PSTDEF /GET IT BACK
TAD PAG /AND CHECK FOR 7600 PAGE OVERFLOW
AND K7600
TAD K200
SNA CLA
SERROR /OVERFLOW-ERROR S
TAD PSTDEF /O.K. GET PAGE SIZE, WHICH
JMP I CPGES /IS DESIRED RESULT
/ROUTINE TO SET DEFINED BIT ON PST
/USED BY CPLFS & ANUMCK
PSTDEF, 0
TAD I PSTCPR /PROTECT CODES
SMA
TAD K4000 /SET DEFINED BIT ON PST
DCA I PSTCPR
JMP I PSTDEF
*5600
/
/ CONSTANT FOR AN ADDRESS FIELD SYMBOL
/
ASM05, TAD I PTSPR /ACTUAL BINARY CONSTANT
AND K7600 /IS IT ON PAGE ZERO
SZA CLA
JMP I ASM5CI /NO
TAD I PTSPR /ADD IN PAGE ZERO ADDRESS
DCA TEMP6
TAD I PTCPR /YES ... IS IT INDIRECT
AND K400
SNA CLA
JMP ASM00 /EXIT TO COMMON AREA
TAD TEMP6
JMP I ASM5AI
ASM5AI, ASM12E
ASM5CI, ASM05C
/
/ OFF BANK DIRECT (COMMON DIRECT)
/
ASM08, JMS I NSCHKP
TAD VAL /ACTUAL ADDRESS IN BANK ZERO
DCA S1 /TO 2 WORD LITERAL TABLE SEARCH LOCATION
CLA IAC
DCA S0 /ABSOLUTE SEARCH
JMS I SERALP /GET A PAGE ADDRESS
TAD K400 /ADD INDIRECT BIT
DCA TEMP6
TAD BANK /BANK INDICATOR
SNA CLA /IS IT SET
JMP ASM00
DCA I ASMX5I
TAD KCDF1A
DCA I ASMX4I
TAD CDZSKI
DCA I ASMX6I
DCA TEM7
JMP I ASME7I
ASMX5I, ASMX5
ASMX4I, ASMX4
KCDF1A, KCDF10
ASMX6I, ASMX6
ASME7I, ASME7
CDZSKI, CDZSKP
SERALP, SRALT
NSCHKP, NSCHK
/
/ASM02 IS THE HEART OF ASSEMBLY
/IT IS CALLED ONCE FOR EACH ITEM ON
/THE PAGE TABLE.
/IT CONSISTS OF MANY PARTS, ONE FOR
/EACH BASIC TYPE OF INSTR. TO BE
/ASSEMBLED PLUS VARIOUS COMMON EXITS
/
ASM02, 0
DCA LFS /ZERO LFS INDICATOR
TAD PASS
SZA CLA
JMS I GETBAP /RESTORE BANK & LSTSKP IF PASS2
JMS I LFSCHK /PROCESS LFS IF ANY
JMS I ANCHK /PROCESS BSS 0 IF ANY
KCDF00, CDF 00
TAD I PTOPR
KCDF10, CDF 10
DCA OP
TAD I PTCPR
AND K40 /IS IT A SKIP INSTRUCTION
DCA CURSKP /YES ... SET SKIP INDICATOR
TAD I PTCPR
AND K10 /IS IT A PSEUDO OP (PAR)
SZA CLA
JMP I ASM03I /YES ... EXIT
TAD I PTCPR
AND K4 /IS IT A MEMORY REFERANCE INSTRUCTION
SZA CLA
JMP ASME1 /NO
TAD I PTCPR /PT CODE WORD
AND K20 /IS AFS A CONSTANT
SZA CLA
JMP ASM05 /YES
TAD I PTCPR /PT CODE WORD
AND K2 /IS AFS A LITERAL
SZA CLA
JMP I ASM06I /YES
TAD I PTSPR /AFS ID WORD FOR SYMBOL TABLE
DCA AFS /TO DIRECTLY ADDRESSABLE LOCATION
JMS I OBSYM /GET ITS POINTERS TO MST
AFS
TAD I PTCPR /PT CODE WORD
AND K400 /IS OP INDIRECT
SZA CLA
JMP I ASM2AI /YES
JMS I UZTST /TEST FOR OFF BANK OR ABSOLUTE
ASM08 /OFF BANK
ASM09 /ABSOLUTE
JMP I ASM07I /NO
ASM2AI, ASM02A
ASM03I, PPAR1
ASM06I, ASM06
ASM07I, ASM07
ANCHK, ANUMCK
UZTST, USETST
/
/ END OF LINE NECESSITIES
/
ASM00, TAD TEMP6
ASME1, TAD OP
ASME2, DCA TEM1
JMS I WRITEP
JMS I OUTBIN
TEM1
ASME1X, 0
ASM01, JMS I CMNASM /SET BANK=1 AFTER A JMS
JMS ASMCMN /SET BANK AND LSTSKP
DCA SKPSAV /SAVE CURSKP IN SKPSAV
TAD BANK /SAVE FOR PROTECTION DURING LISTING
DCA BNKSAV
ISZ ILC /INCREMENT ILC
ASM02R, JMP I ASM02 /USED AS OFF-PAGE RETURN
SERROR /ILC OVERFLOWED 7777 - PROGRAM TOO BIG
CMNASM, CMNSET
GETBAP, GETBAS
BNKSAV, 0
SKPSAV, 0
OPISUB, JMS OPIS
OBISUB, JMS OBIS
/SUBROUTINE TO UPDATE BANK,LSTSKP,LSTBNK
/
ASMCMN, 0
TAD LSTSKP /IS LAST INSTRUCTION A SKIP INSTRUCTION
SNA CLA
JMP .+10 /NO
TAD LSTBNK /YES ... LAST BANK
CIA
TAD BANK /+CURRENT BANK
SNA CLA /ARE THEY THE SAME
JMP .+3 /YES
CLA CMA /NO ... SET BANK UNKNOWN
DCA BANK
TAD CURSKP /PLACE CUR SKIP INDICATOR
DCA LSTSKP /AS LAST SKIP INDICATOR
TAD BANK /PLACE CURRENT BANK
DCA LSTBNK /IN LAST BANK INDICATOR
TAD LSTSKP
JMP I ASMCMN
*6000
/
/
/ INDIRECT DUMMY ARGUMENT
/
DUMSUB
ASM10, TAD I .-1
DCA TEMP6
CLA CMA /SET BANK UNKNOWN
JMP ASME3 /EXIT FOR SKIP CHECK
/
/ OFF BANK INDIRECT (INDIRECT COMMON)
/
OBISUB
ASM11, TAD I .-1
DCA TEMP6
/
TEMP6=EXP
ASME3, DCA BANK /SET C(AC) IN BANK
TAD LSTSKP /WAS LAST A SKIP?
SNA CLA
JMP ASME4 /NO
//FOLLOWING 6 LINES HAVE BEEN
//MOVED TO 6600 TO MAKE ROOM FOR V03
JMP I .+1
ASMEXT
// JMS I OUTSKP /YES, OUTPUT SKP
// TAD ILC /GET PG.LOC.PTR.
// TAD K4 /+4
// AND K177
// TAD K5200A /OUTPUT JMP .+4
// DCA TEM1
REEASM, JMS I WRITEP
JMS I OUTBIN
TEM1
0
ISZ ILC /INCREMENT PG.LOC.PTR.
ASME4, JMS I WRITEP
JMS I OUTBIN /OUTPUT JMS TO
TEMP6 /OBISUB,OPISUB, OR DUMSUB
0
ISZ ILC
JMS I ASM10B /PPAR3S
ISZ ILC
TAD OP
TAD K407
JMP I ASME2P
ASME2P, ASME2
ASM02A, TAD USE /AFS MST USE WORD
AND K20 /IS AFS A DUMMY ARGUMENT
SZA CLA
JMP ASM10 /YES
JMS I UZETST /TEST FOR OFF-BANK OR ABSOLUTE
ASM11 /OFF-BANK
ASM12 /ABSOLUTE
JMP I ASM13I /NO
ASM10B, PPAR3S
ASM13I, ASM13
K407, 0407
ASME5A, TAD OP
SPA CLA /BANK NEED NOT BE CURRENT FOR A JMP OR JMS
JMP ASME6+2 /WHICH IS NOT EXPLICITLY INDIRECT
ASME5, TAD BANK
SMA SZA CLA
JMP ASME6+2
ASME7, TAD LSTSKP
SZA CLA
JMP .+7
JMS I WRITEP
JMS I OUTBIN
ASMX4, KCDF00
ASMX5, 5
ISZ ILC
JMP ASME6
JMS I WRITEP
JMS I OUTBIN
ASMX6, CDFSKP
0
ISZ ILC
JMS I OUTSKP
ASME6, TAD TEM7
DCA BANK
TAD K5
DCA ASMX5
TAD KCDFA
DCA ASMX4
TAD CDFSKI
DCA ASMX6
IAC
DCA TEM7
JMP I .+1
ASM00
CDFSKI, CDFSKP
ASME1I, ASME1
KCDFA, KCDF00
UZETST, USETST
/
/ SYMBOL TABLE TYPEOUT FLAG TYPEOUT ROUTINE
/CALL SEQ.: TAD USE /GET TYPE BITS
/ RTL
/ RTL
/ JMS STFT
/ RETURN
/USED ONLY BY PRSYM
/
STFT, 0
AND K3 /MASK OUT TYPE BITS
SNA
JMP STFT3 /ABSOLUTE SYM.
TAD M3 /CK FOR NEW OPDEF
SNA
JMP STFT2 /YES
IAC
SNA
JMP STFT5 /EXTERNAL
SZL CLA
JMP STFT1 /DEFINED
TAD K2516 /"UN"
JMS I CTYPE
TAD K0406 /"DF"
STFT0, JMS I CTYPE /TYPE FLAG
STFT1, CLA /WE MUST HAVE A CLEAR AC
JMP I STFT /RETURN
K2560, 2560
K1720, 1720
STFT2, TAD K1720 /TYPE "OP"
JMP STFT0
STFT3, TAD USE
AND K40
SZA CLA
JMP STFT4 /COMMON
TAD K0102 /"AB"
JMS I CTYPE
TAD K2300 /"S "
JMP STFT0
STFT4, TAD K0317 /"CO"
JMS I CTYPE
TAD K1500 /"M "
JMP STFT0
K0102, 102
K0317, 317
K2300, 2300
K1500, 1500
K2516, 2516
K0406, 406
K0530, 530
K2400=SLITAB
STFT5, TAD K0530 /"EX"
JMS I CTYPE
TAD K2400
JMP STFT0
*6200
/
/ LOCAL DIRECT REFERANCE
/
ASM07, JMS I SPSTAB /IS AFS ON PST
JMP ASM07A /NO ... ROUTINE PLACES IT THERE
TAD I PSTCPR /PST CODE WORD
SMA CLA /IS SYMBOL ON PAGE
JMP ASM07A /NO
JMS NSCHK
TAD VAL /AFS MST VALUE
AND K177 /SAVE PAGE ADDRESS
TAD K200 /ADD PAGE BIT
JMP I AS00I4 /
ASM07A, TAD I PTSPR /ACTUAL SYMBOL
DCA S1 /TO 2 WORD LITERAL TABLE SEARCH LOCATION
JMS NSCHK
CLL RTL
TAD K2 /RELOCATABLE SEARCH
JMP ASM05C+3
ASM09B, JMS NSCHK
TAD VAL /DIRECT NON-PAGE 0 ABSOLUTE
SKP
/
/
/ NON PAGE ZERO CONSTANT ADDRESS
/
ASM05C, TAD I PTSPR /ACTUAL BINARY CONSTANT
DCA S1 /TO 2 WORD LITERAL TABLE SEARCH LOCATION
CLA IAC
DCA S0 /ABSOLUTE SEARCH
JMS I SERALT /GET A PAGE ADDRESS
TAD K400 /ADD INDIRECT BIT
DCA TEMP6
JMP I .+1
ASME5A /EXIT FOR SKIP CHECK IF OP IS NOT JMP OR JMS
/
/ DIRECT ABSOLUTE OR EXTERNAL
/
ASM09, JMS NSCHK
TAD VAL /ABSOLUTE SYMBOL VALUE
AND K7600 /IS SYMBOL ON PAGE ZERO
SZA CLA
JMP ASM09B /NO
JMS NSCHK
TAD VAL /ADD IN PAGE ZERO ADDRESS
JMP I AS00I4 /
AS00II, ASME5
/
/ LITERAL FOR AN ADDRESS FIELD SYMBOL
/
ASM06, TAD I PTSPR /ACTUAL LITERAL
DCA S1 /TO 2 WORD LITERAL TABLE SEARCH LOCATION
CLA IAC
DCA S0 /ABSOLUTE SEARCH
JMS I SERALT /GET A PAGE ADDRESS
JMP I AS00I4 /EXIT FOR SKIP CHECK
AS00I4, ASM05+5
OUTSK, 0
JMS I WRITEP
JMS I OUTBIN
K7410
0
ISZ ILC
JMP I OUTSK
SERALT, SRALT
/
/ INDIRECT ABSOLUTE
/
ASM12, TAD VAL /AFS MST USE WORD
AND K7600 /IS IT ON PAGE ZERO
SZA CLA
JMP ASM12F /NO
/
/ INDIRECT PAGE ZERO ABSOLUTE SYMBOL
/
JMS NSCHK
TAD VAL /SAVE PAGE ZERO ADDRESS
ASM12E, TAD K400 /ADD INDIRECT BIT
DCA TEMP6
JMP I AS00II
/
/ INDIRECT NON PAGE ZERO ABSOLUTE SYMBOL
/
OPISUB
ASM12F, TAD I .-1
DCA TEMP6
TAD BANK
JMP I AS00I3 /EXIT FOR SKIP CHECK
AS00I3, ASME3
K5377, 5377
/
/ LOCAL INDIRECT REFERANCE
/
ASM13, JMS I SPSTAB /IS AFS ON PST
JMP ASM14 /NO ... MUST BE OFF PAGE
TAD I PSTCPR /YES ... PST CODE WORD
SMA CLA /IS AFS ON PAGE
JMP ASM14 /NO
JMS NSCHK
TAD VAL /AFS VALUE FROM MST
AND K177 /SAVE PAGE DISPLACEMENT
TAD K600 /ADD PAGE AND INDIRECT BIT
DCA TEMP6 /SAVE
JMP I AS00II /GO OUTPUT INSTRUCTION
/
/ OFF PAGE INDIRECT
/
OPISUB
ASM14, TAD I .-1
DCA TEMP6
CLA IAC /SET BANK TO CURRENT
JMP I AS00I3 /EXIT FOR SKIP CHECK
NSCHK, 0
TAD I PTCPR
AND K2000
SZA CLA
IAC /ITS A #
JMP I NSCHK
/"IF" - CONDITIONAL ASSEMBLY PSUEDO-OP
PIF, JMS I GETSYM
JMP PIFERR /NOTHING THERE
JMP .+3 /SYM
NOP /CON
JMP PIFERR /LIT
TAD CHR /CK FOR COMMA
TAD M254
SZA CLA
IERROR /NOT A COMMA
ISZ X0 /PREVENT FLAGGING COMMA
JMS I GETSYM /YES, SET CTR TO SKIP N LINES
NOP
SKP
SKP /I WANT A NUMBER
PIFERR, IERROR
TAD USE /IS SYMBOL DEFINED?
AND K400
SZA CLA
DCA S0 /YES, CONTINUE NORMAL ASSMBLY
JMS I SKIPL
TAD S0 /GET THE NUM.
CIA
DCA IFCTR
JMP I NULLP
IFCTR, 0
ILC4, 0
JMS I OUTBIN
ILC
4
JMP I ILC4
/LAP & EAP PSUEDO-OPS
*6372 /MUST BE AT 6372 OR AT PAGE BOUND. +172 FOR K5376 TO WORK AS SKIP
PLAP, JMS I SKIPL
IAC /LEAVE AUTO-PAGING MODE
K5376, 5376 /THIS REPLACES A SKIP.*******DO NOT MOVE********
PEAP, JMS I SKIPL
DCA APMSW /ENTER AUTO-PAGING MODE
JMP I NULLP
*6400
LISTON, 1411
2324
1116
0700
1716
0000
HISP, 1011
0710
0023
2005
0504
0020
2516
0310
7700
RDER, 0022
0501
0405
2277
0000
/ PART OF MAIN PROGRAM
/ RECOUNT ROUTINE
/FOLLOWING CODE CLEANS UP PST CODES BEFORE RECOUNTING
CLNPST, CIA
DCA IOINIT /SET COUNTER
TAD PSTBSE
IAC
DCA PSTCPR /CODE POINTER
TAD I PSTCPR /LOOP
AND K4003K /KILL OBAC DUE TO THIS SYM.
DCA I PSTCPR
ISZ PSTCPR /MOVE PTR
ISZ PSTCPR
ISZ IOINIT
JMP .-6 /NOT DONE
JMP I .+1
RECRET
K4003K, 4003
/
/
/COMMON EXIT FOR DATA-GENERATING PSUEDO-OPS
/
POPEX, DCA BSSSW
TAD LFS /CK FOR TAG
SNA CLA
JMP I DCIL1 /NO TAG
CMA /DECREMENT PTSZE
TAD PTSZE
DCA PTSZE
JMS I RECTI /YES RECOUNT THE PAGE
ISZ PTSZE /RESTORE PTSZE
JMS I ISZPTX /RESTORE PT PTRS
JMP I DCIL1 /RETURN FOR NEXT LINE
ISZPTX, ISZPT
/ROUTINE T0 INITIALIZE I/O DEVICES
C2=JMS I CTYPE
IOINIT, 0
CDF 10
TAD JL64
DCA TYPE
VN, JMP I VERSI
IOI, JMS I CRLF
TAD JHISP
DCA X1
TAD M5
JMS QUERY
JMP RGO
TAD JRDER
DCA X1
TAD M5
JMS QUERY
JMP RGO
RGO, JMS KSR
TAD JHSR
TAD JASR
DCA I INDEVP
JMS I CRLF
TAD JHISP
DCA X1
TAD M11
JMS QUERY
NOP
JMS KSR
JMP .+4
TAD TYPE
DCA PUNCH
JMP IOX
TAD JL63
DCA PUNCH
JMS I CRLF
TAD JLIST
DCA X1
TAD M17
JMS QUERY
NOP
JMS KSR
IAC /1 = PUNCH, 0 = TYPE
IOX, DCA LSTDEV
JMP I IOINIT
QUERY, 0
DCA JCOUNT
TAD I X1
C2
KSF
SKP
JMP I QUERY
ISZ JCOUNT
JMP .-6
ISZ QUERY
JMP I QUERY
KSR, 0
KSF
JMP .-1
KRB
DCA TEM1
TAD TEM1
JMS I TYPE
TAD TEM1
TAD M331
SZA CLA /0="YES"
ISZ KSR /NOT "YES"
JMP I KSR
LSTDEV=QUERY
M331, -331
JHSR, HSR-ASR
JASR, ASR
INDEVP, INDEV
JL63, L63
JL64, L64
JCOUNT=TEM3
JHISP, HISP-1
JLIST, LISTON-1
JRDER, RDER-1
VERSI, VERNUM
M5, -5
M11, -11
M17, -17
*6600
//
//PART OF MAIN PROGRAM MOVED FOR V03
//
/ROUTINE TO RESTORE BANK AND LSTSKP FOR PASS2
/WILL NOT FIT INTO ASM02 WHERE IT BELONGS
GETBAS, 0
TAD I BNKSAP
DCA BANK
TAD I SKPSAP
DCA LSTSKP
JMP I GETBAS
BNKSAP, BNKSAV
SKPSAP, SKPSAV
/INPUT ROUTINES
HSR, 0
DCA TEM10 /CLR TIMER
RFC
HSR1, RSF
JMP HSR2
RRB
JMP I HSR
HSR2, DCA ASR /WASTE SOME TIME
ISZ TEM10 /CK TIMER
JMP HSR1 /KEEP TRYING
REXIT, TAD X3 /CK FOR EMPTY BUFFER
TAD BUFBEG
SZA CLA
JMP .+4 /NO, WE HAVE A PARTIAL BUFFER
CDF 10
JMP I .+1 /YES TAPE HAS ENDED WITH NO END STATMT
ERRE
DCA I X3 /FILL END OF BUFFER WITH 0'S
TAD X3
TAD BUFEN
SZA CLA
JMP .-4
JMP I RG3P /NOW RET. FOR PROCESSING
ASR, 0
TAD M50
DCA TEM11
DCA TEM10
ASR1, KSF
JMP ASR2
KRB
JMP I ASR
ASR2, ISZ TEM10
JMP ASR1
ISZ TEM11
JMP ASR1-1
JMP REXIT
M50, -50
TEM10, 0
TEM11, 0
BUFBEG, 1-DATA
RG3P, RG3
BUFEN, 1-LINBUF
/
/ ENTRY PSEUDO OPERATION
/
PENTRY, JMS I GETSYM /GET NEXT INPUT ITEM
SKP /NOTHING THERE
JMP .+3 /SYMBOL
NOP /CONSTANT
IERROR /LITERAL
JMS I SKIPL
JMS I SREST /PLACE SYMBOL ON EXTERNAL SYMBOL TABLE
CLA
TAD USE /AFS MST USE WORD
AND K403 /SAVE SYMBOL LENGTH (& DEF. BIT FOR PASS 2)
TAD K2220 /ADD IN PROPER BITS
DCA USE /FOR NEW MST USE WORD
JMP I NULLP /EXIT FOR NEXT LINE
K2220, 2220
K403, 403
/
/
/
/INCREMENT PAGE TABLE POINTERS
/
ISZPT, 0
ISZ PTCPR /INCREMENT PAGE TABLE CODE POINTER BY 2
ISZ PTCPR
ISZ PTSPR /INCREMENT PAGE TABLE SYMBOL POINTER BY 2
ISZ PTSPR
ISZ PTOPR /INCREMENT PT OP CODE POINTER
JMP I ISZPT
/
/CK CONSTANT FOR BLOCK PSEUDO-OP
/
PBSS4, TAD APMSW /AUTOMATIC PAGING?
SNA CLA
TAD K2 /YES, 176 IS MAXIMUM
TAD M200 /NO, 200 IS MAX
TAD S0 /CHECK CONSTANT
SMA SZA CLA
IERROR /TOO BIG
TAD S0 /IS CONSTANT 0?
SNA
JMP I PBSS2J /YES, EQUIVALENCE TAG
JMP I PBSS5I /NO, CREATE BLOCK OF THIS SIZE
PBSS2J, PBSS2
PBSS5I, PBSS5
/
/PATCH TO DELETE DEFINED BIT IN PST FOR A TAG
/EQUIVALENCED TO A LINE THAT OVERFLOWED THE PAGE
/
EQVFIX, TAD EQVBIT /WAS THERE SUCH A TAG?
SNA CLA
JMP I L55CP /NO
TAD I EQVBIT /YES, GET PST CODE FOR THIS TAG
TAD K4000 /CANCEL DEFINED BIT
DCA I EQVBIT
TAD K200 /SET EQUIVALENCE BIT FOR NEXT LINE
DCA EQVBIT /WHEN NEXT PAGE GETS GOING
JMP I L55CP /RETURN TO ASSEMBLE THE PAGE WE HAVE
L55CP, L55C
/
/CK FOR TYPE OF SYMBOL
/CALL SEQ: JMS WHATYP
/ RET. IF USER SYMBOL
/ RET. IF OP SYMBOL
/
WHATYP, 0
TAD USE
AND K3000
TAD M3000
SNA CLA
ISZ WHATYP
JMP I WHATYP
/
/EXECUTE ISZ GTSYM (MOVE RETURN POINTER) ONLY IF IFCTR .GE. 0
/OTHERWISE MOVE LINE PTR TO NEXT SLASH, SEMI-COLON OR CAR.RET.
/& ISZ IFCTR & TREAT AS A NULL LINE.
/
CKIF, 0
TAD I IFCT /IS CONDITIONAL NON-ASM IN EFFECT?
SPA CLA
JMP .+3 /YES: DO NOT ASMBL LINE
ISZ I GETSYM /NO, MOVE RETRN PTR & CONT. AS USUAL
JMP I CKIF
ISZ I IFCT /COUNT IGNORED LINE
NOP
TAD CHR /MOVE LINE PTR TO END OF LINE
CKIF2, SNA
JMP CKIF3 /FOUND A CR
TAD M257
SNA
JMP CKIF3 /SLASH
TAD M14
SNA CLA
JMP CKIF3 /SEMI-COLON
JMS I GETCHR /TRY NEXT
JMP CKIF2
CKIF3, JMP I .+1
ITM15
M257, -257
M14, -14
IFCT, IFCTR
*6776
/PAGE SYMBOL TABLE (200 WORDS)
/DOUBLE WORD ENTRIES
/REBUILT FOR EACH CORE PAGE OF CODE
/EVERY SYMBOL DEFINED OR REFERENCED ON
/GIVEN PAGE IS ENTERED
/TYPICAL ENTRY*: WD1=SYMBOL ID
/ WD2=CODE BITS
/SYMBOL ID=ADDRESS OF SYMBOL ENTRY IN MAIN SYM. TAB
/CODE: BIT0=1 IF SYM. DEF. ON CUR. PAGE
/ BIT11=1 IF SYM REFERENCED NORMALLY BY A MR1 ON THE PG.
/ BIT10=1 IF SYM. REF'D. WITH A #
/ BITS 1-9 USED FOR COUNTING AMOUNT OF OBACTR
/ WHICH IS DUE TO THIS SYMBOL
/SYMBOLS ARE ENTERED ON PST IN ORDER OF APPEARENCE
/IN SOURCE
/NO MORE THAN 64 (DEC) SYMBOLS MAY BE REF'D.
/ON ANY PAGE.
/NOTE: THE SIZE OF THIS TABLE SHOULD NOT BE
/INCREASED UNLESS LFS TABLE IS ALSO INCREASED.
*7176
/PAGE TABLE (402 WORDS)
/DOUBLE WORD ENTRIES
/ONE ENTRY FOR EACH INSTRUCTION TO BE ASSEMBLED
/ROOM FOR 1 EXTRA ENTRY TO COVER PAGE OVERFLOW
/A NEW TABLE FOR EACH PAGE OF CODE
/TYPICAL ENTRY: WD1=CODE BITS
/ WD2=SYMBOL WORD
/CODE: BIT1=1 IF # REF
/ BIT2=1 IF CDF TO CUR BANK
/ BIT3=1 IF INDIRECT
/ BIT4=1 IF BLOCK 0 (FOR EQUIVALENCED TAGS)
/ BIT5=1 IF SPECIAL CALL CONST
/ BIT6=1 IF SKIP INST.
/ BIT7=1 IF AFS IS CONST
/ BIT8=1 IF PARAMETER
/ BIT9=1 IF OPR OR IOT INST.
/ BIT10=1 IF AFS IS LITERAL
/ BIT11=1 IF LFS OCCURS
/ BIT0 UNUSED
/THE SYMBOL WORD=0 IF CODE BIT9=1
/ =THE ACTUAL CONST OR LITERAL IF BITS2,5,7 OR 10=1
/ =THE SYMBOL ID (MST ENTRY ADDR.) FOR AN ADDR. PARAMETER
/ OR FOR THE AFS OF AN MRI
/
/TYPE VERSION NUMBER
/(THIS IS ONCE ONLY CODE)
/(OVERWRITTEN BY P.S.T.)
/
*7000
/
VERNUM, JMS I CRLF
TAD JVERS
DCA X1
TAD M26
JMS I MTYPE
NOP
TAD K7000X
DCA I VNOP
JMP I .+1
IOI
JVERS, VERSN-1
MTYPE, QUERY
M26, -15
VNOP, VN
K7000X, NOP
VERSN, 2004 /PDP-8 SABR DEC-08-A2C2-V#
2055
7040
2301
0222
4004
0503
5560
7055
0162
0462
5564 /- VERSION # (1ST DIGIT)
6001 /2ND DIGIT AND PATCH LEVEL
/SABR BANK 1 SECTION
/TABLES
FIELD 0
*0
EQUTB, 0 /EQUIVALENCE TABLE
/100 WORDS
/TABLE IS REINITIALIZED BEFORE EACH PAGE BEGINS
/COLLECTION, IF NO EQUIV. IS LEFT FROM PREVIOUS PAGE
/MULTIPLE WORD ENTRIES
/ONE ENTRY IS MADE FOR
/EACH LOC. TAG WHICH HAS
/EQUIVALENTS
/1ST WORD OF EACH ENTRY
/CONTAINS NO. OF OTHER WORDS
/IN THE ENTRY
/OTHER WORDS ARE SYMBOL ID'S
/(MST ADDRESSES) OF SYMBOLS
/EQUIVALENT TO THE PARTICULAR
/LOCATION TAG
*100
/BSEEST, 0 /EXTERNAL SYMBOL TABLE
/100 WORDS
/SINGLE WORD ENTRIES
/CONSISTING OF THE SYMBOL ID (MST ADDRESS)
/EACH EXT. SYM. IS ENTRED IN
/THE TABLE WHEN IT FIRST
/OCCURS IN THE SOURCE AND
/ASSIGNED A LOCAL EXT. NUMBER
/ACCORDING TO ITS PLACE IN THE
/TABLE.
*200
/PTOPTB, 0 /PAGE OP CODE TABLE
/200 WORDS
/SINGLE WORD ENTRIES
/ONE FOR EACH ENTRY IN PAGE TABLE
/ENTRY=ACTUAL OP CODE FOR
/ALL MRI, OPR OR IOT'S
/OR 0 FOR ALL PARAMETERS
/NEW TABLE FOR EACH PAGE OF CODE
/NOTE: THIS TABLE MAY OVERFLOW BY 1 WORD DURING COLLECTION
/OVERFLOW CAUSED BY PUTTING INFO ON TABLE BEFORE CK FOR OVERFLOW
/NO HARM IF ASSEM. PHASE LIT. TAB FOLLOWS
CDF CIF 10 /CODE FOR START AT 200
JMP I .+1
START
*400
/LITBSE, 0 /ASSEMBLY PHASE LITERAL TABLE
/200 WORDS
/DOUBLE WORD ENTRIES
/MUST BE SEPARATE FROM COLL.
/PHASE LIT. TAB. BECAUSE BOTH
/GOING AT ONCE IN PASS 2.
/THIS TABLE CONTAINS NOT
/ONLY LITERALS BUT ALSO
/OFF PAGE POINTERS
/1ST WORD OF ENTRY = 1 OR 2 OR 6
/1 MEANS LITERAL &
/2ND WORD CONTAINS ACTUAL VALUE
/2 MEANS OFF PAGE SYMBOL PTR
/& 2ND WORD CONTAINS SYMBOL ID.
/6 MEANS OFF PAGE SYM. PTR
/WHERE SYMBOL REFERENCED BY A #
/2ND WORD AS FOR 2
/TABLE BUILT ANEW FOR EACH
/PAGE OF CODE.
*600
/LFSBSE, 0 /LOC FIELD SYMBOL TABLE
/100 WORDS
/SINGLE WORD ENTRIES
/EACH=SYMBOL ID (MST ADDRESS)
/OF THE GIVEN LFS
/LFS'S ARE ENTERED IN ORDER
/OF THEIR APPEARENCE IN SOURCE
/TABLE REBUILT FOR EACH PAGE OF CODE
/NOTE: THIS TABLE MUST BE AT LEAST AS LONG
/AS THE PST TO PREVENT LFS OVERFLOW
*700
PEBSE, 0 /PAGE ESCAPE PUSH DOWN LIST
/40 WORDS
/SINGLE WORD ENTRIES
/EACH ENTRY IS 0,2, OR 4
/BEING THE VALUE OF THE
/PAGE ESCAPE (0,2,OR 4 WORDS)
/OF EACH PAGE ASSEMBLED
/THESE NOS. ARE SAVED DURING
/PASS 1 & USED DURING
/PASS 2
*740
/SORT LISTS
/SORT LIST FOR INITIAL CHAR. OF LITERAL
SL3, 242 /QUOTE
255 /MINUS
304 /D
313 /K
-1 /SORT LIST MUST BE FOLLOWED BY A NEGATIVE
/BRANCH LISTS
BL6, RLN15
RLN2
RLN2
RLN3
RLN3
/SORT LIST FOR BEGINNING OF INPUT ITEM
SL2, 255 /MINUS
250 /LEFT PARIN
242 /QUOTE
SL6, 273 /SEMI-COLON
257 /SLASH
SL1, 240 /SPACE
211 /TAB
000 /CR
-1 /SORT LIST MUST BE FOLLOWED BY A NEGATIVE
/BRANCH LIST FOR BEGINNING OF INPUT ITEM
BL2, ITM4 /NEGATIVE
ITM8 /LITERAL
ITM7 /ALPHA CONSTANT
ITM15 /NULL ITEM
ITM15 /NULL ITEM
ITM2 /IGNORE SPACE
ITM2 /IGNORE TAB
ITM15 /NULL ITEM
/BRANCH LIST FOR INITIAL CHAR. OF LITERL
BL3, ITM7 /GET ASCII VALUE FOR LITERAL
ITM10 /SET NEG. SW.
ITM11 /SET MODE TO DECIMAL
ITM12 /SET MODE TO OCTAL
*1000
/LTBSE, 0 /COLLECTION PHASE LITERAL TABLE
/100 WORDS
/SINGLE WORD ENTRIES
/CONTAINING ACTUAL VALUES
/TABLE CONTAINS NOT ONLY
/LITERALS BUT ALSO
/POINTERS TO CONSTANT
/AND ABSOLUTE ADDRESSES.
/TABLE BUILT ANEW FOR
/EACH PAGE OF CODE.
/INPUT DATA BUFFER
/546 (OCTAL) WORDS
/ALL DATA CHARACTERS READ DIRECTLY INTO THIS BUFFER
/1 CHAR. PER WORD
/THE ACTUAL SIZE OF THE BUFFER IS ARBITRARY.
*1100
DATA, 0
/LINE BUFFER (73 WORDS)
/CONTAINS ASCII CHARACTERS, 1 PER WORD
/NULLS & RUBOUTS DONT MAKE IT
/END OF LINE MARKED BY A 0000
/CR,LF,FF DON'T GO INTO THE BUFFER
/BUFFER IS LAID OUT AS FOLLOWS:
*1646
LINBUF, 0 /110(OCTAL) WORDS FOR LINE CHARACTERS
*1756
/LINEND, 0 /1 EXTRA WORD TO PREVENT OVERFLOW
/(GETS THE 0 WHEN LINE IS TOO LONG)
*1757
SL7, 215
214
212
240
211 /SORT LIST MUST BE FOLLOWED BY A NEGATIVE
-1
BL1, PTEXT /SPACE
PTEXT /TAB
TEXERR /000
BL7, L72S
L72X
L72+2
L72+2
L72X
/MAIN SYMBOL TABLE
*2000
/ENTRIES ARE COMPOSED OF THE FOLLOWING:
/ FIRST A 1 WORD HEADER CODE
/ THEN THE SYMBOL ITSELF IN PACKED 6BIT ASCII (1-3 WORDS)
/ FINALLY THE 1 WORD BINARY VALUE OF THE SYMBOL
/THE HEADER CODE IS LAID OUT AS FOLLOWS:
/(A) FOR OP CODE SYMBOLS:
/ BIT0=1 AFTER THE SYMBOL HAS BEEN PRINTED BY PRSYM
/ BITS1&2=3 (THESE ARE THE SYMBOL TYPE BITS)
/ BIT3=1 FOR MEMORY REFERENCE INSTRUCTIONS
/ BITS4&5=THE MICRO-GROUP FOR OPR INSTRUCTIONS (0 FOR MRI AND IOT INSTS.)
/ (NOTE: MICRO-GROUP IS SET TO 0 FOR CLA)
/ BIT6=1 IF THE SYMBOL IS A PSUEDO-OP
/ BIT7=1 IF THE INST. IS A SKIP TYPE INST.
/ BIT8=1
/ BIT9=0
/ BITS10&11=THE NUMBER OF PACKED ASCII SYMBOL WORDS IN THE ENTRY
/(B) FOR OTHER SYMBOL TYPES:
/ BIT0 AS ABOVE
/ BITS1&2=0 FOR ABSOLUTE AND COMMON SYMBOLS
/ =1 FOR RELOCATABLE SYMBOLS
/ =2 FOR EXTERNAL SYMBOLS
/ BIT3=1 AFTER THE SYMBOL HAS BEEN DEFINED
/ BIT4=1 FOR ENTRY SYMBOLS
/ BIT5=1 IF THE SYMBOL IS EVER REFERENCED BY A #
/ BIT6=1 IF THE SYMBOL IS IN COMMON
/ BIT7=1 IF THE SYMBOL IS A DUMMY SYMBOL
/ BITS8-11 AS ABOVE
/MST=.
3053 /ABSYM
0102
2331
1500
PABSYM
3052 /ARG
0122
0700
PARG
3412 /AND
0116
0400
AND 0
3053 /BLOCK
0214
1703
1300
PBSS
3052 /CALL
0301
1414
PCALL
3053 /COMMN
0317
1515
1600
PCOMMN
3112 /CIA
0311
0100
CIA
3012 /CLA
0314
0100
CLA
3112 /CLL
0314
1400
CLL
3112 /CMA
0315
0100
CMA
3112 /CML
0315
1400
CML
3053 /DECIM
0405
0311
1500
PDEC
3053 /DUMMY
0425
1515
3100
PDUMMY
3412 /DCA
0403
0100
DCA 0
3052 /EAP
0501
2000
PEAP
3052 /END
0516
0400
PEND
3053 /ENTRY
0516
2422
3100
PENTRY
3053 /FORTR
0617
2224
2200
PFORT
3212 /HLT
1014
2400
HLT
3051 /IF
1106
PIF
3053 /CPAGE
0320
0107
0500
PIFF
3432 /ISZ
1123
3200
ISZ 0
3412 /INC (NON-SKIP ISZ)
1116
0300
ISZ 0
3112 /IAC
1101
0300
IAC
3012 /IOF
1117
0600
IOF
3012 /ION
1117
1600
ION
3412 /JMP
1215
2000
JMP 0
3412 /JMS
1215
2300
JMS 0
3012 /KRB
1322
0200
KRB
3032 /KSF
1323
0600
KSF
3052 /LAP
1401
2000
PLAP
3112 /NOP
1617
2000
NOP
3053 /OCTAL
1703
2401
1400
POCT
3053 /OPDEF
1720
0405
0600
OPDEX
3212 /OSR
1723
2200
OSR
3052 /PAGE
2001
0705
PPAGE
3053 /PAUSE
2001
2523
0500
PPAUSE
3012 /PLS
2014
2300
PLS
3032 /PSF
2023
0600
PSF
3053 /REORG
2205
1722
0700
PRORG
3053 /RETRN
2205
2422
1600
PRTN
3112 /RAL
2201
1400
RAL
3112 /RAR
2201
2200
RAR
3012 /RFC
2206
0300
RFC
3012 /RRB
2222
0200
RRB
3032 /RSF
2223
0600
RSF
3112 /RTL
2224
1400
RTL
3112 /RTR
2224
2200
RTR
3232 /SKP
2313
2000
SKP
3053 /SKPDF
2313
2004
0600
SKPDEX
3232 /SMA
2315
0100
SMA
3232 /SNA
2316
0100
SNA
3232 /SNL
2316
1400
SNL
3232 /SPA
2320
0100
SPA
3112 /STA
2324
0100
STA
3112 /STL
2324
1400
STL
3232 /SZA
2332
0100
SZA
3232 /SZL
2332
1400
SZL
3232 /SPC=SPA+CLA (USED BY COMPILER)
2320
0300
SPA CLA
3412 /TAD
2401
0400
TAD 0
3052 /TEXT
2405
3024
PTEXT
3012 /TLS
2414
2300
TLS
3032 /TSF
2423
0600
TSF
ACH=20
ACM=21
ACL=22
0452 /ACH
0103
1000
ACH
0452 /ACM
0103
1500
ACM
0452 /ACL
0103
1400
ACL
II, 0451 /I
1100
0400
STTP=.
CORE1=7600
*CORE1-1
/THE OCCURRENCE TABLE EXTENDS DOWNWARD FROM HERE
/TOWARD THE MAIN SYMBOL TABLE
/& SHARING THE SAME SPACE WITH IT.
/THIS TABLE IS VARIABLE, BEING COLLAPSED
/AS MUCH AS POSIBLE DURING USE. THE ONLY
/THING LEFT ON IT AT THE END ARE UNDEFINED
/SYMBOLS.
/THE OCC. TAB. CONTAINS AN ENTRY FOR EVERY
/REF. TO AN AS YET UNDF. SYMBOL. EACH
/TIME A SYMBOL IS DEFINED THE TABLE IS SEARCHED
/TO SEE IF FORWARD REFERENCES TO IT EXIST.
/IF SO THEY ARE OUTPUT & THE TABLE
/CONDENSED.
/ENTRIES CONSIST OF 2 OR 3 WORDS
/STRUCTURED AS BELOW:
/HIGH WORD: LOCATION OF REFERENCE
/LOW WORD: SYMBOL I.D.
/OPTIONAL WORD: # FLAG
/THE LOC. WORD CONTAINS THE PROG. ADDR. WHERE
/THE VALUE OF THE SYM. MUST BE ASSEMBLED
/THE # FLAG=1 IF IT EXISTS. IT WILL
/EXIST ONLY FOR THOSE ENTRIES WHERE THE
/SYM. WAS REF'D. BY A #.
/THE TABLE IS ALWAYS SEARCHED IN REVERSE
/FROM LOW CORE UPWARD
/THE O.T. PTR (OTP) ALWAYS PTS. TO THE NEXT FREE
/LOCATION BELOW THE TABLE
/THE TABLE HAS NO IMPORTANCE DURING PASS 2.
/MEMORY IS NOT USED
$