	.TITLE PDP9-15 ALGOL COMPILER PASS2	9 MAR 72  EDIT 305
/EDIT 003 26 AUG 71 TO ALLOW .ABS ASSEMBLY
/IF %SY DEFINED
/COPYRIGHT DIGITAL EQUIPMENT CORPORATION
/SYSTEM VERSION PARAMETERS DEFINE CONDITIONAL ASSEMBLY
/IF UNDEFINED RELOCATABLE VERSION PRODUCED WHERE EACH
/PASS RUNS AS A SEPARATE PROGRAM.
	.IFUND	%SY
	.GLOBL SIZE
	.ENDC
	.IFDEF	DOS
%BOS=152
	.ENDC
	.DEFIN .BOS ADDR
	.IFDEF	DOS
	LAC*	(%BOS
	SPA!CLA
	JMP	ADDR	/BOS MODE
	.ENDC
	.ENDM
/
	.DEFIN	.OVLAY	NAME
	.IFDEF	DOS
	0
	24
	.+1
	.SIXBT	"NAME"
	.ENDC
	.ENDM
  
	.IFDEF	%SY
	.ABS
	.ENDC
/.IFUND  %C2	PRODUCE RELOCATABLE ASSEMBLY
  
/.IFUND  %S2	PRODUCE STAND-ALONE PROGRAM
  
/.IFUND  %S3	DUMP STACKS FOR PASS 3 WHEN STAND-ALONE
  
 
	.IFDEF %C2
	.LOC %C2
	.ENDC
  
START	JMP	P3CON	/JUMP INTO PROGRAM
	.IFUND	%SY
 
	.IODEV	-2,-3,-13,-15
	.ENDC
 
	.IFUND	%S2
 
OBM	302000
ICMK=4000
ALTMDE=400
 
/RCOMST
/START PROGRAM:READ COMMAND STRING AND SET UP CONTROL DATA
	.IODEV -2,-3
RCOMST	XX
	.INIT -3,1,P3CON		/TTA OUTPUT
	.INIT -2,0,P3CON		/TTA INPUT
	.WRITE -3,2,ANNOUC,6	/'ALGOL'
	LAC*	S00102	/GET SCOM+2
	DAC	SP02
	DAC	AOPTW	/ADDR OPTION WORD
	DAC*	S00010
	DZM*	10	/)CLEAR
	DZM*	10	/)FILE
	DZM*	10	/)NAME
	LAC*	S00010
	DAC	AXW	/ADDR EXT
	LAC	K3
	DAC*	AOPTW	/OPTION WORD =-3
	DAC	SP01	/COUNT FOR 6 BIT PACKING
	LAC	PROCH	/SET UP TO READ OPTIONS
	DAC	BRCH
RDCH	.READ -2,3,COMSTR,3	/READ CHAR
	.WAIT -2
	LAC	CHAR	/GET CHAR
	SAD	S00015	/CR?
	JMP	CR	/YES
	SAD	S00175	/ALTMODE?
	JMP	ALTM	/YES
	SAD	S00137	/_?
	JMP	BA	/YES
BRCH	XCT	PROCH+1	/PROCESS CHAR
	JMP	RDCH
PROCH	XCT	.+1
	JMP	OPTION	/PROCESS BEFORE_
	JMS	FILNAM	/PROCESS AFTER_
	JMP	RCOMST+1	/RESTART IF 2_
 
OPTION	AND	S00007	/HOLD LS 3 BITS OF CHAR
	CMA		/)CONVERT TO COUNT
	DAC	SP00	/)& HOLD
	CLA!STL
	RAR		/MOVE 1 BIT TO RIGHT IN AC
	ISZ	SP00	/ACCORDING TO CHAR READ
	JMP	.-2
	CMA		/
	AND*	AOPTW	/CLEAR THIS BIT IN OPTION WORD
	DAC*	AOPTW
	JMP	RDCH	/READ AGAIN
FILNAM	XX
	SAD	S00073	/CHAR=;
	JMP	SCN	/YES,READ EXTN
	AND	S00077	/)HOLD SIXBIT
	DAC	CHAR	/)IN CHAR
	LAC*	SP02	/FILENAME WORD
	RTL		/SHIFTED LEFT
	RTL		/AND NEXT CHAR
	RTL		/PACKED IN
	AND	Z77700
	TAD	CHAR
	DAC*	SP02
	ISZ	SP01	/3 CHARS PACKED?
	JMP*	FILNAM	/NO,READ
	ISZ	SP02	/YES,BUMP TO NEXT WORD
FN01	LAC	K3	/RESET COUNT
	DAC	SP01
	JMP*	FILNAM	/READ CHAR
FW	XX
	LAC	SP01	/GET PACK CT
	SAD	K3	/WORD FULL
	JMP*	FW	/YES,EXIT
	CLA		/PACK IN ZERO
	JMS	FILNAM
	JMP	FW+1
/;
SCN	LAC	FILNAM
	DAC	SP00
	JMS	FW	/FILL UP CURRENT WORD
	LAC	AXW
	DAC	SP02	/SET TO READ EXTN
	JMP*	SP00
/_
BA	ISZ	BRCH	/BUMP TO READ FILENAME
	ISZ	SP02	/PT TO FILNAM
	JMP	RDCH
SRC	232203		/SIXBIT 'SRC'
ANNOUC	3002
	0
	.ASCII /ALGOL >/<175>
 
COMSTR	2003
	0
CHAR	0
ALTM	LAW	777377	/MARK'RETURN TO MONITOR'
	AND*	AOPTW
	DAC*	AOPTW
CR	JMS	FW	/FINISH OFF WORD
	LAC	SP02	
	TAD	K1	
	SAD	AXW
	JMP	.+3
	LAC	SRC
	DAC*	AXW	/EXTN='SRC' IF NONE GIVEN
 
/REST	ROUTINE TO RESTORE COMPILER DATA FROM BULK STORAGE
/	IN DUMP MODE. FILE NAME IN CONTROL AREA
 
 
REST	.INIT	RESTS,0,P3CON
	LAC	K14
	DAC	SP00	/COUNT OF STACKS TO BE READ
	LAC	AOPTW
	DAC	RESTCN
	DAC	RESTFN
	IDX	RESTFN	/ADDRESS OF FILENAME & EXT
	TAD	C4
	DAC	SP01	/ADDR OF WORD HOLDING ADDR OF STAT TABLE
	DAC	SP04	/HOLD ADDR OF WORD HOLDING ADDR STAT TABLE
/	.SEEK	RESTS,RESTFN
	CAL+RESTS&777
	3
RESTFN	0
	LAW	773777
	AND*	AOPTW	/HOLD ALL OPTIONS EXCEPT 'I'
	DAC	SP02
	LAC	SKST
	DAC	SP03	/HOLD ADDR OF TOP OF CORE
/	READ	RESTS,4,RESTCN,4	/READ OPTIONS,FILENAME & EXTN
	CAL+4000 RESTS&777
	10
RESTCN	0
	-4
	LAC	K26
	DAC	RESTL	/LENGTH OF STAT TABLE
	LAC	SP01
	TAD	C1
	DAC	RESTCA	/ADDR OF STAT TABLE
REST1	.WAIT	RESTS
/	.READ	RESTS,4,RESTCA,RESTL	/READ STAT TABLE,THEN STACKS
	CAL+4000 RESTS&777
	10
RESTCA	0
RESTL	0
	IDX	SP01	/ADDR OF SK BASE
	LAC*	SP01	/)LENGTH OF STACK
	DAC	RESTL	/)TO READ
	TAD	SP03	/ADD ADDR OF TOP END OF FREE CORE
	DAC	RESTCA
	IDX	RESTCA	/ADDR OF READ STACK INTO
	LAC	SP03	/)TOP OF FREE CORE
	DAC*	SP01	/)TO SK BASE
	IDX	SP01
	LAC	RESTCA	/)END OF STACK
	DAC*	SP01	/)TO SK PTR
	TAD	K1
	DAC	SP03	/RESET TOP OF FREE CORE
	ISZ	SP00
	JMP	REST1
REST2	.CLOSE	RESTS
	LAC*	AOPTW
	AND	SP02	/HOLD 'I' OPTION FROM OPTIONS RESTORED
	DAC*	AOPTW
	LAC	AINBA	/)UPDATE ADDR OF STAT TABLE
	TAD	K2	/TAD K2(LISTAK)
	DAC*	SP04	/)AT BOTTOM OF CORE
	JMP*	RCOMST
SKST	%C2-1
	.ENDC
	.EJECT
/TABLE OF LOCATIONS REQUIRING BANK BIT INITIALISATION
BKINIT	XCT	.+0
	A	STATIN+1
	A	P3CON2+10
	A	P3CON3-2
	A	P3CON4-3
	A	P3CON4-2
	A	P3CON4+1
	A	P3CON4+4
	A	OVLAY-3
	A	OVLAY-2
	A	ENDP21+2
	A	AINBA
	.IFNZR	%C1-6
	A	CALLP1+2
	.ENDC
	.IFUND	DOS
	A	CALLP1+4
	.ENDC
	.IFDEF	%S3
	A	CALLP3+2
	.IFUND	DOS
	A	CALLP3+4
	.ENDC
	.ENDC
	A	C3-2
	A	C3-1
	A	C3+7
	A	RINTF+2
	A	INPERR+2
	A	ABORT1+2
	.IFDEF	%S2
	A	CLIN+5
	.ENDC
	A	COMP60+1
	A	ERR+11
	A	PUTV+2
	A	PUTW+2
	A	PUTOUT+4
	A	NSTK13+1
	A	LNP+2
	A	SCV+1
	A	BLL+2
	A	BLL+6
	A	LABRF1+3
	A	LABRF4-4
	A	LABRF4+1
	A	LABRF4+4
	A	C6-2
	A	C6-1
	A	C6+4
	A	MODP+1
	A	C4-2
	A	C4-1
	A	FELS+1
	A	FEC+1
	A	T00000-2
	A	GENDP+1
	A	XENDP+5
	A	XENDP+6
	A	GTEP+4
	A	EXCALL+1
	A	EXCALL+2
	A	GPRLK+3
	A	PLSW+3
	A	BNL+3
	A	BNL+5
	A	PLOC+4
	A	OUTSK+4
	A	GGR01+4
	A	GGR-6
	A	GGR-4
	A	GGR-2
	A	P2SK+2
	A	RLSK+1
	A	STRSK+1
	A	OWNSK-4
	A	OWNSK2-2
	A	P2SK1+10
	A	P3SK+2
	A	GLBSK+1
	A	GLBSK1+5
	A	G.E
	A	TXB3E
	A	AAGLST
	A	ASKLIM
	A	XB
	A	DMP+2
	A	DMP01+2
	A	G.S	/10 SPARE ENTRIES
	A	G.S	/FOR PATCHING
	A	G.S
	A	G.S
	A	G.S
	A	G.S
BKEND	A	G.S
	A	TXB3-1
	TXB3-TXB3E
	A	VTOA02
	VTOA02-ATXB3
 
BNCT	BKEND-.+1
Z17777	717777
ASKLIM	OVLAY-55
AAGLST	GLST-1
	.EJECT
/LIST OF RADIX 50 REPRESENTATIONS OF RUN TIME GLOBALS
GLST	124421		/%BA
	124422		/%BB
	124427		/%BG
	124432		/%BJ
	124433		/%BK
	124434		/%BL
	124445		/%BU
	124377		/%AW *
	124567		/%DW *
	127521		/.BA *
	124476		/%CF *
	124507		/%CO *
	124506		/%CN *
	124444		/%BT *
	124372		/%AR *
	127477		/.AW *
	124441		/%BQ *
	124402		/%AZ *
	124400		/%AX *
	124401		/%AY 
	124435		/%BM +
	124436		/%BN +
	124431		/%BI +
	124437		/%BO +
	124450		/%BX +
	124351		/%AA
	124352		/%AB
	124374		/%AT
	124375		/%AU
	124376		/%AV
	124423		/%BC
	124424		/%BD
	124430		/%BH
	124440		/%BP
	124442		/%BR
	124446		/%BV
	124447		/%BW
	124451		/%BY
	124452		/%BZ
	124471		/%CA
	124472		/%CB
	124473		/%CC
	124475		/%CE
	124477		/%CG
	124500		/%CH
	124501		/%CI
	124502		/%CJ
	124503		/%CK
	124504		/%CL
	124505		/%CM
	124510		/%CP
	127452		/.AB
	127454		/.AD
	127455		/.AE
	127467		/.AO
	127470		/.AP
	127471		/.AQ
	127472		/.AR
	127473		/.AS
	127474		/.AT
	127475		/.AU
	127476		/.AV
	127501		/.AY
	127522		/.BB
 
GLSTE=.
 
/NOTE	*THESE POSITIONS FIXED FOR GEN OF JMS* BY GINSTR
/	+		              JMP*
 
	/ASSIGNMENTS OF ALL RUN TIME GLOBAL SYMBOLS
	/TO THE VIRTUAL ADDRESSES OF THE VOCAB ENTRY
	/WHICH HOLDS THEIR RADIX 50 CODES
 
%BA=7775
%BB=%BA-2
%BG=%BB-2
%BJ=%BG-2
%BK=%BJ-2
%BL=%BK-2
%BU=%BL-2
%CF=7751
.AW=7737
%BQ=7735
%AZ=7733
%AY=7727
%AA=7713
%AB=%AA-2
%AT=%AB-2
%AU=%AT-2
%AV=%AU-2
%BC=%AV-2
%BD=%BC-2
%BH=%BD-2
%BP=%BH-2
%BR=%BP-2
%BV=%BR-2
%BW=%BV-2
%BY=%BW-2
%BZ=%BY-2
%CA=%BZ-2
%CB=%CA-2
%CC=%CB-2
%CE=%CC-2
%CG=%CE-2
%CH=%CG-2
%CI=%CH-2
%CJ=%CI-2
%CK=%CJ-2
%CL=%CK-2
%CM=%CL-2
%CP=%CM-2
.AB=%CP-2
.AD=.AB-2
.AE=.AD-2
.AO=.AE-2
.AP=.AO-2
.AQ=.AP-2
.AR=.AQ-2
.AS=.AR-2
.AT=.AS-2
.AU=.AT-2
.AV=.AU-2
.AY=.AV-2
.BB=.AY-2
	.EJECT
	.IFDEF	%S2
OBM	102200
ICMK=400
ALTMDE=1000
	.ENDC
 
 
/P3CON	PHASE 3 CONTROL
/SETS UP STATISTICS TABLE. PUTS GLOBAL NAMES INTO VOCAB IN A
/PREDETERMINED ORDER.
/INITIALISES PHASE 3 PROCESSES THE INTERMEDIATE CODE
/& THEN APPENDS THE STACK CONTENTS.
 
P3CON	JMS	.	/START PASS BY INITIALISING
	LAC	P3CON	/BANK BITS
	AND	S60000
	DAC	BANK	/HOLD BANK BITS
	TAD	BKINIT	/SET UP TABLE START
	AND	S77777
	DAC*	C8	/IN AUTO
	LAW	BKINIT-BKEND
	DAC	SP01	/SET COUNT OF TABLE LENGTH
NXBKAD	LAC*	AUTO	/ADDR FROM TABLE(13 BIT)
	XOR	BANK	/ADD IN BANK BITS
	DAC	SP00	/HOLD
	LAC*	SP00	/GET WORD TO INITIALISE
	AND	Z17777	/DISCARD OLD BANK BITS
	XOR	BANK	/INSERT NEW BANK BITS
	DAC*	SP00	/REPLACE IT
	ISZ	SP01	/FINISHED TABLE
	JMP	NXBKAD
 			/NOW INIT CORE TABLES
NXTABL	LAC*	AUTO	/ADDR OF TABLE(13 BIT)
	AND	S77777
	XOR	BANK	/ADD IN BANK BITS
	DAC*	C9	/HOLD IN AUTO 1.2
	DAC*	C10
	LAC*	AUTO	/LENGTH OF TABLE
	DAC	SP00
	IDX	BNCT	/INCR COUNT OF TABLES(*2)
NXTENT	LAC*	AUTO1	/BANK INIT ALL ENTRIES
	SPA		/IN TABLE:EXCEPT -VE WORDS
	JMP	.+3
	AND	Z17777	
	XOR	BANK
	DAC*	AUTO2
	ISZ	SP00	/END OF TABLE?
	JMP	NXTENT	/NO
	ISZ	BNCT	/END OF LIST OF TABLES?
	JMP	NXTABL	/NO
 
	.IFUND	%S2
	JMS	RCOMST
	.ENDC
 
	LAC*	S00102
	DAC	AOPTW	/SET ADDR OF OPTION WORD
	TAD	C1	/SET UP ADDR OF FILENAME
	DAC	UP15+6	/FOR INT CODE OUTPUT
	DAC	CLOUT1+2	/FOR CLOSING INT CODE OUTPUT
	TAD	C2
	DAC	AXW	/ADDR OF FILE EXTN
	TAD	C2
	DAC	STOUT	/ADDR OF STAT TABLE IN ALCOM
	DAC	STATIN
	JMS	COPY	/MOVE STAT TABLE
STATIN	XX		/INTO MODULE
	INBASE
	33
	LAC	OUBASE	/MOVE PASS 1 OUTPUT
	DAC	INCODE	/TO BE PASS 2 INPUT
	TAD*	WORK	/ADD SIZE FROM PASS 1
	IDX	WORK	/AND LOSE
	TAD	K1
	DAC	ICBASE
	LAC*	S00102	/INITIALISE PASS 2 OUTPUT AK
	AND	S77777
	TAD	C75
	DAC	OUT
	TAD	K39
	DAC	OUBASE
	TAD	K2	/SET UP INT CODE OUTPUT BUFFER
	DAC	UP18+2
	TAD	K1
	DAC	BLKADD
	LAC	S25500	/BUFFER HDR WD
	DAC*	UP18+2
	LAC*	AOPTW
	CMA
	AND	OBM	/EXTRACT OPTIONS O,B,M
	SZA		/ANY REQD?
	JMP	P3CON1	/YES
	LAC	OUBASE	/NO:CLOSE DOWN OUT SK
	TAD	K28
	DAC	OUBASE
	DAC	OUT
	IDX	PUTOUT+1	/MARK NO OUTPUT
P3CON1	LAC	GLBASE	/EMPTY OLD DICT SK
	DAC	GLOBAL
	LAC	VOBASE	/EMPTY VOCAB STACK
	DAC	VOCAB
	LAC	AAGLST
	DAC*	C10	/ADDR GLST-1 TO AUTO 12
	LAW	GLST-GLSTE
	DAC	SAC
P3CON2	LAC*	AUTO2	/RADIX 50 OF GLOBAL NAME
	JMS	PUTV	/TO VOCAB SK
	CLA		/0 PTR WORD
	JMS	PUTV	/TO VOCAB
	ISZ	SAC
	JMP	P3CON2
	.INIT	-2,0,RECALL	/^P TO TERMINATE PASS
	JMS	TOPT
	100		/'D' OPTION?
	SKP		/YES
	JMP	P3CON3	/NO
	.INIT	-2,0,DMP+400000 /ENABLE CTRLT(^T)
P3CON3	JMS	TAKEW	/GET MAXL(MAIN PROGRAM)
	TAD*	WORK	/ADD MAXOTD+1(=DNLBL(MAIN PROGRAM))
	TAD	C1
	JMS	PUTW	/STORE AS DBIL(MAIN PROGRAM)
	JMS	COPY	/)CREATE DUMMY PROC INFO
	K2		/)FOR MAIN PROGRAM
	M*1+WORK		/)ON WORK SK
	4
P3CON4	JMS	EVA
	WKBASE
	DAC	CPI	/POINT CPI TO IT
	JMS	LAM	/RETRIEVE OWN SIZE
	M*6+WORK		/FROM TOP OF WORK
	DAC	DIM	/& HOLD IN DIM
	JMS	COPY	/)SET UP PROC INFO
	M*6+CPI		/)IN FIXED SPACE
	NAME1
	6
OVLAY	JMS	FNW	/OPEN INPUT &GET FIRST WORD
	ISZ*	AXW	/EXT='A02'
	JMS	OBEY
	JMP	ANAL+4
P3CON6	JMS	OUTSK
ENDP2	JMS	CLOUT	/CLOSE OUTPUT FILE
	DZM	TENS
	LAC	ERRNO	/#ERRORS
	IDX	TENS	/BUMP TENS COUNT
	TAD	K10	/-10
	SMA!STL		/-VE?
	JMP	.-3	/NO
	TAD	C10	/YES:ADD 10
	RTR		/)SHIFT TO THIRD
	RTR		/)CHAR IN 5/7 PAIR
	XOR	ENO+1	/PACK LAST 3 BITS
	DAC	ENO+1
	LAC	U40006	/CREATE '('<0>'0'
	SZL
	TAD	C1	/ADD 1 IF UNITS>7
	DAC	ENO
	LAC	TENS	/RETRIEVE TENS-1
	TAD	K1
	SNA		/SUPPRESS TENS IF = 0
	JMP	ENDP21
	TAD	K10	/REDUCE TO <10
	SMA!STL
	JMP	.-2
	TAD	S00072	/MAKE +VE & ASCII CHAR
	RTL		/)SHIFT TO SECOND
	RTL		/)CHAR IN 5/7 PAIR
	XOR	ENO	/PACK INTO BUFFER
	DAC	ENO
ENDP21	.WRITE	-3,2,EOP2M,6 / 'EOP2 (NN)'
	.WAIT	-3
 
	JMS	COPY
AINBA	INBASE
STOUT	XX
C27	33
	XCT	PUTOUT+1	/PASS 3 REQD?
	JMP	RESTART	/NO
CALLP3=.
	.IFUND	%S3
	JMS	DUMP	/DUMP COMPILER DATA
	JMP	RESTART
	.ENDC
 
	.IFDEF	%S3
	.IFUND	DOS
	JMS	OLAY	/CALL PASS 3
	%B3		/SYSTEM BLOCK #
	%C3-1		/CORE ADDR-1
	-%L3		/-LENGTH
	%S3	/START ADDR
	.ENDC
	.OVLAY	ALCP3@
	.ENDC
 
EOP2M	6002
	0
	.ASCII	'EOP2'
ENO	.ASCII	'('<0><0>')'<175>
 
 
 
RESTART	JMS	TOPT
	ALTMDE		/ALTMODE IN COMMAND?
	JMP	MONITR	/YES
	.IFDEF	DOS
	.BOS	MONITR
	.ENDC
CALLP1=.
	.IFUND	DOS
	JMS	OLAY
	%B1		/SYSTEM BLOCK #
	%C1-1		/CORE ADDR-1
	-%L1		/-LENGTH
	%S1		/START ADDR
	.ENDC
	.OVLAY	ALGOL@
 
/^P	COMES HERE
 
RECALL	JMS	INOPEN	/.DLETE INPUT IF OPEN
	IDX	PUTOUT+1	/MARK PASS 3 NOT REQUIRED
	JMS	CLOUT	/CLOSE & DELETE OUT IF THERE
	JMP	CALLP1	/RELOAD PASS 1
 
/INOPEN IF INT.CODE FILE OPEN CLOSE & DELETE IT
 
INOPEN	XX
	LAC	SCRSW	/PICK UP INPUT SWITCH
	XOR	BANK
	DAC	SP00	/PICK UP SWITCH WORD
	LAC*	SP00
	SAD	SCRIN+2	/USING IN CORE DATA?
	JMS	CLIN	/NO:CLOSE & DLETE IT
	JMP*	INOPEN
 
MONITR	.EXIT
 
 
 
