.TITLE PDP9-15 ALGOL COMPILER PASS3	12 FEB71  EDIT 304
/COPYRIGHT DIGITAL EQUIPMENT CORPORATION
/SYSTEM VERSION PARAMETERS DEFINE CONDITIONAL ASSEMBLY
/IF UNDEFINED RELOCATABLE VERSION PRODUCED WHERE EACH PASS
/RUNS AS A SEPARATE PROGRAM
	.IFDEF	%SY
	.ABS
	.ENDC
	.IFDEF	%C3
	.LOC	%C3
	.ENDC
	.IFDEF	DOS
%BOS=152
	.ENDC
/
	.DEFIN .OVLAY NAME
	.IFDEF	DOS
	0
	24
	.+1
	.SIXBT	"NAME"
	.ENDC
	.ENDM
/
/
	.DEFIN	.BOS ADDR
	.IFDEF	DOS
	LAC*	(%BOS
	SPA!CLA
	JMP	ADDR	/BOS MODE
	.ENDC
	.ENDM
/ALGOL COMPILER PDP9 PHASE 4 MIKE BOLAS
	.IFUND	%SY
	.IODEV	-3,-12,-13,-15
	.ENDC
IN=-15;OUT=-13;LIST=-12
DMPS=OUT
IBUFF=BT1;OBUFF=BT1+65;LBUFF=BT1+137
	JMP	P3INIT	/ENTRY TO PASS 3
/TABLE OF ADDRESSES FOR INITIALISATION
/ONCE ONLY CODE. USES LISTING OUTPUT BUFFERS
BT1	XCT	.
	XCT	MESS1A
	XCT	MESS2A
	XCT	READ+3
	XCT	SFIL+3
	XCT	EFIL+5
	XCT	LFIL+5
	XCT	FNAM
	XCT	FNAMED
	XCT	FNAM2
	XCT	PH4C2
	XCT	LWA1
	XCT	SUBTAB
	XCT	LHDR1
	XCT	LHDR2
	XCT	LHDR2E
	XCT	LHDR3
	XCT	LHDR4
	XCT	LHDR4E
	XCT	PLC1+1
	XCT	PLC1C+1
	XCT	PLC1A+1
	XCT	ASIZE
	XCT	AREL
	XCT	AABS
	XCT	PLC6+1
	XCT	A.BLK
	XCT	PLC5+1
	XCT	A.DSA
	XCT	PLC9+1
	XCT	A.ETV
	XCT	PLC10+1
	XCT	A.ITV
	XCT	PLC11+1
	XCT	ADATA
	XCT	PLC12+1
	XCT	PLC12+4
	XCT	AOWN
	XCT	PLC14+1
	XCT	AOTV
	XCT	PLC22+1
	XCT	PLC22A+1
	XCT	AIODEV
	XCT	AALL
	XCT	PLC23+1
	XCT	PLC23+10
	XCT	A.END
	XCT	PLC26+1
	XCT	PLC28+1
	XCT	PLC28A+1
	XCT	PLC29+1
	XCT	PLC31+1
	XCT	PLC35+1
	XCT	PLC39+1
	XCT	ASTACK
	XCT	PLC30+1
	XCT	AEQ
	XCT	PLC33+1
	XCT	AREAL	
	XCT	PLC34+1
	XCT	AINTEG
	XCT	PLC36+1
	XCT	ASTRNG
	XCT	PLC38+1
	XCT	AGLOBR
	XCT	PLC40+1
	XCT	ASWTCH
	XCT	PLC41+1
	XCT	ALALOC
	XCT	PLC44+1
	XCT	PLC49+1
	XCT	PLC50+1
	XCT	PLC52+1
	XCT	PLC54+1
	XCT	PLC56+1
	XCT	PLC57+1
	XCT	PLC60+1
	.IFDEF	%S3
	XCT	INCLS+5
	.ENDC
	XCT	ENDCOM
	XCT	OPWRT+20
	XCT	OPBUFF
	XCT	OPBEND
	XCT	ST4
	XCT	END4
	XCT	DMPSET+3
	XCT	MOVIN+3
	XCT	MOVIN+4
	XCT	MOVIN+7
	XCT	MOVIN+10
	.IFDEF	%S3
	XCT	AINBA-1
	.IFNZR	%C1-6
	XCT	RELOAD+2
	.IFUND	DOS
	XCT	RELOAD+4
	.ENDC
	.ENDC
	XCT	AINBA
	.ENDC
	XCT	STTAB
	XCT	LSTBUFF
	XCT	LSTEND
	XCT	LC9+1
	XCT	LC25+4
	XCT	APROG
	XCT	LC26+1
	XCT	LC27+1
	XCT	LC28+4
	XCT	LC29+4
	XCT	LC31+4
	XCT	LC35+4
	XCT	LC39+4
	XCT	LC33B+1
	XCT	LC34A+1
	XCT	LC36A+1
	XCT	LC40A+1
	XCT	LC44A+1
	XCT	LC46+2
	XCT	ABEGIN
	XCT	LC47+2
	XCT	AENDB
	XCT	OPTAB
	XCT	OPTAB1
	XCT	OPTEND
	XCT	CTABST
	XCT	PH4ST
	XCT	SUBTST
	XCT	SCV+1
	XCT	AAINBA
	XCT	DMP+2
	XCT	DMP+22
BKTEND	XCT	INPUTA
BKSZE	BT1-BKTEND
/BANK BIT INITIALISATION ROUTINE-ONCE ONLY CODE
/ROUTINE AND TABLES OCCUPY PASS 3 LINE BUFFERS
/AND ARE OVERWRITTEN
/INITIALISE 15 BIT ADDRESSES WHICH ARE DISTRIBUTED THROUGH PASS 3
P3INIT	JMS	.	/LINK WRITES IN HERE 15 BITS
	LAC	P3INIT
	AND	S60000
	DAC	SP02	/STORE BANK BITS
	LAC	BKSZE
	DAC	SP01
NXTTAB	LAC	TSTRT	/GET STARTING ADDRESS OF TABLE
	AND	S17777	/AND OFF BANK BITS PRODUCED AT ASSY
	TAD	SP02
	DAC*	C8	/PUT IN AUTO INDEX 10
NXTNT1	LAC*	AUTO	/GET ADDRESS OF ADDRESS TO
	XOR	SP02	/PUT IN BANK BITS
	DAC	SP00	/BE INITIALISED
	LAC*	SP00	/INITIALISE 15 BIT ADDRESS
	AND	Z17777
	XOR	SP02
	DAC*	SP00
	ISZ	SP01	/DONE?
	JMP	NXTNT1	/GET NEXT ENTRY
/NOW INITIALISE PASS 3 ADDRESS TABLES(2)
NXT2	ISZ	NXTTAB	/GET ADDRESS OF NEXT TABLE
	XCT	NXTTAB
	AND	S17777
	TAD	SP02	/INCLUDE BANK BITS
	DAC*	C8	/PUT INTO AUTO INDEX10
	DAC*	C9	/PUT INTO AUTO INDEX 11
	LAC	TABSZE	/TABLE SIZE
	DAC	SP01
NXTNT2	LAC*	AUTO	/GET 15 BIT ADDRESS
	AND	Z17777
	XOR	SP02	/INCLUDE BANK BITS
	DAC*	AUTO1
	ISZ	SP01
	JMP	NXTNT2	/GET NEXT ENTRY
	ISZ	NXTNT2-2	/GET NEXT TABLE SIZE
	ISZ	TEMP
	JMP	NXT2	/GO TO NEXT TABLE
	DZM	IBUFF+5	/ENSURE THIS WORD CLEAR
	JMP	PH4C1	/START PASS 3
TABSZE	T1ADDR-T3END
	PRCTL-PRCTLE
TSTRT	BT1
	T1ADDR-1
	PRCTL
/ROUTINE TO INITIALISE CONDITIONS WHEN INPUT
/DATA IS ALREADY IN CORE
INCORE	XX		/ENTRY
	DZM	BLKCT	/INITIALISE TO 0-NEVER EXPIRES!
	LAC	PH4C2	/SET EXIT LINK IN 4 WORD
	DAC	NLD	/PROCESS FOR INITIAL EXIT
	LAC	INCORD	/INITIALISE LOAD WORD POINTER
	TAD	K1
	DAC	LWA	/TO START OF DATA IN CORE
	JMP*	INCORE
/
/ROUTINE TO INITIALISE CONDITIONS WHEN DATA IS NOT
/IN CORE,ALSO INITIALISES INPUT OF DATA
ININ	XX		/ENTRY
	LAW	-1
	DAC	BLKCT	/SET BLKCT TO FORCE READ 1ST TIME
	LAC	PH4C2	/SET EXIT LINK IN 4 WORD
	DAC	NLD	/PROCESS FOR INITIAL EXIT
	LAC	PH4ST	/RESTART ADDRESS PASS3
	JMS	PH4IPI	/INITIALISE INPUT
	DAC	RBSZE	/STORE RETURN BUFFER SIZE
	JMS	SFIL	/SEEK ON INPUT DEVICE
	LAC	READ+3	/INITIALISE LOAD WORD POINTER
	TAD	C1
	DAC	LWA
	ISZ	ININ	/BUMP LINK FOR RETURN
	JMP*	ININ	/EXIT
/
/ROUTINE TO INITIALISE CONDITIONS FOR PRELIST,AND
/INITIALISE LISTING DEVICE
PREIN	XX		/ENTRY
	LAC	TEMP0	/DO NOT RE-INITIALISE LISTING
	SZA		/FILE IF ALREADY OPEN
	JMP	PLOP
	LAC	PH4ST	/RESTART ADDRESS PASS 3
	JMS	PH4LST	/INITIALISE LISTING DEVICE
	JMS	LFIL	/ENTER ON LISTING DEVICE
	LAC	LSTBUFF	/SET POINTER TO 1ST DATA WORD
	TAD	C2
	DAC	LSTPTR
	LAW	-5	/INITIALISE CHARACTER COUNT
	DAC	CHARCT	/FOR PAK57 FIRST TIME IN
	DAC	TEMP0	/INDICATE LISTING FILE OPEN
	JMS	PCI	/INITIALISE PAGE CNT
	JMS	LCI	/INITIALISE LINE CNT
	JMS	FFOP	/OUTPUT FORM FEED
PLOP	JMS	PLHROP	/OUTPUT PRE-LIST HEADING
	LAC	PRELOP	/RESET TO PRE LIST HEADING
	DAC	PLOP
	JMP*	PREIN	/EXIT
PRELOP	JMS	PLHROP
/
/ROUTINE TO INITIALISE CONDITIONS FOR LISTING,AND 
/IF REQUIRED INITIALISE LISTING DEVICE
LSTIN	XX		/ENTRY
	LAC	LOP	/SET TO LIST
	DAC	PLOP	/HEADING
	JMS	PREIN	/GO DO INITIALISATION
	JMP*	LSTIN
LOP	JMS	LHROP	/OUTPUT LIST HEADING
/
/INPUT ROUTINE CONTROLS INPUT,SETS UP POINTER
/FOR PROCESSING AND NO.OF WORDS TO BE PROCESSED
/AND TAKES SOME DECISIONS ON INPUT ERROR CONDITIONS
INPUT	XX		/ENTRY
	JMS	READ	/FILL INPUT BUFFER
	LAC	IBUFF
	AND	WPCBTS	/GET WORD PAIR COUNT W.P.C.
	SAD	S01000	/WPC=1?
	JMP	INPUT1	/PREMATURE END OF INPUT
	RTR		/NOW CALCULATE BLOCK COUNT
	RTR		/FROM W.P.C
	RTR
	RTR
	RAR
	AND	S00377
	TAD	K1
	RAR
	AND	S00177
	CMA
	TAD	C1
	DAC	BLKCT
	LAC	READ+3	/SET LWA TO POINT TO FIRST DATA WORD
	TAD	C1
	DAC	LWA
	JMP*	INPUT	/EXIT
INPUT1	JMS	INCORE	/NOW GET REMAINDER OF INTERMEDIATE
	JMP	.-2	/CODE (ALREADY IN CORE)
INPUTA	INPUT+1		/ADDRESS OF INPUT+1
/TELETYPE MESSAGE ROUTINES FOR INPUT ERRORS
	.IFDEF	DOS
TTM1	.BOS	ABORT
	.ENDC
	.IFUND	DOS
TTM1=.
	.ENDC
	LAC	MESS1A	/SET TTY TO OUTPUT MESSAGE 1
	DAC	TTWRT+3
	JMS	TTWRT	/OUTPUT MESSAGE
	JMP	ABORT	/SHUT DOWN PASS3 AND QUIT
/
EXIT	.EXIT		/EXIT TO MONITOR
TTWRT	XX		/ENTRY
	.WRITE	-3,2,.,34
	.WAIT	-3
	JMP*	TTWRT
/
MESS1A	MESS1
/
MESS1	5000
	0
	.ASCII	'INPUT'<40>'READ'<40>'ERROR'<15>
MESS2A	MESS2
MESS2	3000
	0
	.ASCII	'EOP3(0)'<175>
/ROUTINE TO FILL INPUT BUFFER ON DAT-15
/EXPECTS 50 WORD BINARY INPUT INCLUDING HEADER
READ	XX		/ENTRY
	.READ	IN,BINY,IBUFF,50
	.WAIT	IN
	LAC	IBUFF
	AND	VALBTS	/VALIDITY BITS
	SAD	PAR
	JMP	TTM1	/INPUT PARITY ERROR
	SAD	CHSUM	
	JMP	TTM1	/CHECK SUM ERROR
	SAD	SHTLN
	JMP	TTM1	/SHORT LINE ERROR
	JMP*	READ	/ACC=0
	0
BINY=0
/ROUTINE TO PROVIDE INITIALISATION FOR PASS3
/INPUT,OUTPUT AND LISTING,ALSO TELETYPE
/COMMENTS
/RESTART ADDRESS IN AC ON ENTRY
/INITIALISE INPUT
PH4IPI	XX		/ENTRY
	DAC	.+3	/SET RESTART ADDRESS IN INIT
	.INIT	IN,0,.
	LAC	.-1	/RETURN BUFFER SIZE IN AC
	JMP*	PH4IPI	/FOR EXIT
/
/INITIALISE OUTPUT
PH4OPI	XX		/ENTRY
	DAC	.+3
	.INIT	OUT,1,.
	LAC	.-1
	JMP*	PH4OPI	/EXIT
/
/INITIALISE LISTING DEVICE
PH4LST	XX		/ENTRY
	DAC	.+3
	.INIT	LIST,1,.
	LAC	.-1
	JMP*	PH4LST	/EXIT
/
/INITIALISE TELETYPE OUTPUT ON DAT-3
PH4TTI	XX		/ENTRY
	DAC	.+3
	.INIT	-3,1,.
	JMP*	PH4TTI	/EXIT
/ROUTINE TO INITIALISE PAGE COUNT
PCI	XX		/ENTRY
	LAC	C1
	DAC	PGCT	/PAGE COUNT SET TO 1
	JMP*	PCI
/
/ROUTINE TO INITIALISE LINE COUNT
LCI	XX		/ENTRY
	LAW	-67	/LINE COUNT SET FOR
	DAC	LNCT	/55 LINES
	JMP*	LCI
/ROUTINES TO GIVE .SEEK FOR INPUT
/		.ENTER FOR OUTPUT
/		.ENTER FOR LISTING
/
SFIL	XX		/ENTRY
	.SEEK	IN,FNAM2+1
	JMP*	SFIL	/EXIT
/
EFIL	XX		/ENTRY
	LAC	BIN
	DAC	FNAM+3	/CHANGE FILNAM EXTN TO BIN
	.ENTER	OUT,FNAM+1
	JMP*	EFIL	/EXIT
/
LFIL	XX		/ENTRY
	LAC	LST
	DAC	FNAM+3	/CHANGE FILNAM EXTN TO LST
	.ENTER	LIST,FNAM+1
	JMP*	LFIL	/EXIT
/
BIN	.SIXBT	'BIN'
LST	.SIXBT	'OBJ'
FNAM	FNAM+1
	.BLOCK	3
FNAMED	.-1
FNAM2	FNAM2+1
	.BLOCK	3
/PHASE 4 INITIALISATION CONTROL-CALLS ROUTINE TO
/MOVE INFORMATION TABLES INTO PHASE 4,INITIALISES INPUT
/INITIALISES OUTPUT AND LISTING IF REQUIRED
PH4C1=.
	.IFUND	%S3
	JMS	RCOMST	/CALL DRIVER (DEVELOPEMENT ONLY)
	.ENDC
	LAC	PH4ST	/INITIALISE TTY ON DAT -3
	JMS	PH4TTI
	JMS	OPDEC	/DETERMINE OPTIONS REQUIRED
	DAC	OPDEC	/SAVE OPTIONS
	JMS	MOVIN	/GET INFORMATION TABLES
	XCT	PRESW	/NOP IF PRELIST REQD
	JMS	PREIN	/INITIALISE PRE-LIST
	XCT	LSTSW	/NOP IF LIST REQD
	JMS	LSTIN	/INITIALISE LIST
	XCT	INSW	/NOP IF INTERMEDIATE FILE PRODUCED
	JMS	ININ	/INITIALISE INPUT
	JMS	INCORE	/SET UP TP EXAMINE DATA IN CORE
	XCT	OPRSW	/NOP IF OUTPUT REQD
	JMS	OPIN	/OUTPUT INITIALISATION
	LAC	ST4	/INITIALISE OUTPUT WORD POINTER
	DAC	OWA
	ISZ	OWA
	LAC	LWA
	DAC	PREIN
	LAC	LWA1	/POINT TEMPORARILY TO DUMMY BLOCK
	DAC	LWA	/FOR SIZE..EBRIL AND TRACE IODEV
	JMP	PSZE
PRST	JMP*	PH4C2
/IF TRACE OPTION SET AN IODEV TO -12 IS NOW PUT INTO
/THE RLB OUTPUT
TRACE	LAC	OPDEC	/GET OPTIONS
	AND	W00000	/MASK FOR T OPTION
	SZA
	JMP	PRST	/TRACE NOT SET
	LAC	U60000	/IODEV CODE
	DAC*	LCWA
	ISZ	LWA
	LAW	-12	/DATSLOT -12
	AND	S00777	/LS 9 BITS ONLY
	DAC*	LWA
	LAW	-1
	TAD	LWA	/RESET POINTER BACK TO START
	DAC	LWA
	JMP	PRST
PSZE	LAC*	GLOBAL	/GET PROGRAM SIZE
	ISZ	GLOBAL
	DAC*	LWA	/AND OUTPUT IT
	ISZ	LC	/SET LOADER CODE TO 1 FOR SIZE
	LAC	LWA	/SET LOADER CODE WORD POINTER
	TAD	C4	/INITIALLY FOR FIRST TIME ROUND
	DAC	LCWA
	JMP	TRACE
/NOW PROCESS 4 WORD BLOCKS,EXTRACTING LOADER CODES
/AND EXITING VIA TABLE JUMP
NLB	LAC	PREIN	/RESTORE POINTER TO COMPILER DATA
	DAC	LWA
	LAC	NLCJMP
	DAC	NLB	/ONCE ONLY RESTORE NORMAL SEQUENCE
NLC	ISZ	BLKCT	/
	SKP
	JMS	INPUT	/REFILL BUFFER IF BLOCK COUNT EXPIRES
	LAC	LWA	/POINTER TO NEXT DATA WORD
	TAD	C4
	DAC	LCWA	/POINTER TO LOADER CODE WORD
	SKP
NLD	XX		/ENTRY
	ISZ	LWA	/POINTS TO 1ST DATA WORD
	LAC*	LCWA	/GET LOADER CODES
	SNA!CLL
	JMP	NLB	/GET NEXT 4 WORD BLOCK
	RAL
	RTL
	RTL
	RTL
	DAC	LC	/CODE RIGHT JUSTIFIED
	AND	Z77700
	RAR
	DAC*	LCWA	/STORE REMAINING CODES
	LAC	LC
	AND	S00077
	DAC	LC	/GET CODE
	JMP*	NLD	/EXIT
/DUMMY FOUR WORD BLOCK FOR SIZE AND TRACE IODEV
LWA1	.+1
	.REPT	5
	0
NLCJMP	JMP	NLC
/PHASE 4 CONTROL CONTINUES WITH CODE IN ACC
PH4C2	PH4C2+1
	LAC	CLOC	/UPDATE LOAD ADDRESS FOR PRINTING
	DAC	PLA
	LAC*	LWA	/COPY INPUT WORD AND LOADER CODE
	DAC*	OWA	/INTO OUTPUT - OVERWRITTEN IF
	LAC	LC	/PROCESS ROUTINES CHANGE THEM
	DAC	OLC
	TAD	T1ADDR	/SET ENTRY INTO PRE-LIST TABLE
	DAC	TABENT	/STORE FOR FUTURE REFERENCE
	XCT	PRESW	/PRE-LIST REQUIRED?
	JMS	LCR	/LIST CONTROL
	LAC	TABENT	/SAME ENTRY IN?
	TAD	C63	/NEXT TABLE
	DAC	TABENT
	LAC*	TABENT
	DAC	PROJMP
	JMP*	PROJMP	/TO CODE PROCESS ROUTINE
PH4C5	ISZ	CLOC	/INCREMENT LOC COUNT
PH4C3	LAC	TABENT	/ENTRY IN NEXT TABLE
	TAD	C63
	XCT	LSTSW	/LISTING REQUIRED?
	JMS	LCR	/LIST CONTROL
	XCT	OPRSW	/OUTPUT REQUIRED?
	JMS	OPCR	/OUTPUT CONTROL
PH4C4	LAC	OLC	/FINISHED?
	SAD	CODE23
	JMP	PH4END
	JMS	NLD	/GET NEXT CODE
	JMP*	PH4C2	/GO ROUND AGAIN
/
/ROUTINE TO OUTPUT PRE-LIST HEADING
PLHROP	XX		/ENTRY
	LAC	LSTBUF	/SAVE BUFFER ADDRESS FOR
	DAC	TEMP2	/FUTURE REFERENCE
	LAW	-5	/INITIALISE CHARACTER COUNT FOR
	DAC	CHARCT	/5/7 PACK ROUTINE
HROP0	LAC	LHDR1	/SET BUFFER ADDRESS FOR
	DAC	LSTBUF	/OUTPUT
	TAD	C8	/SET POINTER FOR 5/7 PACK
	DAC	LSTPTR
	LAC	PGCT	/GET PAGE COUNT
	JMS	DECPNT	/CONVERT TO 5/7 ASCII
	JMS	TABOP	/OUTPUT TAB
	LAC	FNAM	/SET POINTER TO START OF 
	DAC	LPNTR	/FILENAME
	JMS	LSTFNM	/CONVERT FILENAME
	LAC	CARRET
	JMS	PAK57	/GO OUTPUT LINE
	ISZ	LNCT	/INCREMENT LINE COUNT
HROP1	LAC	LHDR2	/SET BUFFER ADDRESS FOR
	DAC	LSTBUF	
HROP4	LAC	LHDR2E
	DAC	LSTPTR
	LAC	LSTBUF
	JMS	LSTWRT	/GO OUTPUT IT
	ISZ	LNCT	/INCREMENT LINE COUNT
	LAC	TEMP2	/RESTORE NOMAL LIST BUFFER ADDRESS
	DAC	LSTBUF
	TAD	C2	/AND RESET POINTER
	DAC	LSTPTR
	LAC	HROP6	/RESET PRE-LIST HEADERS
	DAC	HROP0
	LAC	HROP7
	DAC	HROP1
	LAC	HROP8
	DAC	HROP4
	JMP*	PLHROP	/EXIT
/
/ROUTINE TO OUTPUT LIST HEADING
LHROP	XX		/ENTRY
	LAC	HROP2	/CHANGE BUFFERS FOR
	DAC	HROP0	/LIST
	LAC	HROP3
	DAC	HROP1
	LAC	HROP5
	DAC	HROP4
	JMS	PLHROP
	JMP*	LHROP	/EXIT
HROP2	LAC	LHDR3
HROP3	LAC	LHDR4
HROP5	LAC	LHDR4E
HROP6	LAC	LHDR1
HROP7	LAC	LHDR2
HROP8	LAC	LHDR2E
/ROUTINE TO DECODE INTEGER NUMBER INTO PRINTING
/CHARACTERS.ENTRY WITH INTEGER IN ACC.
DECPNT	XX		/ENTRY
	DZM	DIGIT	/INITIALISE O/P CHAR
	DAC	INTEG	/STORE
	LAW	-6	/SET LEADING ZERO COUNT
	DAC	TEMP1
	LAC	SPACE	/SET TO OUTPUT LEADING
	DAC	LDZERO	/SPACES
	LAC	SUBTST	/INITIALISE SUBTRACTION PNTR
	DAC	SUBPTR
SUB10	LAC	INTEG	/SUBTRACT SUCESSIVE POWERS
	TAD*	SUBPTR	/OF 10
	SPA		/<0?
	JMP	NXTPWR
	DAC	INTEG	/NO
	ISZ	DIGIT	/INCREMENT OUTPUT CHAR
	JMP	SUB10	/GO ROUND AGAIN
NXTPWR	LAC	DIGIT
	SNA
	JMP	ZEROP	/OUTPUT 0 OR SPACE
	LAC	LDZERO
	SAD	ZERO
	JMP	LSPFIN
	LAC	SIGN	/OUTPUT THE SIGN IF PRESENT
	SNA		/OTHERWISE A SPACE
	LAC	SPACE
	JMS	PAK57
	DZM	SIGN
LSPFIN	LAC	ZERO	/NO MORE LEADING SPACES
	DAC	LDZERO
	TAD	DIGIT	/MAKE UP CHAR
OPCHAR	JMS	PAK57	/O/P CHAR
	DZM	DIGIT
	ISZ	SUBPTR	/INCREMENT POINTER
	LAC	SUBPTR
	SAD	SUBTAB	/EXPIRED?
	JMP*	DECPNT
	JMP	SUB10
ZEROP	ISZ	TEMP1
	SKP
	JMP	LSPFIN
	LAC	LDZERO
	JMP	OPCHAR
	.DEC
TEN5	-100000
	-10000
	-1000
	-100
	-10
	-1
	.OCT
SUBTAB	SUBTAB
/OCTAL PRINT ROUTINE .ENTER WITH OCTAL
/WORD IN ACC AND NO OF LEADING DIGITS
/DISCARDED AS -VE TRAILING PARAMETER
OCTPNT	XX		/ENTRY
	DAC	OCTWD
	LAC*	OCTPNT	/GET TRAILING PARAMETER
	DAC	DD	/DISCARDED DIGITS
	LAW	-6
	DAC	DIGCT
	CLL
OPNT1	LAC	OCTWD
	RTL
	RTL
	DAC	DIGIT	/NEXT 3 BITS CORRECTLY JUSTIFIED
	RAR
	DAC	OCTWD
	LAC	DD	/THIS DIGIT TO BE DISCARDED?
	SMA
	JMP	OPNT3	/NO
	ISZ	DD	/YES
	SKP!CLA
	JMP	OPNT2
	JMP	OPNT4
	LAC	SPACE
	JMP	OPNT4
OPNT2	LAC	SIGN
	SNA
	JMP	OPNT2-2
	JMS	PAK57
	DZM	SIGN
	JMP	OPNT4+1
OPNT3	LAC	DIGIT
	AND	S00007
	TAD	ZERO	/MAKE ASCII CHAR
OPNT4	JMS	PAK57
	ISZ	DIGCT
	JMP	OPNT1
	ISZ	OCTPNT	/BUMP LINK FOR RETURN
	JMP*	OCTPNT	/EXIT
/ROUTINE TO CONVERT FILENAME FROM 6 BIT FOR
/5/7 PACKING INTO LISTING BUFFER
LSTFNM	XX		/ENTRY
LFN1	LAC*	LPNTR	/GET WORD
	DAC	TEMP1	/STORE
	LAC	LFN3-1	/SCOND TIME IN USE TEMP1
	DAC	LFN1
LFN2	LAC	TEMP1	/
	SNA		/DONE?
	JMP	LFN3	/YES,GET NEXT WORD
	CLL!RAL		/NO,MOVE CHAR TO CORRECT
	RTL		/POSN
	RTL
	RTL
	DAC	CHAR
	AND	Z77700
	RAR
	DAC	TEMP1
	LAC	CHAR
	AND	S00077	/6 BIT CHARACTER
LFN4	TAD	S00040	
	XOR	S00140	/7 BIT CHARACTER
	JMS	PAK57	/O/P CHAR
	JMP	LFN2	/NEXT CHARACTER
LFN3	ISZ	LPNTR	/INCREMENT POINTER TO NEXT WORD
	LAC	LFN6	/RESET ROUTINE FOR NXT WORD
	DAC	LFN1
	LAC	LPNTR
	SAD	FNAMED	/FINISHED?
	SKP
	JMP	LFN1	/NO,GET NEXT WORD
	CLA
	JMP*	LSTFNM	/EXIT
LFN5	JMP	R50MAK
LFN6	LAC*	LPNTR
/ROUTINE TO OUTPUT A FORM FEED
FFOP	XX		/ENTRY
	LAC	FFD	/FORM FEED
	JMS	PAK57	/OUTPUT IT
	LAC	CARRET
	JMS	PAK57
	JMP*	FFOP
/
/PAGE HEADERS FOR PRE-LIST & LIST
LHDR1	.+1
	0
	0
	.ASCII	' PRE-LIST PAGE '
	.BLOCK	6
LHDR2	.+1
	0
	0
	.ASCII	' LOAD ADD'<11>' OCTAL'<11>' CODE'<11>'SYMBOLIC'<15>
LHDR2E	.-1
LHDR3	.+1
	0
	0
	.ASCII	' LIST PAGE '
	.BLOCK	6
LHDR4	.+1
	0
	0
	.ASCII	'LOAD ADD OCTAL'<11><11>'SYMBOLIC'<11>'COMMENTS'<15>
LHDR4E	.-1
/LIST CONTROL ROUTINE ACC CONTAINS ADDRESS OF
/TABLE ENTRY ON ENTRY
LCR	XX		/ENTRY
	DAC	TABENT
	LAC*	TABENT	/GET ENTRY
	DAC	PROJMP	/STORE FOR JMP* TO SYMBOLIC ROUTINES
	SAD	NULLJ
	JMP	NULL+1
	SPA!RAL
	JMP	LAOP	/LOAD ADDRESS O/P
LCR1	JMS	TABOP	/OUTPUT TAB
	SPA!RAL
	JMP	OCTOP	/OCTAL WORD O/P
LCR2	JMS	TABOP	/OUTPUT TAB
	SPA!RAL
	JMP	OPCODE	/LOADER CODE O/P
LCR3	LAC*	TABENT
	SAD	ACL43	/OMIT TAB IF FOLLOWING CODES
	JMP	LC43
	SAD	ACL46
	JMP	LC46
	SAD	ACL47
	JMP	LC47
	SAD	ACL28
	JMP	LC28
	SAD	ACL29
	JMP	LC29
	SAD	ACL31
	JMP	LC31
	SAD	ACL35
	JMP	LC35
	SAD	ACL39
	JMP	LC39
	JMS	TABOP
	JMP*	PROJMP	/JUMP TO SYMBOLIC ROUTINES
NULL	ISZ	LNCT	/INCREMENT LINE COUNT
	SKP!CLL
	JMS	NEWPGE	/IF EXPIRED,OUTPUT NEW PAGE
	JMP*	LCR	/EXIT
/
/ROUTINE TO OUTPUT LOAD ADDRESS
LAOP	DAC	SAVAC	/SAVE ACC FOR EXIT
	LAC	SPACE
	JMS	PAK57	/OUTPUT LEADING SPACE
	LAC	PLA	/PRINT LOAD ADDRESS
	JMS	OCTPNT	/OCTAL PRINT ROUTINE
		-1	/DISCARD FOR 5 CHAR FIELD
	LAC	SAVAC
	JMP	LCR1
/ROUTINE TO OUTPUT LOADER CODE
OPCODE	DAC	SAVAC	/SAVE ACC FOR EXIT
	LAC	T1ADDR	/IF POST LIST TABLE,PRINT
	TAD	C128	/LETTER FOR WORD TYPE
	CMA
	TAD	TABENT
	SMA
	JMP	CDCON	/GO CONVERT CODE TO LETTER
	LAC	LC	/GET LOADER CODE
	JMS	DECPNT	/DECIMAL PRINT
	LAC	SAVAC	/RESTORE ACC
	JMP	LCR3	/EXIT
/ROUTINE TO OUTPUT OCTAL WORD
OCTOP	DAC	SAVAC
	LAC*	LWA	/DATA WORD
	JMS	OCTPNT	/OCTAL OUTPUT
		0
	LAC	SAVAC
	JMP	LCR2
/
/ROUTINE TO OUTPUT TAB
TABOP	XX		/ENTRY
	DAC	SAVAC	/SAVE ACC FOR EXIT
	LAC	TAB
	JMS	PAK57	/OUTPUT TAB
	LAC	SAVAC	/RESTORE ACC
	JMP*	TABOP
/PRE-LIST DRIVE TABLE T1
T1ADDR	.
	NULL
	CO+PLC1B
	ACO+PLC1B
	ACO+PLC1B
	ACO+PLC5
	CO+PLC6
	CO+PLC7
	CO+PLC7
	CO+PLC9
	CO+PLC10
	CO+PLC11
	CO+PLC12
	CO+PLC1B
	CO+PLC14
	CO+PLC1B
	CO+PLC1B
	CO+PLC1B
	CO+PLC1B
	CO+PLC1B
	CO+PLC1B
	CO+PLC1B
	CO+PLC22
	CO+PLC23
	CO+PLC1B
	CO+PLC1B
	CO+PLC26
	CO+PLC9
	CO+PLC28
	CO+PLC29
	CO+PLC30
	CO+PLC31
	CO+PLC1B
	ACO+PLC33
	ACO+PLC34
	PLC35
	ACO+PLC36
	ACO+PLC1B
	ACO+PLC38
	CO+PLC39
	ACO+PLC40
	ACO+PLC41
	CO+PLC1B
	CO+PLC1B
	ACO+PLC44
	ACO+PLC1B
	CO+PLC1B
	CO+PLC1B
	CO+PLC1B
	ACO+PLC49
	ACO+PLC50
	CO+PLC1B
	ACO+PLC52
	CO+PLC1B
	ACO+PLC54
	CO+PLC1B
	ACO+PLC56
	ACO+PLC57
	CO+PLC1B
	CO+PLC1B
	ACO+PLC60
	CO+PLC1B
	CO+PLC1B
	CO+PLC1B
C=200000
O=100000
CO=300000
ACO=700000
/PROCESS DRIVE TABLE T2 CODES 1-63
	.DSA	PH4C3	/1
	.DSA	PRC2	/2  .LOC
	.DSA	PH4C5	/3
	.DSA	PH4C5	/4
	.DSA	PH4C5	/5
	.DSA	PRC6	/6  .BLOCK
	.DSA	PRC7	/7 RADIX 50 SYMBOL
	.DSA	PRC8	/8 RADIX 50 SYMBOL
	.DSA	PH4C3	/9
	.DSA	PH4C3	/10
	.DSA	PRC11	/11 BLOCK DATA SUBPROGRAM
	.DSA	PRC12	/12 OWN BLOCK DEFN
	.DSA	PH4C3	/13
	.DSA	PH4C3	/14
	.DSA	PH4C3	/15
	.DSA	PH4C3	/16
	.DSA	PH4C3	/17
	.DSA	PRC18	/18 DATA CONSTANT DEFINITION
	.DSA	PH4C3	/19
	.DSA	PH4C3	/20
	.DSA	PH4C3	/21
	.DSA	PH4C3	/22
	.DSA	PH4C3	/23
	.DSA	PH4C3	/24
	.DSA	PRC25	/25
	.DSA	PRC26	/26 POSITION IN OWN
	.DSA	PRC26	/27 ADDRESS OF ETV
	.DSA	PRC28	/28
	.DSA	PRC29	/29
	.DSA	PH4C3	/30
	.DSA	PRC31	/31
	.DSA	PH4C3	/32
	.DSA	PRC33	/33 REAL STACK REFERENCE
	.DSA	PRC33	/34 INTEGER STACK REFERENCE
	.DSA	PRC29	/35
	.DSA	PRC33	/36 STRING STACK REFERENCE
	.DSA	PRC37	/37
	.DSA	PRC33	/38 GLOBAL STACK REFERENCE
	.DSA	PRC29	/39
	.DSA	PRC33	/40 SWITCH STACK REFERENCE
	.DSA	PRC41	/41 LABEL STACK REFERENCE
	.DSA	PH4C3	/42
	.DSA	PRC43	/43
	.DSA	PRC33	/44 OWN STACK REFERENCE
	.DSA	PRC37	/45
	.DSA	PRC29	/46
	.DSA	PRC29	/47
	.DSA	PH4C3	/48
	.DSA	PRC33	/49 REAL STACK DEFINITION
	.DSA	PRC33	/50 INTEGER STACK DEFINITION
	.DSA	PH4C3	/51
	.DSA	PRC33	/52 STRING STACK DEFINITION
	.DSA	PH4C3	/53
	.DSA	PRC33	/54 GLOBAL STACK DEFINITION
	.DSA	PH4C3	/55
	.DSA	PRC33	/56 SWITCH STACK DEFINITION
	.DSA	PRC41	/57 LABEL STACK DEFINITION
	.DSA	PH4C3	/58
	.DSA	PH4C3	/59
	.DSA	PRC33	/60 OWN STACK DEFINITION
	.DSA	PH4C3	/61
	.DSA	PH4C3	/62
	.DSA	PH4C3	/63
/POST LIST DRIVE TABLE T3
	C+PLC1
NULLJ	NULL
	ACO+LC3
	ACO+LC4
	ACO+LC5
	O+PLC6
	NULL
	NULL
	O+LC9
	O+LC9
	O+PLC11
	O+PLC12
	NULL
	O+PLC14
	NULL
	NULL
	NULL
	NULL
	NULL
	NULL
	NULL
	PLC22
	LC23
	NULL
	LC25
	ACO+LC26
	ACO+LC27
ACL28	LC28
ACL29	LC29
	NULL
ACL31	LC31
	NULL
	ACO+LC33
	ACO+LC34
ACL35	LC35
	ACO+LC36
	ACO+LC37
	ACO+LC38
ACL39	LC39
	ACO+LC40
	ACO+LC3
	NULL
ACL43	LC43
	ACO+LC44
	ACO+LC45
ACL46	LC46
ACL47	LC47
	NULL
	ACO+LC33B
	ACO+LC34A
	NULL
	ACO+LC36A
	NULL
	ACO+LC38A
	NULL
	ACO+LC40A
	ACO+LC41
	NULL
	NULL
	ACO+LC44A
	NULL
	NULL
T3END	NULL
/
/PRE-LIST CODE PROCESSORS
/CODE 1 PROCESSOR
PLC1	JMS	BLKLST	/OUTPUT"SIZE"
	.DSA	ASIZE
	LAC*	LWA	/GET DATA WORD
	SPA
	JMP	PLC1A
PLC1C	JMS	BLKLST	/OUTPUT"REL"
	.DSA	AREL
	JMP	PLC1B
PLC1A	JMS	BLKLST	/OUTPUT"ABS"
	.DSA	AABS
PLC1B	LAC	CARRET	/OUTPUT LINE
	JMS	PAK57
	JMP	NULL
/
ASIZE	.+1
	-2
	.ASCII	'SIZE'<11>
AREL	.+1
	-2
	.ASCII	'REL'<0><0>
AABS	.+1
	-2
	.ASCII	'ABS'<0><0>
/
/CODE N PROCESSORS - NOT YET WRITTEN
/
/
/CODE 7 PROCESSOR -RADIX 50 DECODER
PLC7	LAC*	LWA	/GET DATA WORD
	AND	T77777	/AND OFF FLAG BITS
	JMS	R50C1
	LAC	CARRET
	JMS	PAK57	/TERMINATE LINE
	JMP	NULL	/RETURN TO LIST CONTROL
R50C1	XX		/ENTRY
	DAC	NUM
	LAW	-3100
	TAD	NUM
	SPA
	JMP	R50C2
	DAC	NUM
	ISZ	CHAR1
	JMP	R50C1+1
R50C2	LAW	-50	/50
	TAD	NUM
	SPA
	JMP	R50C3
	DAC	NUM
	ISZ	CHAR2
	JMP	R50C2
R50C3	LAC	CHAR1	/CONVERT TO 7 BIT & OUTPUT
	JMS	CON7
	LAC	CHAR2
	JMS	CON7
	LAC	NUM
	JMS	CON7
	DZM	CHAR1
	DZM	CHAR2
	JMP*	R50C1	/EXIT
CON7	XX		/ENTRY
	AND	S00077
	SAD	S00033
	JMP	CON9
	SAD	S00034
	JMP	CON8
	SAD	S00047
	JMP	CON10
	JMP	CON12
CON8	LAC	DOT	/OUTPUT .
	JMP	CON11
CON9	LAC	PCENT	/OUTPUT %
	JMP	CON11
CON10	LAC	HASH	/OUTPUT #
	JMP	CON11
CON12	TAD	K29
	SMA
	TAD	C19
	TAD	C29
	TAD	S00040
	XOR	S00140
	SAD	S00100
	SKP
CON11	JMS	PAK57
	JMP*	CON7	/EXIT
/CODE 6
PLC6	JMS	BLKLST	/OUTPUT '.BLOCK'
	.DSA	A.BLK
	LAC*	LWA
	JMS	OCTPNT	/OUTPUT NUMBER
	-1
	JMP	PLC1B
A.BLK	.+1
	-4
	.ASCII	'.BLOCK'<11><0><0><0>
/
/CODE5	
PLC5	JMS	BLKLST	/OUTPUT'.DSA'
	.DSA	A.DSA
	LAC*	LWA
	JMS	OCTPNT	/OUTPUT ADDRESS
	-1
	JMP	PLC1B
A.DSA	.+1
	-2
	.ASCII	'.DSA'<11>
/CODE9	
PLC9	JMS	BLKLST	/OUTPUT'ETV'
	.DSA	A.ETV
	JMP	PLC1B
A.ETV	.+1
	-2
	.ASCII	'.ETV'
/CODE 10
PLC10	JMS	BLKLST	/OUTPUT'ITV'
	.DSA	A.ITV
	JMP	PLC1B
A.ITV	.+1
	-2
	.ASCII	'.ITV'
/
/CODE 11
PLC11	JMS	BLKLST	/OUTPUT'DATA'
	.DSA	ADATA
	LAC*	LWA	/OUTPUT SIZE
	JMS	OCTPNT
	-1
	JMP	PLC1B
ADATA	.+1
	-2
	.ASCII	'DATA'<11>
/CODE12
PLC12	JMS	BLKLST	/OUTPUT'OWN'
	.DSA	AOWN
	JMS	TABOP
	JMS	BLKLST
	.DSA	ASIZE
	LAC*	LWA	/OUTPUT SIZE
	JMS	OCTPNT
	-1
	JMP	PLC1B
AOWN	.+1
	-2
	.ASCII	'OWN'
/CODE 14
PLC14	JMS	BLKLST	/OUTPUT'OTV'
	.DSA	AOTV
	JMP	PLC1B
AOTV	.+1
	-2
	.ASCII	'.OTV'
/
/CODE22
PLC22	JMS	BLKLST	/OUTPUT'.IODEV'
	.DSA	AIODEV
	LAC*	LWA
	SPA
	JMP	PLC22A
	AND	S00700	/NEGATIVE SLOT?
	SZA
	LAC	Z76776	/YES SO MAKE NEGATIVE
	TAD*	LWA
	SAD	C8	/IF 10 MAKE 10 DECIMAL
	TAD	C2
	DAC*	LWA
	JMP	LC45	/SIGNED DECIMAL PRINT
PLC22A	JMS	BLKLST	/OUTPUT ALL
	.DSA	AALL
	JMP	PLC1B
AIODEV	.+1
	-4
	.ASCII	'IODEV '<0><0><0>
AALL	.+1
	-2
	.ASCII	'ALL'
/CODE 23
PLC23	JMS	BLKLST	/OUTPUT'.END'
	.DSA	A.END
	LAC*	LWA	/OUTPUT START ADDRESS
	JMS	OCTPNT
	-1
	LAC	CARRET
	JMS	PAK57
	JMS	BLKLST
	.DSA	ENDCOM
	JMS	FFOP
	.CLOSE	LIST
	JMP	NULL+1
A.END	.+1
	-2
	.ASCII	' END'<11>
/CODE26
PLC26	XCT	PLC44
	AOWN
	JMP	PLC1B
/CODE 28
PLC28	JMS	BLKLST
	.DSA	AREAL	/OUTPUT 'REAL STACK'
PLC28A	JMS	BLKLST
	.DSA	ASTACK
	JMP	PLC1B
/CODE 29
PLC29	JMS	BLKLST	/OUTPUT 'INTEGER STACK'
	.DSA	AINTEG
	JMP	PLC28A
/CODE 31
PLC31	JMS	BLKLST	/OUTPUT 'STRING STACK'
	.DSA	ASTRNG
	JMP	PLC28A
/CODE 35
PLC35	JMS	BLKLST	/OUTPUT 'SWITCH STACK'
	.DSA	ASWTCH
	JMP	PLC28A
/CODE 39
PLC39	JMS	BLKLST	/OUTPUT 'OWN STACK'
	.DSA	AOWN
	JMP	PLC28A
/
ASTACK	.+1
	-4
	.ASCII	' STACK'
/CODE 30
PLC30	JMS	BLKLST
	.DSA	AEQ
	JMP	PLC1B
/
AEQ	.+1
	-2
	.ASCII	'=.+1'
/CODE 33	
PLC33	JMS	BLKLST	/OUTPUT "REAL"
	.DSA	AREAL
PLC33A	JMS	TABOP	/OUTPUT A TAB
	JMP	PLC1C	/OUTPUT "REL" & TERM LINE
AREAL	.+1
	-2
	.ASCII	'REAL'<0>
/CODE 34
PLC34	JMS	BLKLST	/OUTPUT "INTEG"
	.DSA	AINTEG
	JMP	PLC33A
AINTEG	.+1
	-2
	.ASCII	'INTEG'
/CODE 36
PLC36	JMS	BLKLST	/OUTPUT 'STRNG'
	.DSA	ASTRNG
	JMP	PLC33A
ASTRNG	.+1
	-2
	.ASCII	'STRNG'
/CODE 38
PLC38	JMS	BLKLST	/OUTPUT 'GLOBR'
	.DSA	AGLOBR
	JMP	PLC33A
AGLOBR	.+1
	-2
	.ASCII	'GLOBR'
/
/CODE 40
PLC40	JMS	BLKLST	/OUTPUT 'SWTCH'
	.DSA	ASWTCH
	JMP	PLC33A
ASWTCH	.+1
	-2
	.ASCII	'SWTCH'
/CODE 41
PLC41	JMS	BLKLST	/OUTPUT 'LALOC'
	.DSA	ALALOC
	JMP	PLC33A
ALALOC	.+1
	-2
	.ASCII	'LALOC'
/CODE 44
PLC44	JMS	BLKLST	/OUTPUT 'OWN'
	.DSA	AOWN
	JMP	PLC33A
/CODE 49
PLC49	JMS	BLKLST	/OUTPUT 'REAL'
	.DSA	AREAL
PLC49A	JMS	TABOP	/OUTPUT ATAB
	JMP	PLC1A	/OUTPUT 'ABS' & TERM LINE
/CODE 50
PLC50	JMS	BLKLST	/OUTPUT 'INTEG'
	.DSA	AINTEG
	JMP	PLC49A
/CODE 52
PLC52	JMS	BLKLST	/OUTPUT 'STRNG'
	.DSA	ASTRNG
	JMP	PLC49A
/CODE 54
PLC54	JMS	BLKLST	/OUTPUT 'GLOBR'
	.DSA	AGLOBR
	JMP	PLC49A
/CODE 56
PLC56	JMS	BLKLST	/OUTPUT 'SWTCH'
	.DSA	ASWTCH
	JMP	PLC49A
/CODE 57
PLC57	JMS	BLKLST	/OUTPUT 'LALOC'
	.DSA	ALALOC
	JMP	PLC49A
/CODE 60
PLC60	JMS	BLKLST	/OUTPUT 'OWN'
	.DSA	AOWN
	JMP	PLC49A
/CODE PROCESSING ROUTINES -EXISTING LOADER CODES
/CODE 2	-.LOC
PRC2	LAC*	LWA	/GET DATA WORD
	AND	S77777	/ADDRESS 15 BITS
	DAC	CLOC	/SET CURRENT LOC
	JMP	PH4C3
/CODE 6 - .BLOCK
PRC6	LAC*	LWA	/GET DATA WORD
	AND	S37777	/SIZE OF BLOCK
	TAD	CLOC
	DAC	CLOC	/INCREMENT CURRENT LOC
	JMP	PH4C3
/CODE11  BLOCK DATA INDICATION
PRC11	ISZ	BDFLG	/SET BLOCK DATA FLAG
	JMP	PH4C3
/CODE 12	COMMON BLOCK DEFINITION
PRC12	LAC*	LWA	/GET DATA WORD
	AND	S77777	/SIZE OF BLOCK
	DAC	COMSZE	/STORE
	JMP	PH4C3
/CODE 18	DATA INITIALISATION CONSTANT DEFN
PRC18	LAC	BDFLG	/BLOCK DATA SUBPROGRAM?
	SZA!CLA
	LAC	COMSZE	/YES,ADD BLOCK SIZE TO LOAD ADDRESS
	TAD*	LWA	/NO LOAD ADDRESS -> LOC
	JMP	PH4C3
/CODE 25
PRC25	LAC	LFN4
	DAC	TEMP
	LAC	LFN5	/MODIFY LSTFNM
	DAC	LFN4
	LAC	FNAM	/SET POINTER TO START OF
	DAC	LPNTR	/FILENAME
	DZM	TEMP0	/INITIALISE VARIOUS REGISTERS
	LAW	-3
	DAC	R50CT
	JMS	LSTFNM
	LAC	TEMP0
	XOR	W00000
	DAC	R507
	DAC*	OWA
	DZM	TEMP0
	LAC	C7
	DAC	OLC
	XCT	OPRSW
	JMS	OPCR
	JMS	LSTFNM
	LAC	TEMP0
	DAC	R508
	DAC*	OWA
	LAC	C8
	DAC	OLC
	XCT	OPRSW
	JMS	OPCR
	LAC	W00000
	DAC*	OWA
	LAC	C19
	DAC	OLC
	LAC	TEMP
	DAC	LFN4
	LAC	LFN6
	DAC	LFN1
	JMP	PH4C3
/
R50MAK	JMS	CECHK	/CHECK IF CHARS HAVE EXPIRED
	JMS	SPCHK	/CHECK FOR NUMERIC OR SPECIAL CHAR
	TAD	TEMP0
	ISZ	R50CT
	SKP
	JMP	R50MK1
	RCL
	RTL
	DAC	TEMP0
	RTL
	TAD	TEMP0
	DAC	TEMP0
	JMP	LFN2
R50MK1	DAC	TEMP0
	LAW	-3
	DAC	R50CT
	JMP*	LSTFNM
R50MK2	CLA
	JMP	R50MAK
/CHECK IF CHARS HAVE PREMATURELY EXPIRED
CECHK	XX		/ENTRY
	DAC	SAVAC	/SAVE CHAR IF THERE IS ONE
	LAC	TEMP1	/ANY SIXBIT LEFT?
	SZA
	JMP	CECHK1	/YES
	LAC	CECHK2	/DO NOT GO TO LSTFNM YET
	DAC	R50MK1-1
	JMP	CECHK3	/RETURN
CECHK1	LAC	CECHK4	/NO GO BACK TO LSTFNM
	DAC	R50MK1-1
CECHK3	LAC	SAVAC	/RESTORE CHAR TO ACC
	JMP*	CECHK
CECHK2	JMP	R50MK2	/GO ROUND UNTILL CT =0
CECHK4	JMP	LFN2	/GET NXT CHAR FRON/M LSTFNM
/ROUTINE TO CHECK FOR SPECIAL CHARACTER OR NUMERIC
SPCHK	XX		/ENTRY
	SAD	HASH	/#
	JMP	SPCHK5
	SAD	DOT	/.
	JMP	SPCHK6
	SAD	PCENT	/%
	JMP	SPCHK3
	TAD	K48
	SMA		/NUMERIC?
	JMP	SPCHK2	/YES
	TAD	C48	/NO
SPCHK1	JMP*	SPCHK	/EXIT
SPCHK2	TAD	C29
	JMP	SPCHK1
SPCHK3	LAC	S00033
	JMP	SPCHK1
SPCHK5	LAC	S00047
	JMP	SPCHK1
SPCHK6	LAC	S00034
	JMP	SPCHK1
/CODES 26 AND 27
PRC26	LAC*	OWA
	DAC	TEMP0
	LAC	C5
	DAC	OLC
	XCT	OPRSW
	JMS	OPCR
	LAC	TEMP0
	DAC*	OWA
	LAC	LC
	SAD	C27
	JMP	PRC27
	LAC	C13
	DAC	OLC
	XCT	OPRSW
	JMS	OPCR
	LAC	CLOC
	DAC*	OWA
	LAC	C14
PRC26A	DAC	OLC
	JMP	PH4C5
/CODE 27
PRC27	LAC	C9
	JMP	PRC26A
/CODES 28,29,30,31,35,39
PRC28	LAW	-1
	DAC	TWOWD
	LAC	RLCD
	SZA
	JMP	PRC28A
	ISZ	RLCD
	JMP	PRC29
PRC28A	DZM	RLCD
	JMP	PRC29
PRC29	DZM	OLC	/CLEAR OUTPUT LOADER CODE
	JMP	PH4C3
PRC31	LAC	SRTCD
	SZA
	JMP	PRC31A
	ISZ	SRTCD
	JMP	PRC29
PRC31A	DZM	SRTCD
	JMP	PRC29
/CODES 37 & 45
PRC37	LAC	C4	/OUTPUT CODE 4
	DAC	OLC
	JMP	PH4C5	/EXIT
/CODE PROCESSING ROUTINES FOR ALGOL PSEUDO LOADER
/CODES >24 - GENERATE MODIFIED INSTRUCTIONS
/AND DATA WORDS WITH A LOADER CODE IN
/THE RANGE 1-24
/CODE 33,34,36,38,40,44,49,50,52,54,56,60
PRC33	JMS	PRISA	/PROCESS INSTRUCTION
	JMS	LCDET1	/PROCESS CODE
	JMP	PH4C5	/RETURN
/CODES 41,57
PRC41	JMS	PRISA	/PROCESS INSTRUCTION TO OBTAIN
	LAW	0	/STACK ADDRESS
	AND*	LWA	/REPLACE ADDR FIELD OF INSTRUCTION
	TAD*	STKADD	/BY STACK ADDRESS
	DAC*	OWA	/NEW INSTRUCTION
	DAC*	LWA	/FOR LISTING
	JMS	LCDET1	/PROCESS CODE
	JMP	PH4C5	/RETURN
/CODE 43
PRC43	LAC*	LWA	/TRANSFER DATA WORD AS IS
	DAC*	OWA
	LAC	C19	/CHANGE LOADER CODE TO 19
	DAC	OLC
	JMP	PH4C3	/RETURN
/CODE 45
LC45	LAC*	LWA	/GET CONSTANT
	DAC	INTEG
	SMA
	JMP	LC45A
	CMA		/IF -VE NEGATE IT
	TAD	C1	/FOR PRINTING
	DAC	INTEG
	LAC	MINUS	/SET TO OUTPUT MINUS
	DAC	SIGN	/SIGN
LC45A	LAC	INTEG
	JMS	DECPNT	/OUTPUT INTEGER
	JMP	LC3A
/CODES 7 & 8
PRC7	LAC*	LWA
	AND	X77777
	DAC*	OWA
	DAC	R507	/SAVE RADIX 50 SYMBOL
	JMP	PH4C3
PRC8	LAC*	LWA
	DAC	R508	/SAVE RADIX 50 SYMBOL
	JMP	PH4C3
/COMMON ROUTINE TO GENERATE RELOCATABLE
/INSTRUCTIONS FROM PASS2 PSEUDO INSTRUCTIONS
/AND PROVIDE APPROPRIATE STACK ADDRESSES
PRISA	XX		/ENTRY
	LAC	LC	/GET INPUT CODE
	AND	S00017
	RCL		/CALCULATE ENTRY INTO LOOK UP TABLE
	TAD	PRCTL	/AS AN INSTRUCTION THEN
	DAC	PRISA1	/EXECUTE IT
	LAC*	LWA	/GET DATA WORD
	DAC	TEMP1
	AND	S07777	/CALCULATE STACK ADDRESS
	TAD	Z70001
PRISA1	0
	DAC	STKADD	/STORE IT
	ISZ	PRISA1	/INC INSTR TO GET STACK POINTER
	CLA
	XCT	PRISA1
	DAC	PRISA1
	LAW	770000
	TAD*	LWA	/CALCULATE RELOCATABLE
	TAD*	PRISA1	/INSTRUCTION
	DAC*	OWA	/STORE IN OUTPUT WORD
	DAC*	LWA
	JMP*	PRISA	/EXIT
/COMMON ROUTINE TO DETERMINE IF OUTPUT LOADER
/CODE IS CODE 03 OR CODE 05
LCDET1	XX		/ENTRY
	LAC	LC	/GET INPUT CODE
	AND	S00020	/60 OCTAL RANGE?
	SZA
	LAC	C2	/YES,MAKE CODE =5
	TAD	C3	/NO,MAKE CODE =3
	DAC	OLC	/OUTPUT CODE
	JMP*	LCDET1	/EXIT
/CODE PROCESS LOOK UP TABLE PROVIDES ENTRIES
/INTO THE STATISTICS TABLE
PRCTL	TAD*	.+1	
	.DSA	VOBASE
	.DSA	VOCAB
	.DSA	RLBASE
	.DSA	REAL
	.DSA	INBASE
	.DSA	INTEGR
	.DSA	INBASE
	.DSA	INTEGR
	.DSA	STBASE
	.DSA	STRING
	.DSA	LABASE
	.DSA	LABEL
	.DSA	GLBASE
	.DSA	GLOBAL
	.DSA	PRBASE
	.DSA	PROC
	.DSA	SWBASE
	.DSA	SWITCH
	.DSA	LLBASE
	.DSA	LABLOC
	.DSA	ICBASE
	.DSA	INCORD
	.DSA	WKBASE
	.DSA	WORK
	.DSA	OWBASE
PRCTLE	.DSA	OWN
/ROUTINE TO INITIALISE CONDITIONS FOR OUTPUT
/AND INITIALISE OUTPUT DEVICE
OPIN	XX		/ENTRY
	LAC	PH4ST	/RESTART ADDRESS PASS 3
	JMS	PH4OPI	/INITIALISE OUTPUT DEVICE
	JMS	EFIL	/.ENTER ON OUTPUT DEVICE
	LAC	OPBUFF	/INITIALISE BUFFER POINTER
	DAC	OPPTR
	ISZ	OPPTR
	LAC	ST4
	DAC	OWA	/INITIALISE OUTPUT WORD ADDRESS
	ISZ	OWA
	JMP*	OPIN	/EXIT
/PH4END END OF COMPILATION - COMPLETES OUTPUT
/OF R.L.B THEN CLOSES COMPILER SLOTS
PH4END	XCT	OPRSW	/ANY RLB OUTPUT?
	JMS	OPEND	/YES,COMPLETE OUTPUT
	XCT	INSW	/ANY INTERMEDIATE INPUT?
	JMS	INCLS	/YES,CLOSE AND DELETE FILE
	LAC	MESS2A	/OUTPUT 'EOP3(0)'
	DAC	TTWRT+3	/ON TELETYPE
	JMS	TTWRT
DONE	.CLOSE	-3	/CLOSE TTY
	XCT	RELSW	/RELOAD COMPILER?
	JMP	RELOAD
	JMP	EXIT
OPEND	XX		/ENTRY-CODE TO COMPLETE OUTPUT
	LAC	OWA	/ANYTHING TO TRANSFER TO
	TAD	K1
	SAD	ST4	/LINE BUFFER?
	JMP	OPEND2	/NO-OUTPUT BUFFER
	LAC	ST4	/YES
	DAC	OWA
LCJUST	LAC*	OWA	/LEFT JUSTIFY LOADER CODES
	AND	Z70000	/IF NECESSARY
	SZA
	JMP	OPEND1
	LAC*	OWA
	RCL
	RTL
	RTL
	RAL
	DAC*	OWA
	JMP	LCJUST+1
OPEND1	LAC*	OWA	/TRANSFER WORDS TO LB
	ISZ	OPPTR
	DAC*	OPPTR
	ISZ	OWA
	LAC	OWA
	SAD	END4	/FINISHED?
	SKP
	JMP	OPEND1	/NO
OPEND2	JMS	OPWRT	/YES-OUTPUT IT
	.CLOSE	OUT
	JMP*	OPEND	/EXIT
/
/ROUTINE TO RESTART COMPILER WITH ^P
RSTRT	LAC*	RELSW	/SET UP TO RECALL PASS1?
	SAD	SKP
	ISZ	RELSW	/NO,SET IT TO RECALL PASS 1
	JMP	ABORT
INCLS	XX	/ENTRY
	.CLOSE	IN
	.IFDEF	%S3
	.DLETE	IN,FNAM2+1
	.ENDC
	JMP*	INCLS
/
/
ABORT	XCT	PRESW
	JMS	LSTABT
	XCT	LSTSW
	JMS	LSTABT
	.CLOSE	IN
	JMP	DONE
/
/
LSTABT	XX
	.CLOSE	LIST
	JMP*	LSTABT
/
RELOAD=.		/CALL OVERLAY ROUTINE
	.IFUND	DOS
	JMS	OLAY
	.IFDEF	%S3
	%B1
	%C1-1
	-%L1
	%S1
	.ENDC
	.IFUND	%S3
	101
	5
	740075
	247
	.ENDC
	.ENDC
	.OVLAY	ALGOL@
ENDCOM	.+1
	-10
	.ASCII	'END OF COMPILATION'
/OUTPUT CONTROL MAKES UP 4 WORD BLOCKS FOR
/OUTPUT,CALLS ROUTINE TO TRANSFER TO
/OUTPUT LINE BUFFER WHEN BLOCK IS COMPLETE.
OPCR	XX		/ENTRY
	LAC	OLC	/IF NO LOADER CODE,DO NOTHING
	SNA!CLL
	JMP*	OPCR
	LAC*	ST4	/INSERT CURRENT NEW CODE INTO
	RTL		/LOADER CODE WORD
	RTL
	RTL
	XOR	OLC
	DAC*	ST4
OPCR1	LAC	OWA	/IS 4 WORD BLOCK COMPLETE ?
	TAD	C1
	SAD	END4
	JMP	TRAN4	/YES-TRANSFER TO LINE BUFFER
	ISZ	OWA	/INCREMENT OUTPUT WORD POINTER
	JMP*	OPCR
/ROUTINE TO TRANSFER 4 WORD BLOCK TO LINE BUFFER
/AND RESET OWA
TRAN4	LAC	ST4	/USER OWA AS TRANSFER
	DAC	OWA	/POINTER
TRAN41	LAC*	OWA	/TRANSFER WORD TO LINE
	ISZ	OPPTR	/BUFFER AND BUILD SUMCHK
	DAC*	OPPTR	/INCREMENT BUFFER POINTER
	LAC	OPPTR
	SAD	OPBEND	/BUFFER FULL?
	JMS	OPWRT	/YES,OUTPUT IT
	ISZ	OWA	/TRANSFER COMPLETE?
	LAC	OWA
	SAD	END4
	JMP	.+2
	JMP	TRAN41	/NO-GO ROUND AGAIN
	LAC	ST4	/RESET OWA POINTER
	DAC	OWA
	DZM*	ST4	/CLEAR OUTPUT CODE LOCATION
	JMP	OPCR1	/RETURN
/ROUTINE TO WRITE OUTPUT BUFFER
OPWRT	XX		/ENTRY
	LAW	-1
	TAD	OPBUFF	/CALCULATE WORD PAIR
	CMA		/COUNT
	ISZ	OPPTR
	TAD	OPPTR
	TAD	C1
	CLL
	RTL
	RTL
	RTL
	RTL
	AND	V77000
	DAC*	OPBUFF	/WPC INTO HEADER WD 0
	.WRITE	OUT,0,OBUFF,50
	.WAIT OUT
	LAC	OPBUFF	/RESET OUTPUT POINTER TO
	DAC	OPPTR	/2ND HEADER WORD
	ISZ	OPPTR
	JMP*	OPWRT	/EXIT
OPBUFF	OBUFF
OPBEND	OBUFF+51
ST4	.+1
	0	/4 WORD BLOCK
	0
	0
	0
END4	.
/PASS3 OPTION DECODE ROUTINE  MASKS OFF OPTION BITS
/IN CONTROL WORD TO DETERMINE WHICH OPTIONS ARE
/REQUIRED - CONTROL WORD IN FIRST FREE REGISTER(SCOM+2)
OPDEC	XX		/ENTRY
	LAC*	SCOM02	/GET CONTROL WORD
	DAC	SCOM02
	LAC*	SCOM02
	AND	RELDWD	/IS COMPILER TO BE RELOADED AT
	SZA		/END OF COMPILATION?
	ISZ	RELSW	/YES,GO SET SWITCH
	LAC*	SCOM02
	AND	PRELWD	/IS PRE-LIST REQUIRED?
	SNA
	ISZ	PRESW	/YES,GO SET SWITCH
	LAC*	SCOM02
	AND	LISTWD	/LISTING REQUIRED?
	SNA
	ISZ	LSTSW	/YES,GO SET SWITCH
	LAC*	SCOM02
	AND	OPWD	/IS BINARY OUTPUT REQUIRED?
	SNA
	ISZ	OPRSW	/YES,GO SET SWITCHES
	LAC*	SCOM02
	AND	INCOR	/WAS INTERMEDIATE CODE PRODUCED
	SNA
	ISZ	INSW	/YES,GO SET SWITCHES
	LAC*	SCOM02	/IF DUMP OPTION SET
	AND	DMPWD	/DO AN INIT FOR ^T
	SNA
	JMS	DMPSET
	LAC*	SCOM02
	SAD	K3	/PASS3 REQUIRED AT ALL?
	JMP	PH4END	/NO,GO TO END
	JMP*	OPDEC	/YES,NORMAL EXIT
/
/ROUTINE TO INITIALISE ^T
DMPSET	XX		/ENTRY
	.INIT	-3,1,DMP+400000
	JMP*	DMPSET
RELSW	XCT	SKP		/OPTION SWITCHES
PRESW	XCT	SKP		/
OPRSW	XCT	SKP		/
INSW	XCT	SKP		/
LSTSW	XCT	SKP		/
SKP	SKP
NOP	NOP
/OPTION MASKS
	.IFUND	%S3
RELDWD	400
PRELWD	200000
INCOR	4000
	.ENDC
	.IFDEF	%S3
RELDWD	1000
PRELWD	200
INCOR	400
	.ENDC
LISTWD	2000
OPWD	100000
DMPWD	100
/ROUTINE TO TRANSFER TABLES OF INFORMATION FROM
/ABSOLUTE ADDRESSES IN CORE TO SPECIFIED
/INTERNAL LOCATIONS IN PASS 3
/SCOM+2 POINTS TO START OF TABLES
/FILE NAME FOR INPUT-OUTPUT & LISTING
/NAME,STATISTICS TABLE ARE TRANSFERRED
MOVIN	XX		/ENTRY
	ISZ	SCOM02
	JMS	COPY	/GET FILNAME INTO INTERNAL BLOCK
	SCOM02+400000
	FNAM+1
	3
	JMS	COPY
	SCOM02+400000
	FNAM2+1
	3
	.IFDEF	%S3
	LAC	SCOM02	/SET PARAMETERS TO COPY
	TAD	C4	/STATISTICS TABLE
	DAC	SCOM02
	JMS	COPY	/COPY STATISTICS TABLE
	SCOM02+400000
AINBA	INBASE
	33
	LAC	OUTP
	DAC	ICBASE	/MAKE INPUT FOR THIS PASS
	LAC	OUBASE
	DAC	INCODE
	TAD	K3
	DAC	BLKADR
	.ENDC
	JMP*	MOVIN
AUTO=10
/STATISTICS TABLE
STTAB	STTAB
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
INCORD	XX
OUTP	XX
OUBASE	XX
SCOM	XX
/PAK57	-ASCII 5/7 PACKING ROUTINE
PAK57	XX		/ENTRY
	DAC	CHAR	/STORE CHARACTER
	JMS	PAK	/5/7 PACK
	LAC	CHAR
	SAD	CARRET	/C/R?
	JMP	.+2
	SAD	ALTMOD	/ALTMODE-SAME AS C/R
	JMP	OPLST	/OUTPUT BUFFER
	JMP*	PAK57	/EXIT
PAK	XX		/ENTRY
	LAC	CHARCT
	SAD	K5
	JMP	PAK1	/1ST CHAR
	SAD	K4
	JMP	PAK2	/2ND CHAR
	SAD	K3
	JMP	PAK3	/3RD CHAR
	SAD	K2
	JMP	PAK4	/4TH CHAR
	JMP	PAK5	/5TH CHAR
PAK1	CLL
	LAC	CHAR
	RTR
	RTR
	RTR
	RTR
	DAC*	LSTPTR	/1ST CHAR IN POSITION
PAK6	ISZ	CHARCT
	JMP*	PAK	/EXIT
RESCT	LAW	-6
	DAC	CHARCT
	ISZ	LSTPTR	/BUMP POINTER TO NEXT WORD PAIR
	JMP	PAK6	/EXIT
PAK2	LAC	CHAR
	CLL
	RTL
	RTL
	XOR*	LSTPTR
	DAC*	LSTPTR	/2ND CHAR IN POSITION
	JMP	PAK6
PAK3	LAC	CHAR
	RTR
	RAR
	DAC	TEMP
	AND	S00017
	XOR*	LSTPTR
	DAC*	LSTPTR
	ISZ	LSTPTR
	LAC	TEMP
	RAR
	AND	Z00000
	DAC*	LSTPTR	/3RD CHAR PACKED
	JMP	PAK6
PAK4	LAC	CHAR
	CLL
	RTL
	RTL
	RTL
	RTL
PAK7	XOR*	LSTPTR
	DAC*	LSTPTR	/4TH CHAR PACKED
	JMP	PAK6
PAK5	LAC	CHAR
	RAL	
	JMP	PAK7
OPLST	LAC	LSTBUF	/ADDRESS OF LISTING BUFFER
	JMS	LSTWRT	/OUTPUT BUFFER
	JMP	RESCT	/RESET CHAR CNT
/WRITE LIST BUFFER ROUTINE
LSTWRT	XX		/ENTRY
	DAC	WRITE+2	/BUFFER ADDRESS INTO .WRITE
	CMA
	TAD	C1
	ISZ	LSTPTR
	TAD	LSTPTR	/NOW CALCULATE W.P.C.
	TAD	C1
	CLL
	RTL
	RTL
	RTL
	RTL
	AND	V77000
	TAD	C2	/ADD IOPS ASCII MODE
	DAC*	WRITE+2	/W.P.C. INTO HEADER WORD
WRITE	.WRITE	-12,2,.,52
	.WAIT	-12
	LAC	WRITE+2
	TAD	C1
	DAC	LSTPTR	/RESET POINTER
	DZM	CHAR
	JMP*	LSTWRT	/EXIT
/ROUTINE TO LOAD PRE-DETERMINED BLOCKS INTO
/LISTING OUTPUT BUFFER - 1ST WORD OF BLOCK
/CONTAINS NO.OF WORDS OF TEXT IN BLOCK
BLKLST	XX		/ENTRY
	LAC*	BLKLST	/GET ADDRESS OF BLOCK TO BE
	DAC	BLKADD	/LOADED
	LAW	-5	/IF CHARCT=-5,USE CURRENT
	SAD	CHARCT	/VALUE OF PNTR,OTHERWISE
	JMP	BKLST4
	TAD	C1	/INCREMENT IT TO MAINTAIN
	CMA
	TAD	CHARCT	/WORD PAIRS
	SMA!SZA
	JMP	BKLST4-1
	ISZ	LSTPTR
	DZM*	LSTPTR
	ISZ	LSTPTR
BKLST4	LAW	-5
	DAC	CHARCT	/SET CHARCT TO -5
	ISZ	BLKADD
	LAC*	BLKADD	
	DAC	BWDCT	/NO.OF WORDS TO BE LOADED
BKLST1	ISZ	BLKADD	/POINT TO 1ST WORD
	LAC	LSTPTR	/IS BUFFER NEAR OVERFLOW?
	SAD	LSTEND
	JMP	BKLST2
BKLST3	LAC*	BLKADD	/NO,CARRY ON LOADING
	DAC*	LSTPTR	/INTO BUFFER
	ISZ	LSTPTR	/BUMP BUFFER POINTER
	ISZ	BWDCT	/FINISHED?
	JMP	BKLST1	/NO-LOAD NEXT WORD
	ISZ	BLKLST	/BUMP LINK FOR RETURN
	JMP*	BLKLST	/EXIT
BKLST2	LAC	CARRET	/FORCE OUTPUT OF BUFFER
	JMS	PAK57
	JMP	BKLST3	/NOW CARRY ON LOADING
/
LSTBUFF	LBUFF
LSTEND	LBUFF+64
/
/ROUTINE TO OUTPUT NEW PAGE HEADING ON A NEW PAGE
NEWPGE	XX		/ENTRY
	JMS	FFOP	/OUTPUT A FORM FEED
	ISZ	PGCT	/INCREMENT PAGE COUNT
	JMS	LCI	/INITIALISE LINE COUNT
	XCT	PRESW	/PRE-LIST?
	JMS	PLHROP	/OUTPUT PRE-LIST HEADING
	XCT	LSTSW	/LIST?
	JMS	LHROP	/OUTPUT LIST HEADING
	JMP*	NEWPGE	/EXIT
/LIST CODE PROCESSORS
/CODE 3
LC3	JMS	SYDEC	/OP CODE
	JMS	TABOP	/TAB
	JMS	ADDOCT	/ADDRESS IN OCTAL
LC3A	LAC	CARRET	/TERMINATE LINE
	JMS	PAK57
	JMP	NULL	/EXIT
/CODE 4
LC4	JMS	SYDEC	/OP CODE
	LAC*	OWA	/OUTPUT ADDRESS IF MEM REF INST
	AND	Z00000
	SAD	Z00000
	JMP	LC3A
	JMP	LC3+1
/CODE 5
LC5	LAC*	OWA
	DAC*	LWA
	JMP	PLC5
/CODES 9 AND 10
LC9	JMS	BLKLST	/OUTPUT '.ITV'
	.DSA	A.ITV
LC9A	JMS	TABOP
	JMS	NAMPR	/OUTPUT NAME
	JMP	LC3A
/CODE 19
LC19	LAC*	OWA	/IS THIS A PROGRAM (PROCEDURE NAME)
	SPA
	JMP	LC25	/YES
	LAC	R507	/OUTPUT 3 CHARS
	AND	T77777
	JMS	R50C1
	LAC	R507
	SMA
	JMP	.+3
	LAC	R508	/OUT 2ND 3 CHARS
	JMS	R50C1
	JMS	TABOP
	LAC*	OWA	/GET DATA WORD
	AND	S37777	/15 BITS ADDRESS
	JMS	OCTPNT	/OUTPUT
	-1		/5 DIGIT FIELD
	JMP	LC3A
/CODE 23 .END
LC23	XCT	PRESW	/DO NOT ATTEMPT TO WRITE ENDCOM IF
	JMP	NULL+1	/PRELIST HAS CLOSED LISTING DEVICE
	JMP	PLC23
/CODE 25
LC25	LAC*	LWA	/IS CODE 25 A .EBREL?
	SAD	K1
	JMP*	LCR	/YES DO NOT ATTEMPT TO LIST IT
	JMS	BLKLST	/OUTPUT PROGRAM NAME
	.DSA	APROG
	JMS	NAMPR
	JMP	LC3A
APROG	.+1
	-4
	.ASCII	'PROG NAME '
/CODE 26
LC26	JMS	BLKLST	/OUTPUT '.OTV'
	.DSA	AOTV
LC26A	JMS	TABOP
	LAC	TEMP0	/OUTPUT 15 BIT DISPLACEMENT
	AND	S37777
	JMS	OCTPNT
	-1
	JMP	LC3A	/EXIT
/CODE 27
LC27	JMS	BLKLST	/OUTPUT 'ETV'
	.DSA	A.ETV
	JMP	LC9A
/CODE 28
LC28	JMS	TWOSP
	JMS	DETL
	JMP	PLC28
	XCT	PLC49
	AREAL
	JMP	PLC30
/CODE29
LC29	JMS	TWOSP
	JMS	DETL
	JMP	PLC29
	XCT	PLC50
	AINTEG
	JMP	PLC30
/CODE 31
LC31	JMS	TWOSP
	JMS	DETL
	JMP	PLC31
	XCT	PLC52
	ASTRNG
	JMP	PLC30
/CODE 35
LC35	JMS	TWOSP
	JMS	DETL
	JMP	PLC35
	XCT	PLC56
	ASWTCH
	JMP	PLC30
/CODE 39
LC39	JMS	TWOSP
	JMS	DETL
	JMP	PLC39
	XCT	PLC44
	AOWN
	JMP	PLC30
/
DETL	XX		/ENTRY
	ISZ	SECOND
	JMP*	DETL
	LAW	-2
	DAC	SECOND
	ISZ	DETL
	JMP*	DETL
/CODE 33
LC33	JMS	SYDEC	/OP FIELD
	JMS	TABOP
LC33B	JMS	BLKLST	/"REAL"
	.DSA	AREAL
LC33A	JMS	DISPOP	/OUTPUT DISPLACEMENT
	JMP	LC3A	/EXIT
/CODE 34
LC34	JMS	SYDEC
	JMS	TABOP
LC34A	JMS	BLKLST	/"INTEG"
	.DSA	AINTEG
	JMP	LC33A
/CODE 36
LC36	JMS	SYDEC
	JMS	TABOP
LC36A	JMS	BLKLST	/"STRING"
	.DSA	ASTRNG
	JMP	LC33A
/CODE 40
LC40	JMS	SYDEC
	JMS	TABOP
LC40A	JMS	BLKLST	/"SWTCH"
	.DSA	ASWTCH
	JMP	LC33A
/CODE 41
LC41	JMS	TABOP
	JMS	ADDOCT
	JMP	LC3A
/CODE 37
LC37	DZM	OCTPAR
	LAC*	LWA
	DAC	TEMP0
	LAC	SRTCD	/IS THIS A STRING?
	SZA
	JMP	LC37E	/YES
	LAC	RLCD	/IS THIS A REAL?
	SNA
	JMP	.+3	/NO
	ISZ	TWOWD	/ONLY SIGN AND ZERO SUPRESS EXPT
	JMP	LC37E
	LAC	TEMP0
	AND	W00000
	SAD	W00000	/-VE ?
	JMP	LC37C	/YES
LC37D	LAC	Z00000
	CLL
	DAC	TEMP1
LC37A	LAC	TEMP1	/DETERMINE AMMOUNT OF ZERO SUPPN
	SAD	S00007	/ALWAYS PRINT LS CHAR
	JMP	LC37F
	AND	TEMP0
	SZA
	JMP	LC37B	/COMPLETED
	LAC	TEMP1
	RTR
	RAR
	DAC	TEMP1
	ISZ	LZCT
	JMP	LC37A
LC37B	LAW	-1
	TAD	LZCT
	CMA
	DAC	OCTPAR
LC37E	LAC	TEMP0
	JMS	OCTPNT
OCTPAR	0
	DZM	SIGN
	DZM	LZCT
	LAC	TWOWD
	SAD	C2
	LAW	-1
	DAC	TWOWD
	JMP	LC3A	/EXIT
LC37C	LAC	MINUS
	DAC	SIGN
	LAW	-1
	TAD	TEMP0
	CMA
	DAC	TEMP0
	JMP	LC37D
LC37F	LAW	-5
	DAC	OCTPAR
	JMP	LC37E
/CODE 43
LC43	JMS	TWOSP	/OUTPUT SYMBOL IN TAB FIELD
	LAC	R507	/OUTPUT 3 CHARS IN TAB FIELD
	AND	T77777
	JMS	R50C1
	LAC	R507
	SMA
	JMP	LC43A
	LAC	R508	/OUTPUT 3 CHARS
	JMS	R50C1
LC43A	LAC	EQUALS	/=
	JMS	PAK57
	LAC	DOT	/.
	JMS	PAK57
	JMP	LC3A
/CODE 38
LC38	JMS	SYDEC	/OP CODE
	JMS	TABOP
LC38A	DZM	LC
	LAC*	OWA
	DAC	TEMP0
	LAC*	STKADD
	DAC*	LWA
	JMS	PRISA
	LAC	TEMP0
	DAC*	OWA
	LAC*	STKADD
	AND	T77777
	JMS	R50C1	/OUTPUT 3 CHARS
	LAC*	STKADD
	SMA
	JMP	.+5
	ISZ	STKADD
	LAC*	STKADD
	AND	T77777
	JMS	R50C1	/OUTPUT 3 CHARS
	JMP	LC3A
/CODE 44
LC44	JMS	SYDEC
	JMS	TABOP
LC44A	JMS	BLKLST	/"OWN"
	.DSA	AOWN
	JMP	LC33A
/CODE 46
LC46	JMS	TWOSP
	JMS	BLKLST
	ABEGIN
LC46A	JMS	TABOP
	LAC*	OWA
	JMS	OCTPNT
	-2
	JMP	LC3A
ABEGIN	.+1
	-4
	.ASCII	!'BEGIN'!
/CODE 47
LC47	JMS	TWOSP
	JMS	BLKLST
	AENDB
	JMP	LC46A
AENDB	.+1
	-2
	.ASCII	!'END'!
/
TWOSP	XX
	LAC	SPACE
	JMS	PAK57
	LAC	SPACE
	JMS	PAK57
	JMP*	TWOSP
/ROUTINE TO CREATE SYMBOLIC OPCODES
SYDEC	XX		/ENTRY
	LAC*	OWA	/GET INSTRUCTION WORD
	AND	Z60000	/OP CODE BITS
	SAD	Z60000	/LAW INSTRUCTION ?
	JMP	SYDEC5	/YES
	DAC	OPFLD
	AND	Z00000
	SAD	Z00000	/OPERATE INSTRUCTION?
	JMP	SYDEC2	/YES
	LAC	OPFLD	/NO,MEM REF INSTRUCTION
	SNA
	JMP	SYDEC1
	RCL
	RTL
	RTL
	TAD	OPTAB	/USE OP FIELD BITS TO CALCULATE
	DAC	POPTAB	/ENTRY INTO RADIX 50 SYMBOL TABLE
	GLK
	DAC	INDFLG	/SET INDIRECT FLAG
	LAC*	POPTAB	/GET SYMBOL IN R50
	JMS	R50C1	/OUTPUT SYMBOL
	LAC	INDFLG
	SNA		/INDIRECT INSTRUCTION?
	JMP	SYDEC1	/NO
	LAC	STAR	/YES,OUTPUT*
	JMS	PAK57
SYDEC1	JMP*	SYDEC	/EXIT
/CODE TO INTERPRET OPERATE INSTRUCTIONS
SYDEC2	LAC	OPTAB1	/SET POINTER TO RADIX 50 TABLE
	DAC	POPTAB	/FOR OPERATE INSTRUCTIONS
SYDEC3	LAC*	OWA	/GET INSTRUCTION WORD
	SAD*	POPTAB	/MATCH WITH TABLE IF POSSIBLE
	JMP	SYDEC4	/MATCH FOUND?
	ISZ	POPTAB	/INC POINTER IF NO MATCH
	LAC	POPTAB
	SAD	OPTEND	/END OF TABLE
	JMP	SYDEC7	/YES,NO MATCH IN TABLE
	JMP	SYDEC3	/NO,TRY NEXT MATCH
SYDEC4	LAC	POPTAB	/MOVE POINTER TO EQUIV
	TAD	C30	/ENTRY IN EXECUTE TABLE
	DAC	POPTAB
	LAC*	POPTAB
	SPA
	XCT*	POPTAB
	JMS	R50C1	/OUTPUT SYMBOL
	JMP	SYDEC1	/EXIT
/CODE TO INTERPRET LAW INSTRUCTIONS
SYDEC5	LAC	SLAW	/OUTPUT LAW
	JMS	R50C1
	JMS	TABOP
	LAC*	OWA
	AND	S10000	/ -VE CONSTANT ?
	SNA
	JMP	SYDEC6	/NO
	LAC	MINUS	/OUTPUT MINUS
	DAC	SIGN
	LAW	-1
	TAD*	OWA	/NEGATIVE SO COMPLEMENT
	CMA
	SKP
SYDEC6	LAC*	OWA
	JMS	OCTPNT
	-2		/OUTPUT 4 DIGIT CONSTANT
	JMP*	SYDEC
/CODE TO OUTPUT NOP+ NNNNN WHEN NO MATCH IN OPERATE TABLE
SYDEC7	LAC	SNOP
	JMS	R50C1	/OUTPUT NOP
	JMS	TABOP
	LAC	PLUS
	DAC	SIGN	/+
	LAC*	OWA
	XOR*	OPTAB1
	JMS	OCTPNT	/OUTPUT NNNNN
	-1
	JMP*	SYDEC
/CODE TO OUTPUT DEFINED SYMBOLS IN OPERATE GROUP
SYCOM1	XX		/ENTRY
	LAC	SCLC
	JMS	R50C1	/OUTPUT 'CLC'
	JMP*	SYCOM1
SYCOM2	XX		/ENTRY
	LAC	SSPA
	JMS	R50C1	/OUTPUT "SPA"
	JMP*	SYCOM2
SYCOM3	XX
	LAC	SSZA
	JMS	R50C1	/OUTPUT "SZA"
	JMP*	SYCOM3
SYCOM4	XX
	LAC	SSNA
	JMS	R50C1	/OUTPUT "SNA"
	JMP*	SYCOM4
SYCOM5	XX
	LAC	SSMA
	JMS	R50C1	/OUTPUT "SMA"
	JMP*	SYCOM5
SYCOM6	XX		/ENTRY
	LAC	EXPT
	JMS	PAK57	/OUTPUT "!"
	JMP*	SYCOM6
/ROUTINES TO OUTPUT SYMBOLIC COMBINATIONS IN OPERATE GROUP
SYCOP1	JMS	SYCOM1
	JMS	SYCOM6	/OUTPUT "CLC!SPA!SNA!"
	JMS	SYCOM2
	JMS	SYCOM6
	JMS	SYCOM4
	JMP	LC3A	/EXIT
SYCOP2	JMS	SYCOM1
	JMS	SYCOM6	/OUPUT "CLC!SZA"
	JMS	SYCOM3
	JMP	LC3A	/EXIT
SYCOP3	JMS	SYCOM1
	JMS	SYCOM6	/OUPUT"XLX!SMA"
	JMS	SYCOM5
	JMP	LC3A	/EXIT
SYCOP4	JMS	SYCOM1
	JMS	SYCOM6	/OUTPUT "CLC!SPA"
	JMS	SYCOM2
	JMP	LC3A	/EXIT
SYCOP5	JMS	SYCOM1
	JMS	SYCOM6	/OUTPUT "CLC!SNA"
	JMS	SYCOM4
	JMP	LC3A	/EXIT
SYCOP6	JMS	SYCOM1
	JMS	SYCOM6	/OUTPUT "CLC!SMA!SZA"
	JMS	SYCOM5
	JMS	SYCOM6
	JMS	SYCOM3
	JMP	LC3A	/EXIT
OPTAB	.+1		/RADIX 50 MEM REF SYMBOLS
	11364		/CAL
	14453		/DAC
	40233		/JMS
	16435		/DZM
	45453		/LAC
	114152		/XOR
	3344		/ADD
	76454		/TAD
	113214		/XCT
	35522		/ISZ
	4164		/AND
	73354		/SAD
	40230		/JMP
OPTAB1	.+1		/MATCH TABLE FOR OPERATE GROUP
	740000		/NOP
	740001		/CMA
	740002		/CML
	740010		/RAL
	740020		/RAR
	740040		/XX
	740100		/SMA
	740200		/SZA
	740400		/SNL
	741000		/SKP
	741100		/SPA
	741200		/SNA
	741400		/SZL
	742010		/RTL
	742020		/RTR
	744000		/CLL
	744002		/STL
	744010		/RCL
	744020		/RCR
	750000		/CLA
	750001		/CLC
	750010		/GLK
	760000		/LAW
	750101		/CLC!SMA
	750201		/CLC!SZA
	750301		/CLC!SMA!SZA
	751101		/CLC!SPA
	751201		/CLC!SNA
	751301		/CLC!SPA!SNA
OPTEND	.
/RADIX TABLE FOR OPERATE INSTRUCTIONS
SNOP	60122
SCMA	12311
SCML	12324
SRAL	70264
SRAR	70272
SXX	114700
SSMA	74311
SSZA	75321
SSNL	74374
SSKP	74210
SSPA	74501
SSNA	74361
SSZL	75334
SRTL	71654
SRTR	71662
SCLL	12254
SSTL	74754
SRCL	70404
SRCR	70412
SCLA	12241
SCLC	12243
SGLK	26653
SLAW	45477
/ROUTINES TO OUTPUT COMBINED INSTRUCTIONS
	JMP	SYCOP3	/CLC!SMA
	JMP	SYCOP2	/CLC!SZA
	JMP	SYCOP6	/CLC!SMA!SZA
	JMP	SYCOP4	/CLC!SPA
	JMP	SYCOP5	/CLC!SNA
	JMP	SYCOP1	/CLC!SPA!SNA
/CODE TO OUTPUT ADDRESS FIELD IN OCTAL
ADDOCT	XX		/ENTRY
	LAC*	OWA	/INITIALISATION
	AND	S17777	/ADDRESS FIELD
	JMS	OCTPNT	/OUTPUT IT
	-1		/5 DIGIT FIELD
	JMP*	ADDOCT
/CODE TO OUTPUT DISPLACEMENT IN STACK
DISPOP	XX		/ENTRY
	LAC	MINUS	/OUTPUT - SIGN
	DAC	SIGN
	LAC	TEMP1	/INPUT WORD
	AND	S07777	/12 BIT -VE DISPLACEMENT
	XOR	Z70000
	CMA
	TAD	C1
	JMS	OCTPNT	/OUTPUT DISPLACEMENT
	-2		/4 DIGIT FIELD
	JMP*	DISPOP	/EXIT
/ROUTINE TO OUTPUT $ BEFORE STACK DISPLACEMENT
OPDOLL	LAC	DOLLAR	/$
	JMS	PAK57
	JMP*	PROJMP	/TO SYMBOLIC ROUTINES
/ROUTINE TO OUTPUT NAMES FROM RADIX 50
/AND PUT NAME ON NAME STACK
NAMPR	XX		/ENTRY
	LAC	R507	/GET 1ST HALF
	AND	W00000
	DAC	TWOWD	/POSSIBLE TWO WORDS
	LAC	R507
	AND	T77777
	JMS	R50C1	/OUTPUT 1ST HALF
	LAC	TWOWD
	SMA
	JMP	NAMPR1
	LAC	R508	/GET 2ND HALF
	JMS	R50C1	/OUTPUT 2ND HALF
NAMPR1	JMP*	NAMPR	/EXIT
/ROUTINE TO CONVERT LOADER CODES INTO SYMBOLIC
/REPRESENTATION AS WORD TYPE
/A=ABSOLUTE INSTRUCTION
/R=RELOCATABLE INSTRUCTION 13 BIT ADDRESS
/B=RELOCATABLE 15 BIT ADDRESS
/E=EXTERNAL REFERENCE
/C=CONSTANT
CDCON	LAC	OLC	/GET LOADER CODE
	TAD	CTABST	/SET POINTER INTO TABLE
	DAC	CDABPT
	XCT*	CDABPT	/PICK UP CHAR FOR O/P
	JMS	PAK57	/OUTPUT IT
	JMP	LCR3	/RETURN
CTABST	.		/TABLE OF CHARS
	SKP		/1
	SKP		/2
	LAC	R	/3
	LAC	A	/4
	LAC	B	/5
	LAC	R	/6
	SKP		/7
	SKP		/8
	LAC	E	/9
	LAC	R	/10
	LAC	A	/11
	LAC	A	/12
	SKP		/13
	SKP		/14
	SKP		/15
	SKP		/16
	SKP		/17
	SKP		/18
	LAC	B	/19
	SKP		/20
	SKP		/21
	LAC	A	/22
	LAC	A	/23
	SKP		/24
	SKP		/25
	SKP		/26
	SKP		/27
	SKP		/28
	SKP		/29
	SKP		/30
	SKP		/31
	SKP		/32
	LAC	R	/33
	LAC	R	/34
	SKP		/35
	LAC	R	/36
	SKP		/37
	LAC	R	/38
	LAC	CEE	/39
	LAC	R	/40
	LAC	R	/41
	SKP		/42
	SKP		/43
	LAC	R	/44
	SKP		/45
	SKP		/46
	SKP		/47
	SKP		/48
	LAC	B	/49
	LAC	B	/50
	SKP		/51
	LAC	B	/52
	SKP		/53
	LAC	B	/54
	SKP		/55
	LAC	B	/56
	LAC	B	/57
	SKP		/58
	SKP		/59
	LAC	E	/60
	SKP		/61
	SKP		/62
	SKP		/63
/CONSTANTS AND NAMED VARIABLES
BLKADR	0		/STARTING BLOCK PASS 1
BDFLG	0		/BLOCK DATA FLAG
BLKADD	0		/ASCII BLOCK ADDRESS FOR OUTPUT
BLKCT	0		/COUNT OF 4 WORD BLOCKS
BWDCT	0		/NO OF WORDS IN ASCII BLOCK FOR O/P
CDABPT	0		/CODE CONVERSION POINTER
COMSZE	0		/BLOCK COMMON SIZE
CHAR	0		/CHARACTER FOR PAK57
CHARCT	0		/CHARACTER COUNT FOR PAK57
CHAR1	0		/1ST CHAR FROM R50 WORD
CHAR2	0		/2ND CHAR FROM R50 WORD
CLOC	0		/CURRENT VALUE OF .LOC
CHSUM	40		/CHECKSUM BIT MASK FOR READ
DIGIT	0		/DIGIT FOR OUTPUT
DIGCT	0		/DIGIT COUNT FOR OCTAL PRINT
DD	0		/DISCARDED DIGIT COUNT
DNESW	0		/TRANSFER DONE SWITCH FOR MOVIN
EOF	5		/EOF MASK FOR READ
EOM	6		/EOM MASK FOR READ
GNMPTR	0		/GLOBAL NAME LIST POINTER
INDFLG	0		/INDIRECT INSTRUCTION FLAG
INTEG	0		/SOURCE WORD FOR DECPT
LC	0		/INCOMING LOADER CODE
LCWA	0		/POINTER TO LOADER CODE WORD
LDCNT	0		/WORD COUNT FOR MOVIN
LDPTR	0		/POINTER FOR MOVIN
LDZERO	0		/LEADING ZERO SUPPRESSION
LNCT	0		/LINE COUNT
LPNTR	0		/POINTER FOR FILE NAME CONVERSION
LSTPTR	0		/POINTER FOR LIST BUFFER
LWA	0		/ADDRESS OF NEXT WORD FOR PROCESS
LZCT	0		/LEADING ZERO COUNT FOR OCTPNT
MODBTS	17		/MASK FOR MODE BITS AFTER READ
NUM	0		/STORE R50 FOR CONVERSION
OCTWD	0		/SOURCE WORD FOR OCTPNT
OLC	0		/LOADER CODE FOR OUTPUT
OPPTR	0		/POINTER FOR OUTPUT BUFFER
OPFLD	0		/STORE FOR INSTRUCTION OP FIELD
OWA	0		/ADDRESS OF OUTPUT DATA WORD
PAR	20		/MASK FOR INPUT ERROR
PGCT	0		/PAGE COUNT
PH4ST	RSTRT		/RESTART ADDRESS COMPILER
PLA	0		/LOAD ADDRESS FOR LISTING
POPTAB	0		/POINTER TO SYMBOLIC R50 TABLE
PROJMP	0		/ENTRY POINTER TO JUMP TABLE
RBSZE	0		/RETURN BUFFER SIZE FROM .INIT
RLCD	0		/REAL MARKER
R507	0		/STORE FOR CODE 7 WORD
R508	0		/STORE FOR CODE 8 WORD
R50CT	0		/COUNT FOR R50 CONVERSION
SAVAC	0		/ACCUMULATOR SAVE
SECOND	-2		/TWO WORD FLAG FOR CODES 26 &27
SCOM02	102		/SCOM+2
SHTLN	60		/SHORT LINE MARK
SIGN	0		/STORE FOR OUTPUT OF MINUS
SP00	0
SP01	0
SP02	0
SP03	0
SP04	0
SRTCD	0		/STRING MARKER
STKADD	0		/STACK ADDRESS
SUBPTR	0		/POINTER FOR INTEGER CONV
SUBTST	TEN5		/INITIAL ADDRESS FOR SUBPTR
TABENT	0		/ENTRY INTO DRIVE TABLE
TEMP	-2		/TEMP STORE,INITIALLY -2 FOR BANK INIT
TEMP0	0		/    ..    ..
TEMP1	0		/   ..     ..    ..
TEMP2	0		/   ..    ..    ..
TWOWD	0		/INDICATES 2 WORDS FOR R50 SYMBOL
VALBTS	60		/VALIDITY BITS MASK
WPCBTS	377000		/W.P.C. BITS MASK
CODE23	27
/ASCII PRINTING CHARACTERS
ALTMOD	175
CARRET	015
FFD	014
TAB	011
ZERO	60
SPACE	40
PLUS	53	/+
MINUS	55	/-
EQUALS	75	/=
DOT	56	/.
HASH	43	/#
PCENT	45	/%
DOLLAR	44	/$
COMMA	47	/,
STAR	52	/*
EXPT	41	/!
A	101	/A
B	102	/B
CEE	103	/C
E	105	/E
R	122	/R
/LOGICAL CONSTANTS
S00007	7
S00010	10
S00015	15
S00016	16
S00017	17
S00020	20
S00033	33
S00034	34
S00040	40
S00047	47
S00073	73
S00077	77
S00100	100
S00102	102
S00116	116
S00117	117
S00137	137
S00140	140
S00175	175
S00177	177
S00377	377
S00700	700
S00777	777
S01000	1000
S03100	3100
S07777	7777
S10000	10000
S17777	17777
S37777	37777
S04000	4000
S60000	60000
S77777	77777
T77777	177777
U60000	260000
V77000	377000
X77777	577777
Z00000	700000
Z17777	717777
Z40000	740000
Z60000	760000
Z70000	770000
Z77000	777000
Z76776	776776
Z70001	770001
Z77700	777700
W00000	400000
/ARITHMETIC CONSTANTS
	.DEC
C1	1
C2	2
C3	3
C4	4
C5	5
C7	7
C8	8
C9	9
C10	10
C11	11
C13	13
C14	14
C19	19
C21	21
C22	22
	.IFDEF	PDP15
C25	25
	.ENDC
C27	27
C29	29
C30	30
C48	48
C52	52
C63	63
C72	72
C128	128
K1	-1
K2	-2
K3	-3
K4	-4
K5	-5
K14	-14
K15	-15
K26	-26
K28	-28
K29	-29
K39	-39
K48	-48
	.OCT
/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
	.EJECT
/TCA
/ROUTINE TO TWO'S COMPLEMENT THE AC
TCA	XX
	CMA
	TAD	C1
	JMP*	TCA
	.EJECT
	.IFUND	%S3
	.GLOBL AAINBA,LISTAK,SIZE
 
/RCOMST
/START PROGRAM:READ COMMAND STRING AND SET UP CONTROL DATA
	.IODEV -2,-3
RCOMST	XX
START	.INIT -3,1,START		/TTA OUTPUT
	.INIT -2,0,START		/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	CHARX	/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	START	/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	CHARX	/)IN CHAR
	LAC*	SP02	/FILENAME WORD
	RTL		/SHIFTED LEFT
	RTL		/AND NEXT CHAR
	RTL		/PACKED IN
	AND	Z77700
	TAD	CHARX
	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
CHARX	0
CR	LAW	777377	/MARK'RETURN TO MONITOR'
	AND*	AOPTW
	DAC*	AOPTW
ALTM	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
 
 
	.IODEV	2
REST	.INIT	RESTS,0,REST
	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*	SP01
	ISZ*	SP01
	DAC	SP04	/HOLD ADDR OF WORD HOLDING ADDR STAT TABLE
	DAC	STATIN
	IDX	STATIN	/ADDR OF STAT TABLE AFTER RESTORE
/	.SEEK	RESTS,RESTFN
	CAL+RESTS
	3
RESTFN	0
	LAW	773777
	AND*	AOPTW	/HOLD ALL OPTIONS EXCEPT 'I'
	DAC	SP02
	LAC	(21000
	DAC	SP03	/HOLD ADDR OF TOP OF CORE
/	READ	RESTS,4,RESTCN,4	/READ OPTIONS,FILENAME & EXTN
	CAL+4000+RESTS
	10
RESTCN	0
	-4
	LAC	K26
	DAC	RESTL	/LENGTH OF STAT TABLE
	LAC*	SP01
	DAC	RESTCA	/ADDR OF STAT TABLE
REST1	.WAIT	RESTS
/	.READ	RESTS,4,RESTCA,RESTL	/READ STAT TABLE,THEN STACKS
	CAL+4000+RESTS
	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	S04000	/HOLD 'I' OPTION FROM OPTIONS RESTORED
	XOR	SP02	/INSERT OPTIONS READ IN COMMAND STRING
	DAC*	AOPTW
	JMS	COPY	/)MOVE STAT TABLE NOW CREATED
STATIN	XX		/)INTO PROGRAM AREA
AINBA	INBASE
	33
	LAC	AINBA	/)UPDATE ADDR OF STAT TABLE
	DAC*	SP04	/)AT BOTTOM OF CORE
	LAC	OUTP
	DAC	ICBASE	/)MAKE PREVIOUS PASS OUTPUT
	LAC	OUBASE	/)INPUT FOR THIS PASS
	DAC	INCODE
	LAC*	S00102	/REINITIALISE OUT SK
	AND	S77777
	TAD	C72
	DAC	OUTP
	TAD	K39
	DAC	OUBASE
	JMS*	LISTAK
	JMP*	RCOMST
	.ENDC
/CONSTANTS LOCAL TO ABOVE CODE
AOPTW	0
AUTO=10
AUTO1=11
AUTO2=12
AUTO3=13
AXW	0
INCODE=INCORD
SIZE	0
AAINBA	INBASE-1
 
COPYCT	XX
COPYSC	XX
COPYSV	XX
IDX=ISZ
LVM	XX
PUT	XX
VTOA	XX
	XX
RESTS=2
/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*	BLKADR	/MAKE ABSOLUTE
	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
/DMP
/CODE TO DUMP COMPILER DATA ONTO DATSLOT DMPS=-13 IN DUMP MODE.
/ACTIVATED BY ^T (BUT ONLY WHEN DUMP OPTION REQUESTED).
 
DMP	.INIT	DMPS,1,DMP
	LAC*	S00102	/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	/)
	ISZ	DMPFN+2	/INCREMENT EXTENSION
	.ENTER	DMPS,DMPFN
	LAC	AINBA
	TAD	K2
	DAC	DMP92
	LAC	K15
	DAC	DMP91	/CT FOR #WRITES
	DAC	DMP90
	ISZ	DMP90	/CT FOR #SKS
DMP02	LAC*	DMP92	/BASE
	CMA		/-B-1
	ISZ	DMP92
	TAD*	DMP92	/PTR-B-1(-#WDS ON SK)
	DAC*	17
	LAC*	DMP92	/PTR
	DAC*	17
	ISZ	DMP92
	ISZ	DMP90	/END OF STAT TABLE?
	JMP	DMP02	/NO, LOOP
	LAC	K28
	DAC	DMPL
/	.WRITE
DMP04	CAL+4000	DMPS&777
	11
DMPCA	0
DMPL	0
	LAC*	DMP93
	DAC	DMPL	/SET LENGTH OF SK IN .WRITE
	ISZ	DMP93
	LAC*	DMP93
	DAC	DMPCA	/SET UP ADDR OF SK
	ISZ	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
DDTP	.BLOCK	40	/DDT PATCH AREA
	.END