[pdp8.git] / sw / os8 / v3d / sources / system / dectapes / dectape2 / SABR.PA

/SABR ASSEMBLER V18
/
/
/
/
/
/
/
//
/
/
/
/
/COPYRIGHT (C) 1971,1974,1975
/DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
/
/
/
/THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A
/SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE INCLU-
/SION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE, OR ANT OTHER
/COPIES THEREOF, MAY NOT BR PROVIDED OR OTHERWISE MADE AVAILABLE
/TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO
/AGREES TO THESE LICENSE TERMS.  TITLE TO AND OWNERSHIP OF THE
/SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.
/
/
/THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
/NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
/EQUIPMRNT COROPATION.
/
/DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
/SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
/
/
/
/
/
/
\f/	VERSION SABR.17
/	OCTOBER 26, 1971
/	C. MCCOMAS
/	R. LARY
/	B. CLOGHER
/SABR.V17  DEC-08-A2D2-17
/	OCTOBER 26,1971
/COPYRIGHT	 1971, DIGITAL EQUIPMENT CORPORATION, MAYNARD MASSACHUSETTS 01754
/		C. MCCOMAS/R. LARY/B. CLOGHER


//
/
/FIXES TO SABR FOR V18		J.K 1975
/
/ .LITERAL POOL OVERFLOW
/ .INCORRECT LINE NUMBER WITH ERROR MESSAGE
/
/
/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

\f*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
\f*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


\f*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
\f*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


\f*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


\f*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


\f*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

/
\f*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

\f*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

\f*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
\f*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

\f*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
\f*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

\f*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


\f*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

\f*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


\f*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
\f*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
\f*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
\f*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.


/
\fSETCT,	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
\f*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
\f*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
\f*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
\f*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
\f*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

\f	*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

\f*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
\f*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
	5561		/- VERSION # (1ST DIGIT)
	7001		/2ND DIGIT AND PATCH LEVEL


\f
/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
\f*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

\f

/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=.
\fCORE1=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


$
\f