CLOUT	XX	/CLOSE OUTPUT
	JMS	TOPT
	ICMK		/INT.CODE OUTPUT PRODUCED?
	SKP		/YES
	JMP*	CLOUT	/NO
	.CLOSE	INTOUT	/CLOSE FILE
	XCT	PUTOUT+1	/OUTPUT REQD FOR PASS 3?
	SKP		/NO
	JMP*	CLOUT	/YES
CLOUT1	.DLETE	INTOUT,CLOUT1+2 /NO:DELETE IT
	JMP*	CLOUT
	.EJECT
/SOURCE INPUT CONTROL ROUTINE
/	S/R 'FNW' IS CALLED TO FETCH NEXT WORD OF INPUT INTO NXOP
/	THROUGHOUT PASS 2. (MAINLY CALLED IN ANAL VIA GTNEXT)
/	'SCRSW' CONTROLS FROM WHERE THE INPUT IS READ
/INITIALLY 'INITIN' IS OBEYED TO DETERMINE WHETHER AN INT CODE
/FILE IS PRESENT
/	IF SO,THE FILE IS OPENED AND 'SCRSW' CAUSES INFILE
/TO BE OBEYED
/	IF THERE IS NO INT CODE FILE OR THE INT CODE FILE
/HAS BEEN READ 'SCRSW' CAUSES INPUT TO BE TAKEN FROM
/THE STACK 'INCODE'
 
 
FNW	XX		/FETCH NEXT WORD OF INPUT
SCRSW	XCT	SCRIN	/SWITCH ON SOURCE OF INPUT
INCORE	IDX	SCRSW	/SWITCH TO INCODE SK
	LAC*	INCODE
	IDX	INCODE	/NXOP_INCODE(-)
	DAC	NXOP
	JMP*	FNW
 
 
SCRIN	JMP	INITIN	/ON FIRST CALL OF FNW INITIALISE INPUT
	JMP	INFILE	/GET INPUT FROM INT CODE FILE
	SKP		/GET INPUT FROM INCODE SK
 
 
/INITIALISE INPUT
 
INITIN	IDX	SCRSW	/SWITCH TO INT CODE FILE INPUT
	JMS	TOPT
	ICMK		/INT CODE FILE PRESENT?
	SKP		/YES
	JMP	INCORE	/NO:SWITCH TO INCODE SK
	LAC*	AOPTW	/)
	XOR	INITIN+2	/)CLEAR INT CODE MARK
	DAC*	AOPTW	/)
	JMS	COPY	/
	M*4+CLOUT1+2	/)PRESERVE INPUT FILE NAME
	INFN		/)FOR .DLETE AFTER READING
C3	3
 
	.INIT INTIN,0,P3CON
 
	.SEEK INTIN,INFN
 
	JMP	RINTF	/READ FIRST BUFFER LOAD
 
 
/GET INPUT FROM INT CODE FILE
 
INFILE	LAC*	AINWD	/NEXT INPUT WORD FROM BUFFER
	IDX	AINWD	/BUMP ADDR
	DAC	NXOP	/NXOP_NEXT INPUT WORD
	ISZ	IBUFCT	/END OF BUFFER LOAD?
	JMP*	FNW	/NO:EXIT WITH WORD IN NXOP
 
RINTF	.READ INTIN,0,INBUFF,42 /READ BUFFER LOAD OF INT CODE FILE
 
	.WAIT INTIN
 
	LAC	INBUFF	/HEADER WORD
	AND	S00077
	SAD	C5	/EOF?
	JMP	ENDIF	/YES:CLOSE INTIN & SWITCH TO INCODE SK
	TAD	V77760
	SPA		/READ ERROR?
	JMP	INPERR	/YES:REPORT & ABORT
 
/INITIALISE BUFFER CONTROL
 
	LAW	-51
	DAC	IBUFCT	/BUFFER LOAD OF 50 WORDS
	LAC	AINB2
	DAC	AINWD	/ADDR OF FIRST WORD
	JMP	INFILE	/FETCH FIRST WORD
 
/END OF INT CODE FILE REACHED
 
ENDIF	JMS	CLIN	/CLOSE & DELETE INPUT FILE
 
	JMP	INCORE	/SWITCH TO INPUT FROM INCODE SK
 
 
/REPORT READ ERROR & ABORT
 
INPERR	.WRITE -3,2,INFAIL,12 /REPORT READ ERROR
 
	.CLOSE INTIN	/CLOSE INT CODE FILE
 
	JMP	ABORT1
ABORT	JMS	ERR	/REPORT ERROR & ABORT
	JMS	INOPEN	/.DLETE INOUT IF OPEN
ABORT1	.WRITE	-3,2,BORT,6
	IDX	PUTOUT+1	/MARK PASS 3 NOT REQD
	JMP	ENDP2
 
CLIN	XX	/CLOSE & DELETE INPUT FILE
	.CLOSE	INTIN
	.IFDEF %S2
	.DLETE	INTIN,INFN
	.ENDC
	JMP*	CLIN
 
BORT	3002
	0
	.ASCII	'ABORTED '<175>
 
INFAIL	6000
	0
	.ASCII	'INT.CODE FILE READ ERROR'<15>
	.EJECT
/COMP	COMPILE OPERATOR
/ON ENTRY OPERATOR TO BE PROCESSED HELD IN NXOP
/USES TABLE TXB3 IF NXOP HOLDS OPERATOR
/USES (LCR,LCP) GEN TABLE IF NXOP HOLDS SKPTR
/USES (LVR,LVP) GEN TABLE IF NXOP INDICATES DICT INFO
/FOR DICT INFO Q2 IS SET UP TO INDICATE GEN TABLE ENTRY
 
 
COMP	XX
	LAC	NXOP	/LOAD OPERATOR
	SPA!RAL		/DICT INFO?
	JMP	COMP50	/YES
	SPA		/OPCODE?
	JMP	COMP30	/YES
	JMS	MES	/NO:STACK PTR
	JMP	RR+15	/SK # TO LS END
	AND	S00017	/& EXTRACT FOR MODIFIER
	JMS	GFTLU	/TO GEN CODE FROM TABLE LCR
	LAC	LCR-1
	LCP-LCR
COMP20	DZM	NXTRQD	/MARK NXT REQD
	JMP*	COMP
 
COMP30	JMS	MES
	JMP	R-7	/OPCODE TO LS END
	AND	S00077
	TAD	ATXB3
	DAC	SP04
	LAC*	SP04	/GET TXB3 TABLE ENTRY
	SPA		/TO USE ANAL?
	JMP*	SP04	/NO:JMP TO ENTRY(XX IF ILLEGAL)
 
	LAC	COMP	/STACK COMPS LINK
	JMS	PUTW	/THEN STACK XB AND PLANT RETURN
	JMS	OBEY	/LINK FOR ANAL
LCOMP	JMP	COMP44
	DAC	XB	/RESET XB
	JMS	TAKEW	/RESET COMP LINK
	DAC	COMP
	JMP*	COMP	/EXIT
 
COMP44	LAC	S77777
	AND*	SP04	/GET 15 BIT ADDR FOR XB
	DAC	XB
	XOR*	SP04	/EXTRACT  TOP 3 BITS
	SNA		/OPERATOR REQD ON WK SK?
	JMP	COMP45	/NO
	LAC	NXOP	/YES,HOLD OPERATOR ON WORK
	JMS	PUTW
COMP45	JMS	FNW
	JMP	ANAL+4	/ENTER ANAL (RETURNS TO COMP41-1)
 
COMP50	SMA		/IS IT L & C COUNT?
	JMP	ERREC	/YES
	JMS	CLADI	/CLASSIFY DICT INFO
	TAD	FADSW	/ADD FADSW IF NOT ARRAY(OR SWITCH)
	JMS	GFTLU	/GENERATE CODE FROM LVR TABLE
	LAC	LVR
	LVP-LVR
	ISZ	ARSW	/WAS THIS AN ARRAY REF?
	SKP
	JMP*	COMP	/NO:EXIT
 
COMP60	JMS	LAM	/YES:GET # DIMS
	M*1+WORK		/FROM WORK STACK
	DAC	NXOP	/& HOLD IN NXOP AS LEADING PARAM
	LAC	JMS%BV	/AC=JMS* %BV
	JMS	OUT3L	/GENERATE
	JMP*	COMP	/EXIT
	.EJECT
 
/ELSE3	PROCESS ELSE OPERATOR
 
ELSE3	JMS	GELSE
	JMP	COMP20
 
/DO3	PROCESS DO OPERATOR
/	S/R CALL GENERATED IF MULTIPLE FOR ELEMENTS
 
DO3	LAC	DOLAB
	SNA		/MULTIPLE FOR ELEMENTS?
	JMP	DO31	/NO:'DO' A DUMMY
 
	JMS	GLLR	/YES
	JMS	/DOLAB	/G(JMS 'DOLAB')
	LAC	ELLAB	/IS FOREL AN AFOR?
	SNA		/NO
	JMP	COMP20	/YES:CONTINUE
	JMS	GLLR	/G(JMP 'ELLAB')
	JMP	/ELLAB
	LAC	U12000	/)ENDC TO NXOP
	DAC	NXOP	/)TO TERMINATE IFS
	JMP*	COMP	/EXIT
 
DO31	LAC	ELLAB	/)IS FOREL A'WHILE'
	SZA		/) OR 'STEP'?
	JMS	PUTW	/YES: STACK ELLAB
	JMP	COMP20	/RETURN
 
/FLK3	PROCESS SECOND FLK OPERATOR IN FOREL
/	ONLY PRESENT ON MULTIPLE FOR ELEMENTS
 
FLK3	JMS	FNW	/OTD(FOR LINK) TO NXOP
	JMS	JLW	/G(JMP 'OVER DO STATS')
	LAC	JMS%AU	/G(DISPL(FOR LINK))
	JMS	OUT4	/G(JMS* %AU)
	LAC	DOLAB
	JMS	PLOC	/DOLAB PLANTED
	JMS	GEN4
	XX		/G(XX):LINK TO DO S/R
	JMS	GEN3
	JMP	.-3
	LAC	NXOP
	JMS	PUTW	/OTD(FOR LINK) TO WK
	JMP	COMP20	/EXIT & RELOAD NXOP
	.EJECT
/ERROR REPORTING ROUTINE	-ERR# IN AC
/ONLY ERROR NOS. 23,24,29,98 &99 pOSSIBLE
 
ERR	XX
	IDX	ERRNO	/COUNT #ERRORS REPORTED
	JMS	TCA
	TAD	ERRCH
	DAC	.+1	/PICK UP ASCII FOR ERROR #
	0 /LAC	ERRNUM-27+ERROR #
	DAC	EBUFF
	.WRITE	-3,2,ERRBUF,14
	.WAIT	-3
	JMP*	ERR
 
ERRCH	LAC	ERRNUM-27
 
ERRBUF	7002
	0
	.ASCII	'**E'
EBUFF	.ASCII	<0><0><0>' ('
ERPOSN	.ASCII	'0,0)(0,0)'<15>
	.BLOCK	5	/BLOCK FOR LINE & CHAR COUNT
			/FROM INT.CODE INPUT
ERREC	LAW	-11	/READ IN 8 WORDS OF ASCII
	DAC	SP00	/LINE & CHAR POSN
	LAC	AAERP
	DAC*	C8
ERREC1	JMS	FNW
	DAC*	AUTO
	ISZ	SP00
	JMP	ERREC1
	JMP	COMP+1
	.EJECT
/RDDI	READ AND DECODE DICT INFO
/CALLED WHEN NXOP CONTAINS OP(DICT INFO) TO READ DICT BLOCK
/ITS STORES IT IN CORE AND SETS Q2=8 IF NONLOCAL
/			Q2=4 IF OWN
/			Q2=0 IF LOCAL
/                SETS UP LOCNSSKTHL	/FROM 1ST WORD READ
/		NXOP	/TO HOLD DISPL READ AS 2ND WORD
/SETS NXTRQD =0 TO INDICATE ANOTHER WORD INPUT REQD
 
 
RDDI	XX
	LAC	NXOP	/HOLD FIRST WORD IN CASE
	AND	T77777	/REMOVE TOP 2 CONTROL BITS
	DAC	HOLDP	/SHORT	DICT INFO (2 WORDS)
	DZM	Q2
	JMS	FNW
	DAC	SKTHL	/HOLD NEXT WORD OF DICT INFO
	AND	S03700
	CMA		/-H-1
	AND	Z77700
	TAD	CHL	/CHL-H-1
	SPA!CLA	/NONLOCAL?
	JMP	RDDI03	/NO,LOCAL
	LAC	C8
	DAC	Q2	/NONLOCAL:Q2=8
RDDI01	JMS	TOPT
	40000		/'X' OPTION?
	SKP		/YES
	JMP	RDDI02	/NO:DICT INFO NOW READ
	JMS	FNW	/DISPL HELD IN NXOP
	DAC	HOLDP	/HOLD DISPL
	JMS	FNW	/FETCH LAST WORD
RDDI02	LAC	HOLDP
	DAC	NXOP	/NXOP_DISP
	DZM	NXTRQD	/MARK NEXT REQD
	LAC	SKTHL
	AND	T40000	/EXTRACT KIND
	SAD	S40000	/OWN?
	SKP		/YES
	JMP*	RDDI	/NO,EXIT
	LAC	C4
	DAC	Q2	/Q2_4 IF OWN
	JMP*	RDDI
RDDI03	SAD	CLRSW	/LOCAL REF VALID
	JMP	RDDI01
	LAW	-1	/NO:CHECK LEVEL NOT=CURRENT LEVEL
	TAD	SKTHL	/HL-1
	CMA
	TAD	CHL	/CHL-HL
	AND	S03777	/EXTRACT RESULTANT HL
	SZA		/REF. WITHIN THIS BLOCK
	JMP	RDDI01	/NO:OK
	LAW	-143	/YES,REPORT ERROR 99
	JMS	ERR
	JMP	RDDI01
/CLADI	CLASSIFY DICT INFO:Q2=6 IF SWITCH NAME
/Q2&1=1 IF REAL:Q2&2=2 IF FN:Q2&4=4 IF OWN:Q2&8=8 IF NON LOCAL
/EXIT TO LINK+1 IF ARRAY OR SWITCH NAME
 
CLADI	XX
	JMS	RDDI
Z50001	CLC
	DAC	ARSW	/ARSW=-1(IF NOT ARRAY)
	LAW	774000
	AND	SKTHL	/EXTRACT SKT
	SAD	U24000	/LABEL ARRAY (IE SWITCH)
	JMP	CLADI2	/YES:Q2=6
	SMA!RAL		/SORT=ARRAY?
	ISZ	ARSW	/YES:ARSW=0
	SKP!RTL		/NO:SKIP
	JMP	CLADI4	/EXIT AS IF LOCAL INTEGER ACTUAL
	SZL!RAL		/KIND=ACTUAL OR OWN?
	SNL		/NO:FORMAL BY NAME?
	JMP	CLADI3	/NO
	AND	Z00000	/EXTRACT TYPE
	SAD	W00000	/IS IT STRING?
	JMP	CLADI1	/YES: EXIT AS IF ACT. INT.
	IDX	Q2	/YES:Q2:=Q2+2
	IDX	Q2
CLADI3	AND	U00000	/EXTRACT INT/BOOL BIT
	SNA		/INTEGER OR BOOLEAN?
	IDX	Q2	/NO:2:=Q2+1 IF NOT INT/BOOL
CLADI1	LAC	Q2
	JMP*	CLADI	/EXIT WITH Q2 IN AC
 
CLADI4	LAC	Q2
	SAD	C4	/OWN ARRAY?
	TAD	C12	/YES:TREAT AS FETCH ADDR
	SKP
CLADI2	LAC	C6	/Q2=6 FOR SWITCH
	DAC	Q2	/ALSO IN AC
	IDX	CLADI	/BUMP LINK FOR ARRAY OR SWITCH
	JMP	CLADI1	/EXIT TO LINK+1
	.EJECT
/ANAL
/ANALYSES THE SOURCE BY INTERPRETING SYNTAX BLOCKS
 
ANAL	LAC*	XB
	AND	S17777
	XOR	BANK
	DAC	XB	/XB:= ADDR OF CATOM
	LAC*	XB	/CATOM INTO AC
	SPA!RTL		/SKIP IF C=0 OR 1
	JMP	ANAL02	/JUMP IF ATOM NOT CODE OR MASK
	SNL!RTR		/SKIP IF C=1:CATOM IN AC
	JMP	ANAL01	/J IF C=0: CATOM IN AC
	SAD	NXOP	/CATOM=CURRENT CODE ?
	ISZ	NXTRQD	/YES, SO MARK NEXT INPUT REQD & SKIP
	JMP	ANAL03-2
	JMP	ANAL03-3
ANAL02	SZL		/)IF C=3 THEN JUMP TO XB TO OBEY ROUTINE TO
	JMP*	XB	/)DETERMINE STATE:RETURN TO ANAL03
	JMS	OBEY	/STACK XB AS LINK AND ENTER ANAL (C=2)
LANAL	JMP	ANAL
ANAL01	AND	NXOP	/MASK CURRENT CODE WITH CATOM
	SNA!STL		/MASK BIT SET IN CURRENT CODE ?
	CLC!SKP		/NO, SO SET AC=-1(FALSE) AND SKIP
	GLK		/YES, SO SET AC = +1(TRUE)
/COMMON PATH ONCE CATOM HAS BEEN PROCESSED;DEALS WITH ACTION AND NEXT
ANAL03	DAC	STATE
	TAD	XB
	DAC	XB	/XB:=NEXT(STATE)
	TAD	STATE
	DAC	ANAL90
	LAC*	XB	/AC:=NEXT(STATE)
	SPA		/ACTION REQD ?
	XCT*	ANAL90
ANAL04	LAC	NXTRQD
	SZA!CLC		/SKIP IF NEXT INPUT REQD (NXTRQD=0)
	JMP	.+3
	DAC	NXTRQD	/RESET NXTRQD TO -1(NEXT INPUT NOT REQD)
	JMS	FNW	/GET NEXT INPUT 
	LAC*	XB	/AC=NEXT(STATE)
	RTL		/AC0=N(STATE),L=S(STATE)
	SPA!CLC		/SKIP IF N=0(FALSE):AC=-1
	JMP	ANAL	/IF N=TRUE THEN GO TO PROCESS NEXT XB
	SZL		/SKIP IF S=0(FALSE):AC=-1
	CLA!RAL		/IF S=1(TRUE) THEN AC=+1
	DAC	STATE	/RESET STATE FROM AC
	JMP	EXIT	/EXIT TO LINK ON WORK STACK
	.EJECT
/PUT	
/SUBROUTINE TO PUT C(AC) ON STACK GIVEN AS A TRAILING ARGUMENT.
/CALLING SEQUENCE:
/SCRATCHPAD USED:SP00,SP01,SP02
/	JMS	PUT
/	.DSA	PTR
 
PUT	XX
	DAC	SP00
PUT01	LAC*	PUT	/LOAD ADDR OF STACK POINTER
	AND	S77777
	SAD	AOUT	/OUT SK?
	JMP	PUT04	/YES
	DAC	STLIM	
	DAC	PTRADD
	LAC*	STLIM	/LOAD STACK POINTER
	TAD	K1	/DECREMENT STACK PTR
	DAC	STWDAD	/HOLD
	ISZ	STLIM	/STLIM:=ADDR OF STACK LIMIT
	SAD*	STLIM	/STACK OVERFLOW?
	JMP	MOVE	/YES,SO MOVE STACKS ABOUT
	DAC*	PTRADD	/INSERT NEW PTR IN STAT. TABLE
PUT02	LAC	SP00	/LOAD WORD TO BE STACKED
	DAC*	STWDAD	/PUT ON STACK
	ISZ	PUT	
	JMP*	PUT	
PUT04	LAC	OUBASE	/)LOAD ADDR OF WD ABOVE LAST
	TAD	SIZE	/)WD ON OUT SK
	SAD	OUT-1	/OUT SK OVERFLOW?
	JMP	PUT06	/YES
	DAC	STWDAD	
	JMS	TCA
	TAD	OUT
	SPA		/SIZE LESS THAN 40?
	ISZ	OUT	/NO,SO INCREMENT OUT PTR
	ISZ	SIZE
	JMP	PUT02
PUT06	JMS	UP	/MOVE STACKS UP OR OUTPUT BUFFER
	JMP	PUT04	/TRY AGAIN
	.EJECT
PUTV	XX
	JMS	PUT
	.DSA	VOCAB
	JMP*	PUTV
 
PUTW	XX
	JMS	PUT
	.DSA	WORK
	JMP*	PUTW
 
PUTOUT	XX
	XCT	OUTSW	/SKP IF OUTPUT REQD
	JMP*	PUTOUT	/OTHERWISE EXIT
	JMS	PUT
	.DSA	OUT
	JMP*	PUTOUT
 
TAKEW	XX
	LAC*	WORK
	ISZ	WORK
	JMP*	TAKEW
 
	.EJECT
/MOVE
/CALLED FROM ROUTINE PUT TO MOVE STACKS DOWN THE CORE WHEN STACK
/OVERFLOW OCCURS.
/ENTRY:STLIM CONTAINS THE ADDRESS OF THE LOCATION IN THE STATISTICS
/TABLE FOLLOWING THE POINTER TO THE STACK WHICH OVERFLOWED.
/SCRATCHPAD USED:SP01,SP02
MOVE	LAC	STLIM
	DAC	SP01	
MOVE2	LAC*	SP01	/LOAD ADDR OF BASE OF CURRENT STACK
	SAD	OUT	/OUT SK?
	JMP	MOVE10	/YES
	ISZ	SP01	/SP01:=ADDR OF CURRENT STACK POINTER
	LAC*	SP01	
	CMA	 	/AC=-CURRENT STACK POINTER-1
	DAC	SP02	/STORE TEMPORARILY
	ISZ	SP01	/SP01:=ADDR OF NEXT BASE PTR
	LAC*	SP01
	AND	S77777	/IGNORE SIGN BIT IF SET
	TAD	SP02
	TAD	C25	/AC:=BASE(NEXT)-PTR(CURRENT)+24
	SMA		/FREE SPACE>23?
	JMP	MOVE2	/NO,SO TRY AGAIN
	LAC	SP01	
	TAD	K1
	DAC	SP01	/SP01:=ADDR Of STACK POINTER
	LAC*	SP01	/LOAD STACK POINTER
	TAD	K1	/SET UP A-I 10 WITH START ADDR FOR
	DAC*	C8	/STACK TRANSFER
	TAD	K24	/SET UP A-I 11 WITH DESTINATION
	DAC*	C9	/ADDR FOR STACK TRANSFER
	LAC*	STLIM
	CMA	
	TAD*	SP01	/AC:=PTR-(BASE + 1)
	DAC	SP02	/SET UP COUNT FOR TRANSFER LOOP
MOVE4	LAC*	AUTO	/START OF TRANSFER LOOP
	DAC*	AUTO1
	ISZ	SP02
	JMP	MOVE4	/END OF TRANSFER LOOP
/THIS SECTION UPDATES THE STATISTICS TABLE WITH THE NEW STACK POSITIONS
MOVE6	LAC*	SP01	/AC:=ADDR OF LAST ENTRY TO BE UPDATED
	TAD	K24
	DAC*	SP01	/STORE UPDATED ENTRY
	LAC	SP01
	SAD	STLIM	/TABLE UPDATED?
	JMP	MOVE8	/YES
	TAD	K1
	DAC	SP01	/DECREMENT PTR
	JMP	MOVE6
MOVE8	LAC	STWDAD
	JMP	PUT02-1
MOVE10	JMS	UP	/MOVE STACKS UP CORE, OR OUTPUT BUFFER
	JMP	PUT01
	.EJECT
/UP
/SUBROUTINE TO MOVE STACKS UP THE CORE WHEN STACK OVERFLOW
/OCCURS. IF THE STACKS ARE TOO TIGHTLY PACKED TO BE MOVED
/UP,A BUFFER-FULL OF INTERMEDIATE CODE IS OUTPUT (UNLESS
/THIS WOULD NOT RELIEVE THE JAM,WHEN THE RUN IS ABORTED
/AND AN ERROR MESSAGE OUTPUT).
/ENTRY	LOCN FSREQD HOLDS 1+THE SIZE OF FREE SPACE
/	REQUIRED BEFORE THE STACK BELOW THE FREE SPACE IS
/	MOVED UP.
/EXIT	STACKS MOVED UP,BUFFER OUTPUT,OR ABORT.
/SCRATCHPAD USED: SP01,SP02
/AUTO-INDEX REGS. USED: 14,15
 
UP	XX
	DZM	SMF	/CLEAR "STACKS MOVED" FLAG
	LAC	FREQD
	SKP
UP02	LAC	FSREQD
	RCR
	DAC	FSREQD	/HALVE SIZE OF FREE SPACE REQD
	SNA		/RESULT=0?
	JMP	UP12	/YES,SO GO TO OUTPUT BUFFER
	LAC	AINBA
	DAC	SP02
UP04	ISZ	SP02
UP06	LAC*	SP02	/GET NEXT PTR
	SAD	OUT-1	/LAST FREE SPACE?
	JMP	UP10	/YES,SO EXIT FROM LOOP
	ISZ	SP02	/SP02:=ADDR OF NEXT BASE
	JMS	TCA
	TAD*	SP02	/AC:=-(FREE SPACE+1)
	TAD	FSREQD	/AC:=-(FREE SPACE-(FSREQD-1))
	SMA		/STACK TO BE MOVED?
	JMP	UP04	/NO,SO FIND NEXT FREE SPACE
	DAC	SMF
	JMS	TCA	/AC:=FREE SPACE -FSREQD
	DAC	SP01	/HOLD
	TAD*	SP02	/)SET NEW BASE ENTRY
	DAC*	SP02	/)IN STAT TABLE
	DAC*	C12	/HOLD
	ISZ	SP02	/SP02:=ADDR OF PTR
	LAC	SP01
	TAD*	SP02	/)SET NEW PTR ENTRY
	DAC*	SP02	/)IN STAT TABLE
	CMA		/ACC:=-(NEWPTR-1)
	TAD	C2
	DAC	SP01	/HOLD FOR USE IN LOOP
	JMP	UP09
UP08	LAC*	AUTO4	/START OF LOOP TO MOVE STACK UP
	DAC*	AUTO5
	ISZ	ISZCT
	JMP	UP08	
UP09	LAC*	C12	/LOAD OLD ADDR OF LAST WD MOVED
	TAD	SP01	/SUBTRACT (NEW PTR-1)
	SPA!SNA		/WHOLE STACK MOVED?
	JMP	UP06	/YES,SO JMP OUT OF LOOP
	TAD	SMF	/SUBTRACT NO OF WORDS TO MOVE
	SMA		/SHORT BLOCK TO BE MOVED ?
	CLA		/NO ACC:=0
	JMS	TCA	/YES ACC:=MODIFIER
	TAD	SMF	/MODIFY NO OF WORDS TO BE MOVED:=CNT
	DAC	ISZCT	/RESET COUNT FOR INNER LOOP
	LAC*	C12	/)
	TAD	ISZCT	/)RESET AUTO-INDICES
	DAC*	C13	/)FOR INNER LOOP
	TAD	SMF	/)
	DAC*	C12	/)
	JMP	UP08
UP10	LAC	SMF
	SNA		/ANY STACKS MOVED?
	JMP	UP02	/NO
	JMP*	UP	/YES,SO EXIT
UP12	LAW	-50	/LOAD NO OF WORDS IN OUT STACK
	TAD	SIZE
	SMA		/SHOULD BUFFER BE OUTPUT?
UP14	JMP	UP16	/YES
K23	LAW	-27	/NO,SO REPORT ERROR 23
	JMP	ABORT
 
UP15	.INIT	INTOUT,1,P3CON	/OBEYED ONCE ONLY
	.ENTER	INTOUT,UP15+6	/ADDR OF FILENAME SET BY P3CON
	LAC	INITIN+2
	XOR*	AOPTW	/)SET IC MARKER IN OPT WD
	DAC*	AOPTW	/)
	IDX	UP14	/BUMP TO .ENTER ONLY ONCE
	SKP
UP16	JMP	UP15
	LAW	-6	/SET TO WRITE 6 BUFFER LOADS
	DAC	SP02	/(ONE FILE BLOCK)
UP18	.WRITE	INTOUT,0,UP18,42	/BUFF ADDR SET BY P3CON
	LAC	SIZE
	JMS	TCA
	DAC	SP01	/HOLD CT FOR LOOP
	LAC	OUBASE
	TAD	C39
	DAC*	C12
	TAD	K40
	DAC*	C13
UP20	LAC*	AUTO4	/START OF LOOP
	DAC*	AUTO5
	ISZ	SP01	/END?
	JMP	UP20	/NO
K40	LAW	-50	/)DECREMENT SIZE BY
	TAD	SIZE	/)NO OF WDS
	DAC	SIZE	/)OUTPUT
	TAD	K40	/AC:=NEW SIZE-40
	SPA		/SIZE<40?
	CLA		/YES: AC:=0
	TAD	C39	/AC:=39 OR SIZE-1
	TAD	OUBASE
	DAC	OUT	/SET OUT SKPTR IN STAT TABLE
	ISZ	SP02	/6 BUFFERS WRITTEN?
	SKP		/NO
	JMP*	UP	/YES:EXIT
	LAW	-50	/REDUCE SIZE
	TAD	SIZE	/BY BUFFER LOAD
	SMA		/BUFFER LOAD LEFT?
	JMP	UP18	/YES
	JMP*	UP	/EXIT
 
 
 
/TOPT
/TEST FOR OPTION
/CALL:	JMS	TOPT
/	MASK FOR OPTION
/RETURNS TO LINK IF OPTION SET(BIT=0)
/RETURNS TO LINK+1 IF OPTION NOT REQUIRED(BIT=1)
 
TOPT	XX
	LAC*	AOPTW	/LOAD OPTION WORD
	AND*	TOPT	/MASK FOR OPTION REQD
	IDX	TOPT
	SZA		/OPTION REQD?
	IDX	TOPT	/NO,SKP LOCATION
	JMP*	TOPT	/YES,RETURN
	.EJECT
/OBEY
/ROUTINE TO STACK A LINK ON THE WORK STACK AND ENTER THE ROUTINE
/SPECIFIED AS A TRAILING PARAMETER.
/A LINK ALWAYS HAS THE SIGN BIT SET.
/WHEN LINK POINTS TO ANAL, IT IS STORED AS XB WITH BITS 0-2 SET TO 110
/WHEN LINK POINTS TO COMP, IT IS STORED AS XB WITH BITS 0-2 SET TO 111
/IN ALL OTHER CASES C(AC) IS STACKED, THEN LINK AS 15-BIT ADDR
/WITH SIGN BIT SET.
/CALLING SEQUENCE:
/	JMS	OBEY
/	JMP	ROUTINE
 
OBEY	XX
	JMS	PUTW	/PUT C(AC) ON WORK STACK
	LAC	OBEY	/GET LINK
	AND	S77777	/KEEP 15 BIT ADDR
	SAD	ALANAL	/LINK TO ANAL?
	LAC	Y00000	/YES
	SAD	ALCOMP	/LINK TO COMP?
	LAC	Z00000	/YES
	SPA		/LINK TO COMP OR ANAL?
	JMP	OBEY2	/YES
	TAD	W00001	/SET SIGN AND STEP 1
	JMS	PUTW	/PUT LINK ON WORK STACK
	JMP*	OBEY	/ENTER ROUTINE
OBEY2	XOR	XB
	DAC*	WORK
	JMP*	OBEY
 
 
 
/EXIT
/ROUTINE TO JUMP TO THE ADDRESS SPECIFIED BY THE LAST LINK
/STORED ON THE WORK STACK.
/CALLING SEQUENCE:
/	JMP	EXIT
EXIT	JMS	TAKEW	/TAKE CURRENT WD OFF WORK STACK
	SMA		/SKIP IF LINK
	JMP	EXIT	/REPEAT
	DAC	SP01	/DUMP LINK ADDR
	RTL
	SZL		/LINK FROM ANAL OR COMP?
	JMP	EXIT05	/YES
	JMS	TAKEW	/TAKE STORED AC OFF WORK STK
	JMP*	SP01	/JUMP TO IT
EXIT05	RAL
	LAC	SP01
	AND	S77777
	SZL		/LINK FROM ANAL
	JMP	LCOMP+1	/NO
	TAD	STATE
	JMP	ANAL03+2
	.EJECT
/NSTK
/ROUTINE TO SEARCH THE VOCAB STACK FOR A MATCH WITH THE NAME HELD (IN
/RADIX 50 FORMAT) IN THE FIRST TWO WDS OF THE NAME CHARACTER BLOCK.
/IF NO MATCH IS FOUND THE NEW NAME IS ADDED TO THE STACK. THE DISPLACE-
/MENT OF THE ENTRY FROM THE BASE OF THE STACK IS INSERTED IN THE L.S.
/EXIT	AC CONTAINS VADDR OF VOCAB ENTRY
 
NSTK	XX
	LAC	NCB
	RAL		/L=1 IF NEW NAME 2 WDS, L=0 IF 1 WD
	LAC	VOCAB
	DAC	SP01
NSTK2	SAD	VOBASE	/AC POINTS TO BASE OF VOCAB STACK ?
	JMP	NSTK14	/YES
	ISZ	SP01
	LAC*	SP01	/AC := FIRST WD OF CURRENT NAME
	ISZ	SP01
	SAD	NCB	/SAME AS FIRST WD OF NEW NAME ?
	JMP	NSTK8	/YES
	SPA		/TWO WD NAME IN VOCAB ?
NSTK4	ISZ	SP01	/YES: SP01 POINTS TO SECOND WD
NSTK6	LAC	SP01
	JMP	NSTK2	/J WITH AC = ADDR OF LAST WD OF CURR ENTRY
NSTK8	SMA!SNL		/NEW NAME ONE WD AND CURR NAME ONE WD ?
	JMP	NSTK12	/YES
	SMA		/NEW NAME TWO WDS AND CURR NAME ONE WD?
	JMP	NSTK6	/YES
	SNL		/NEW NAME ONE WD AND CURR NAME TWO WDS?
	JMP	NSTK4	/YES
	LAC*	SP01	/LOAD SECOND WD OF CURR NAME
	SAD	NCB1	/SAME AS SECOND WD OF NEW NAME ?
	JMP	NSTK12	/YES, SO EXIT WITH TWO-WD NAME FOUND
	JMP	NSTK4
NSTK12	LAC	SP01
	TAD	K2	/AC:=PTR
NSTK13	JMS	EVA00	/CONVERT ADDR TO VADDR
	.DSA	VOBASE
	JMP*	NSTK	/EXIT WITH VADDR IN AC
NSTK14	SNL		/NEW NAME ONE WD?
	JMP	NSTK16	/YES
	LAC	NCB1	/PUT SECOND WD OF NEW
	JMS	PUTV	/NAME ON VOCAB STACK
NSTK16	LAC	NCB
	JMS	PUTV	/PUT FIRST WD ON VOCAB
Z50000	CLA		/PUT ZERO DICT PTR WD
	JMS	PUTV	/ON VOCAB STACK
	LAC	VOCAB	/LOAD POINTER
	JMP	NSTK13
	.EJECT
/EVA	12/8/69	JDS
/ROUTINE TO EVALUATE VIRTUAL ADDRESS OF FREE END OF STACK
/CALLING SEQUENCE	JMS	EVA
/		ADDRESS OF STACK BASE
/RESULT IS VIRTUAL ADDRESS IN AC AND SP00 AND IS 16 BIT
/STACK INDICATOR(4 BITS) + DISPLACEMENT (12BITS)
/SIGN BIT OF PARAMETER SET IF INDIRECT REFERENCE
/USES LOCATIONS SP00,SP01,SP02
 
EVA	XX
	LAC*	EVA	/GET PARAMETER
	DAC	SP00	/DUMP (IN CASE INDIRECT)
	SPA		/SKIP IF DIRECT
	LAC*	SP00	/RELOAD IF INDIRECT
	DAC	SP00	/DUMP ADDRESS OF BASE
	DAC	SP02	/:=ADDR OF BASE
	ISZ	SP00	/:=ADDR OF PTR
	LAC*	SP00	/VALUE OF PTR
	DAC	SP00	/:=ABS ADDR TO CONVERT
 
EVA01	LAC*	SP02	/VALUE OF BASE
	DAC	SP01
	CMA
	TAD	SP00	/ADDR-BASE VAL.-1 = DISPL.
	TAD	S07777	/VADDR+4095
	SPA		/VADDR > 12 BITS?
	JMP	EVA90
	TAD	Z70001	/REVERT TO DISPL. (-VE)
	AND*	SP01	/SET IN STACK #
	DAC	SP00	/STORE RESULT: ALSO IN AC
	ISZ	EVA
	JMP*	EVA	/EXIT
 
EVA90	LAW	-35	/ERROR 29
	JMP	ABORT
 
/COMPUTE VADDR OF ABS ADDR GIVEN IN AC  WRT STACK SPECIFIED.
/CALLING SEQUENCE:
/	ABS ADDR IN AC
/	JMS	EVA00
/	ADDR OF SK BASE	/INDIRECTION NOT ALLOWED
 
EVA00	XX
	DAC	SP00	/:=ABS ADDR TO CONVERT
	LAC*	EVA00
	DAC	SP02	/:=ADDR OF BASE
	LAC	EVA00	/)MOVE LINK
	DAC	EVA	/)
	JMP	EVA01	/J & COMPUTE VADDR
	.EJECT
 
/VTOA***JDSMART  29/7/69
/SUBROUTINE TO CONVERT STACK DISPLACEMENT(VIRTUAL ADDRESS)TO AN
/ABSOLUTE CORE ADDRESS
/VIRTUAL ADDRESSES ARE 16BIT QUANTITIES OF THE FORM
/	LS 12 BITS GIVE DISPLACEMENT(0-4094)
/	TOP 4 BITS (B2-B5) INDICATE STACK REFERENCED
 
/ON ENTRY THE AC HOLDS THE VIRTUAL ADDRESS
/ON EXIT THE AC HOLDS THE CORRESPONDING ABSOLUTE ADDRESS
/AND IT IS DUMPED INTO SP00
/USES ROUTINES	MES
 
/USES LOCATIONS	SP00,SP01,
 
 
VTOA	XX		/ON ENTRY AC=VIRTUAL
	DAC	SP01	/DUMP VIRTUAL
	JMS	MES	/GET INDICATOR TO LS END OF AC
	JMP	RR+14
	AND	C15
	RCL
	TAD	VTOA02	/)GET APPROP POSITION IN STACK
	DAC	VTOA01	/)INDICATOR CONVERSION TABLE
	LAC	SP01	/GET VADDR
	AND	S07777	/)MAKE REL TO BASE
	TAD	Z70001	/)-VE DISPL.
VTOA01	0	/TAD* VTOA02+1+SK#	:ADD BASE VALUE
	DAC	SP00	/)TO GIVE ABSOLUTE ADDRESS
	CMA		/-ABS ADDR-1
	ISZ	VTOA01	/STEP TO ADRR OF PTR
	XCT	VTOA01	/AC:=PTR ADDR-ABS ADDR-1
	SMA		/WITHIN CURRENT LIMIT OF STACK?
	JMP	VTOA90	/NO:ERROR 24:ABORT
	LAC	SP00	/LOAD RESULT
	JMP*	VTOA	/EXIT
 
VTOA90	LAW	-30
	JMP	ABORT
	.EJECT
/MES	9SEP69	JDS

/MULTIPLE ENTRY SUBROUTINE
/CALL	JMS	MES
/	JMP	(LABEL)	/WHERE (LABEL) IS THE ADDRESS OF THE
/			/CODE TO BE EXECUTED
/
MES	XX
	JMP*	MES	/OBEY IN LINE JMP TO CODE 
	ISZ	MES	/BUMP LINK
	JMP*	MES	/RETURN
 
 
/SHIFT AC RIGHT UP TO 9 PLACES
	.REPT	11
	RAR
R	JMP	MES+2
 
/SHIFT AC LEFT TO 9 PLACES
	.REPT	11
	RAL
L	JMP	MES+2
RR=L-23
LL=R-23
	.EJECT
/LAM****JDSMART   14/8/69
/ROUTINES TO LOAD AC FROM INDIRECTLY ADDRESS CORE (AFTER MODIFICATION)
/CALLING SEQUENCE 	JMS	LAM(LOAD AC) OR DAM(DUMP AC)
/			MOD+A
/WHERE LOCN.A CONTAINS ADDR TO BE MODIFIED AND THEN USED.
/'MOD' IS THE TOP 3 BITS(VALUE 0-7) WHICH IS ADDED TO THE
/ADDR FOUND TO GIVE THE EFFECTIVE ADDR.
/ROUTINE EQUIVALENT TO:-
/	LAC	A
/	TAD	MOD
/	DAC	SP00
/	LAC*	SP00
 
/OR TO	LAC*	A,X	WHERE INDEX REG.CONTAINS MOD
 
/USES LOCATIONS	SP00,SP01,SP02,SP03
/USES ROUTINE	EMA
/ON EXIT SP00 HOLDS ABS(15-BIT) ADDR OF CORE LOCATION REFERENCED.
 
EMA	XX	/EVALUATE MODIFIED ADDRESS GIVEN IN AC
	DAC	SP03
	RTL
	RTL
	AND	C7	/)EXTRACT MODIFIER AND
	DAC	SP01	/)DUMP IT
	LAC*	SP03	/)GET ADDRESS OF
	TAD	SP01	/)OF LOCATION REQUIRED
	DAC	SP00	/)&DUMP IT
	JMP*	EMA
 
LAM	XX		/LOAD AC FROM ABSOLUTE MODIFIED
	LAC*	LAM	/GET PARAMETER
	JMS	EMA	/EVALUATE MODIFIED ADDRESS
	LAC*	SP00	/LOAD REQUIRED CONTENTS
	ISZ	LAM
	JMP*	LAM	/EXIT
 
DAM	XX	/DUMP AC IN ABSOLUTE MODIFIED
	DAC	SP02	/STORE AC
	LAC*	DAM	/GET PARAMETER
	JMS	EMA	/EVALUATE MODIFIED ADDRESS
	LAC	SP02	/RELOAD AC
	DAC*	SP00	/DUMP IN SPECIFIED LOCATION
	ISZ	DAM
	JMP*	DAM	/EXIT
	.EJECT
/LVM****J.D.SMART 29/7/69
/ROUTINES TO LOAD AC AND DUMP AC FROM & TO VIRTUALLY ADDRESSED STORE
/CALLING SEQUENCE	JMS	LVM(LOAD AC FROM VIRTUAL)OR DVM
/		MOD+A
/WHERE LOCATION A CONTAINS A VIRTUAL ADDRESS,WHICH IS MODIFIED
/TO GIVE THE EFFECTIVE VIRTUAL ADDRESS.
/MOD IS THE TOP 3 BITS OF PARAMETER WD.(VALUE 0-7)
 
/USES LOCATIONS	SP00,SP01,SP02,SP03
 
/USES ROUTINES	EMA VTOA
/ON EXIT SP00 HOLDS ABS(15-BIT) ADDR OF CORE LOCN.REFERENCED
 
 
LVM	XX		/LOAD AC FROM VIRTUAL MODIFIED
	LAC*	LVM	/GET PARAMETER
	JMS	EMA	/EVALUATE REQUIRED VIRTUAL
	JMS	VTOA	/CURRENT VIRTUAL TO ABSOLUTE
	LAC*	SP00	/LOAD AC FROM ABSOLUTE
	ISZ	LVM
	JMP*	LVM	/EXIT
 
DVM	XX		/DUMP AC IN VIRTUAL MODIFIED
	DAC	SP02	/STORE AC
	LAC*	DVM	/GET PARAMETER
	JMS	EMA	/EVALUATE REQUIRED VIRTUAL
	JMS	VTOA	/CONVERT TO ABSOLUTE
	LAC	SP02	/RELOAD AC
	DAC*	SP00	/DUMP IN SPECIFIED LOCATION
	ISZ	DVM
	JMP*	DVM	/EXIT
 
 
LNP	XX
	JMS	LVM
	NXOP
	JMP*	LNP
	.EJECT
/COPY***JDSMART  14/8/69
/SUBROUTINE TO COPY BLOCKS OF CORE
/THREE PARAMETERS:-1)POSITION OF SOURCE AND MEANS OF ACCESS
/	2)POSITION OF DESTINATION AND MEANS OF ACCESS
/	3)LENGTH (IN WORDS)
/THERE ARE THREE MEANS OF ACCESS:-
/	1)ABSOLUTE CORE ADDRESS GIVEN
/	2)DISPLACEMENT IN STACK GIVEN (VIRTUAL ACCESS)
/	3)ON FREE END OF STACK (STACK ACCESS)
/THE ABOVE INFORMATION IS SUPPLIED BY THREE IN-LINE PARAMETERS
/FOLLOWING THE SUBROUTINE CALL:-
/	JMS	COPY
/	SOURCE INFO
/	DESTINATION   INFO
/	LENGTH (GIVEN POSITIVELY)
/THE SOURCE AND DESTINATION INFO TAKE THE FOLLOWING FORM
/MS 3 BITS ARE INDICATORS
/	BN(SIGN BIT)=1=>LEVEL OF INDIRECTION
/	B1=1=> POSITION GIVEN AS VIRTUAL ADDRESS
/	B2=1=> POSITION GIVEN AS STACK POINTER (ONLY IF B1=0)
/IF B1 =1 & B0=0 THEN LS 16 BITS ARE THE VIRTUAL ADDRESS OTHERWISE
/THE LS 15 BITS ARE ADDRESS APPROPRIATE TO SETTING OF B0,1&2
/THE ACCUMULATOR IS PRESERVED
/USES ROUTINES:-	PUT
/		VTOA
/		LVM
/USES LOCATIONS:	SP00,1,2
/USES AUTOINDICES:	AUTO2,AUTO3
 
COPY	XX		/LINK
	DAC	COPYSV	/DUMP AC
	LAC*	COPY	/PICK UP SOURCE INFO
	DAC	COPYSC	/DUMP(IN CASE INDIRECT)
	SPA		/SKIP IF NOT INDIRECT
	LAC*	COPYSC	/ACCESS ADDRESSED WORD
	DAC	COPYSC	/DUMP SOURCE POSITION
	LAC*	COPY	/RELOAD SOURCE INFO
	ISZ	COPY	/INCR.LINK TO DEST INFO
	SNA		/SOURCE = ZERO?
	JMP	COPY11	/YES: ARRANGE TO CLEAR DEST.
	RTL		/B1 TO LINK,B2 TO AC0
	SZL		/IS SOURCE A VIRTUAL ADDRESS?
	JMP	COPY06	/YES
	SPA		/IS SOURCE A STACK
	JMP	COPY08	/YES
/ABSOLUTE SOURCE-LOAD ADDRESS -1 INTO AUTOINDEX
	LAC	COPYSC	/LOAD SOURCE ADDRESS
COPY01	TAD	K1	/DECREMENT FOR AUTOINDEXING
	DAC*	C10	/DUMP IN AUTOINDEX 12
	LAC	ASCAB
COPY02	DAC	COPY05	/SET UP SOURCE ROUTINE
/PROCESS DESTINATION INFO
	LAC*	COPY	/LOAD DEST INFO
	DAC	COPYDT	/DUMP(IN CASE INDIRECT)
	SPA		/INDIRECT?
	LAC*	COPYDT	/YES:ACCESS ADDRESS
	DAC	COPYDT
	LAC*	COPY	/RELOAD DEST INFO
	SNA		/DEST. = ZERO?
	JMP	COPY12	/YES: ARRANGE NOT TO COPY SOURCE
	RTL
	SZL		/DEST VIRTUAL?
	JMP	COPY09	/YES
	SPA		/DEST A STACK
	JMP	COPY10	/YES
/ABSOLUTE DESTINATION-LOAD ADDRESS-1 INTO AUTOINDEX
	LAC	COPYDT	/DEST ADDRESS
COPY03	TAD	K1	/DECREMENT
	DAC*	C11	/DUMP IN AUTOINDEX 13
	LAC	ADTAB	/SET TO COPY ABSOLUTE
COPY04	DAC	COPY05+1	/SET UP DEST ROUTINE
	ISZ	COPY	/STEP AUTO TO LENGTH
	LAC*	COPY	/LOAD LENGTH
	DAC	COPYCT	/DUMP IN COUNT
	SPA		/INDIRECT REF
	LAC*	COPYCT	/YES-LOAD LENGTH
	SNA		/ZERO?
	JMP	COPY05+4	/YES,SO DO NOTHING
	JMS	TCA	/NEGATE COUNT
	DAC	COPYCT	/DUMP
COPY05	XX		/GET WORD FROM SOURCE
	XX		/PUT RESULT IN DESTINATION
	ISZ	COPYCT	/INCREMENT COUNT
	JMP	COPY05	/REPEAT IF NONZERO
	ISZ	COPY	/STEP  LINK
	LAC	COPYSV	/RESTORE AC
	JMP*	COPY	/EXIT
 
/VIRTUAL SOURCE-CONVERT TO ABSOLUTE IF DEST. NOT A STACK
COPY06	LAC*	COPY	/LOAD DEST INFO
	RTL		/B2 TO AC0
	SMA		/IS DEST A STACK?
	JMP	COPY07	/NO
	SZL		/IS IT VIRTUAL?
	JMP	COPY07	/YES: S BIT IS SK#
	LAC	ASCV	/SET TO COPY FROM VIRTUAL
	JMP	COPY02
 
/CONVERT VIRTUAL SOURCE TO ABSOLUTE
COPY07	LAC	COPYSC	/VIRTUAL ADDRESS TO AC
	JMS	VTOA	/CONVERT TO ABSOLUTE &
	JMP	COPY01	/J TO LOAD INTO AUTOINDEX
 
/SOURCE A STACK
COPY08	LAC	ASCS	/SET TO COPY FROM STACK
	JMP	COPY02
 
/CONVERT VIRTUAL DESTINATION TO ABSOLUTE
COPY09	LAC	COPYDT	/VIRTUAL ADDRESS TO AC
	JMS	VTOA	/CONVERT TO ABSOLUTE &
	JMP	COPY03	/LOAD INTO AUTOINDEX
 
/DESTINATION A STACK
COPY10	LAC	ADTS	/SET TO COPY STACK
	JMP	COPY04
 
/	ZERO SOURCE
COPY11	LAC	ASCZE	/SET AC CLEAR AS SOURCE
	JMP	COPY02
 
/	ZERO DEST.
COPY12	LAC	ADTZE	/SET NOT TO WRITE TO DEST
	JMP	COPY04
 
/ADDRESS OF CODE SEQUENCES FOR LOADING AND DUMPING AC APPROPRIATELY
ASCAB	LAC*	AUTO2	/ABS. SRC
ASCS	JMP	SCS	/SRC A STACK
ASCV	JMP	SCV	/VIRTUAL SRC
ASCZE	CLA		/ZERO SRC
ADTAB	DAC*	AUTO3	/ABS,VIRT DEST
ADTS	JMP	DTS	/DEST A STACK
ADTZE	NOP		/ZERO DEST
			/DUMP AC ON STACK
DTS	JMS	PUT
COPYDT	.DSA	/DESTINATION ADDRESS IN APPROPRIATE FORM
	JMP	COPY05+2
			/LOAD AC FROM VIRTUAL
SCV	JMS	LVM	/
	COPYSC		/ADDR. OF VIRT ADDR
	ISZ	COPYSC	/REDUCE VADDR BY ONE
	JMP	COPY05+1 	/J TO DUMP AC
			/LOAD AC FROM STACK
SCS	LAC*	COPYSC	/GET ADDRESS OF STACK PNTR
	DAC	SP00	/DUMP IT
	LAC*	SP00	/LOAD STACK WORD
	ISZ*	COPYSC	/TAKE WORD OFF STACK
	JMP	COPY05+1	/J TO DUMP AC
 
 
 
/TCA
/ROUTINE TO TWO'S COMPLEMENT THE AC
TCA	XX
	CMA
	TAD	C1
	JMP*	TCA
	.EJECT
	/PHASE 3 SYNTAX BLOCKS
 
	JMS	COMP	/COMPILE PROG MODULE
	AS		/EXIT OK
MODL3	CC+MP		/*MP?*
	AN	MODL13	/YES_
	JMP	GEMP	/G(ENTER MAIN PROGRAM)
MODL13	CX	BEG3	/PROCESS MAIN PROGRAM BLOCK
Y00000	AS		/EXIT OK
	JMP	JMS%DW	/G(JMS* %DW)
BEG3	JMP	STCHL	/<STCHL>:TRUE
	N	BEG13	/_
	JMS	COMP	/COMPILE DECL
	AN	BEG13	/NO_
BEG13	CC+ENDD		/*ENDD?*
	AN	BEG23	/YES_
	JMP	GENDD	/G(END DEC)
	JMS	COMP	/COMPILE OPS UNTIL END
	AN	BEG23	/_
BEG23	CC+END		/*END?*
	AS		/YES
	JMP	GENDB	/G(END BLOCK)
	N	PDEC23	/NO_
PDEC3	JMP	INTPR	/<INTERNAL PROC?>
	N	PDEC13	/YES_
	JMP	GJPE	/G(JMP & PROC ENTRY)
	AN	PDEC33	/_
PDEC13	JMP	MODP	/<MODULE PROC?>
	AN	PDEC33	/YES
	JMP	GPEM	/G(PROC ENTRY FOR MODULE)
	N	PDEC43
PDEC23	JMP	TROP	/<TRACE ON?>
	AN	PDEC43
	JMP	GTEP	/G(TRACE EXT PROC CALL)
	JMS	COMP	/COMPILE OPS UNTIL ENDP
	AN	PDEC33	/REPEAT
PDEC33	CC+ENDP		/*ENDP?*
W00000	A		/EXIT FAIL
	JMP	GENDP	/G(END PROC)
	N	PDEC43	/SCAN UNTIL ENDP
PDEC43	CC+ENDP
	AS
	JMP	XENDP	/EXIT FROM EXT. PROC DECL
IFS3	CX	IFCL	/RECURSE 'IFCL'
	AN	IFS13	/_
	JMS	JLW	/G(JMP W(+))
	N	IFS23	/_
IFS13	CC+ENDC		/*ENDC?*
W00001	A	1	/EXIT FAIL
	JMS	PLW	/PLANT LABEL
W00002	A	2	/EXIT FAIL
FR23	0		/MASK 0;FALSE
SVX1	JMP	KTW	/<END OF SV?>
	AN	SVX	/NO
	JMP	JMS%AZ	/G(STACK INTEGER)
	A		/NO:
FI3	JMP	TFN	/<FORMAL BY NAME?>
	N	FI13	/YES_
	N	ARD3	/NO_
ARD13	JMP	ARNM	/<ARRAY NAME?>
	AN	ARD13	/YES_COMPILE IT
	JMS	COMP	/COMPILE PARAMS
	AN	PC3	/REPEAT
PC3	JMP	DICT	/<DICT INFO?>
	AS
	JMP	GPC	/G( PROC CALL)
	DZM	DOLAB	/MARK 'NO LABEL IN DOLAB'
	AN	FOR13	/_
FOR3	CC+FLK		/*FLK?* MULTIPLE FOR ELEMENTS?
	AN	FOR23	/_YES
	JMP	DOL	/BUY LABEL & HOLD IN DOLAB
SVX	JMP	COMP00	/COMPILE SUBSCR EXP OR CALL SV
	N	SVX1	/_LOOK AT NXOP
STEP3	JMP	STEP	/<G(V:=A)& WH3>
	N	STEP13	/_
WH3	JMP	WHILE	/<SET UP ELLAB>
	AN	STEP23	/_
	JMS	COMP
	AN	IFS13	/_NO
IFS23	CC+ENDF		/*ENDF?*IN WHILE OR STEP?
	A		/EXIT
	JMP	ENDFOR	/TERMINATE FOR(SINGLE FOREL)
AFOR3	JMP	COMP00	/G(V:=A)
	AN	STEP23	/_
	DZM	ELLAB	/MARK AFOR
STEP13	JMP	COMP00	/G(V:=V+B;(STEP))
	AN	STEP23	/_
	JMP	EFOREL	/SET LOC FOR INIT JMP
STEP23	JMP	COMP00	/G(CONDITION;(WH,STEP);DO(AFOR))
	0		/FAIL
ARD3	JMP	ASEG	/<NXOP=ASEG OP?>
	AN	ARD23	/YES_
	DZM	NXTRQD	/DISCARD ASEG OP
	JMS	COMP	/COMPILE BPL
	AN	ARD13	/_
ARD23	0		/M(0):FAIL
	JMS	COMP	/COMPILE OPS UNTIL ENDF
	AN	FOR13	/REPEAT
FOR13	CC+ENDF		/*END OF FOR?*
	0		/FAIL
	JMS	COMP	/COMPILE OPS UNTIL ENDF
	AN	FOR23	/_REPEAT
FOR23	CC+ENDF		/*END OF FOR?*
	AS		/EXIT OK
	JMP	GXDO	/G(EXIT FROM DO S/R)
	JMP	DECLAB	/SET OTLOC FOR LABEL
	A		/FAIL
LAB3	0		/M(0):FAIL
NEG3	JMP	COMP00	/<COMPILE>
	N	NEG13	/_
	JMP	JMS%CF	/G(JMS* %CF)
	A		/FAIL(LOSE OP)
NEG13	JMP	TRL	/<REAL?>
	A		/FAIL(LOSE OP)
	JMP	JMS.BA	/G(JMS* .BA)
NOT3	JMP	COMP00	/<COMPILE>:TRUE
	AS
	JMS	GCMA	/G(CMA)
REL3	JMP	RELAT2	/<RELAT2>:TRUE
	AS		/_
	JMS	GCLA	/G(CLA)
IFX3	CX	IFCL	/RECURSE 'IFCL'
	AN	IFX13	/_
	JMS	JLW	/G(JMP W(+))
IFX13	JMP	COMP00	/<COMPILE>:TRUE
	AN	IFX23	/_
	JMP	FELS	/G(FLOAT IF REQD);GELSE
IFX23	JMP	COMP00	/<COMPILE>:TRUE
	A		/FAIL
	JMP	FEC	/G(FLOAT IF REQD):PLW
	N	IFCL2	/_
IFCL	JMP	REL	/<RELATIONAL OP?>
	N	IFCL1	/_
IFCL1	JMP	RELAT1	/<RELAT1>:TRUE
	S		/OK
IFCL2	JMP	COMP00	/<COMPILE>:TRUE
	AS		/OK
	JMP	GSNA	/G(SNA)
FIX3	JMP	COMP00	/<COMPILE>:TRUE
	AS		/OK
	JMP	JMS%AR	/G(JMS* %AR)
FLT3	JMP	COMP00	/<COMPILE>:TRUE
	AS		/OK
	JMP	JMS.AW	/G(JMS* .AW)
	0
GOTO3	JMP	COMP00	/<COMPILE>:FALSE IF LOCAL TO BLOCK
	AS		/OK
	JMP	JMP%BX	/G(JMP* %BX)
BPL3	JMP	COMPC	/<COMPILE(CHECK LOC REF)>:TRUE
	AN	BPL13	/_
	JMP	JMS%AZ	/G(JMS* %AZ)
	N	BPL3	/_
BPL13	CC+END		/*END?*
	A		/FAIL
	JMP	DARR	/G(DECL ARRAY)
DYAD3	JMP	COMP00	/<COMPILE>:TRUE
	AN	DYAD13	/_
	JMP	FL1	/G(FLOAT FIRST ARG IF NEC)
	N	DYAD53	/_
DYAD13	JMP	CI	/<COMPLEX INT OP?>
	AN	DYAD23	/_
	JMP	JMS%AZ
DYAD23	JMP	COMP00	/<COMPILE>:TRUE
	AN	DYAD33	/_
	JMP	FL2	/G(FLOAT SECOND ARG IF NEC)
	JMP	JMS%CO
	AN	DYAD43	/_
DYAD33	JMP	CI	/<COMPLEX INT OP?>
	AN	DYAD43	/_
	JMP	JMS%CN
FSTR3	JMP	COMP00	/G(LOAD ADDR OF STRING)
	A
	JMP	JMS%AZ	/STACK IT
	0
DYAD43	JMP	OPS	/<COMPILE OP FROM SK>:FALSE
	N	DYAD63	/_
DYAD53	JMP	CRL	/<COMPLEX REAL OP?>
	AN	DYAD23	/_
	JMP	JMS%AX
	A		/NO:STACK THEN FAIL
FR3	JMP	TFN	/<FORMAL BY NAME?>
	N	FR13	/YES_
	JMP	OPR	/G(SIMPLE REAL DYADIC OP)
	A		/FAIL
DYAD63	JMP	SI	/<SIMPLE INT OP?>
	A		/FAIL
	JMP	OPI	/G(SIMPLE INTEGER DYADIC OP)
	N	SV33	/_
SV3	JMP	VCALL	/<VALUE CALL?>
	N	SV13	/_
	N	SV23	/_
SV13	JMP	TRL	/<REAL?>
	N	SV33	/_
SV23	JMP	SV31	/<COMPILE SV>:TRUE
	A		/FAIL
	JMP	JMS%BQ
SV33	JMP	SV31	/<COMPILE SV>:TRUE
	0		/FAIL
	JMP	JMP%BN
	AN	FR23	/_
FR13	CX	CF	/RECURSE
	AN	FR23	/_
	JMP	JMP%BI
	JMP	JMP%BM
	AN	FR23	/_
FI13	CX	CF	/RECURSE
	AN	FR23	/_
	JMP	JMP%BO
	N	CF1	/_
CF	JMP	DICT	/<DICT INFO?>
	AS		/OK
	JMS	COMPA	/COMPILE 'FETCH ADDR'
	JMS	COMP	/COMPILE
	A		/FAIL
CF1	JMP	SUBV	/<SUBSCR VAR?>
	AS		/OK
	JMS	COMPA	/COMPILE 'FETCH ADDR'
SW3	JMP	COMP00	/<COMPILE>:TRUE
	AN	SW13	/_
	JMS	JLW	/G(JMP W(+))
	JMP	PLSW	/PLANT LOC IN SW LIST
	AN	SW13	/_
SW13	CC+END		/*END?*
	AS		/OK
	JMS	PLW	/PLANT LOC
	JMP	JMP%BN
	AN	FR23	/_
FLAB13	0		/MASK 0:FALSE
FLAB3	JMP	TFN	/<FORMAL BY NAME?>:TRUE
	AN	FLAB13	/_
	JMS	COMPA	/COMPILE 'FETCH ADDR'
	N	ASS53	/_
ASS3	CC+END		/*END?*
	N	ASS13	/_
ASS13	JMP	COMP00	/<COMPILE>:TRUE
	AN	ASS23	/_
	JMP	FFASS	/G(FIX OR FLOAT FOR ASSIGN)
	JMP	SDA	/SET UP # DICT ATTRS TO PROCESS
	AN	ASS43	/_
ASS23	JMP	KARG	/<COUNT ARGS?> FALSE IF ZERO
	N	ASS33	/_
	JMP	JMS%BT	/STORE REAL FROM STACKED ADDR
	AN	ASS23	/_
ASS33	JMP	TRL	/<REAL ASSIGN?>
	AN	ASS23	/_
	JMP	SRS
	JMP	SNX	/RESET NXOP/NXTRQD
	A		/FAIL
ASS43	JMP	KARG	/<COUNT ARGS?>
	AN	ASS43	/_
	JMP	GASS	/G(ASSIGN TO DICT INFO)
	N	ASS3	/_
ASS53	JMP	SKAD	/<STACKING ADDR?>
	AN	ASS3	/_
	JMP	JMS%AZ
	.EJECT
/STEP 3,AFOR3,WH3
/PROCESS ABOVE FOR ELEMENT OPERATORS
/COMP IS USED TO PROCESS THE CONSTITUENTS OF EACH ELEMENT
/STEP3 & WH3 PLANT A LABEL IN 'ELLAB' FOR LATER REFERENCE 
 
 
STEP	IDX	STEPAS
	JMS	COMP	/COMPILE(V:=A)
	LAC	C2
	DAC	TAG	/SET LOC BACK TO VALUE
	LAC	HOLDL
	DAC	LOC	/LOC SET BACK TO ASSIGN STORE CODE
	JMS	OUTRLB	/ISSUE CODE 2(RESET LOC)
	JMS	JLW	/COMPILE JMP OVER STEP CODE
WHILE	JMS	BNL	/BUY LABEL (SET AT LOC)
	DAC	ELLAB	/AND HOLD IN ELLAB
	JMS	PLOC
	JMP	TRUE
 
EFOREL	LAC	LOC	/HOLD LOC IN HOLDP
	DAC	HOLDP
	LAC	HOLDL	/PLANT DESTINATION FOR
	DAC	LOC	/STEP JMP AT 'STORE' OF ASSIGN
	JMS	PLW
	LAC	HOLDP	/RESET LOC
	DAC	LOC
	JMP	ANAL04
	.EJECT
/DECLAB	PROCESS LABEL DECLARATION
/ON ENTRY	NXOP HOLDS PTR TO ATTRS ON LABEL STACK
/NEXT 1 OR 2 WORDS IN INCODE ARE LABEL NAME IN RADIX 50
 
DECLAB	JMS	BLL	/GET LABLOC ENTRY
	JMS	PLOC	/PLANT LOC IN LABLOC ENTRY
	JMS	FNW	/1ST HALF OF LABEL NAME
	DAC	NAME1	/TO NAME1
	JMS	FNW	/GET SECOND HALF
	DAC	NAME2	/STORE IN NAME2
	JMS	OUTNAM	/OUTPUT CODES 7&8
	JMS	GEN43	/APPEND CODE 43
	JMP	TT	/TEST FOR TRACING
 
/BLL	BUY LABLOC FOR LABEL IF NECESSARY:LPTR IN NXOP
 
BLL	XX
	JMS	LVM	/GET LABLOC FROM LABEL ATTRS
	M*2+NXOP
	SNA		/LABLOC ASSIGNED?
	JMS	BNL	/NO:GET ONE
	JMS	DVM	/STORE IN LABEL ATTRS
	M*2+NXOP
	JMP*	BLL
	.EJECT
 
/LABREF	GENERATE CODE SEQUENCE FOR LABEL REFERENCE
/COMPILES 'LABEL VALUE TO FLOPAC'EXCEPT FOR 'VALUE'CALL FOR LABELS
/IN CURRENT LEVEL;THEN EXITS TO COMP WITH STATE=FALSE
 
LABREF	XX
	JMS	LNP	/UPNPTR(ATTRS) TO AC
	SPA		/DECLARED?
	JMP	LABRF1	/YES
	AND	T77777	/NO:EXTACT UPNPTR
	DAC	NXOP	/INTO NXOP
	SZA		/END OF CHAIN?
	JMP	LABREF+1	/NO
	LAW	-142	/YES:NOT DECLARED
	JMS	ERR	/ERROR 98
	JMS	GEN3
	JMP	.+0	/G(JMP .)
	JMP*	LABREF
 
LABRF1	JMS	BLL	/BUY LABLOC & PLACE IN ATTRS
	DAC	LLL	/HOLD LABLOC IN LLL (OTDISPL IF FORMAL)
	JMS	LVM	/SKTHL WORD OF ATTRS
	M*3+NXOP
	AND	S03777	/)HOLD HL
	DAC	SKTHL	/)IN SKTHL
	AND	S00077	/EXRACT L(LEVEL)
	SNA		/FORMAL LABEL(L=0)?
	JMP	FORML	/YES
	DAC	NXOP	/INTO NXOP
	LAC	SKTHL
	JMS	TCA	/-HL
	TAD	CHL	/CHL-HL
	SZA		/IN CURRENT BLOCK?
	JMP	.+3	/NO
	SAD	FADSW	/YES:VALUE CALL?
	JMP	LABRF2	/YES
	TAD	NXOP	/CHL-H
	JMS	MES	/CHL-H TO LS END OF AC
	JMP	R-6
	AND	S00077	/EXTRACT H
	SNA!CMA		/IN CURRENT HIER?
	JMP	LABRF3	/YES
	TAD	C1	/)NO: HOLD CT OF HIERARCHIES BACK
	DAC	SP05	/)IN SP05
	LAC	PRCHN	/GET HIER CHAIN PTR
	JMP	.+3	/WORK UP CHAIN
	JMS	LVM	/UNTIL RIGHT HIER REACHED
	SP04
	DAC	SP04	/)
	ISZ	SP05	/)
	JMP	.-4	/)
LABRF4	JMS	LVM	/ACCESS NEXT WORD ON SK(PTR TO PROC INFO)
	M*1+SP04
	DAC	SP04	/HOLD
	JMS	LVM	/ACCESS DBIL FOR LABEL'S HIER
	M*4+SP04
	SKP
LABRF3	LAC	DBIL
	CMA		/-DBIL-1
	TAD	NXOP	/ADD LEVEL
	JMS	TCA	/DBIL-L+1
	DAC	NXOP
	LAC	JMS%BR	/G(JMS* %BR);D(BASE);D(DBIL-L+1)
	JMS	OUT3NL
	LAC	LLL
	XOR	U00000
	JMS	GLLR	/G(ADDR OF LABEL):15 BIT
	0
	JMP*	LABREF
 
LABRF2	LAC	LLL	/FOR LABELS LOCAL TO BLOCK
	JMS	GLLR	/G(JMP LABEL)
	JMP
	DZM	NXTRQD	/MARK NXTRQD
	JMP	FALSE	/EXIT FROM LABREF,GFTLU,COMP,COMP00
 
FORML	LAC	LLL	/OTDISPL OF FORMAL THUNK
	DAC	NXOP	/TO NXOP
	LAC	SKTHL
	CMA
	AND	Z77700
	TAD	CHL
	SMA!CLA		/NONLOCAL?
	LAC	C8	/YES AC_8
	JMS	GFTLU	/G(FETCH FORMAL REAL VALUE)
	LAC	LVR+3
	LVP-LVR
	JMP	COMP20	/EXIT TO COMP
	.EJECT
	/PHASE 3 CATOM TESTS
 
/STCHL	USED ON BEGIN BLOCK TO STACK CHL AND RESET
/FROM NXOP (WORD FOLLOWING BEG OPERATOR)
 
STCHL	LAC	CHL
	JMS	PUTW
	LAC	C46	/LIST BLOCK ENTRY
	DAC	TAG
	LAC	NXOP
	DAC	CHL
	JMS	OUTRLB
	DZM	NXTRQD
	JMP	TRUE
 
/INTPR	PROCESS DICT INFO FOR PROC DECL
/STACKS CHL & RESETS H=H+1,L=1
/STACKS OLD HIERARCHY INFO (CPI) & RESETS IT FROM ATTRS
/EXITS TRUE IF INTERNAL PROC;FALSE IF EXTERNAL
 
INTPR	LAC	CHL
	JMS	PUTW	/STACK CHL
	AND	S03700	/HOLD H
	TAD	S00101	/H=H+1;L=1
	DAC	CHL	/INTO CHL
	LAC	CPI
	JMS	PUTW	/W(+)_CPI
	JMS	RDDI	/READ & DECODE DICT INFO
	LAC	NXOP
	DAC	CPI	/RESET CPI
	JMS	COPY	/CPOY PROC INFO INTO
	M*6+CPI		/FIXED STORE
	NAME1
C6	6
	LAC	PRCHN	/)HOLD PRCHN ON
	JMS	PUTW	/)WORK SK
	JMS	EVA	/RESET PRCHN TO
	WKBASE		/HOLD VADDR OF OUTER HIER
	DAC	PRCHN	/POINTER
	CLC		/MARK NEXT NOT REQD
	DAC	NXTRQD	/(SET BY RDDI)
	JMS	LNP
	AND	U00000	/EXTRACT EXT BIT
INTPR2	SZA
	JMP	FALSE
	JMP	TRUE
 
/MODP	TRUE IF (WORK+2)=0
 
MODP	JMS	LAM	/STACKED CHL=0?
	M*2+WORK
	JMP	INTPR2	/YES:TRUE
	.EJECT
/SI	TRUE IF CAA(WORK)=0 ELSE FALSE
 
SI	LAC*	WORK
	AND	S70000
	JMP	INTPR2
 
/CI	TRUE IF CAA(WORK)=4 ELSE FALSE
 
CI	LAC*	WORK
	TAD	Z40000
	JMP	SI+1
 
/CRL	TRUE IF CAA(WORK)>4 ELSE FALSE
 
CRL	LAC	S70000
	AND*	WORK
	TAD	Z40000
CR01	SPA!SNA
	JMP	FALSE
	JMP	TRUE
 
/TRL	TRUE IF A1(WORK)=1 ELSE FALSE
 
TRL	LAC*	WORK
	AND	S20000
	JMP	CR01
 
/DICT	TRUE IF NXOP IS DICT INFO
 
DICT	LAC	NXOP
	SMA
	JMP	FALSE
	JMP	TRUE
 
/SUBV	TRUE IF NXOP IS SV
 
SUBV	LAC	NXOP
	AND	U07700
	TAD	X74100	/IS IT 203700?
	JMP	INTPR2
 
/ASEG	TRUE IF NXOP IS ASEG
 
ASEG	LAC	NXOP
	AND	U07700
	TAD	X72600	/=0 IF ASEG
	JMP	INTPR2
 
/ARNM	TRUE IF NXOP IS SK#=6 OR 7 (ARRAY NAME)
 
ARNM	LAC	NXOP
	AND	Z60000
	SAD	S60000	/SK#=6 OR 7?
	JMP	TRUE
	JMP	FALSE
/RELAT1,RELAT2	COMPILE RELATIONAL
/ON ENTRY TO RELAT1 OPERATOR IN  NXOP & IS TO BE STACKED
/ON ENTRY TO RELAT2 OPERATOR STACKED & NXOP UPDATED
RELAT1	LAC	NXOP
	JMS	PUTW	/STACK OPERATOR
	JMS	FNW	/
RELAT2	JMS	COMP	/COMPILE SUBTRACTION
	LAC*	WORK
	AND	S20000
	SNA		/REAL ARGUMENT?
	JMP	.+3	/NO
	JMS	GGR	/G(LAC* .AB) IF REAL
	LAC*	.AB
	LAC*	WORK	/GET REL OPCODE
	TAD	S00400	/SET 'AND' IF GT,GE,NE
	AND	S01300	/PRESERVE OPERATE SKIP BITS
	TAD	Z50001	/ADD CLC OPBITS
	JMS	GEN4A	/GENERATE
	JMP	TRUE
 
/VCALL	TRUE IF FADSW=0 ELSE FALSE
 
VCALL	LAC	FADSW
	DZM	FADSW	/CLEAR SWITCH
	JMP	INTPR2
 
/TFN	TEST IF FORMAL BY NAME:IF SO G(SET THUNK;JMP OVER THUNK):TRUE
/			:ELSE COMPILE EXPRESSION :FALSE
TFN	LAC*	WORK
	AND	S20000
	SZA		/FORMAL BY NAME?
	JMP	TFN01	/YES
	JMS	COMP	/NO
	JMP	FALSE
TFN01	JMS	GGR	/G(JMS* %BP)
	JMS*	%BP
	JMS	JLW	/G(JMP OVER THUNK ROUTINE)
	JMP	TRUE
 
/SV31	COMPILE SUBSCRIPT EXPS & STACK FOLLOWED BY ARRAY CALL
/# SUBSCRIPTS IN ARGCT FIELD OF OP ON WORK
 
SV31	LAW	-1
	TAD*	WORK
	AND	S00077
	DAC	DIM	/#DIMS
	LAC	XB	/
	JMS	OBEY	/STACK XB
	JMP	SV3101
	DAC	XB	/RESET XB
	JMP	TRUE
 
SV3101	LAC	DIM	/ARGCT
	JMS	PUTW	/STACK # DIMS FOR RDDI
	CMA
	JMS	PUTW	/WORK(+)_
	LAC	ASVX	/)SET UP XB
	DAC	XB	/)FOR SUBSCR EXP
	JMP	ANAL+4	/ENTER ANAL
 
/KTW	BUMP ARGCT ON WORK:FALSE IF ZERO
 
KTW	ISZ*	WORK
	JMP	TRUE
	JMP	FALSE
 
/TROP	TRUE IF TRACE OPTION ON ELSE FALSE
 
TROP	DZM	NXTRQD	/MARK NEXT REQD
	JMS	TOPT
	400000
	SKP
FALSE	CLC!SKP
TRUE	LAC	C1
	JMP	ANAL03
 
/KARG	SAC+1:IF SAC=0 THEN FALSE ELSE TRUE
 
KARG	ISZ	SAC
	JMP	TRUE	
	JMP	FALSE
 
/REL	TRUE IF NXOP IS RELATIONAL OR NOT,ELSE FALSE
 
REL	LAC	NXOP
	SMA!RAL		/SKIP IF DICT INFO
	SMA		/OPERATOR?
	JMP	FALSE	/NO
	AND	S06000	/YES:
	SAD	S04000	/IS OP 20-27 OR 60-67
	JMP	TRUE	/YES:(RELAT OR NOT)
	JMP	FALSE	/NO:(ANY OTHER EXPRESSION OP)
 
/SKAD	PROCESS LHS OF ASSIGNMENT
/IF SV OR(NOT OWN &(FN OR 1 WORD NL)) THEN COMPILE 'ADDRESS'
/IF OWN OR REAL OR LOCAL 1 WORD STACK DICT INFO ON WORK FOR LATER
 
SKAD	LAC	NXOP
	SPA		/DICT INFO?
	JMP	SKAD02	/YES
	JMS	COMPA	/COMPILE 'ADDR OF ARRAY ELEMENT'
SKAD01	IDX	SAC	/INCR COUNT OF 'STACKED ADDRESSES'
	JMP	TRUE
 
SKAD02	JMS	CLADI	/CLASSIFY DICT INFO(NEVER ARRAY)
	TAD	K8
	SZA!RTR		/NON LOCAL ONE WORD?
	SZL		/NO:FORMAL BY NAME
	SKP		/YES
	JMP	SKAD03	/NO:STACK DICT INFO
	LAC	Q2	/PICK UP DICT TYPE
	JMS	GFTLU	/USE LVR,LVP TABLE FOR
	LAC	LVR+14	/CODE GENERATION OF FETCH ADDR.
	LVP-LVR
	JMP	SKAD01
 
SKAD03	JMS	TAKEW
	DAC	HOLDP	/HOLD ASS OP
	JMS	COPY	/STACK Q2,NXOP & HOLDP
	Q2
	M*1+WORK
C4	4
	JMP	FALSE
 
/OPS	COMPILE DYADIC OPERATION FOR
/	1ST ARG COMPUTED ONTO RUN TIME STACK
/	2ND ARG COMPUTED INTO AC OR FLOPAC
 
OPS	LAC	NXOP	/PRESERVE NXOP
	DAC	HNX
	LAC	S27773	/PUT SKPTR OF (16)
	DAC	NXOP	/INTO NXOP
	JMS	TAKEW	/RETRIEVE OPERATOR
	JMS	MES
	JMP	R-6
	AND	S00077
	ISZ	STATE	/STATE=FALSE(-1) IF REAL
	TAD	C8	/SUBTRACT 8 IF REAL OP
	TAD	K8
	JMS	GFTLU	/COMPILE FROM
	LAC	OPSR-14	/TABLES (OPSR,OPSP)
	OPSP-OPSR
	LAC	HNX	/RESET NXOP
	DAC	NXOP
	JMP	FALSE
 
/COMPC 	COMPILE OPERATOR CHECKING THAT NO REFERENCES ARE
/TO VARIABLES LOCAL TO CURRENT BLOCK
/SWITCH CLRSW SET NON ZERO INDICATES TO RDDI THAT CHECK
/IS TO BE APPLIED:NOT USED RECURSIVELY
 
COMPC	CLC
	DAC	CLRSW
	JMS	COMP
	DZM	CLRSW
	JMP	TRUE
 
COMP00	JMS	COMP
	JMP	TRUE
	.EJECT
/PHASE 3 ACTIONS
 
/OPI	COMPILE SIMPLE 'AC'DYADIC OPERATION(INT OR BOOL)
/	1ST ARG ALREADY COMPILED,PRODUCING VALUE IN AC OR FLOPAC AT OBJECT TIME
/	2ND ARG IS SIMPLE(CONSTANT OR DICT INFO(NOT FN)) AND
/	IS AVAILABLE IN NXOP
 
OPI	JMS	CLARG	/CLASSIFY 2ND ARG INTO AC
	JMS	GFTLU	/COMPILE FROM TABLES(OPIR,OPIP)
	LAC	OPIR-14
	OPIP-OPIR
	JMP	ANAL04
 
/OPR COMPILE SIMPLE REAL DYADIC OPERATION
/	/AS FOR OPI
 
OPR	JMS	CLARG
	JMS	GFTLU
	LAC	OPRR-40
	OPRP-OPRR
	JMP	ANAL04
 
/JMSGL GENERATE JMS* GLOBAL NAME
/	ENTERS AT APPROP IDX TO GENERATE MOD TO VOCAB PTR
/	ON ENTRY COUNT IN JMSCT IS ZERO
 
JMS%AW	IDX	JMSCT
JMS%DW	IDX	JMSCT
JMS.BA	IDX	JMSCT
JMS%CF	IDX	JMSCT
JMS%CO	IDX	JMSCT
JMS%CN	IDX	JMSCT
JMS%BT	IDX	JMSCT
JMS%AR	IDX	JMSCT
JMS.AW	IDX	JMSCT
JMS%BQ	IDX	JMSCT
JMS%AZ	IDX	JMSCT
JMS%AX	LAC	JMSCT
GINSTR	DZM	JMSCT
	CCL		/
	RAL		/1+2*JMSCT
	TAD	T27730	/ADD JMS*(-47)
	JMS	GGRA
	JMP	ANAL04
 
/JMPGL GENERATE JMP* GLOBAL NAME
/	ENTRY AS FOR JMSGL
 
JMP%BM	IDX	JMSCT
JMP%BN	IDX	JMSCT
JMP%BI	IDX	JMSCT
JMP%BO	IDX	JMSCT
JMP%BX	LAC	JMSCT
	TAD	U37772	/MAKE INTO JMP*(-63)
	JMP	GINSTR
 
/DOL  BUY NEW LABEL & HOLD VADDR(LABLOC) IN DOLAB
 
DOL	JMS	BNL
	DAC	DOLAB
	JMP	ANAL04
 
/ENDFOR	TERMINATE WHILE OR STEP WHEN SINGLE FOREL
 
ENDFOR	JMS	TAKEW	/TAKE STACKED ELLAB
	JMS	GLLR
	JMP	/ELLAB	/G(JMP 'ELLAB')
	JMS	PLW	/PLANT FALSE DEST FOR IFS
	CLC
	DAC	NXTRQD	/LEAVE'ENDF' IN NXOP FOR 'FOR13
	JMP	ANAL04
 
/GCMA GENERATE 'CMA'
 
GCMA	XX
	JMS	GEN4
	CMA
	JMP*	GCMA
 
GCLA	XX
	JMS	GEN4
	CLA
	JMP*	GCLA
GSNA	JMS	GEN4
	SNA
	JMP	ANAL04
 
/COMPA COMPILE OPERATOR INTO 'FETCH ADDR OF VARIABLE'
/SWITCH FADSW SET TO 12(DEC) IMPLIES THIS TO COMP
/ USED RECURSIVELY:PROC WITH FN PARAMS USED AS SUBSCRIPT
/FADSW HAS NO NEED TO BE RECURSIVE
 
COMPA	XX
	LAC	C12
	DAC	FADSW
	LAC	COMPA	/W(+)_LINK
	JMS	PUTW
	JMS	COMP
	DZM	FADSW
	JMS	TAKEW	/LINK_W(-)
	DAC	COMPA
	JMP*	COMPA
	.EJECT
/FFASS	FIX/FLOAT FOR ASSIGNMENT:OPERATOR ON WORK
/ARGCT CHANGED TO # STACKED DICT INFO AND FIX/FLOAT GENERATED ACCORDING
/TO CAA IN OPERATOR:MARK'NEXT NOT REQD'(NXTRQD=-1)
 
FFASS	LAC	NXOP	/)PRESERVE NXOP
	DAC	HNX	/)
	LAC	NXTRQD	/)AND NXTRQD WHILE COMPILING
	DAC	HNR	/)ASSIGNMENTS
	CLC		/MARK NEXT NOT REQD
	DAC	NXTRQD
	LAC	LOC	/HOLD LOC
	DAC	HOLDL	/IN HOLDL
	IDX	HOLDL	/INCR FOR FIX/FLOAT
	LAC	SAC
	CMA
	DAC	SAC	/SAC=-#STACKED ADDRS-1
	TAD*	WORK
	DAC*	WORK	/ARGCT(WORK)=# OF STACKED DICT INFO
	LAC	STEPAS	/CHECK IF V:=A IN STEP ELEMENT
	SZA!CLC
	DAC	SAC	/RESET SAC=-1 IF SO
	LAC*	WORK
	AND	S30000
	SAD	S10000	/ASSIGNING REAL TO INT?
	JMP	JMS%AR	/YES,FIX
	SAD	S20000	/ASSIGNING INT TO REAL?
	JMP	JMS.AW	/YES FLOAT
K1	LAW	-1	/REDUCE HOLDL
	TAD	HOLDL	/IF NO FIX/FLOAT
	DAC	HOLDL
	JMP	ANAL04	/RETURN
 
/SNX	RESET NXOP,NXTRQD AT END OF ASSIGNMENT PROCESS
 
SNX	LAC	HNR
	DAC	NXTRQD
	LAC	HNX
	DAC	NXOP
	JMP	ANAL04
 
/SDA	/SET UP STACKED DICT INFO COUNT IN SAC
 
SDA	JMS	TAKEW
	AND	S00077	/EXTRACT # STACKED DICT INFO
	CMA		/-#SDI-1
	DAC	SAC	/HOLD IN SAC FOR USE BY KARG
	JMP	ANAL04
	.EJECT
/GENDD	/GENERATE END DEC CODE
GENDD	JMS	GGR
	LAC*	%AA
	JMS	CBILE
	LAC	JMS%BU
	JMS	OUT3L
	JMP	ANAL04
 
/GENDB	GENERATE END BLOCK CODE
 
GENDB	LAC	C47
	DAC	TAG
	LAC	CHL
	JMS	OUTRLB
	JMS	TAKEW
	DAC	CHL
	SNA		/MAIN PROGRAM TOP LEVEL?
	JMP	ANAL04	/YES
	TAD	K1	/HL-1
	SNA		/H=0 &L=1?
	JMP	GENDB1	/YES
	AND	S00077
	SNA		/L=1 & H NOT=0(INTERNAL PROC)?
	JMP	ANAL04	/YES:IGNORE AT END OF PROC
GENDB1	JMS	CBILE
	LAC	JMS%BG
	JMS	OUT4
	JMS	GGR
	DAC*	%AA
	JMP	ANAL04
 
/CBILE	COMPUTE BIL ENTRY DISPL LEFT IN NXOP +VELY
 
CBILE	XX
	LAC	CHL
	AND	S00077
	CMA
	TAD	C2
	TAD	DBIL
	DAC	NXOP
	JMP*	CBILE
 
/GELSE GENERATE ELSE CODE
 
GELSE	XX
	JMS	TAKEW
	DAC	HOLDP
	JMS	JLW	/G(JMP W(+))
	LAC	HOLDP
	JMS	PLOC	/PLANT LABEL FROM WORK
	JMP*	GELSE
	.EJECT
/FELS	/IF AA(WORK-1)=1 THEN FLOAT;GO TO GELSE
/USED IN IFEXP
 
FELS	JMS	LAM
	M*1+WORK
	AND	S30000	/EXTRACT AA FROM OP
	SAD	S10000
	JMS	FLOAT
	JMS	GELSE
	JMP	ANAL04
 
/FEC	IF AA(WORK-1)=2 THEN FLOAT;GO TO PLW
 
FEC	JMS	LAM
	M*1+WORK
	AND	S30000
	SAD	S20000
	JMS	FLOAT
FEC1	JMS	PLW
	JMP	ANAL04
 
/FL1	/IF AA(WORK)=1 THEN FLOAT
 
FL1	LAC*	WORK
	AND	S30000
	SAD	S10000
	JMP	JMS.AW
	JMP	ANAL04
 
FL2	LAC*	WORK	/FLOAT IF AA(WORK)=2
	AND	S30000
	SAD	S20000
	JMP	JMS.AW
	JMP	ANAL04
 
 
 
/DARR	INITIAL CALL FOR DECLARING ARRAYS
/G(JMS* %AW) WITH DIM & ELEMENT SIZE INFO IN AC
/OPERATOR ON WORK GIVES 2*#DIM IN ARGCT FIELD & A2=1 IF REAL ARRAY
 
DARR	LAW	-2
	TAD*	WORK
	AND	S00077	/AC=2*#DIM-2=2B-2
	CMA
	DAC	SP00	/SP00=-2B+1
	LAC*	WORK
	AND	S10000
	SZA		/REAL ARRAY?
	LAC	C1	/YES
	XOR	SP00
	JMS	GEN4A
	JMP	JMS%AW
	.EJECT
/FLOAT COMPILE FLOAT INSTRUCTION
 
FLOAT	XX
	JMS	GGR
	JMS*	.AW
	JMP*	FLOAT
/GXDO COMPILE EXIT FROM DO S/R
/FOR LINK DISPL ON WORK:LABEL FOR JMP OVER S/R IN WORK-1
 
GXDO	JMS	TAKEW
	DAC	NXOP	/FOR LINK DISPL TO NXOP
	LAC	JMP%AT	/G(LAW DISPL(FOR LINK))
	JMS	OUT4	/G(JMP* %AT)
	JMP	FEC1	/PLANT LABEL FOR JMP OVER S/R
 
/STRL	/COMPILE STORE REAL CODE
 
STRL	XX
	JMS	GEN3
	DAC	.+2	/G(DAC .+2)
	JMS	GGR
	JMS*	.AP	/G(JMS* .AP)
	JMS	GEN4
	XX		/G(XX)
	JMP*	STRL
/SRS	COMPILE STORE REAL IN STACKED ADDR
 
SRS	JMS	GGR
	JMS*	%AY	/G(JMS* %AY) ADDR TO AC
	JMS	STRL	/STORE REAL
	JMP	ANAL04
 
/GPC	GENERATE PROC CALL
 
GPC	JMS	RDDI	/ANALYSE DICT INFO
	JMS	LNP
	AND	U00000	/EXTRACT EXT BIT
	SZA		/INTERNAL PROC?
	JMP	EXCALL	/NO:G(EXT CALL)
 
/	GENERATE INTERNAL PROC CALL
/NXOP SET UP BY INTPR1 TO HOLD VADDR OF PROC INFO FOR PROC
 
	DZM	SKTHL	/MAKE H=0 FOR OUT2H
	JMS	OUT2H
	LAC	Z50000	/G(CLA) IF DNLBL=0
	JMS	GEN4A	/G(LAW DISPL OF NLBL)
	JMS	LVM	/ACCESS PROC ENTRY POINT)
	M*2+NXOP
	JMS	GLLR
T00000	JMS	/EP
	JMP	ANAL04
	.EJECT
/GENDP	/COMPILE END PROC SEQUENCE
/VADDR OF PROC INFO ON WORK(+)
 
GENDP	JMS	LVM	/ACCESS NPW WORD IN PROC INFO
	M*3+CPI
	TAD	C2	/BUMP TO DISPL OF 1 WORD RESULT
	DAC	NXOP
	SMA		/REAL?
	JMP	GENDP1	/NO
	TAD	W00002	/YES
	JMS	TCA
	JMS	GEN4A	/G(LAW DISPL(REAL RESULT LOC))
	JMS	GGR
	JMS*	%BJ	/G(JMS* %BJ)
GENDP1	LAC	JMS%BD	/G(JMS* %BD)
	JMS	OUT3L	/G(DIPL OLD BASE-1)
	JMS	PLW
XENDP	JMS	TAKEW
	DAC	PRCHN	/UNSTACK OUTER HIER PTR
	JMS	TAKEW
	DAC	CPI
	JMS	COPY
	M*6+CPI
	NAME1
	6
	JMS	TAKEW	/)RESET
	DAC	CHL	/)CHL
	JMP	ANAL04
	.EJECT
 
 
/GJPE	GENERATE PROC ENTRY SEQUENCE (NOT FOR PROC MODULE)
/PROC INFO ALREADY COPIED INTO NAME1...ETC TO DNLBL
 
GJPE	JMS	JLW	/GEN JUMP OVER PROC BODY
	JMS	OUTNAM	/PROCNAME AS CODES 7&8
 
ENTPR	JMS	GGR
	JMS*	%BB
	JMS	GPEP	/G(PROC ENTRY PARAMS)
TT	JMS	TOPT	/TRACE OPTION ON?
	400000
	JMS	GTC	/YES: G(TRACE CALL)
NEXT	DZM	NXTRQD	/MARK NEXT REQD
	JMP	ANAL04	/RETURN
 
 
/GPEP	GENERATE PROC ENTRY PARAMETERS
/	TO FOLLOW G(JMS* %BB)
 
GPEP	XX
	JMS	GEN43	/G(LINK LOCN) & HOLD ADDR IN PROC INFO
	JMS	GPRLK
GJPE1	JMS	GEN3
	JMP	.-2	/G(JMP .-2)
	LAC	NPW
	TAD	C2
	AND	S17777
	JMS	GEN37	/G(NPW+2)
	LAC	DBIL
	CMA
	JMS	GEN37	/G(-DBIL-1)=FIXED SPACE
	LAC	DNLBL
	JMS	TCA
	JMS	GEN37	/G(DISPL OF NLBL)
	LAC	CHL
	JMS	MES
	JMP	R-6
	AND	S00037
	JMS	TCA
	JMS	GEN37	/G(-HIERARCHY #)
	JMP*	GPEP
	.EJECT
 
/GTEP	GENERATE TRACE EXTERNAL PROC
  
GTEP	JMS	JLW	/G(JUMP OVER TRACE SEQUENCE)
	JMS	GPRLK	/PLANT PROC LINK
	JMS	GTC	/GEN TRACE CALL
	JMS	LVM	/CLEAR EXT BIT
	CPI		/IN PROC INFO
	AND	X77777	/SO THAT CALLS APPEAR
	DAC*	SP00	/TO BE INTERNAL
	LAC	EP
	JMS	GLLR
U06501	LAC	6501	/G(LAC 'LINK')
	JMS	NSTK	/PUT PROC NAME IN VOCAB
	TAD	S60000	/PREFIX DAC*
	JMS	GGRA	/G(DAC* EXTNAME)
	LAC	GGRA+3
	TAD	T20000	/PREFIX LAC
	JMS	GGRA
	LAC	EP
	JMS	GLLR	/G(DAC 'EP')
S40000	DAC
	LAC	EP
	JMS	GLLR	/G(ISZ 'EP')
	ISZ
	LAC	EP
	JMS	GLLR	/G(JMP* 'EP')
	JMP*	
	JMP	FEC1
/EXCALL	/GENERATE CALL TO EXTERNAL PROC
 
EXCALL	JMS	COPY	/)COPY NAME OF PROC
	M*6+NXOP		/)TO NAME1,2
	NAME1
C2	2
	JMS	NSTK	/PUT NAME ON VOCAB SK
	TAD	T20000	/PREFIX JMS*
	JMS	GGRA	/G(JMS*	EXT. NAME)
	JMP	ANAL04
	.EJECT
 
/GPRLK	GENERATE PROCEDURE LINK LOCATION
 
GPRLK	XX
	JMS	BNL	/BUY NEW LABLOC ENTRY
	JMS	DVM	/STORE IN EP IN PROC INFO
	M*2+CPI
	DAC	EP	/HOLD IN EP
	JMS	PLOC	/PLANT LOC
	JMS	GEN4	/G(XX)
	XX
	JMP*	GPRLK
 
/GPEM	GENERATE PROC ENTRY FOR MODULE
 
GPEM	DZM	CHL	/HL=0 FOR MODULE
	JMS	OUTNAM
	LAC	C10
	DAC	TAG
	LAC	C1	/DEFINE PROC NAME AS INTERNAL GLOBAL
	JMS	OUTRLB
	LAC	C19	/)PROC MODULE NAME
	DAC	TAG	/)OUTPUT AS PROG NAME
	LAC	W00000
	JMS	OUTRLB
	JMS	GGR	/G(JMS* %BB)
	JMS*	%BB
	JMS	GEN43	/DEFINE PROC NAME AS INTERNAL SYMBOL
	JMS	GPEP	/G(PARAMS)
	JMS	JLW	/G(JMP INTO PROC)
	JMS	P2SK	/OUTPUT SKS
	DZM	NXTRQD	
	JMP	FEC1	/PLANT JMP DEST
 
/GEMP	GENERATE ENTRY TO MAIN PROGRAM
	
GEMP	JMS	P2SK	/OUTPUT SKS
	LAC	LOC	/HOLD PROG STARTING
	DAC	STLOC	/ADDR FOR .END
	LAC	C25	/INDICATE TO P3 COMPILING
	DAC	TAG	/)MAIN PROGRAM
	JMS	OUTRLB
	JMS	GGR
	JMS*	%BA	/G(JMS* %BA)
	LAC*	AOPTW	/)SET SIGN BIT
	AND	W00000	/)IF TRACE OPTION
	XOR	W00000	/)ON.
	TAD	DIM	/ADD IN OWN SIZE
	JMS	GEN37	/G(OWNSIZE,37)
	LAC	DIM
	SNA		/ANY OWN?
	JMP	GEMP1	/NO
	LAC	C26	/)OUTPUT ADDRESS
	DAC	TAG	/)OF FIRST WORD
	CLA		/)OF OWN
	JMS	OUTSTW
GEMP1	JMS	FNW
	SAD	U06501	/NXOP='BEG'OP?
	JMP	GEMP2	/YES:END OF DATSLOT LIST
	JMS	GEN37	/G(DATSLOT#,37)
	LAC	C22
	DAC	TAG
	LAC	NXOP
	JMS	OUTRLB	/G(.IODEV DATSLOT#)
	JMP	GEMP1	/(400000 IF ALL)
 
GEMP2	JMS	GGR
	JMS*	%BB	/G(JMS*	%BB)
	JMS	GPEP	/G(PARAMS)
	JMP	NEXT
 
/GASS	GENERATE ASSIGNMENT TO DICT INFO STACKED
/WORK HOLDS OTDISPL (MOVED BACK TO NXOP)
/WORK-1 HOLDS Q2 FOR THIS VARIABLE
 
GASS	JMS	TAKEW	/HOLD SKTHL
	DAC	SKTHL
	JMS	TAKEW	/HOLD OTDISPL
	DAC	NXOP	/IN NXOP
	LAC	STEPAS	/CHECK IF V:=A IN STEP ELEMENT
	RAR
	DZM	STEPAS	/RESET STEPAS
	JMS	TAKEW	/RETRIEVE Q2
	SZL		/YES,IT WAS,DO NOT GENERATE CODE
	JMP	ANAL04
	TAD	C54	/USE ENTRIES IN OPRP+54-32
	JMP	OPR+1
 
/PLSW	PLANT LOC IN SWITCH LIST
 
PLSW	IDX	SWLA
	LAC	LOC
	JMS	DVM
	SWLA
	JMS	COMPA
	JMP	JMP%BN
	.EJECT
/FORWARD REFERENCE HANDLING ROUTINES
/BNL	BUY NEW LABEL & HOLD ON LABLOC STACK
/PLOC	PLANT LOCATION COUNT IN SPECIFIED WORD OF LABLOC SK
 
BNL	XX
	CLA
	JMS	PUT	/LABLOC(+)_0
	LABLOC
	JMS	EVA
	LLBASE		/VADDR(END OF LABLOC)IN AC
	JMP*	BNL
 
PLOC	XX		/AC HOLDS VADDR OF LABLOC ENTRY TO BE SET
	DAC	SP04
	LAC	LOC
	JMS	DVM
	SP04
	JMP*	PLOC
 
/JLW BUY A LABEL,HOLD ON WORK & G(JMP 'LAB')
 
JLW	XX
	JMS	BNL	/BUY NEW LABEL
	JMS	PUTW	/HOLD ON WORK(+)
	JMS	GLLR	/G(JMP 'LAB')
	JMP	0
	JMP*	JLW
 
 
/PLW 	IF WORK(+) IS VADDR(LABLOC)THEN SET VALUE OF LOC
/	INTO THIS LABLOC ENTRY
 
PLW	XX
	LAW	770000
	AND*	WORK	/HOLD MS 6 BITS OF WORD ON WORK
	SAD	T10000	/IS IT LABLOC PTR
	SKP		/YES
	JMP*	PLW	/NO:EXIT
	JMS	TAKEW	/VADDR(LABLOC) TO AC
	JMS	PLOC	/PLANT LOC INTO IT
	JMP*	PLW	/EXIT
	.EJECT
/CLARG CLASSIFY SECOND ARG TO DYADIC OPERATOR
/USED BY OPI,OPR
 
CLARG	XX
	LAC	NXOP
	SPA!CLL		/SK PTR?
	JMP	CLARG2	/NO
	AND	T70000	/EXTRACT SK#
	JMS	MES
	JMP	RR+14	/SHIFT TO LS END
	SAD	C1	/IF REAL(SK#=1)
	TAD	C1	/MAKE=2
	RTL
	RTL		/16*SK#=32 FOR ARITH
CLARG1	DAC	SP00	/       48 FOR BOOLS
	JMS	TAKEW	/GET OPERATOR
	JMS	MES
	JMP	R-6
	AND	S00077	/EXTRACT OPCODE
	TAD	SP00	/ADD COMPUTED MODIFIER
	DZM	NXTRQD
	JMP*	CLARG	/EXIT
 
CLARG2	JMS	RDDI	/DECODE DICT INFO
	LAC	Q2	/SET AC=0 LOCAL
	RCL
	JMP	CLARG1	/      =8 OWN
	.EJECT		/      =16 NON LOCAL
/CODE GENERATION ROUTINES
/CALLED FROM TABLES WITH SYMBOLS?R,?P
/
 
 
OUT1	XX	/IF NXOP=0G(CLA,4)ELSE G(-NXOP,4)
	LAC	NXOP	/GET DISPL
	AND	S17777
	JMS	TCA
	SNA
	LAC	Z50000	/AC=INSTR(CLA)
	JMS	GEN4A
	JMP*	OUT1
 
OUT2L	XX	/G(-DISPL,39):TRAILING PARAMETER
	LAC	NXOP
	AND	S17777
	JMS	TCA
	JMS	GEN39
	JMP*	OUT2L
 
OUT2H	XX	/SET AC=-DNLBL+H:EXIT TO LINK+1 IF NOT=0
	LAC	SKTHL
	JMS	MES	/EXTRACT H FROM SKTHL
	JMP	R-6	/AND SHIFT TO LS END
	AND	S00037
	CMA		/-H-1
	TAD	DNLBL	/DNLBL-H-1
	CMA		/-DNLBL+H
	SZA		/ZERO?
	IDX	OUT2H	/BUMP LINK IF DISPL NOT=0
	JMP*	OUT2H
 
OUT2NL	XX	/G(-DNLBL+H,37);OUT2L
	JMS	OUT2H
	NOP		/DUMMY IN CASE=0
	JMS	GEN37
	JMS	OUT2L
	JMP*	OUT2NL
 
OUT3L	XX	/G(P,GLOB):OUT2L:P IN AC
	JMS	GGRA
	JMS	OUT2L
	JMP*	OUT3L
 
OUT3NL	XX	/G(P,GLOB);OUT2NL:P IN AC
	JMS	GGRA
	JMS	OUT2NL
	JMP*	OUT3NL
 
OUT4	XX	/OUT1;G(P,GLOB):P IN AC
	DAC	.+3
	JMS	OUT1
	JMS	GGR
	XX
	JMP*	OUT4
 
OUT5L	XX	/OUT3L(JMS* %BZ)
	LAC	JMS%BZ
	JMS	OUT3L
	JMP*	OUT5L
 
OUT5NL	XX	/OUT3NL(JMS* %BY)
	LAC	JMS%BY
	JMS	OUT3NL
	JMP*	OUT5NL
 
OUT6	XX	/OUT3NL(JMS* %BH)
	LAC	JMS%BH
	JMS	OUT3NL
	JMP*	OUT6
 
OUT7	XX	/G(P,GLOB):GSR(LAC*)
	JMS	GGRA
	JMS	GSR
U21000	LAC*	1000
	JMP*	OUT7
 
OUT8L	XX	/OUT5L;OUT7(P)
	DAC	HOLDP
	JMS	OUT5L
	LAC	S27773	/PUT SKPTR TO (16)
	DAC	NXOP	/INTO NXOP
	LAC	HOLDP
	JMS	OUT7
	JMP*	OUT8L
 
OUT8NL	XX	/OUT5NL;OUT7(P)
	DAC	HOLDP
	JMS	OUT5NL
	LAC	S27773	/PUT SKPTR TO (16)
	DAC	NXOP
	
	LAC	HOLDP
	JMS	OUT7
	JMP*	OUT8NL
 
OUT9	XX	/GSR(P)
	DAC	.+2
	JMS	GSR
	XX
	JMP*	OUT9
 
OUT10	XX	/G(P,GLOB);GSR(LAC)
	JMS	GGRA
	JMS	GSR
U07700	LAC	7700
	JMP*	OUT10
 
OUT11	XX	/GSR(TAD*)
	JMS	GSR
V77760	TAD*	17760
	JMP*	OUT11
 
OUT12	XX	/G(P,GLOB);GSA(400000)
	JMS	GGRA
	JMS	GSA
	XCT
	JMP*	OUT12
 
OUT13	XX	/G(P,GLOB);GSA(0)
	JMS	GGRA
	JMS	GSA
	0
	JMP*	OUT13
 
OUT14	XX	/G(P,GLOB);G(400016,4)
	JMS	GGRA
	JMS	GEN4
	XCT	16
	JMP*	OUT14
 
OUT15	XX	/OUT6,OUT14(P)
	DAC	HOLDP
	JMS	OUT6
	LAC	HOLDP
	JMS	OUT14
	JMP*	OUT15
 
OUT16	XX	/GSR(AND*)
	JMS	GSR
	AND*
	JMP*	OUT16
 
OUT17L	XX	/OUT5L;P
	DAC	.+4
	JMS	OUT5L	
	LAC	S27773	/PUT SKPTR TO (16)
	DAC	NXOP	/INTO NXOP
	XX	/JMS PLANTED
	JMP*	OUT17L
 
OUT17N	XX	/OUT5NL;P
	DAC	.+4
	JMS	OUT5NL
	LAC	S27773	/PUT SKPTR TO (16)
	DAC	NXOP	/INTO NXOP
	XX	/JMS PLANTED
	JMP*	OUT17N
 
OUT18	XX	/GSA(XOR*);G(CMA,4)
	JMS	GSR
	XOR*
	JMS	GCMA
	JMP*	OUT18
 
OUT19	XX	/G(JMS* %CG);GSR(XOR*)
	JMS	GGR
	JMS*	%CG
	JMS	GSR
	XOR*
	JMP*	OUT19
 
OUT20	XX	/OUT6;G(P,GLOB)
	DAC	.+3
	JMS	OUT6
	JMS	GGR
	XX
	JMP*	OUT20
 
OUT21	XX	/OUT4(P);G(JMS* %BQ)
	JMS	OUT4
	JMS	GGR
	JMS*	%BQ
	JMP*	OUT21
 
OUT22	XX	/OUT20(P);G(JMS* %BQ)
	JMS	OUT20
	JMS	GGR
	JMS*	%BQ
	JMP*	OUT22
 
OUT23	XX	/IF NXOP=037776(FALSE=0)THEN G(CLA,4)
Z70001	LAW	770001	/ELSE G(CLC,4)(TRUE)
	TAD	NXOP	/AC=027776(T),027777(F)
	CMA		/AC=750001(T);750000(F)
	JMS	GEN4A	/G(CLC)(T);G(CLA)(F)
	JMP*	OUT23
 
OUT24	XX	/IF AC=BOOLEAN (NXOP)THEN OUT23 ELSE NULL
	SAD	NXOP
	JMS	OUT23
	JMP*	OUT24
 
OUT25	XX	/IF BOOL(NXOP)=TRUE G(CLC) ELSE G(CMA)
	SAD	NXOP	/AC=TRUE (037775)
	JMP	.+3
	JMS	GCMA	/G(CMA) IF FALSE
	SKP
	JMS	OUT23	/G(CLC) IF TRUE (IN AC)
	JMP*	OUT25
 
OUT26	XX	/IF  NXOP='FALSE':G(CMA) ELSE NULL
	SAD	NXOP	/AC='FALSE'
	JMS	GCMA	/GCMA
	JMP*	OUT26
 
 
OUT27	XX	/FETCH ADDR OF ACTUAL REAL & STORE FLOPAC
	DAC	SP00	/HOLD PARAM
	LAC	GFTLU	/PRESERVE CURRENT LINK
	DAC	LGFTLU	/OF GFTLU
	LAC	SP00	/PARAM TO AC
	JMS	GFTLU
	LAC	LVR
	LVP-LVR
	LAC	LGFTLU	/RESET LINK
	DAC	GFTLU	/OF GFTLU
	JMS	STRL	/G(STORE REAL SEQUENCE)
	JMP*	OUT27
 
HSLA	XX	/HOLD SWITCH LIST ADDR
	LAC	NXOP
	DAC	SWLA
	JMP*	HSLA
 
OUT28	XX	/OUT2H;OUT13(JMS*	%BW)
	JMS	OUT2H
	LAC	Z50000	/G(CLA) IF DNLBL=0
	JMS	GEN4A
	LAC	JMS%BW
	JMS	OUT13
	JMP*	OUT28
 
/OPTIMISATION OF INTEGER DYADIC OPERATIONS
 
/OUT29:	ADD INTEGER
 
OUT29	XX
	LAC	NXOP	/GET INTEGER SKPTR
	SAD	S27776	/IS INTEGER ZERO?
	JMP*	OUT29	/YES:NO CODE
	JMS	GSR	/NO
	TAD		/G(TAD(INT))
	JMP*	OUT29
 
/OUT30	SUBTRACT INTEGER
 
OUT30	XX
	LAC	NXOP	/GET INT SKPTR
	SAD	S27776	/IS INTEGER ZERO?
	JMP*	OUT30	/YES:NO CODE
	LAC	JMS.AY	/NO
	JMS	OUT10	/G(JMS* .AY);(LAC (INT))
	JMP*	OUT30
 
/OUT31:	MULTIPLY INTEGER
 
OUT31	XX
	LAC	NXOP
	SAD	S27774	/IS INTEGER=1?
	JMP*	OUT31	/YES:NO CODE
	SAD	S27775	/IS INTEGER=-1?
	JMP	OUT311	/YES
	SAD	S27772	/IS INTEGER =2?
	JMP	OUT312	/YES
	LAC	JMS.AD	/NO
	JMS	OUT10	/G(JMS* .AD):G(LAC(INT))
	JMP*	OUT31
 
OUT311=.	/MULT BY -1
	JMS	GGR	/G(JMS* %CF)
	JMS*	%CF	/TO NEGATE AC
	JMP*	OUT31
 
OUT312=.	/MULT BY 2
	JMS	GEN4	/G(RCL)
	RCL		/TO DOUBLE AC
	JMP*	OUT31
 
/OUTNAM	OUTPUTS CODES 7&8 FOR RADIX 50 NAME HELD IN
/	NAME1 &NAME2.  NAME2 IS CLEARED FOR SHORT NAMES
 
OUTNAM	XX
	LAC	C7	/OUTPUT 1ST HALF
	DAC	TAG	/AS CODE 7
	LAC	NAME1
	SMA		/SHORT NAME?
	DZM	NAME2	/YES
	JMS	OUTRLB
	IDX	TAG	/CODE 8
	LAC	NAME2	/2ND HALF OF NAME
	SZA		/ZERO (SHORT NAME)?
	JMS	OUTRLB	/NO
	JMP*	OUTNAM
	.EJECT
/GGRA GENERATE GLOBAL REF (INSTR IN AC)
GGRA	XX
	DAC	.+2	/DEPOSIT INSTR
	JMS	GGR
	XX
	JMP*	GGRA
 
OUTSK	XX	/OUTPUT STACKS AS RLB AND TERMINATE
	JMS	P3SK	/OUTPUT FINAL CONSTANTS
	LAC	LOC	/)PUT PROG SIZE
	JMS	PUT	/)ON END OF GLOBAL FOR PH4
	GLOBAL
	LAC	C23	/)OUTPUT LOADER CODE 23(.END)
	DAC	TAG	/)WITH STARTING ADDR
	LAC	STLOC	/ LOCN OF 1ST INSTR
	JMS	OUTRLB
	LAW	-3
	SAD	LCCT	/ALL TAGS OUTPUT?
	JMP*	OUTSK	/YES
	JMP	.-4	/NO:OUTPUT FILLERS
 
/GSR	GENERATE STACK REFERENCE:SKPTR IN NXOP
 
	LAC	NXOP
	JMS	GENR
GSR	XX
	JMP	.-3
	JMP*	GSR
 
/GSA	GENERATE STACK ADDRESS(15 BIT):SKPTR IN NXOP
 
	LAC	NXOP
	XOR	U00000	/ADD 16 TO SK#
	JMS	GENR
GSA	XX
	JMP	.-4
	JMP*	GSA
 
/GLLR	GENERATE LABLOC SK REFERENCE:SKPTR IN AC
 
	JMS	GENR
GLLR	XX
	JMP	.-2
	JMP*	GLLR
	.EJECT
/GTC	GENERATE TRACE CALL
/ON ENTRY NAME IN RADIX 50 FORM IS HELD IN NAME1,NAME2
/THE ROUTINE GENERATES THE SEQUENCE:-
/	JMS*	%BC
/	.SIXBT	(CHARS FROM NAME1
/	.SIXBT	(CHARS FROM NAME2)OR 0 IF NAME IS SHORT
 
GTC	XX
	JMS	GGR	/G(JMS* %BC)
	JMS*	%BC
	LAC	NAME1	/FIRST 3 CHARS
	AND	T77777	/REMOVE TOP 2BITS
	JMS	OUT.SB	/OUTPUT AS .SIXBT
	JMS	GEN37
	LAC	NAME1
	SMA!CLA		/SHORT NAME?
	JMP	GTC1	/YES
	LAC	NAME2	/SECOND 3 CHARS
	JMS	OUT.SB	/OUTPUT AS .SIXBT
GTC1	JMS	GEN37
	JMP*	GTC
 
 
 
/OUT.SB	GIVEN AC IN RADIX 50 FORMAT OUTPUT A
/	SIXBIT LITERAL
 
OUT.SB	XX
	JMS	XR50	/CREATE 3 SEPARATE CHARS
	DZM	SP00	/CLEAR .SIXBT PACKED WORD
	LAC	R50.1	/)FIRST CHAR
	JMS	R50.SB	/)TO .SIXBT
	JMS	MES	/SHIFT UP
	JMP	L-6
	DAC	SP00
	LAC	R50.2	/)SECOND CHAR
	JMS	R50.SB	/)TO .SIXBT
	JMS	MES	/SHIFT UP
	JMP	L-6
	DAC	SP00
	LAC	R50.3	/)THIRD CHAR
	JMS	R50.SB	/)TO .SIXBT
	JMP*	OUT.SB
 
 
 
/XR50	EXPAND AC(IN RADIX 50 FORMAT) INTO 3
/	RADIX 50 CHARS
 
XR50	XX
	DZM	R50.1	/)CLEAR 2 RADIX 50
	DZM	R50.2	/)CHARS
XR50.1	IDX	R50.1
	TAD	Z74700	/SUBTRACT(50*50)
	SMA		/>3100?
	JMP	XR50.1		/YES
 
	TAD	S03100
XR50.2	IDX	R50.2	/CREATE SECOND CHAR+1
	TAD	K40	/SUBTRACT 50
	SMA		/>50?
	JMP	XR50.2	/YES
 
XR50.3	TAD	C41
	DAC	R50.3	/REMAINDER=THIRD CHAR
	JMP*	XR50
 
 
 
/R50.SB	CONVERT RADIX 50 CHAR IN AC INTO .SIXBT FORM
/	RESULT XOR'D INTO SP00
 
R50.SB	XX
	TAD	K1	/REDUCE TO CHAR VALUE
	SNA		/SPACE?
	JMP	R50.SP	/YES
	TAD	K27
	SPA		/LETTER?
	JMP	R50LET	/YES
	SNA		/%?
	TAD	K9	/YES
	SAD	C1	/.?
	CLA		/YES
	TAD	S00016	/ASSUME DIGIT
	SAD	S00032	/#?
	TAD	K23	/YES
R50.SP	TAD	C5
R50LET	TAD	C27
	CLL
	XOR	SP00
	JMP*	R50.SB
	.EJECT
/OUTRLB	OUTPUT RELOCATABLE BINARY UNIT
/CALL:-AC CONTAINS LOADER WORD: THE LOADER CODE IS IN TAG
/	JMS	OUTRLB
/LOADER WORD PUT ONTO OUT STACK AND TAG PACKED INTO LCWORD
/WHEN THIS HAS THREE TAGS IN IT IS PUT ONTO OUT STACK
/SCRATCH PAD USED:SP00,1,2
 
OUTRLB	XX
	JMS	PUTOUT	/LOADER WORD TO OUTSK
	LAC	LCWORD	/GET PARTIAL WORD OF CODES
	JMS	MES	/SHIFT LEFT 6
	JMP	L-6
	AND	Z77700
	XOR	TAG	/PACK IN NEW CODE
	DAC	LCWORD
	ISZ	LCCT	/WORD NOW FULL?
	JMP*	OUTRLB	/NO
	JMS	PUTOUT	/YES,OUTPUT IT
K3	LAW	-3
	DAC	LCCT	/RESET COUNT OF 3
	JMP*	OUTRLB
 
 
OUTSTW	XX
	JMS	OUTRLB	/OUTPUT RLB
	IDX	LOC	/INCR LOCATION COUNT
	JMP*	OUTSTW
	.EJECT
/GENR	GENERATE STACK REFERENCE INSTRUCTION
/CALL:- AC HOLDS VADDR OF STACK POSN BEING REFERENCED
/	JMS	GENR
/ROUT 	LINK OF CALLER	/ADDR OF SKELETON INSTR
/	JMP	?	/CALLER JMP TO PROCESS
/	NEXT INSTRUCTION	/CONTROL RETURNS HERE WITH CALLERS
/			/LINK BUMPED PASSED SKELETON INSTR & JMP ?
/SK#+32 BECOMES THE LOADER CODE(TAG)
/SCRATCHPAD USED:SP00,1,2,
 
GENR	XX
	XOR	W00000	/ADD 32 TO SK#(=TAG)
	DAC	TAG	/HOLD
	AND	S07777	/EXTRACT DISPL
	DAC	SP00	/HOLD
	LAC	TAG	/)SHIFT LOADER CODE
	JMS	MES	/)TO LS END IF TAG
	JMP	RR+14
	AND	S00077
	DAC	TAG
	LAC*	GENR	/LOAD ADDR OF SKELETON INSTR
	DAC	SP01	/
Z60000	LAW	760000
	AND*	SP01	/EXTRACT OPFIELD OF INSTR
	XOR	SP00	/ADD IN DISPL
	JMS	OUTSTW	/OUTPUT GENERATED INSTR
	ISZ*	GENR	/BUMP CALLERS LINK
	IDX	GENR	/BUMP LINK(TWICE)
	IDX	GENR
	JMP*	GENR	/EXIT
	.EJECT
/GGR	GENERATE GLOBAL REFERENCE INSTRUCTION
/CALL:-	JMS	GGR
/	OPFIELD 	VOCPTR
/OPFIELD IS THE INSTR MNEMONIC (WITH * IF REQD)
/VOCPTR IS THE DISPLACEMENT OF THE VOCAB ENTRY FOR THE GLOBAL NAME
/THE POINTER WORD IN THE VOCAB ENTRY IS ZERO UNTIL THE NAME IS USED
/WHEN USED THE POINTER WORD POINTS TO THE ETV WORD BOUGHT FOR IT
/ON THE GLOBAL STACK
/SCRATCHPAD USED:SP00,1,2
 
GGR01	LAC*	GGR	/GET PARAM
	AND	S07777	/EXTRACT VOCPTR
	DAC	SP04	/HOLD
	JMS	LVM	/LOAD VOCAB PTR WORD
	SP04
	SZA		/NAME ALREADY USED?
	JMP	GGR-1	/YES:GENERATE INSTR
	LAC	SP04	/NO:BUY ETV WORD
	TAD	C1	/STEP VOCPTR TO NAME
	JMS	PUT	/PUT ON GLOBAL STACK
	GLOBAL
	JMS	EVA	/FIND VADDR OF ETV WORD
	GLBASE
	JMS	DVM	/STORE IN PTR IN VOCAB ENTRY
	SP04
	JMS	GENR	/GENERATE REFERENCE INSTR
GGR	XX
	JMP	GGR01	/JUMP ON ENTRY TO PROCESS
	JMP*	GGR	/EXIT
 
 
/GFTLU	/GENERATE FROM TABLE LOOK UP
/GENERAL PURPOSE DOUBLE TABLE LOOK UP. THE FIRST TABLE WILL CONTAIN
/SUBROUTINE CALLS. THE SECOND TABLE WILL CONTAIN THE PARAMETER TO BE
/SUPPLIED TO THIS ROUTINE
/CALLING SEQUENCE:-
/	AC CONTAINS TABLE MODIFIER
/	JMS	GFTLU
/	LAC	T1	/T1=ADDRESS OF FIRST TABLE
/	T2-T1		/T2=ADDRESS OF SECOND TABLE
 
GFTLU	XX
	TAD*	GFTLU	/AC=LAC T1+MOD
	DAC	.+4	/DUMP AHEAD
	IDX	GFTLU	/BUMP TO NEXT PARAM
	TAD*	GFTLU	/AC=LAC T2+MOD
	DAC	.+3	/DUMP AHEAD
	0 /LAC	T1+MOD	/LOAD ROUTINE CALL
	DAC	.+2	/DUMP AHEAD
	0 /LAC	T1+MOD+(T2-T1)	/LOAD PARAM TO AC
	0 /JMS	ROUT	/CALL ROUTINE
	IDX	GFTLU	/BUMP LINK
	JMP*	GFTLU	/EXIT
	.EJECT
/BEGSK	OUTPUT LOADER CODE INTRODUCING A STACK
/	LOADER CODE=SK#+27:LOADER WORD=-(# WORDS ON STACK)
/	IF STACK EMPTY NO OUTPUT PRODUCED
/CALL	JMS	BEGSK
/	SKBASE
/	JMP	NOSTACK	/_RETURN HERE IF STACK EMPTY
/RETURN HERE IF STACK HAS SOME CONTENTS,THEN SAC
/ HOLD -(#WORDS ON STACK) AND NXOP HOLDS VADDR OF PTR
/OF END OF STACK
/SCRATCHPAD USED:	SP00,6
/ROUTINES USED:	MES,OUTRLB,EVA
 
BEGSK	XX
	LAC*	BEGSK	/ADDR OF SKBASE
	DAC	SP06	/HOLD
	DAC	BEGSK1	/AND FOR EVA
	IDX	BEGSK	/BUMP LINK TO EMPTY STACK RETURN
	LAC*	SP06
	DAC	SP00	/ADDR GIVEN BY BASE WORD
	JMS	TCA	/-BASE
	IDX	SP06
	TAD*	SP06	/PTR-BASE=-(# WORDS ON SK)
	SNA
	JMP*	BEGSK	/EXIT IF EMPTY STACK
 
	DAC	SAC	/HOLD # WORDS ON SK
	IDX	BEGSK	/BUMP LINK TO 'SK NOT EMPTY' RETURN
	LAC*	SP00	/BASE WORD OF SK
	JMS	MES
	JMP	RR+14
	AND	S00077	/SK# TO LS END
	SAD	C6	/GLOBAL SK?
	JMP	BEGSK1-1	/YES: NO INTRODUCTORY CODE
	TAD	C27
	DAC	TAG	/STORE TAG(=SK#+27)
	LAC	SAC
	JMS	OUTRLB	/OUTPUT SK INTRODUCOR CODE
	JMS	EVA	/)COMPUTE VADDR OF PTR END
BEGSK1	XX /SKBASE	/)OF SK
	DAC	NXOP
	JMP*	BEGSK
	.EJECT
/OUTBLK	OUTPUT BLOCK FROM STACK
/CALL:	TAG TO USE IN AC
/	JMS	OUTBLK
/ON ENTRY NXOP HOLDS VADDR OF FIRST WORD TO OUTPUT
/	SAC HOLDS -(#WORDS TO OUTPUT)
/IF,WHEN THE BLOCK HAS BEEN OUTPUT ,NXOP POINTS TO BASE
/ENDSK IS CALLED
/AND RETURN IS TO LINK+1
 
OUTBLK	XX
	DAC	TAG	/SET UP TAG
	JMS	LNP	/GET STACK WORD
	JMS	OUTSTW	/OUTPUT AS RLB
	IDX	NXOP	/BUMP TO NEXT SK WORD
	ISZ	SAC	/END OF BLOCK?
	JMP	OUTBLK+2	/NO:REPEAT
	JMS	ENDSK	/CHECK FOR END OF SK
	JMP*	OUTBLK	/NO:EXIT LINK
	IDX	OUTBLK	/YES:BUMP LINK & EXIT
	JMP*	OUTBLK
 
/ENDSK	CHECK IF NXOP AT END OF SK
/	IF NOT EXIT TO LINK
/IF SO,PUT LOC+1 ON TO SK,OUTPUT CODE 27+SK# & EXIT TO LINK+1
 
ENDSK	XX
	LAC	NXOP	/
	AND	S07777	/EXTRACT SK DISPL
	SAD	S07777	/BACK TO BASE?
	SKP!CLL		/YES
	JMP*	ENDSK	/NO:EXIT
	IDX	ENDSK	/BUMP LINK
	XOR	NXOP	/EXTRACT SK#
	JMS	MES
	JMP	RR+13	/SK#*2 TO LS END
	DAC	HOLDL	/2*SK# TO HOLDL
	TAD	GSKPTR	/ADD(LAC VTOA02+1)
	DAC	.+1
ENDSK1	XX /LAC	VTOA02+1+2*SK#
	DAC	SP00	/HOLD SK BASE
	IDX	ENDSK1	
	XCT	ENDSK1	/LOAD SK PTR
	DAC	ENDSK4	/DEPOSIT SK PTR
	LAW	-14
	TAD	HOLDL
	SNA		/GLOBAL SK?
	JMP	ENDSK2	/TES
	LAC*	SP00	/NO:DISCARD SK
	DAC*	ENDSK4	/CONTENTS
ENDSK2	LAC	HOLDL	/)CODE
	RCR		/27+SK#
	TAD	C27	/)TO
	DAC	TAG	/)TERMINATE SK
	LAC	LOC
	TAD	C1	/)LOC+1 TO END
	JMS	PUT	/)OF SK
ENDSK4	XX /SK PTR
K12	LAW	-14
	TAD	HOLDL
	SZA		/GLOBAL SK?
	JMS	OUTRLB	/NO
	JMP*	ENDSK	/EXIT
GSKPTR	LAC	VTOA02+1
	.EJECT
/P2SK	OUTPUT CONTENTS OF INTEGER,REAL,STR & OWN STACKS
 
P2SK	XX
	/OUTPUT INTEGER STACK AS CODE 45'S
	JMS	BEGSK	/INTRODUCE SK
	INBASE
		UNUSED	/INTEGER SK NEVER EMPTY
	LAC	C45	/CODE 45 TO TAG
	JMS	OUTBLK	/OUTPUT SK CONTENTS
		UNUSED	/SK EMPTY WHEN SAC=0
 
RLSK=.	/OUTPUT REAL STACK AS CODE 37'S
	JMS	BEGSK	/INTRODUCE SK
	RLBASE
	JMP	STRSK	/NEXT IF SK EMPTY
	LAC	C37
	JMS	OUTBLK
		UNUSED	/SK EMPTY WHEN SAC=0
 
STRSK=.	/OUTPUT STRING STACK
	/FIRST WORD OF STRING BLOCK CHANGED TO CHARACTER COUNT
 
	JMS	BEGSK	/INTRODUCE SK
	STBASE
	JMP	OWNSK	/NEXT IF SK EMPTY
STRSK1	IDX	NXOP	/BUMP NXOP TO STR PTR VADDR
	JMS	GSA	/OUTPUT STR ADDR PTR
	0
	JMS	LNP	/LOAD STRING WORD COUNT(=N)
	DAC	SP00
	CMA!CLL		/-N-1
	DAC	SAC	/COUNT OF WORDS IN THIS STRING BLOCK
	LAC	SP00
	RTL
	TAD	SP00
	RAR		/5N/2
	JMS	TCA
	JMS	DVM	/PUT CHAR CT INTO HEAD OF STRING BLOCK
	NXOP
	LAC	C37
	JMS	OUTBLK	/OUTPUT THIS STRING BLOCK
	JMP	STRSK1	/REPEAT IF STACK NOT EMPTY
 
OWNSK=.	/OUTPUT OWN STACK:WORK SK GIVES COMMON SIZE
	/OTHER ENTRIES ON OWN ARE EITHER
	/(1)	COMMON DISPLACEMENTS(SINGLE +VE WORDS)
	/(2)	OWN DOPE VECTORS INTRODUCED BY VADDR
	/POINTING TO NEXT WORD ON OWN
 
	LAC	DIM
	SNA		/ANY COMMON SPACE?
	JMP	P2SK1	/NO:END OF OUTPUT
	DAC	NXOP	/HOLD SIZE OF COMMON
	LAC	.XX
	DAC	NAME1
	JMS	OUTNAM	/INTRODUCE BLANK COMMON(.XX)
	LAC	C12
	DAC	TAG
	LAC	NXOP	/DEFINE BLANK COMMON SIZE
	JMS	OUTRLB
	JMS	BEGSK
	OWBASE
		UNUSED	/OWN SK NOT EMPTY IF OWN NONZERO
OWNSK2	LAC	C26	/SET CODE 26 IN CASE OWN T.V
	DAC	TAG
	JMS	LNP
	IDX	NXOP
	SAD	NXOP	/ARRAY WORD POINTING TO DOPE VECTOR?
	JMP	OWNSK4	/YES
	JMS	OUTSTW	/DEFINE T.V. LOCN FOR THIS COMMON WORD:
			/ BUYS LOCN. FOR CODE 5 GENERATED FROM
			/ CODE 26 BY PHASE 4
	JMS	ENDSK	/CHECK END OF SK?
	JMP	OWNSK2	/NO
	DZM	SAC	/CLEAR SAC FOR ASSIGNMENTS
	JMP	P2SK1	/YES:END OF OUTPUT
 
OWNSK4	JMS	GSA	/OUTPUT ARRAY WORD
	0
	JMS	LNP	/GET(-#DIMS)
	TAD	K3	/
	DAC	SAC	/)=(-#DIMS-3)WORDS TO OUTPUT
	LAC	C37	/)AS CONSTANTS
	JMS	OUTBLK
	JMP	OWNSK2
 
/MOVE INTEG STACK TO HIGHEST AVAILABLE CORE ADDRESS
 
P2SK1	LAC*	INTEGR	/HOLD OCLOC FROM INTEGER SK
	IDX	INTEGR	/&REMOVE IT
	DAC	SP00	/FOR INTEGER SK(ONLY CONTENTS OF SK)
	LAC	ASKLIM	/MOVE INBASE
	DAC	INBASE	/AND INTEGR PTR
	DAC	INTEGR	/TO TOP OF AVAILABLE FREE STORE
	LAC	SP00	/RESET INTEGER 'OCLOC'
	JMS	PUT	/ONTO SK
	INTEGR
	JMP*	P2SK	/EXIT
	.EJECT
/P3SK	OUTPUT SWITCH SK & GLOBAL SK AT END OF PHASE 3
 
P3SK	XX
	/OUPUT SWITCH STACK
	/FIRST WORD OF SWITCH LIST GIVES LENGTH OF LIST
	/ENTRIES IN LIST ARE UNRELOCATED ADDRESSES OF GENERATED CODE
 
	JMS	BEGSK	/INTRODUCE SK
	SWBASE
	JMP	GLBSK	/JMP IF EMPTY
SWSK1	LAC	C37
	DAC	TAG	/HEAD OF SWITCH LIST AS CONSTANT
	JMS	LNP
	IDX	NXOP
	JMS	TCA	/
	DAC	SAC	/COUNT FOR OUTBLK
	JMS	OUTSTW	/OUTPUT WORD
	LAC	C5	/)OUTPUT SWITCH LIST
	JMS	OUTBLK	/)AS 15 BIT ADDRESSES
	JMP	SWSK1
 
GLBSK=.	/OUTPUT GLOBAL STACK AS TABLE OF ETV LOCNS
	/EACH ENTRY ON SK IS VADDR OF GLOBAL NAME IN VOCAB
 
	JMS	BEGSK	/INTRODUCE GLOBALS
	GLBASE
	JMP*	P3SK
GLBSK1	JMS	LNP	/GET VOCPTR
	TAD	U00000	/MARK VADDR FOR COPY
	DAC	.+2
	JMS	COPY	/COPY R50 NAME
	XX		/FROM VOCAB
	NAME1		/INTO NAME1,NAME2
	2
	JMS	OUTNAM
	LAC	C19	/DEFINE GLOBALS
	DAC	TAG	/AS INTERNAL SYMBOLS
	LAC	LOC
	JMS	OUTRLB
	LAC	C27	/CODE FOR ETV
	DAC	TAG
	LAC	LOC	/PUT OWN ADDR IN ETV
	JMS	OUTSTW
	IDX	NXOP
	JMS	ENDSK	/CHECK END OF SK?
	JMP	GLBSK1	/NO
	JMP*	P3SK	/YES:EXIT
	.EJECT
/GEN3	/GENERATE CODE 3 STORABLE WORD
/CALL:	JMS	GEN3
/	OPCODE	.(RELATIVE LOCN)
 
GEN3	XX
	LAC	C3
	DAC	TAG	/CODE 3 TO TAG
	LAC	GEN3	/ADDR OF PARAM
	AND	S17777
	JMS	TCA
	TAD*	GEN3	/REDUCE BACK TO RELATIVE LOC
	TAD	LOC	/ADD CURRENT LOC
	JMS	OUTSTW
	IDX	GEN3
	JMP*	GEN3
 
/GEN4	GENERATE CODE 4 STORABLE WORD
/CALL	JMS	GEN4
/	OPERATE INSTRUCTION
 
GEN4	XX
	LAC	C4
	DAC	TAG
	LAC*	GEN4
	JMS	OUTSTW
	IDX	GEN4
	JMP*	GEN4
 
/GEN4A	AS GEN 4 BUT OPERATE INSTRUCTION IN AC
 
GEN4A	XX
	DAC	.+2
	JMS	GEN4
	XX
	JMP*	GEN4A
/GEN37	GENERATE CODE 37(LITERAL)
/LITERAL IN AC
 
GEN37	XX
	DAC	SP00
	LAC	C37
	DAC	TAG
	LAC	SP00
	JMS	OUTSTW
	JMP*	GEN37
 
/GEN43	GENERATE CODE 43 (LOCATION OF USER NAME)
 
GEN43	XX
	LAC	C43
	DAC	TAG
	LAC	LOC
	JMS	OUTRLB
	JMP*	GEN43
	.EJECT
/CONTROL TABLE FOR OPERATORS:USED BY COMP
TXB3	S+ASS3
	S+IFX3
	S+DYAD3		/AND
	S+DYAD3		/OR
	S+DYAD3		/IMP
	S+DYAD3		/EQUIV
		UNUSED	/ENDC,ENDF
	S+REL3		/LT
	S+REL3		/EQ
	S+REL3		/LE
	FOR3		
	S+REL3		/GE
	S+REL3		/NE
	S+REL3		/GT
	AFOR3
	WH3
	STEP3
	GOTO3
	IFS3
	PC3
	PC3		/FC
	S+SV3
	S+DYAD3		/+
	S+DYAD3		/-
	S+DYAD3		/*
	S+DYAD3		//
	S+DYAD3		/IDIV
	S+DYAD3		/^
	S+DYAD3		/I^Z
	S+NEG3
	ARD3
	PDEC3		/PDEC
		UNUSED	/ASEG
	S+BPL3
	LAB3
	SW3
		UNUSED	/MP
		UNUSED	/DUMST
	JMP*	COMP	/IGNORE ENDP
	JMP	DO3	/DO
	NOT3		/NOT
	JMP*	COMP	/IGNORE ENDD
	JMP	ELSE3	/ELSE
	BEG3		/BEG
		UNUSED	/END
		UNUSED	/DICT
	JMP	FLK3	/FLK(SECOND ONE IN FOREL)
	S+FR3
	S+FI3
		UNUSED
	FSTR3
	S+FLAB3
	FIX3
TXB3E	FLT3
/TABLE TO GENERATE CODE FOR LOAD ADDR/VALUE FROM DICT INFO
	/LOAD VALUE ROUT	/Q2=
LVR	JMS	OUT4	/0:1WD ACT LOC
	JMS	OUT4	/1 3WD ACT LOC
	JMS	OUT21	/2 1WD FN LOC
	JMS	OUT4	/3 3WD FN LOC
	JMS	OUT9	/4 1WD OWN
	JMS	OUT12	/5 3WD OWN
	JMS	OUT28	/6 SWITCH
		UNUSED	/7
	JMS	OUT20	/8 1WD ACT NON LOCAL
	JMS	OUT15	/9 3WD ACT NON LOCAL
	JMS	OUT22	/10 1WD FN NON LOCAL
	JMS	OUT20	/11 3WD FN NON LOCAL
/LOAD ADDR ROUT
	JMS	OUT4	/0
	JMS	OUT4	/1
	JMS	OUT4	/2
	JMS	OUT4	/3
	JMS	OUT9	/4
	JMS	OUT9	/5
	JMS	OUT28	/6
		UNUSED	/7
	JMS	OUT6	/8
	JMS	OUT6	/9
	JMS	OUT20	/10
	JMS	OUT20	/11
JMS%BG=.	/LOAD VALUE PARAM
LVP	JMS*	%BG	/0
	JMS*	%BJ	/1
	JMS*	%BK	/2
	JMS*	%BK	/3
U24000	LAC*	4000	/4
	JMS*	.AO	/5
JMS%BW	JMS*	%BW	/6:UNUSED AS PARAM:INSTR GENERATED BY OUT28
JMP%AT	JMP*	%AT	/7:UNUSED AS PARAM
	JMS*	%BQ	/8
	JMS*	.AO	/9
	JMS*	%BL	/10
	JMS*	%BL	/11
/LOAD ADDR PARAM
	TAD*	%AB	/0
	TAD*	%AB	/1
	JMS*	%BK	/2
	JMS*	%BK	/3
	LAC		/4
	LAC		/5
	0		/6
JMS%AU	JMS*	%AU	/7 NOT PARAM
JMS%BD	JMS*	%BD	/8 NOT PARAM
		UNUSED	/9
	JMS*	%BL	/10
	JMS*	%BL	/11
	.EJECT
/OPIR TABLE FOR CODE GENERATION OF INTEGER DYADIC
/OPERATIONS FOR SIMPLE SECOND ARG
/THERE ARE 4 CASES:LOCAL,NON LOCAL,OWN OR CONSTANT
 
/AC=12	/LOCAL BOOLEAN(Q2=0)
OPIR	JMS	OUT17L	/AND
	JMS	OUT17L	/OR
	JMS	OUT8L	/IMP
	JMS	OUT17L	/EQUIV
		UNUSED
		UNUSED
		UNUSED
		UNUSED
/AC=20	/OWN BOOLEAN (Q2=8)
	JMS	OUT6	/AND
	JMS	OUT19	/OR
	JMS	OUT7	/IMP
	JMS	OUT18	/EQUIV
		UNUSED
		UNUSED
		UNUSED
		UNUSED
/AC=28	/NON LOCAL BOOLEAN (Q2=16)
	JMS	OUT17N	/AND
	JMS	OUT17N	/OR
	JMS	OUT8NL	/IMP
	JMS	OUT17N	/EQUIV
/AC=32	/LOCAL INTEGER (Q2=0)
	JMS	OUT3L	/+
	JMS	OUT3L	/-
	JMS	OUT3L	/*
		UNUSED	// N/A
	JMS	OUT8L	/IDIV
ERRNUM	311430		/ERROR# 23
	311500		/ERROR# 24
		UNUSED
/AC=40	/OWN INTEGER (Q2=8)
	JMS	OUT11	/+
	JMS	OUT7	/-
	JMS	OUT7	/*
	311620		/ERROR# 29
	JMS	OUT7	/IDIV
		UNUSED	/^
		UNUSED
		UNUSED
/AC=48	/NON LOCAL INTEGER (Q2=16)
	JMS	OUT17N	/+
	JMS	OUT8NL	/-
	JMS	OUT8NL	/*
		UNUSED	//
	JMS	OUT8NL	/IDIV
		UNUSED	/^
		UNUSED
		UNUSED
		UNUSED
		UNUSED
		UNUSED
		UNUSED
/AC=60	/CONSTANT BOOLEAN (Q2=48)
	JMS	OUT24	/AND
	JMS	OUT24	/OR
	JMS	OUT25	/IMP
	JMS	OUT26	/EQUIV
/AC=64	/CONSTANT INTEGER (Q2=32)
	JMS	OUT29	/+
	JMS	OUT30	/-
	JMS	OUT31	/*
		UNUSED	//
	JMS	OUT10	/IDIV
	JMS	OUT10	/^
 
/OPIP TABLE OF PARAMETERS FOR USE WITH OPIR TABLE
 
	/LOCAL BOOLEAN
OPIP	JMS	OUT16	/AND
	JMS	OUT19	/OR
	JMS*	%CH	/IMP
	JMS	OUT18	/EQUIV
		UNUSED
		UNUSED
		UNUSED
		UNUSED
	/ OWN BOOLEAN
		UNUSED	
		UNUSED
	JMS*	%CH
		UNUSED	/EQUIV
		UNUSED
		UNUSED
		UNUSED
		UNUSED
	/NON LOCAL BOOLEAN
	JMS	OUT16	/AND
	JMS	OUT19	/OR
	JMS*	%CH	/IMP
	JMS	OUT19	/EQUIV
	/LOCAL INTEGER
	JMS*	%CA	/+
	JMS*	%CB	/-
	JMS*	%CC	/*
JMS%BV	JMS*	%BV	//:UNUSED AS PARAM
	JMS*	.AE	/IDIV
		UNUSED	/^
		UNUSED
		UNUSED
	/OWN INTEGER
		UNUSED
	JMS*	.AY	/-
	JMS*	.AD	/*
		UNUSED	//
	JMS*	.AE	/IDIV
		UNUSED	/^
		UNUSED	
		UNUSED
	/NON LOCAL INTEGER
	JMS	OUT11	/+
JMS.AY	JMS*	.AY	/-
JMS.AD	JMS*	.AD	/*
JMS%BY	JMS*	%BY	//:UNUSED AS PARAM
	JMS*	.AE	/IDIV
JMS%BZ	JMS*	%BZ	/^:UNUSED AS PARAM
	345600		/ERROR# 98
	345620		/ERROR# 99
		UNUSED
		UNUSED
		UNUSED
		UNUSED
	/CONSTANT BOOLEAN
	37776	/FALSE	/AND
	37775	/TRUE	/OR
	37775	/TRUE	/IMP
	37776	/FALSE	/EQUIV
	/CONSTANT INTEGER
		UNUSED	/+
		UNUSED	/-
		UNUSED	/*
		UNUSED	//
	JMS*	.AE	/IDIV
	JMS*	.BB	/^
	.EJECT
/OPRR,	TABLE FOR CODE GENERATION OF REAL DYADIC
/OPERATIONS FOR SIMPLE SECOND ARG
 
/AC=32	/LOCAL REAL
OPRR	JMS	OUT4	/+
	JMS	OUT4	/-
	JMS	OUT4	/*
	JMS	OUT4	//
		UNUSED	/IDIV
	JMS	OUT4	/^
		UNUSED
		UNUSED
/AC=40	/OWN REAL
	JMS	OUT12	/+
	JMS	OUT12	/-
	JMS	OUT12	/*
	JMS	OUT12	//
		UNUSED	/IDIV
	JMS	OUT12	/^
		UNUSED
		UNUSED
/AC=48	/NON LOCAL REAL
	JMS	OUT15	/+
	JMS	OUT15	/-
	JMS	OUT15	/*
	JMS	OUT15	//
		UNUSED	/IDIV
	JMS	OUT15	/^
	JMS	OUT3L	/1 WD LOCAL ASSIGN
	JMS	OUT27	/3 WD LOCAL ASSIGN
		UNUSED
		UNUSED
	JMS	OUT9	/1 WD OWN ASSIGN
	JMS	OUT12	/3 WD OWN ASSIGN
		UNUSED
		UNUSED
		UNUSED
	JMS	OUT27	/3 WD NON LOCAL ASSIGN
 
/AC=64	/REAL CONSTANT
	JMS	OUT13	/+
	JMS	OUT13	/-
	JMS	OUT13	/*
	JMS	OUT13	//
		UNUSED	/IDIV
	JMS	OUT13	/^
 
/OPRP TABLE OF PARAMETERS FOR USE WITH OPRR TABLE
 
 
	/LOCAL REAL
OPRP	JMS*	%CI	/+
	JMS*	%CJ	/-
	JMS*	%CK	/*
	JMS*	%CL	//
		UNUSED	/IDIV
	JMS*	%CM	/^
		UNUSED
		UNUSED
	/OWN REAL
	JMS*	.AQ	/+
	JMS*	.AR	/-
	JMS*	.AS	/*
	JMS*	.AT	//
		UNUSED	/IDIV
	JMS*	%CE	/^
		UNUSED
		UNUSED
	/NON LOCAL REAL
	JMS*	.AQ	/+
	JMS*	.AR	/-
	JMS*	.AS	/*
	JMS*	.AT	//
		UNUSED	/IDIV
	JMS*	%CE	/^
JMS%BU	JMS*	%BU	/1 WD LOCAL ASSIGN
C13	15		/3 WD LOCAL ASSIGN
		UNUSED
		UNUSED
	DAC*		/1 WD OWN ASSIGN
	JMS*	.AP	/3 WD OWN ASSIGN
		UNUSED
		UNUSED
		UNUSED
C21	25		/3 WD NON LOCAL ASSIGN
 
	/REAL CONSTANT
	JMS*	.AQ	/+
	JMS*	.AR	/-
	JMS*	.AS	/*
	JMS*	.AT	//
		UNUSED	/IDIV
	JMS*	%CE	/^
	.EJECT
/OPSR,OPSP TABLES FOR GENERATION OF DYADIC OPERATIONS
/WHEN FIRST ARG WAS STACKED
OPSR	JMS	OUT9	/AND
	JMS	OUT19	/OR
	JMS	OUT7	/IMP
	JMS	OUT18	/EQUIV
/GENERATION TABLE FOR STACK PTRS
LCR	JMS	OUT13	/1 REAL
	JMS	OUT9	/2 INTEGER
	JMS	OUT23	/3 BOOLEAN
	JMS	OUT9	/4 STRING
	JMS	LABREF	/5 LABEL
	JMS	OUT3L	/6 OT DISPL OF ARRAY WORD
	JMS	OUT3L	/7 OT DISPL OF ARRAY WORD
	JMS	HSLA	/10 SWITCH(HOLD SW LIST ADDR)
	JMS	OUT14	/REAL+
	JMS	OUT14	/REAL-
	JMS	OUT14	/REAL*
	JMS	OUT14	/REAL/
		UNUSED	/REAL IDIV -ILLEGAL
	JMS	OUT14	/REAL^
		UNUSED
		UNUSED
	JMS	OUT9	/INT+
	JMS	OUT7	/INT-
	JMS	OUT7	/INT*
		UNUSED	/INT/ CANNOT OCCUR
	JMS	OUT7	/INT IDIV
			/INT^ CANNOT OCCUR(EXPN +VE CONSTANT
 
OPSP	AND*		/AND
		UNUSED	/OP
	JMS*	%CH	/IMP
		UNUSED	/EQUIV
		UNUSED
LCP	JMS*	.AO	/1
	LAC		/2
JMS%BH	JMS*	%BH	/NO PARAM
	LAC		/4
JMS%BR	JMS*	%BR	/NO PARAM
JMS%AV	JMS*	%AV	/6
	JMS*	%AV	/7
	JMS*	.AQ	/R+
	JMS*	.AU	/R-
	JMS*	.AS	/R*
	JMS*	.AV	/R/
		UNUSED
	JMS*	%CP	/R^
		UNUSED
		UNUSED
	TAD*		/I+
	JMS*	.AY	/I-
	JMS*	.AD	/I*
		UNUSED
	JMS*	.AE	/I 'IDIV'
/STATISTICS TABLE
 
G.E	SP06		/LIMITS OF GLOBAL DATA
G.S	AINWD		/FOR PRINTING BY LISTAK
INBASE	XX
INTEGR	XX
RLBASE	XX
REAL	XX
STBASE	XX
STRING	XX
OWBASE	XX
OWN	XX
SWBASE	XX
SWITCH	XX
LABASE	XX
LABEL	XX
PRBASE	XX
PROC	XX
VOBASE	XX
VOCAB	XX
WKBASE	XX
WORK	XX
LLBASE	XX
LABLOC	XX
GLBASE	XX
GLOBAL	XX
ICBASE	XX
INCODE	XX
OUT	XX
OUBASE	XX
SCOM	A
	.EJECT
/	VTOA CONVERSION TABLE
 
VTOA02	TAD*	.+1	/SK#
		VOBASE	/0
		VOCAB
		RLBASE	/1
		REAL
		INBASE	/2
		INTEGR
		INBASE	/3
		INTEGR
		STBASE	/4
		STRING
		LABASE	/5
		LABEL
		GLBASE	/6
		GLOBAL
		PRBASE	/7
		PROC
		SWBASE	/8
		SWITCH
		LLBASE	/9
		LABLOC
		ICBASE	/10
		INCODE
		WKBASE	/11
		WORK
		OWBASE	/12
		OWN
		OUBASE	/13
AOUT		OUT
 
 
/	ADDRESS CONSTANTS
 
AAERP	ERPOSN-1
INFN=OVLAY-2
INBUFF=INFN-52
AINB2	INBUFF+2
ALANAL	LANAL
ALCOMP	LCOMP
ASVX	SVX
ATXB3	TXB3-12
	.EJECT
 
/NUMERICAL CONSTANTS
	.DEC
C1	1
C5	5
C7	7
C8	8
C9	9
C10	10
C11	11
C12	12
C14	14
C15	15
C19	19
C22	22
C23	23
C25	25
C26	26
C37	37
C39	39
C41	41
C43	43
C45	45
C46	46
C47	47
C54	54
C72	72
C75	75
/K1=FFASS+15
/K3=OUTRLB+11
K8	-8
K9=ERREC
K10	-10
/K12=ENDSK4+1
K14	-14
K24=VTOA90
K26	-26
K27	-27
K39	-39
K63	-63
	.OCT
		/LITERALS
S00007=C7
S00010=C8
S00015=C13
S00016=C14
S00017=C15
S00032=C26
S00033=C27
S00034	34
S00037	37
S00047=C39
S00072	72
S00073	73
S00077	77
S00101	101
S00102	102
S00103	103
S00116	116
S00117	117
S00137	137
S00175	175
S00400	400
S01300	1300
S03100	3100
S03700	3700
S03777	3777
S04000	4000
S06000	6000
S07777	7777
S10000	10000
S17777	17777
S20000	20000
S25500	25500
S27772	27772
S27773	27773
S27774	27774
S27775	27775
S27776	27776
S30000	30000
S60000=C13+3
S70000	70000
S77777	77777
T10000	110000
T20000	120000
T27730	127730
T40000	140000
T70000	170000
T77777	177777
U00000=LCP+1
U12000=IFS13
U37772	237772
U40006	240006
X72600	572600
X74100	574100
X77777	577777
Z00000	700000
/Z50000=NSTK16+2
/Z50001=CLADI+2
Z70000	770000
/Z70001=OUT23+1
Z74700	774700
Z77700	777700
.XX	131330		/RADIX 50 OF .XX
	.EJECT
BANK	XX		/HOLDS BANK BITS
AINWD	XX		/ADDR INPUT WORD IF INT FILE
AOPTW	XX		/ADDR OPTION WORD
AXW	XX		/ADDR OF FILE EXT
BLKADD	XX		/STARTING BLOCK PASS 1
CPI	XX		/VADDR OF CURRENT PROC INFO
DOLAB	XX		/HOLDS VADDR(LABLOC) FOR DO S/R
ELLAB	XX		/HOLDS LABLOC FOR FOR ELEMENT LOOPS
HNR	XX		/HOLD NXTRQD IN ASSIGNS
HNX	XX		/HOLD NXOP IN ASSIGNS & OPS
HOLDL	XX		/HOLDS LOC DURING ASS.FOR 'FOR' OPTM.
IBUFCT	XX		/INPUT BUFFER COUNT
LCWORD	XX		/HOLDS PACKING OF LC'S FOR RLB
LGFTLU	XX
LLL	XX		/HOLDS LABLOC FOR USER LABEL ADDR
STATE	XX		/USED BY ANAL
SWLA	XX		/HOLDS SWITCH LIST VADDE FOR DECLM
TAG	XX		/HOLDS LOADER CODE FOR CURRENT RLB
 
/GLOBALS:INITIALLY SET
K2	-2	/THIS BLOCK OF 4 INITIALLY COPIED TO WORK AS PROC INFO
ARSW	0		/ARRAY SWITCH(=O:ARRAY,-1=NOT ARRAY)
CHL	0		/CURRENT HIERARCHY,LEVEL
CLRSW	0		/CHECK LOCAL REF SWITCH
DIM	0		/# DIMENSIONS/PARAMETERS :ALSO #OWN WORDS AT START
ERRNO	0		/COUNTS # ERRORS REPORTED
FADSW	0		/FETCH ADDR SWITCH(-12:FA;=0:FV)
FREQD	40		/CONTROLS OPERATION OF 'UP'
LCCT	-3		/LOADER CODE PACKING COUNT
LOC	0		/LOCATION COUNT FOR RLB
JMSCT	0		/COUNT FOR IDX CHAIN
NXTRQD	-1
OUTSW	SKP		/OBEYED IF OUTSK REQD.
Z40000	NOP		/HERE IF OUTSK NOY REQD
	NOP		/IN CASE SWITCHED OFF AGAIN BY ABORT
PRCHN	0		/WK SK PTR FOR OUTER PROCS
SIZE	0		/USED BY UP
SAC	0		/CT OF SKD ADDRS FOR ASS3
STLOC	1		/STARTING ADDR OF OBJECT CODE
XB	MODL3		/STARTING SYNTAX BLOCK ADDR FOR ANAL
STEPAS	0	/FLAG FOR V:=A IN STEP ELEMENT
 
/LOCAL STORAGE
ANAL90	XX
COPYSV	XX
COPYSC	XX
COPYCT	XX
FSREQD	XX		/USED BY UP
Q2	XX	/)	/CLASSIFICATION OF DICT INFO
NXOP	XX	/)FIXED	/NEXT OPERATOR FROM INPUT
SKTHL	XX	/)ORDER	/SKTHL WORD OF DICT INFO
HOLDP	XX	/)	/HOLDS PARAM IN OUT R/T(# ARG IN SKAD)
PTRADD	XX		/USED BY  MOVE
SMF	XX		/USED BY UP
STLIM	XX		/USED BY MOVE
STWDAD	XX		/USED BY MOVE
 
/STORAGE FOR CURRENT HIERARCHY INFO(FROM PROC INFO)
NAME1	XX
NAME2	XX
EP	XX		/ENTRY PT TO PROC
NPW	XX		/# PARAMETER WORDS
DBIL	XX		/DISPL BLOCK INDEX LIST
DNLBL	XX		/DISPL NON LOCAL BASE LIST
/SCRATCHPAD
SP00	XX
SP01	XX
SP02	XX
SP03	XX
SP04	XX
SP05	XX
SP06	XX
 
/AUTO-INDEX REGISTERS USED
AUTO=10
AUTO1=11
AUTO2=12
AUTO3=13
AUTO4=14
AUTO5=15
 
	/ASSIGNMENTS
ENDP=6000
ENDC=12000
ENDD=6300
ENDF=2000
MP=5600
FLK=7001
END=6600
N=100000
M=100000
NCB=NAME1
NCB1=NCB+1
IDX=ISZ
INTIN=-13
INTOUT=-15
TENS=SP00
R50.1=SP04
R50.2=SP05
R50.3=SP06
GEN39=GEN37
ISZCT=JMSCT
UNUSED=XX
CC=200000
S=CC
A=400000
AS=A+S
AN=A+N
CX=A
DMPS=-15
DUMPS=-15
RESTS=-13
/GENERAL ROUTINE TO DRIVE SYSTEM BOOTSTRAP
/FOR CORE OVERLAY OR TO WRITE TO SYSTEM DEVICE
/CALLING SEQUENCE JMS	OLAY
/		BLOCK NO +400,000 IF WRITE
/		CORE ADDR.-1
/		2'S COMP NEG  W.C.
/		PROGRAM START ADDRESS ON COMPLETION
/ROUTINE PUTS THIS ADDRESS INTO .SCOM+5
	.IFUND	DOS
OLAY	XX		/ENTRY
	LAW	-1	/SET AUTO INDEX 10 WITH
	TAD	OLAY	/ADDRESS OF FIRST TRAILING
	AND	S77777
	DAC*	C8	/PARAMETER -1
	LAC*	S00100	/SET ADDR OF  BOOTSTRAP
	DAC*	C9	/-1 INTO AUTO INDEX 11
	TAD	C21
	DAC	SP01	/PUT IN JMP ADDRESS FOR
	TAD	C2	/JMPS TO BOOTSTRAP
	DAC	SP02
	LAC*	AUTO	/GET BLOCK NO
	TAD*	BLKADD
	DAC	SP00	/STORE
	AND	S07777	/AND OF SIGN BIT
	DAC*	AUTO1	/PUT INTO BTSTRAP
	LAC*	AUTO	/TRANSFER CORE ADDR-1
	DAC*	AUTO1
	LAC*	AUTO	/TRANSFER WORD CT
	DAC*	AUTO1
	LAC*	AUTO1	/MOVE AUTO INDEX 11
	LAC*	AUTO1	/TO NEXT REQD LOCN IN BOOTSTRAP-1
	LAC	S21000	/UNIT  NO INTO BOOTSTRAP
	DAC*	AUTO1
	LAC*	AUTO	/PUT STARTING ADDR
	DAC*	NOWT	/INTO LOCATION 0
	LAC	JMP.T1	/START VIA MONITOR
	DAC*	S00105
	LAC	SP00
	SMA		/WRITE?
	JMP*	SP01	/EXIT TO DTBEG
	JMP*	SP02	/EXIT TO DTOUT
S21000	21000
S00105	105
NOWT	0	/LOCATION 0
	.IFDEF	PDP15
JMP.T1	253
	.ENDC
	.ENDC
S00100	100
	.EJECT
/DUMP STACKS AND CONTINUE
/DMP
/CODE TO DUMP COMPILER DATA ONTO DATSLOT DMPS=-15 IN DUMP MODE.
/ACTIVATED BY ^T (BUT ONLY WHEN DUMP OPTION REQUESTED).
 
DMP	.INIT	DMPS,1,DMP+400000
	LAC	AOPTW	/ADDR OF OPTION WD
	DAC*	S00016	/HOLD IN AUTO 16
	TAD	C4	/ADDR OF STAT TABLE SPACE
	DAC*	S00017	/HOLD IN AUTO 17
	TAD	C1
	DAC	DMPCA	/SET IN .WRITE
	DAC	DMP93
	LAC*	16	/)
	DAC	DMPFN	/)SET UP FILENAME FOR
	LAC*	16	/)DUMP FILE
	DAC	DMPFN+1	/)
	IDX	DMPFN+2	/INCREMENT EXTENSION
DMP01	.ENTER	DMPS,DMPFN
	LAW	-2
	TAD	AINBA
	DAC	DMP92
K15	LAW	-17
	DAC	DMP91	/CT FOR #WRITES
	DAC	DMP90
	IDX	DMP90	/CT FOR #SKS
DMP02	LAC*	DMP92	/BASE
	CMA		/-B-1
	IDX	DMP92
	TAD*	DMP92	/PTR-B-1(-#WDS ON SK)
	DAC*	17
	LAC*	DMP92	/PTR
	DAC*	17
	IDX	DMP92
	ISZ	DMP90	/END OF STAT TABLE?
	JMP	DMP02	/NO, LOOP
K28	LAW	-34
	DAC	DMPL
/	.WRITE
DMP04	CAL+4000	DMPS&777
	11
DMPCA	0
DMPL	0
	LAC*	DMP93
	DAC	DMPL	/SET LENGTH OF SK IN .WRITE
	IDX	DMP93
	LAC*	DMP93
	DAC	DMPCA	/SET UP ADDR OF SK
	IDX	DMP93
	ISZ	DMP91	/LAST SK?
	JMP	DMP04	/NO, SO WRITE OUT SK
	.CLOSE	DMPS
	LAC*	S00116	/LOAD PC AND LINK
	DAC	DMP90
	RAL		/SET LINK FOR RETURN
	LAC*	S00117	/SET AC FOR RETURN
	JMP*	DMP90
 
DMPFN	0
	0
	.SIXBT	!D10!
 
DMP90	XX
DMP91	XX
DMP92	XX
DMP93	XX
	.EJECT
	.IFUND	%S3
 
 
/DUMP ROUTINE TO DUMP COMPILER DATA ONTO BULK STORAGE IN DUMP MODE
/	USES CONTROL DATA STORED AT ADDR GIVEN BY SCOM+2
DUMP	XX
	.INIT	DUMPS,1,DUMP
	IDX	DUMPFN+2	/BUMP DUMP FILE EXTN
	LAC	AOPTW	/GET ADDR OF OPTION WORD
	DAC	DUMPOW
	DAC*	S00010	/& HOLD IN AUTO 10
	LAC*	10
	DAC	DUMPFN	/SET UP FILNAM FOR DUMP FILE
	LAC*	10
	DAC	DUMPFN+1
	LAC	AXW	/GET ADDR OF STAT TABLE
	TAD	C2		/TAD C2(LISTAK)
	DAC	SP02
	DAC	SP04
	DAC	DUMPCA
	.ENTER DUMPS,DUMPFN	/OPEN DUMP FILE
/	.WRITE DUMPS,4,AOPTW,4	/WRITE OPTION WORD & FILNAM
	CAL+4000 DUMPS&777
	11
DUMPOW	0
	-4
	LAC	K14
	DAC	SP01	/CT FOR # WRITES
	DAC	SP00
	ISZ	SP00	/COUNT FOR # SK
DUMP1	LAC	SP02	/
	DAC	SP03	/HOLD ADDR OF BASE WORD
	LAC*	SP02	/BASE
	CMA		/-B-1
	ISZ	SP02
	TAD*	SP02	/PTR-B-1(-#WDS ON SK)
	DAC*	SP03	/HOLD IN BASE WORD
	ISZ	SP02
	ISZ	SP00	/END OF STAT TABLE?
	JMP	DUMP1	/NO,REPEAT
	LAC	K26	/YES,DUMP STAT TABLE
	DAC	DUMPL
/	.WRITE
DUMP2	CAL+4000 DUMPS&777
	11
DUMPCA	0
DUMPL	0
	LAC*	SP04
	DAC	DUMPL	/SET UP LENGTH OF SK
	ISZ	SP04
	LAC*	SP04
	DAC	DUMPCA	/SET UP ADDR OF SK
	ISZ	SP04
	ISZ	SP01	/END OF SK
	JMP	DUMP2	/NO DUMP STACK
	.CLOSE	DUMPS
	JMP*	DUMP
DUMPFN	0
	0
	.SIXBT !AL1!	/!AL2!FOR PASS 2
	.ENDC
 
CSIZE=.-START+1
 
PCH	.BLOCK	7000-CSIZE /CREATE PATCHING AREA
			/TO FILL UP TO 7000 WORDS OF CORE
 
	.END	P3CON
