	.TITLE PDP9-15 ALGOL COMPILER PASS4	8 FEB 71  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
	.IFUND	%SY
	.IODEV -2,-3,-11,-12,-13
	.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
	.ENDC
	.ENDM
	.IFDEF	%S4
	.LOC %S4
	.ENDC
ERRBK     JMS       .         /START ERROR MODULE
          LAC       ERRBK     /BY INITIALISING 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      /FINISH TABLE
          JMP       NXBKAD
NXTABL    LAC*      AUTO      /ADDR OF CORE 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      /INCREMENT COUNT OF TABLE
NXTENT    LAC*      AUTO1     /BANK INIT ALL ENTRIES
          AND       Z17777
          XOR       BANK
          DAC*      AUTO2
          ISZ       SP00      /END OF TABLE?
          JMP       NXTENT    /NO
          ISZ       BNCT      /END OF LIST OF TABLES?
          JMP       NXTABL    /NO
          .EJECT
	.INIT	-11,0,ERMOD
PAPER=.
	.BOS	INIT
	LAC	PAPER-1
	SAD	C52
	SKP
	JMP	INIT
	.INIT	-3,0,INIT
	.WRITE	-3,2,CONTR,4
	JMP	.
 
CONTR	2000
	0
	.ASCII /^P/<175>
INIT	.INIT -3,0,TESTOP
	.IFUND	%C4
ERMOD	JMS	RCOMST
	LAW	-1
	DAC	FIRST
	DZM	NUMMES
	LAC*	S00102	/ADDRESS OF OPTION WORD
	DAC	AOPTW	/HOLD
	JMS	INITB
	JMS	TOPT
	20000		/LISTING REQUIRED
	SKP		/YES
	JMP	ERRM3	/NO
	.INIT DATOUT,1,ERMOD
	LAC	S02766	/CHANGE DATSLOT FOR OUTPUT
	DAC	PAGEHD+11
	DAC	GNC00+5
	DAC	PNC03+1	/IN .WRITE
	DAC	GNC22-2
	DAC	FINAL+15
	LAC	S00766	/CHANGE DATSLOT
	DAC	PNC03+5	/IN .WAIT
	DAC	GNC22+2
	DAC	FINAL+21
ERRM3	LAC*	S00102
	TAD	C1
	DAC	ERSEEK	/ADDRESS OF FILENAME & EXT FOR .SEEK
	DAC	GNC021-2
	JMP	.+5
	DAC	SP00	/EXT ADDRESS
	DAC*	S00010
	LAC*	AUTO
	DAC*	SP00	/EXT GIVEN IN COMMAND STRING
	LAC	INBASE
	DAC	INTEGR	/EMPTY INTEGER STACK,
	DAC	TEMBAS
	TAD	K400
	DAC	MOVEUP	/LIMIT OF TEMBAS
	LAC	STBASE
	DAC	STRING	/STRING STACK
	LAC	OWBASE	/INITIALISE ALL STACKS
	DAC	OWN
	LAC	SWBASE
	DAC	SWITCH	/EXCEPT OUT
	LAC	LABASE
	DAC	LABEL
	LAC	PRBASE	/AND VOCAB
	DAC	PROC
	LAC	RPBASE
	DAC	REVPOL
	LAC	DIBASE
	DAC	DICT
	LAC	POBASE
	DAC	POLISH
	LAC	WKBASE	/WORK STACK
	DAC	WORK
	LAC	EMBASE
	DAC	EMSTK	/AND ERROR MESSAGE STACK
/	.SEEK DATIN,ERSEEK
	CAL DATIN&777
	3
ERSEEK	0
	JMS	TOPT
	200000
	SKP
	JMP	BEGIN
	LAC	AOPTW
	TAD	C1
	DAC	SP00
	DAC	INSEEK
	DAC	INDLET
	LAC	SP00
	TAD	C2
	DAC	SP00
	LAC	A01
	DAC*	SP00
	.INIT -13,0,ERMOD
	/.SEEK -13,INSEEK
	CAL -13&777
	3
INSEEK	0
	ISZ	INFO
	JMS	READ
	.ENDC
	.EJECT
	.IFDEF	%C4
ERMOD	LAC*	S00102
	DAC	AOPTW
	TAD	C3
	DAC	AXW	/ADDRESS OF EXT
	TAD	C1
	DAC	SYMB	/ADDRESS OF ORIGINAL EXT
	TAD	C1
	DAC	STATIN	/ADDR OF WORD HOLDING ADDRESS OF STATS TABLE
	LAW	-1
	DAC	FIRST
	JMS	COPY	/COPY STATS TABLE FROM
STATIN	XX		/BOTTOM OF CORE INTO
AINBA	INBASE		/PROGRAM AREA
	32
	LAC	OUT
	TAD	K3
	DAC	BLKADD
	LAC*	AXW	/PRESERVE INT CODE EXT FOR .DLETE
	DAC	COPY
	LAC*	S00102
	TAD	C1
	DAC	INSEEK
	DAC	ERSEEK
	DAC	INDLET
	JMS	INITB
	JMS	TOPT
	400		/INTERMEDIATE CODE?
	SKP
	JMP	NOINT
	.INIT -13,0,ERMOD
	/.SEEK -13,INSEEK
	CAL -13&777
	3
INSEEK	0
	ISZ	INFO
	JMS	READ
NOINT	LAC*	SYMB
	DAC*	AXW
	/.SEEK DATIN,ERSEEK
	CAL DATIN&777
	3
ERSEEK	0
	JMS	TOPT
	200000		/LISTING REQUIRED?
	SKP		/YES
	JMP	ERRM3
	.INIT DATOUT,1,ERMOD
	LAC	ERREXT	/PUT EXT ERR IN LISTING FILENAME
	DAC*	AXW
ENTER	.ENTER	DATOUT,ERSEEK
	LAC	S02766	/CHANGE DATSLOT
	DAC	PAGEHD+11
	DAC	GNC00+5	/FOR OUTPUT
	DAC	PNC03+1
	DAC	GNC22-2	/IN .WRITE
	DAC	TESTOP-6
	LAC	S00766	/CHANGE DATSLOT
	DAC	PNC03+5
	DAC	GNC22+2	/FOR OUTPUT IN .WAIT
	DAC	TESTOP-2	/CHANGE DATSLOT IN .CLOSE
	LAC	COPY	/INT CODE EXT FOR .DLETE
	DAC*	AXW
ERRM3	LAC	INBASE
	DAC	INTEGR
	DAC	TEMBAS
	TAD	K400
	DAC	MOVEUP	/LIMIT OF TEMBAS
	LAC	STBASE
	DAC	STRING
	LAC	OWBASE
	DAC	OWN
	LAC	SWBASE
	DAC	SWITCH
	LAC	LABASE
	DAC	LABEL
	LAC	PRBASE
	DAC	PROC
	LAC	RPBASE
	DAC	REVPOL
	LAC	DIBASE
	DAC	DICT
	LAC	POBASE
	DAC	POLISH
	LAC	WKBASE
	DAC	WORK
	LAC	EMBASE
	DAC	EMSTK
	.ENDC
	.EJECT
BEGIN	JMS	PACKFN	/OUTPUT PAGE HEADINGS
	JMS	PAGEHD	/FILENAME&PAGE NUMBER
	LAC	C1
	DAC	STACK
ERRM0	LAC	OUT
	SAD	OUBASE	/OUT STACK EMPTY?
	JMP	FINAL	/YES,NOMORE ERROR MESSAGES
	JMS	MEDIAT
	DAC	ERROR	/HOLD ERROR NUMBER
	SNA		/IF ZERO WORD
	JMP	FINAL	/THEN END OF ERROR MESSAGES
	AND	S00777
	TAD	K49
	SMA		/PHASE1 ERROR?
	JMP	ERRM13	/NO
	LAC	ERROR	/PHASE 1 ERROR NUMBER
ERRM10	JMS	PUTI	/ONTO INTEGER STACK
	AND	S10000
	SZA		/TYPE 1 ERROR?
	LAC	C1	/YES 1 MORE WORD IN ERROR MESSAGE
	TAD	K2	/NO,2 MORE WORDS TO ERROR MESSAGE
	DAC	SP05	/HOLD NUMBER OF WORDS TO COPY
	JMS	MEDIAT	/FROM INTERMEDIATE CODE
	JMS	PUTI	/OR OUT STACK TO
	ISZ	SP05	/INTEGER STACK
	JMP	.-3
	ISZ	STACK
	LAC	STACK
	SAD	C101	/100 SUCCESSIVE PHASE1 ERRORS STACKED?
	SKP		/YES
	JMP	ERRM0	/NO GET NEXT ERROR MESSAGE
	LAW	-50
	DAC	PROCES	/PROCESS 1ST 50 OF STACKED ERRORS
	DZM	STACK
	JMS	PHASE1	/GET ERROR NUMBER AND
	JMS	PHLIN	/LINE & CHAR OF PHASE 1 ERROR
	JMP	ERRM7	/GO PROCESS ERROR
ERRM13	LAC	ERROR
	DAC	PH2ERR	/PHASE 2 ERROR NUMBER
	JMS	MEDIAT
	DAC	ERROR+1	/HOLD LINE & CHAR WORD
	AND	S03777
	DAC	PH2LIN	/LINE OF BEG OF PHASE2 ERROR
	LAC	C1
	DAC	STACK
ERRM1	LAC	TEMBAS
	SAD	INTEGR	/INTEGER STACK EMPTY?
	JMP	ERRM2	/YES
ERRM6	JMS	PHASE1
	JMS	PHLIN	/PH1LIN IN AC ON EXIT
	JMS	TCA
	TAD	PH2LIN
	SMA!SZA		/PH1LIN<PH2LIN?
	JMP	ERRM7	/YES
	SZA		/PH2LIN<PH1LIN?
	JMP	ERRM2	/YES
	LAC	ERROR
	AND	S10000
	SZA
	JMP	ERRM7
	LAC	PH11	/PH1LIN=PH2LIN
	JMS	TCA
	TAD	ERROR+1
	SPA		/PH1CHA<PH2CHA?
	JMP	ERRM2	/NO
ERRM7	LAC	PH1LIN
	SAD	PRINT	/ERROR LINE ALREADY PRINTED?
	JMP	.+10	/YES
	JMS	TCA
	TAD	PRINT
	SMA
	JMP	NEST1
	JMS	ERRMES	/NO,OUTPUT ERROR MESSAGES ALREADY PROCESSED
	LAC	PH1LIN
	JMS	CHECK	/PRINT SOURCE LINE IN ERROR
	JMS	PROPH1	/PROCESS STACKED ERROR
ERRM15	LAC*	OUT
	SNA		/END OF ERROR MESSAGES?
	JMP	FINAL	/YES
	LAC	TEMBAS
	SAD	INTEGR	/INTEGER STACK EMPTY?
	SKP		/YES
	JMP	ERRM14	/NO
	LAC	STACK
	SNA		/PHASE2 ERROR TO PROCESS?
	JMP	ERRM0-2	/NO
ERRM2	LAC	PH2LIN
	SAD	PRINT	/ERROR LINE ALREADY PRINTED?
	JMP	.+10	/YES
	JMS	TCA
	TAD	PRINT
	SMA
	JMP	NEST2
	JMS	ERRMES	/OUTPUT ERROR MESSAGES FROM EMSTK
	LAC	PH2LIN
	JMS	CHECK	/PRINT SOURCE LINE IN ERROR
	JMS	PROPH2	/PROCESS PHASE2 ERROR
	LAC	OUT
	SAD	OUBASE	/MORE ERROR MESSAGES?
	JMP	FINAL	/NO
ERRM8	JMS	MEDIAT	/GET NEXT ERROR NUMBER
	DAC	ERROR
	SNA		/END OF ERROR MESSAGES?
	JMP	FINAL	/YES
	AND	S00777
	TAD	K49
	SMA		/PHASE1 ERROR?
	JMP	.+3	/NO
	LAC	ERROR
	JMP	ERRM10	/STACK PHASE 1 ERROR
	JMS	MEDIAT
	DAC	TEMP	/LINE & CHAR WORD
	SAD	ERROR+1	/THIS LINE & CHAR =LAST?
	JMP	.+5	/YES
	LAC	ERROR	/NO,PROCESS THIS ERROR
	DAC	PH2ERR
	LAC	TEMP
	JMP	ERRM13+3
	LAC	ERROR
	AND	S04000
	SZA		/TYPE 4 ERROR?
	LAW	-1	/YES 3 MORE WORDS TO COPY
	TAD	K1	/NO 2 MORE WORDS TO COPY
	DAC	SHIFT
	LAC	ERROR	/COPY ERROR
	JMS	PUTEM
	LAC	ERROR+1	/MESSAGE TO
	JMS	PUTEM
	JMS	MEDIAT	/ERROR MESSAGE
	JMS	PUTEM
	ISZ	SHIFT	/STACK
	JMP	.-3
	JMP	ERRM8
ERRM14	LAC	STACK	/INTEGER STACK NOT EMPTY
	SNA		/PH2 ERROR TO BE PROCESSED?
	SKP		/NO
	JMP	ERRM6	/YES
	ISZ	PROCES	/50 SUCCESSIVE PHASE1 ERRORS PROCESSED?
	JMP	.+4
	LAC	C51	/YES
	DAC	STACK
	JMP	ERRM0	/GET NEXT FROM WORK
	JMS	PHASE1	/GET NEXT PHASE1 ERROR FROM INTEGER
	SAD	PH11	/THIS LINE&CHAR=LAST?
	JMP	.+3	/YES
ERRM4	JMS	PHLIN	/NO
	JMP	ERRM7	/PROCESS THIS ERROR
	LAC	ERROR
	AND	S10000
	SNA!CLA		/TYPE 1 ERROR?
	LAC	C1	/NO 3 WORDS IN MESSAGE
	TAD	C2	/YES 2 WORDS IN MESSAGE
	DAC	SHIFT
	SAD	C2	/IF ERROR IS TYPE 1 THERE
	JMP	ERRM5	/IS NO 2ND LINE & CHAR WORD
	LAC	TEMBAS
	TAD	K3
	DAC	TEMP
	LAC*	TEMP	/2ND LINE & CHAR WORD OF NEXT ERROR
	SAD	PH1END	/=2ND LINE & CHAR WORD OF CURRENT ERROR?
	SKP
	JMP	ERRM4	/NO
	LAC	SHIFT	/YES
ERRM5	JMS	TCA
	TAD	TEMBAS	/COPY MESSAGE FROM INTEGER STACK 
	DAC	TEMP	/TO ERROR MESSAGE STACK
	DAC	TEMBAS
	JMS	MOVEIN	/TEST IF TEMBAS BELOW LIMIT
	JMS	COPYIT
	JMP	ERRM15	/GET NEXT ERROR MESSAGE
FINAL	LAC	TEMBAS
	SAD	INTEGR	/ANY PHASE 1 ERROR STILL TO BE PROCESSED?
	SKP	/NO
	JMP	ERRM13-3	/YES JUMP TO PROCESS THEM
	JMS	ERRMES
	LAC	NUMMES	/NUMBER OF ERRORS
	JMS	BDEC	/CONVERT TO DECIMAL
	JMS	DLZ
	DAC	LB01
	LAC	NUM3+1
	XOR	S04672
	DAC	LB01+1
	.WRITE	-3,2,LB3,8
	.WAIT -3
	.WRITE -3,2,LB3,6
	.CLOSE	-3
TESTOP	NOP
	.IFDEF	%C4
	JMS	TOPT
	1000
	JMP	MONIT	/ALTMODE-RETURN TO MONITOR
CONTRP=.
	.IFUND	DOS
	JMS	OLAY	/RECALL PASS1
	%B1		/OVERLAY WITH PASS1
	%C1-1
	-%L1
	%S1
	.ENDC
	.ENDC
	.OVLAY	ALGOL@
MONIT	NOP
	.EXIT
/
ERREXT	.SIXBT	"ERR"	/EXT ERR FOR ERROR FILE
NEST1	LAC	ERROR
	AND	S10000
	SNA
	JMP	.+5
	LAC	C2
	DAC	SHIFT
	JMS	TCA
	JMP	NEST11+1
	LAC	C3
	DAC	SHIFT
	LAC	PH10
	TAD	K1
	DAC	PH10
	LAC*	PH10
	DAC	PH1END	/2ND LINE & CHAR WORD
	AND	S03777	/OF TYPE 2 ERROR
	DAC	END	/END OF ELEMENT LINE NUMBER
	SAD	PRINT	/ALREADY PRINTED?
	JMP	.+5	/YES
	JMS	TCA
	TAD	PRINT
	SMA
	JMP	NEST11
	JMS	SOURCE	/NO,READ AND PRINT SOURCE
	LAC	PH1END
	JMS	PAKCHA
	51		/PACK ) INTO INDICATOR BUFFER
	LAC	DEPOS
	DAC	LAST
	JMS	CARRET
NEST11	LAW	-3
	TAD	TEMBAS
	DAC	TEMP
	DAC	TEMBAS	/COPY ERROR MESSAGE FROM
	JMS	MOVEIN	/INTEGER STACK
	JMS	COPYIT	/TO EMSTK
	JMP	ERRM15
NEST2	JMS	MEDIAT
	DAC	ERROR+2	/2ND LINE & CHAR WORD OF
	AND	S03777	/TYPE 3 OR 4 ERROR
	DAC	END	/END OF ELEMENT LINE
	SAD	PRINT	/NUMBER ALREADY PRINTED
	JMP	.+5
	JMS	TCA
	TAD	PRINT
	SMA
	JMP	NEST21
	JMS	SOURCE	/NO,READ AND PRINT SOURCE
	LAC	ERROR+2
	JMS	PAKCHA
	51		/PACK ) INTO INDICATOR BUFFER
	LAC	DEPOS
	DAC	LAST
	JMS	CARRET
NEST21	LAC	PH2ERR	/COPY MESSAGE
	JMS	PUTEM
	LAC	ERROR+1	/TO EMSTK
	JMS	PUTEM
	LAC	ERROR+2
	JMS	PUTEM
	LAC	PH2ERR
	AND	S04000	/TYPE 4 ERROR ?
	SNA		/YES
	JMP	ERRM8-3	/NO,RETURN
	JMS	MEDIAT	/COPY 4TH WORD FROM
	JMS	PUTEM	/OUT TO EMSTK
	JMP	ERRM8-3
 
INBUF	0
	0
	.BLOCK 50
BUFPT	INBUF+1
 
A01	.SIXBT /A01/
 
LB3	6/2*1000
	0
	.ASCII /EOP4(/
LB01	0
	0
 
PTCH	.BLOCK 60
	.EJECT
	.IFDEF	%C4
/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
	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 -1
	DAC*	C9	/INTO AUTO INDEX 11
	TAD	C21
	DAC	SP01	/PUT IN JMP ADDRESS FOR
	TAD	C2	/JMS TO BOOTSTRAP
	DAC	SP02
	LAC*	AUTO	/GET BLOCK NO
	TAD*	BLKADD
	DAC	SP00	/STORE
	AND	S07777	/AND OFF SIGN BIT
	DAC*	AUTO1	/PUT INTO BOOTSTRAP
	LAC*	AUTO	/TRANSFER CORE ADDR-1
	DAC*	AUTO1
	LAC*	AUTO	/TRANSFER WORD COUNT
	DAC*	AUTO1
	LAC*	AUTO1	/MOVE AUTO INDEX 11
	LAC*	AUTO1	/TO NEXT REQD LOCN IN BOOTSTRAP-1
	LAC	S21000	/UNIT NUMBER 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
	.IFUND	PDP15
JMP.T1	247
	.ENDC
	.IFDEF	PDP15
JMP.T1	253
	.ENDC
	.ENDC
	.ENDC
	.EJECT
PROPH1	XX
	LAC	ERROR
	AND	S10000
	SNA		/TYPE 1 ERROR?
	JMP	PROP02	/NO
	LAC	C2	/YES
	DAC	SHIFT	/2 WORDS IN ERROR MESSAGE
	LAC	PH11	/LINE&CHAR
	JMS	PAKCHA
	136		/PACK ^ INTO LINE BUFFER
	LAC	DEPOS
	DAC	START
	DAC	LAST
	JMS	CARRET
PROP04	LAC	SHIFT	/NUMBER OF WORDS TO COPY
	JMS	TCA	/FROM INTEGER TO EMSTK
	TAD	TEMBAS
	DAC	TEMP
	DAC	TEMBAS
	JMS	MOVEIN
	JMS	COPYIT	/TRANSFER ERROR MESSAGE
	JMP*	PROPH1	/EXIT
PROP02	LAC	C3	/TYPE 2 ERROR
	DAC	SHIFT	/3 WORDS TO ERROR MESSAGE
	LAC	PH11
	JMS	PAKCHA	/PACK ( INTO LINE BUFFER
	50		/FOR BEG OF ELEMENT IN ERROR
	LAC	DEPOS
	DAC	START
	JMS	CARRET
	LAC	PH10
	TAD	K1
	DAC	PH10
	LAC*	PH10	/GET END OF ELEMENT LINE&CHAR
	DAC	PH1END
	AND	S03777	/END OF ELEMENT LINE NUMBER
	SAD	PH1LIN	/BEG=END?
	JMP	PROP06	/YES
	JMS	SOURCE
PROP06	LAC*	PH10
	SAD	PH11	/CHAR POSITIONS SAME FOR BEG AND END?
	JMP	PROP07	/YES
	JMS	PAKCHA
	51	/PACK ) FOR END OF ELEMENT
          LAC       DEPOS
          DAC       LAST
	JMS	CARRET
	JMP	PROP04
PROP07	LAC	START
	SAD	LAST	/SYMBOL ALREADY PACKED INTO THIS POSITION?
	JMP	PROP04	/YES,NO FURTHER PACKING
	DAC	LAST
	DAC	.+3
	LAC	S00126	/SINCE CHAR POSITION SAME FOR BEGINNING
	JMS	PC	/AND END
	XX		/CONVERT SYMBOL ALREADY PACKED
	JMP	PROP04	/FROM ( TO ^
	.EJECT
PROPH2	XX
	LAC	ERROR+1
	JMS	PAKCHA
	50	/PACK ( INTO LINE BUFFER
	LAC	DEPOS
	DAC	START
	JMS	CARRET
	JMS	MEDIAT
	DAC	ERROR+2	/END OF ELEMENT LINE&CHAR
	AND	S03777
	SAD	PH2LIN	/END=BEG?
	JMP	CURR02	/YES
	JMS	SOURCE
CURR02	LAC	ERROR+2
	SAD	ERROR+1	/BEG OF EL CHAR = END OF EL CHAR?
	JMP	CURR01	/YES
	JMS	PAKCHA
	51	/PACK ) FOR END OF ELEMENT
          LAC       DEPOS
          DAC       LAST
	JMS	CARRET
	LAC	PH2ERR	/TRANSFER
	JMS	PUTEM
	LAC	ERROR+1	/ERROR MESSAGE
	JMS	PUTEM
	LAC	ERROR+2	/TO EMSTK
	JMS	PUTEM
	LAC	PH2ERR
	AND	S04000
	SNA		/TYPE 4 ERROR?
	JMP*	PROPH2	/NO
	JMS	MEDIAT	/YES,COPY 4TH WORD
	JMS	PUTEM	/FROM OUT TO EMSTK
	JMP*	PROPH2
CURR01	LAC	START	/SYMBOL ALREADY PACKED
	SAD	LAST	/INTO THIS CHAR POSITION?
	JMP	CURR02+7
	DAC	LAST
	DAC	.+3
	LAC	S00126
	JMS	PC	/CONVERT SYMBOL ALREADY PACKED
	XX		/FROM ( TO ^
	JMP	CURR02+7
	.EJECT
 
 
 
 
SOURCE	XX
	TAD	K1
	DAC	END	/END OF ELEMENT LINE-1
	JMS	ERRMES	/OUTPUT ERROR MESSAGES FOR THIS LINE
	ISZ	LIST	
	LAC	LCT1
	SAD	END	/THIS LINE ALREADY READ?
	JMP	.+3	/YES
	JMS	GNC	/NO, PRINT CURRENT SOURCE LINE
	JMP	.-4	/AND RETEST
	TAD	C1
	DAC	PRINT	/PRINT=ERROR LINE
	JMS	GNC	/PRINT ERROR LINE
	JMP*	SOURCE	/EXIT
	.EJECT
ERRMES	XX
	LAC	CRPOS
	TAD	C1
	DAC	.+3
	LAC	S00015
	JMS	PC
	XX
MESS0	JMS	ERROUT
	SAD	EMSTK	/ERROR MESSAGE STACK EMPTY?
	JMP	ENDMES	/YES
	ISZ	NUMMES	/INCREMENT NO OF ERROR LINES
	LAC	ERRCON
	ISZ	BW
	DAC*	BW	/**E INTO BUFFER
	ISZ	BW
	LAC	ERRCON+1
	DAC*	BW
	ISZ	BW
	JMS	GETERR
	DAC	TEMP	/HOLD
	AND	S00777
	DAC	ERRNO	/HOLD ERROR NUMBER
	JMS	PAKERR	/PACK ERROR NUMBER INTO BUFFER
	LAC	TEMP
	AND	S14000
	DAC	TYPE	/B5 SET=TYPE1,B6 SET=TYPE4
	SAD	S04000	/TYPE 4 ERROR?
	LAW	-1	/YES 3 MORE WORDS TO MESSAGE
	SAD	S10000	/TYPE 1 ERROR?
	LAC	C1	/YES 1 MORE WORD TO MESSAGE
	TAD	K3	/TYPE 2 OR 3 ,2 MORE WORDS
	DAC	TEMP05
	LAC	TEMPEM
AGAIN	DAC	TEMP02	/ADDRESS OF CURRENT ERROR NUMBER
	TAD	TEMP05
	DAC	TEMP03	/ADDRESS OF NEXT ERROR NUMBER
	TAD	TEMP05
	DAC	TEMP04	/ADDRESS OF THIRD ERROR NUMBER
SUPP	LAC*	TEMP03
	SAD	TEMP	/NEXT ERROR NUMBER = CURRENT
	SKP		/YES
	JMP	MESS1-12	/NO
	LAW	-1
	TAD	TEMP02
	DAC	TEMP02
	LAC*	TEMP02	/2ND WORD OF CURRENT ERROR MESSAGE
	DAC	TEMP
	LAW	-1
	TAD	TEMP03
	DAC	TEMP03	/ADDRESS OF 1ST LINE & CHAR OF NEXT MESSAGE
	SAD	TEMP04	/=ADDRESS OF 3RD ERROR NUMBER
	SKP		/YES
	JMP	SUPP	/NO
	LAC	TEMP05	/NEXT ERROR MESSAGE=CURRENT
	JMS	TCA	/SO SET POINTER ON ERROR
	TAD	ERRCT	/MESSAGE STACK TO
	DAC	ERRCT	/NEXT ERROR MESSAGE
	LAC	TEMP02
	JMP	AGAIN
	JMS	LINCHA	/PACK LINE NUMBER
	DAC	LINE+1	/AND
	LAC	TEMP
	DAC	LINE	/CHARACTER POSITION
	JMS	PACK	/INTO BUFFER
	DAC	FINCHA	/LAST WORD PACKED
	LAC	TYPE
	SAD	S10000	/TYPE 1 ERROR?
	SKP		/YES
	JMP	.+5	/NO
MESS1	LAC	FINCHA
	AND	Z77400	/CONVERT LAST CHAR TO NULL
	DAC*	BW	/AND PACK INTO BUFFER
	JMP	MESS3	/GET ASCII TEXT
	JMS	LINCHA
	DAC	TEMP05
	SAD	LINE+1	/THIS CHAR POSITION =LAST?
	SKP		/YES
	JMP	DIFF	/NO
	LAC	TEMP	/YES
	SAD	LINE	/THIS LINE NUMBER=LAST
	JMP	SAME	/YES
DIFF	LAC	TEMP05	/NO
	DAC	LINE+1
	LAC	TEMP
	DAC	LINE
        LAC       FINCHA
	XOR	S00112
	DAC*	BW
	ISZ	BW
	JMS	PACK	/PACK THIS LINE & CHAR
	SKP
SAME	LAC	FINCHA
	AND	Z77400
	DAC*	BW
	LAC	TYPE
	SAD	S04000	/TYPE 4 ERROR?
	SKP		/YES
	JMP	MESS3	/GET ASCII TEXT
	LAC	ERRNO
	SAD	C69	/ERROR NUMBER =69?
	JMP	MESS2	/YES GET -(NUMBER OF PARAMETER IN ERROR)
	JMS	GETERR	/NO,GET 4TH WORD OF ERROR
	DAC	TEMP
	SPA		/OPCODE?
	JMP	MESS6	/YES
	LAC	S00057
	JMS	PNC
	JMS	LVM	/NO
	M*1+TEMP		/GET FIRST WORD OF NAME
	DAC	NAME
	AND	V77777	/CLEAR SIGN BIT
	JMS	FIVE7	/PACK RADIX 50 NAME IN 5/7 ASCII
	LAC	NAME
	RAL
	SNL		/ANOTHER WORD FOR NAME?
	JMP	MESS4	/NO
	JMS	LVM
	M*2+TEMP
	DAC	NAME	/PACK SECOND WORD OF NAME
	JMS	FIVE7
	CLA
	JMS	PNC
MESS8	CLA
	JMS	PNC	/2 NULLS PACKED
MESS4	LAC	S00057	/FOLLOWED BY /
	JMS	PNC
	JMP	MESS3	/GET ASCII TEST
MESS2	JMS	GETERR
	JMS	TCA		/-NUMBER OF PARAMETER IN ERROR
	AND	S00077	/NUMBER OF PARAMETER IN ERROR
	ISZ	BW
	JMS	BDEC	/CONVERT TO DECIMAL
	JMS	DLZ
	XOR	U74000	/CONVERT NULL TO /
	DAC*	BW
	LAC	NUM3+1
	XOR	S07400	/CONVERT 2 SPACES TO /NULL
	ISZ	BW
	DAC*	BW
	JMP	MESS3	/GET ASCII TEXT
MESS6	CLL
	AND	S07700	/GET OPCODE
	JMS	MES	/TO BOTTOM
	JMP	R-6	/6 BITS OF WORD
	TAD	ATABLE	/ADD ADDRESS OF TABLE
	DAC	TEMP	/ADDRESS OF OPCODE
	LAC*	TEMP
	DAC	ADDR	/ADDR OF ASCII TEXT FOR OPCODE
	SMA!CLA		/IF SIGN BIT NOT SET IN ADDRESS
	LAC	C2	/THEN 2 WORDS IN TEXT
	TAD	K4	/OTHERWISE 4 WORDS
	DAC	SP05
MESS7	LAC*	ADDR	/TRANSFER ASCII TEXT
	DAC*	BW	/INTO LINE BUFFER
	ISZ	ADDR
	ISZ	BW
	ISZ	SP05
	JMP	MESS7	/LOOP
MESS3	ISZ	BW
	LAC	ERRNO
	TAD	AERTAB	/ADD ADDRESS OF ERROR TABLE
	DAC	ADDR
	LAC*	ADDR	/ADDRESS OF ASCII TEXT FOR THIS ERROR
	DAC	TEMP
	JMS	COPY
	M*4+TEMP		/COPY ERROR TEXT
	M*4+BW		/TO LINE BUFFER
	30
	LAC	S00015
	JMS	PC
	150
	JMP	MESS0
ENDMES	LAC	EMBASE
	DAC	EMSTK	/RE-INITIALISE EMSTK
	DZM	ERRCT
	DZM	START
        DZM       LAST
	DZM	CRPOS
	DZM	DEPOS
	LAC	S00015
	JMS	PC
	1
	JMP*	ERRMES
 
 
/GETERR
/ROUTINE TO GET NEXT WORD FROM ERROR MESSAGE STACK
GETERR	XX
	JMS	ERROUT
	TAD	K1
	DAC	TEMPEM	/ADDRESS OF NEXT WORD TO BE RPOCESSED
	LAC*	TEMPEM
	ISZ	ERRCT
	JMP*	GETERR
 
 
/ERROUT
/ROUTINE TO CALCULATE ADDR OF NEXT WORD ON ERROR MESSAGE STACK
ERROUT	XX
	LAC	ERRCT	/NUMBER OF WORDS ON EMSTK ALREADY PROCESSED
	JMS	TCA
	TAD	EMBASE	/SUBTRACT FROM BASE ADDRESS
	JMP*	ERROUT	/ADDRESS OF LAST WORD PROCESSED IS IN AC ON EXIT
/CHECK
CARRET	XX
	JMS	TCA
	TAD	CRPOS
	SMA
	JMP*	CARRET
	LAC	DEPOS
	DAC	CRPOS
	JMP*	CARRET
	.EJECT
/ROUTINE TO GET,FROM SOURCE,THE LINE
/SPECIFIED IN THE ERROR MESSAGE
CHECK	XX
	TAD	K1
	DAC	TEMP	/LINE NUMBER
CHEK01	SAD	LCT1	/ERROR LINE ALREADY READ?
	JMP	CHEK02	/YES
	DZM	LIST	/NO,READ SOURCE
	ISZ	FIRST	/FIRST TIME GNC CALLED?
	JMP	.+3	/NO
	JMS	GNC00	/YES
	SKP
	JMS	GNC	/WITHOUT PRINTING
	LAC	TEMP	/LOAD ERROR LINE
	JMP	CHEK01	/AND LOOP
CHEK02	ISZ	LIST
	TAD	C1
	DAC	PRINT	/PRINT=ERROR LINE
	ISZ	FIRST
	JMP	.+3
	JMS	GNC00
	JMP*	CHECK
	JMS	GNC	/PRINT THIS LINE
	JMP*	CHECK	/EXIT
 
/PAKCHA
/ROUTINE TO GET CHAR POSITION FROM LINE+CHAR WORD
/AND OUTPUT CHAR GIVEN AS PARAMETER TO THIS ROUTINE
/INTO THIS POSITION
 
 
PAKCHA	XX
	AND	Z74000	/CHAR POSITION
	CLL
	JMS	MES	/GET CHAR POSITION
	JMP	L-10	/TO BOTTOM 7 BITS
	TAD	K1
	DAC	DEPOS
	DAC	PAKC04+1
	SAD	START	/THIS CHAR POSITION ALREADY PACKED?
	JMP	.+6	/YES EXIT
          SAD       LAST	/THIS CHAR POSITION ALREADY PACKED?
          JMP       .+4	/YES EXIT
	LAC*	PAKCHA	/SYMBOL TO BE PACKED
PAKC04	JMS	PC
	XX
	ISZ	PAKCHA
	JMP*	PAKCHA
	.EJECT
 
 
/PAKERR
/ROUTINE TO PACK THE ERROR NUMBER INTO THE OUTPUT
/BUFFER
PAKERR	XX
	JMS	BDEC	/CONVERT ERROR NUMBER TO DECIMAL
	AND	S03777	/CONVERT FIRST CHAR TO NULL
	DAC*	BW
	ISZ	BW
	LAC	NUM3+1
	XOR	S00020	/CONVERT LAST CHAR TO (
	DAC*	BW
	ISZ	BW
	JMP*	PAKERR
 
 
/LINCHA
/ROUTINE TO PUT LINE NUMBER IN TEMP AND CHAR POS INTO
/AC ON EXIT FROM LINE&CHAR WORD
 
LINCHA	XX
	JMS	GETERR
	DAC	BEG
	AND	S03777	/LINE NUMBER
	DAC	TEMP
	LAC	BEG
	CLL
	AND	Z74000
	JMS	MES
	JMP	L-10	/CHAR POSITION TO BOTTOM 7 BITS
	JMP*	LINCHA
 
 
/PHASE1
/ROUTINE TO GET ERROR NUMBER AND LINE&CHAR WORD
/OF PHASE1 ERROR FROM INTEGER STACK
/
 
PHASE1	XX
	LAW	-1
	TAD	TEMBAS
	DAC	PH10        /ADDRESS OF ERROR NUMBER
	LAC*	PH10
	DAC	ERROR
	LAW	-1
	TAD	PH10
	DAC	PH10        /ADDRESS OF LINE AND CHAR WORD
	LAC*	PH10
	JMP*	PHASE1
	.EJECT
 
 
 
/PHLIN
/ROUTINE TO MASK LINE NUMBER FROM LINE AND CHAR
/WORD AND HOLD IN PHLIN
 
PHLIN	XX
	DAC	PH11        /LINE & CHAR WORD
	AND	S03777
	DAC	PH1LIN        /PHASE 1 ERROR LINE NUMBER
	JMP*	PHLIN
MEDIAT	XX
	LAC	INFO
	SZA		/INTERMEDIATE CODE FILE?
	JMP	.+3	/YES
	JMS	TAKEO	/NO,GET NEXT WORD FROM OUT
	JMP*	MEDIAT	/EXIT
	LAC*	AUTO4	/INTERMEDIATE CODE FILE
	DAC	TEMP	/NEXT WORD IN FILE
	ISZ	WORDCT
	LAC	WORDCT
	SAD	C40	/COMPLETE BUFFER NOW READ?
	JMS	READ	/YES
	LAC	TEMP	/NO
	JMP*	MEDIAT
	.EJECT
 
 
/READ
/ROUTINE TO READ BUFFER FROM INTERMEDIATE CODE
READ	XX
	.READ -13,0,INBUF,42
	.WAIT -13
	DZM	WORDCT
	LAC	INBUF
	AND	S00077
	SAD	C5	/END OF FILE?
	JMP	ENDINT	/YES
	SZA		/READ ERROR?
	JMP	REDERR	/YES
	LAC	BUFPT	/NO,SET AUTO INDEX 12 TO
	DAC*	C12	/START OF BUFFER
	JMP*	READ
ENDINT	DZM	INFO
	/.DLETE -13,INDLET        /DELETE INTERMEDIATE CODE FILE
	CAL*1000 -13&777
	2
INDLET	0
	.CLOSE -13
	JMP*	READ
REDERR	.WRITE -3,2,LB4,8        /OUTPUT ERROR MESSAGE
	.WAIT -3
	JMP	TESTOP        /RETURN TO ALGOL OR MONITOR
 
LB4	10/2*2000
	0
	.ASCII /READ ERROR/<15>
	.EJECT
/XR50 EXPAND AC(IN RADIX 50 FORMAT) INTO 3
/RADIX 50 CHARS
XR50	XX
	DZM	R50.1
	DZM	R50.2
	DZM	R50.3
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
 
/R50SEV
/ROUTINE TO CONVERT RADIX 50 CHAR TO 6 BIT AND
/THEN TO 7 BIT
/
R50SEV	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
	JMS	R507BT
	JMP*	R50SEV	/EXIT
 
 
FIVE7	XX
	JMS	XR50
	LAC	R50.1
	JMS	R50SEV
	LAC	R50.2
	JMS	R50SEV
	LAC	R50.3
	JMS	R50SEV
	JMP*	FIVE7
 
 
 
R507BT	XX
	TAD	S00040
	XOR	S00140	/CONVERT FROM 6 BIT TO 7 BIT
	JMS	PNC	/PACK CHAR 5/7 ASCII
	JMP*	R507BT
	.EJECT
PUT	XX
	DAC	SP00	/HOLD AC
PUT01	LAC*	PUT	/LOAD ADDR OF STACK POINTER
	AND	S77777
	DAC	STLIM
	DAC	PTRADD
	LAC*	STLIM	/LOAD STACK POINTER
	TAD	K1	/DECREMENT STACK POINTER
	DAC	STWDAD	/HOLD
	ISZ	STLIM	/STLIM:=ADDR OF STACK LIMIT
	SAD*	STLIM
	JMP	MOVE
	DAC*	PTRADD	/INSERT NEW POINTER IN STAT.TABLE
PUT02	LAC	SP00	/LOAD WORD TO BE STACKED
	DAC*	STWDAD	/PUT ON STACK
PUT03	LAC	SP00
	ISZ	PUT
	JMP*	PUT
/PUTEM
/PUT CONTENTS OF AC ONTO ERROR MESSAGE STACK	/HOLD ERROR NUMBER
/	/ADDRESS OF BASE
PUTEM	XX
	JMS	PUT	/ADDRESS OF LINE & CHAR
	.DSA	EMSTK
	JMP*	PUTEM
 
 
/PUTI
/PUT CONTENTS OF AC ONTO INTEGER STACK
/
PUTI	XX
	JMS	PUT
	.DSA	INTEGR
	JMP*	PUTI
 
 
/TAKEO
/GET NEXT WORD FROM OUT STACK
TAKEO	XX
	LAC*	OUT
	ISZ	OUT
	JMP*	TAKEO
 
 
COPYIT	XX
	JMS	COPY
	0		/COPY ERROR
	M*1+EMSTK		/MESSAGE FROM
	M*4+SHIFT		/INTEGER
	JMS	EVA	/STACK
	EMBASE		/TO ERROR
	XOR	U00000	/MESSAGE STACK
	DAC	.+3
	JMS	COPY
	M*4+TEMP
	XX
	M*4+SHIFT
	JMP*	COPYIT
	.EJECT
/PACKFN-PACK FILENAME FROM COMMAND STRING FROM
/6 BIT INTO 5/7 ASCII
/PHLIN
/
PACKFN	XX
	LAW	-3
	DAC	PACKCT
	LAC	S60000
	JMS	PAK5.7	/PACK FORM FEED
	LAC*	S00102
	DAC	TEMP	/ADDR OF FILENAME WORD
	ISZ	TEMP
PACK02	LAC*	TEMP	/1ST WORD OF FILENAME
	DAC	TEMP1
PACK04	JMS	CHARAC
	LAC	CT1
	SAD	C4	/5 CHARS PACKED 5/7?
	JMP	PACK03	/YES
	ISZ	PACKCT	/NO,3 CHARS UNPACKED FROM TEMP
	JMP	PACK04	/NO,LOOP
	ISZ	TEMP	/YES,SET TO NEXT WORD OF FILENAME
	LAW	-3	/RESET UNPACKING COUNT TO -3
	DAC	PACKCT
	JMP	PACK02	/LOOP
PACK03	LAC	TEMPFN+1	/PACK FILENAME
	RCL		/)AND FILENM+1
	DAC	FILENM+1	/)WITH 5*7 BIT ASCII
	LAC	TEMPFN+2	/)CHARS
	RAL
	DAC	FILENM
	DZM	TEMPFN+1	/PAIR TO 0
	ISZ	PACKCT
PACK06	JMS	CHARAC
	ISZ	PACKCT	/REMAINING 2 CHARS PACKED?
	JMP	PACK06	/NO,LOOP
	LAC	TEMPFN+1
	RTL
	RTL
	DAC	FILENM+2
	JMP*	PACKFN
 
/CHARAC
/ROUTINE TO CONVERT 6 BIT TO 5/7 PACKED
/
CHARAC	XX
	LAC	TEMP1
	AND	Z70000	/GET TOP 6 BITS
	SNA
	JMP	CHAR01	/YES
	CLL!RAR
	TAD	U00000	/CONVERT FROM 6  BIT
	XOR	Y00000	/TO 7 BIT
CHAR01	JMS	PAK5.7
	ISZ	CT1	/INCREMENT CHAR COUNT
	LAC	TEMP1
	JMS	MES	/SHIFT NEXT CHAR OF FILENAME
	JMP	L-6	/TO TOP 6 BITS
	DAC	TEMP1
	JMP*	CHARAC
 
/PAK5.7
/ROUTINE TO PACK 5/7 ASCII
/
PAK5.7	XX
	DAC	TEMPFN
	LAW	-7
	DAC	TEMP2	/COUNT FOR 7 BIT PACK
PAK01	LAC	TEMPFN
	RAL
	DAC	TEMPFN
	LAC	TEMPFN+1
	RAL
	DAC	TEMPFN+1
	LAC	TEMPFN+2
	RAL
	DAC	TEMPFN+2
	ISZ	TEMP2	/7 BITS PACKED?
	JMP	PAK01	/NO,LOOP
	JMP*	PAK5.7	/YES,LOOP
	.EJECT
/PNC	JDS	18SEPT1969
/PUT NEXT CHAR INTO OUTPUT BUFFER
/CALL:	CHAR RIGHT JUSTIFIED IN AC(PRESERVED BY ROUTINE)
/	JMS	PNC
/IF CHAR IS<CR>OR<ALTMODE>BUFFER IS OUTPUT & REINITIALISED
PNC	XX	
	DAC	CHAR	/PRESERVE AC
	XOR	S00040
	AND	S00177	/EXTRACT LS 7 BITS
	CLL		/CLEAR LINK
PNC01	XCT	WPPR	/)POSN CHAR ACCORDING TO WORD PAIR
	XOR*	BW	/)POSN & PACK INTO BUFFER
	DAC*	BW	/)WORD
	LAC	PNC01
	TAD	C1	/INCREMENT WORD PAIR COUNT
	SAD	EOWP	/END OF WORD PAIR?
	LAC	SOWP	/YES:START NEW WORD PAIR
	DAC	PNC01
	LAC	CHAR
	AND	S00177
	SAD	S00015	/CHAR=CR?
	JMP	FWP	/YES,OUTPUT BUFFER
	SAD	S00175	/CHAR=ALTMODE?
	JMP	FWP	/YES:OUTPUT BUFFER
PNC03	JMP	PNC02	/NO:EXIT
WRITE	.WRITE -3,2,LB1,52
	.WAIT -3
	ISZ	LCT
	LAC	LCT
	SAD	C56	/56 LINES PRINTED?
	JMS	PAGEHD	/YES,OUTPUT PAGE HEADINGS
	JMS	INITB	/REINITIALISE DOUBLE BUFFERS
PNC02	LAC	CHAR	/RESET AC
	JMP*	PNC	/EXIT
BW	XX		/BUFFER POSN ADDRESS
EOWP	XCT	WPPR+5
SOWP	XCT	WPPR
WPPR	JMP	WP1	/DO FIRST CHAR IN WORD PAIR
	JMP	WP2	/SECOND
	JMP	WP3	/THIRD
	JMP	WP4	/FOURTH
	RAL		/FIFTH
	JMP	PNC01+1
WP1	RTR		/FIRST CHAR :TO LH END OF AC
	RTR
WP31	ISZ	BW	/)2ND HALF OF 3RD CHAR IN WP  TO LH
	RTR		/) END OF AC
	RTR
	JMP	PNC01+1
WP4	RTL		/FOURTH CHAR:8 BITS TO LEFT
	RTL
WP2	RTL		/SECOND CHAR:4 BITS TO LEFT
	RTL
	JMP	PNC01+1
WP3	RTR		/THIRD CHAR MS 4 BITS TO
	RAR		/BOTTOM OF AC
	AND	C15
	XOR*	BW	/PACK INTO 1ST WORD OF WORD PAIR
	DAC*	BW
	LAC	CHAR
	AND	C7	/EXTRACT LS 3 BITS OF 3RD CHAR
	CLL
	JMP	WP31	/PACK TO TOP OF NEXT BW
/INITIALISE BUFFERS
/SWAPS BUFFERS AND CLEARS ONE TO BE FILLED
/USES AUTOINDEX 10
INITB	XX
	LAC	B1	/)ADDR OF BUFFER JUST FILLED
	DAC	TEMP01	/)&WRITTEN
	LAC	B2	/ADDR OF BUFFER TO FILL
	DAC	B1
	DAC*	S00010	/PUT IN AUTOINDEX 10
	DAC	WRITE+2	/& IN WRITE COMMAND
	LAC	TEMP01
	DAC	B2
	LAW	-62
	DAC	L01	/SET UP CLEAR COUNT
	LAC*	AUTO
	LAC*	S00010	/PUT THIS ADDR IN BW TO
	DAC	BW	/INITIALISE PNC
	LAC	W1
	DAC*	AUTO
	XOR	W2
	ISZ	L01
	JMP	.-3
	LAC	SOWP	/INITIALISE PNC TO PACK FIRST
	DAC	PNC01	/CHAR OF WORD PAIR
	JMP*	INITB
B1		LB1	/BUFFER ADDRESSES
B2		LB2	
LB1	32*1000		/TWO 52(DEC)WORD BUFFERS
	0
	.BLOCK 62
LB2	32*1000
	0
	.BLOCK 62
W1	201004
W2	221104
TEMP01=PNC01
L01=PNC01
AUTO=10
BWP	0
PP	0
FWP	LAC	SOWP	/IS WORD PAIR HOLDING <CR>
	SAD	PNC01	/COMPLETELY FILLED
	JMP	WRITE	/YES:OUTPUT
	CLA		/NO:APPEND NULL
	JMP	PNC01
/PACK CHAR TO SPECIFIED POSITION IN BUFFER
/CALL CHAR RIGHT JUSTIFIED IN AC
/	JMS	PC
/	+LP	/LP=LINE POSITION(0=1ST POSN IN LINE)
PC	XX
	DAC	CHAR
	LAC*	PC
	DZM	BWP
	TAD	K5
	ISZ	BWP
	SMA
	JMP	.-3
	DAC	PP
	TAD	EOWP
	DAC	PNC01
	LAC	BWP
	RAL!CLL
	TAD	B1
	TAD	K1
	DAC	BW
	LAC	PP
	TAD	C2
	SMA
	ISZ	BW
	TAD	C2
	SMA
	ISZ	BW
	ISZ	PC
	LAC	PC
	DAC	PNC
	LAC	CHAR
	JMP	PNC+2
	.EJECT
TABLE	0
LINE	0
	0
PH1LIN	0
PH2LIN	0
STACK	0
ERROR	0
	0
	0
PH2ERR	0
	ASS
	IF+A
	AND+A
	OR+A
	IMPL+A
	EQUIV+A
PROCES	0
	LT+A
	EQ+A
	LE+A
SHIFT	0
	GE+A
	NE+A
	GT+A
PH11	0	/LINE & CHAR WORD
PH10	0
PRINT	-1	/LINE IN ERROR
END	0
TEMP	0
BEG	0
ATABLE	TABLE
AERTAB	ERRTAB
	PLUS
	MINUS
	MULT
	DIV+A
	IDIV+A
	EXP
	.EJECT
 
ERRCON	.ASCII /**E/
ASS	.ASCII ?/:=/?
IF	.ASCII ?/'IF'/?
AND	.ASCII ?/'AND'/?
OR	.ASCII ?/'OR'/?
IMPL	.ASCII ?/'IMPL'/?
EQUIV	.ASCII ?/'EQUIV'/?
LT	.ASCII ?/'LT'/?
EQ	.ASCII ?/'EQ'/?
LE	.ASCII ?/'LE'/?
GE	.ASCII ?/'GE'/?
NE	.ASCII ?/'NE'/?
GT	.ASCII ?/'GT'/?
PLUS	.ASCII ?/+/?
MINUS	.ASCII ?/-/?
MULT	.ASCII ?/*/?
DIV	.ASCII ?/'DIV'/?
IDIV	.ASCII ?/'IDIV'/?
EXP	.ASCII ?/^/?
	.EJECT
ERRTAB	XX
	ERR1
	ERR2
	ERR3
	ERR4
	ERR5
	ERR6
	ERR7
	ERR8
	ERR9
	ERR10
	ERR11
	ERR12
	ERR13
	ERR14
	ERR15
	ERR16
	ERR17
	ERR18
	ERR19
	ERR20
	ERR21
	ERR22
	ERR23
	ERR24
	ERR25
	ERR26
	ERR27
	ERR28
	ERR29
	ERR30
	ERR31
	ERR32
	ERR33
	ERR34
	XX
	XX
	ERR37
	ERR38
	ERR39
	ERR40
	ERR41
	ERR42
	ERR43
	ERR44
	ERR45
	ERR46
	ERR47
	ERR48
	ERR49
	ERR50
	ERR51
	ERR52
	ERR53
	ERR54
	ERR55
	ERR56
	ERR57
	ERR58
	ERR59
	ERR60
	ERR61
	ERR62
	ERR63
	ERR64
	ERR65
	ERR66
	ERR67
	ERR68
	ERR69
	ERR70
	ERR71
	ERR72
	ERR73
	ERR74
	ERR75
	ERR76
	ERR77
	ERR78
	ERR79
	ERR80
	ERR81
	ERR82
	ERR83
	ERR84
	ERR85
	ERR86
	ERR87
	ERR88
	ERR89
	ERR90
	ERR91
	ERR92
	ERR93
	ERR94
	ERR95
	ERR96
	ERR97
	.EJECT
/STATISTICS TABLE
INBASE	XX
INTEGR	XX
EMBASE	XX
EMSTK	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
RPBASE	XX
REVPOL	XX
DIBASE	XX
DICT	XX
POBASE	XX
POLISH	XX
OUBASE	XX
OUT	XX
	.EJECT
ERR1	.ASCII /RESTART POINT AFTER ERROR/<15>
ERR2	.ASCII /INCORRECT DELIMITER TO ACTUAL PARAMETER/<15>
ERR3	.ASCII /CLOSING ] TO SUBSCRIPTED VARIABLE NOT FOUND/<15>
ERR4	.ASCII /PRIMARY NOT FOUND WHEN EXPECTED/<15>
ERR5	.ASCII /'THEN' NOT FOUND IN CONDITIONAL EXPRESSION/<15>
ERR6	.ASCII /'ELSE' NOT FOUND IN CONDITIONAL EXPRESSION/<15>
ERR7	.ASCII /PROC WITH PARAMETERS AS A LEFT PART OF ASS/<15>
ERR8	.ASCII /ELEMENT INVALID IN CONTEXT/<15>
ERR9	.ASCII /:= EXPECTED AFTER SUBSCRIPTED VARIABLE/<15>
ERR10	.ASCII /'THEN' NOT FOUND IN CONDITIONAL STATEMENT/<15>
ERR11	.ASCII /NO NAME FOLLOWING 'GOTO' OR IN A 'SWITCH' LIST/<15>
ERR12	.ASCII /NO NAME FOLLOWING 'SWITCH'/<15>
ERR13	.ASCII /'OWN' ARRAY BOUNDS NOT INTEGERS/<15>
ERR14	.ASCII /IDENTIFIER EXPECTED AND NOT FOUND/<15>
ERR15	.ASCII /CLOSING ) TO EXPRESSION NOT FOUND/<15>
ERR16	.ASCII /NO TYPE GIVEN AFTER 'OWN'/<15>
ERR17	.ASCII /NO [ IN ARRAY DECLARATION/<15>
ERR18	.ASCII /NO : IN BOUND PAIR LIST/<15>
ERR19	.ASCII /CLOSING ] TO BOUND PAIR LIST NOT FOUND/<15>
ERR20	.ASCII /NO NAME AFTER 'PROCEDURE'/<15>
ERR21	.ASCII /FORMAL PARAMETER NAME EXPECTED AND NOT FOUND/<15>
ERR22	.ASCII /INCORRECT DELIMITER TO FORMAL PARAMETER/<15>
ERR23	.ASCII /MORE CORE NEEDED FOR COMPILATION/<15>
ERR24	.ASCII /COMPILER ERROR/<15>
ERR25	.ASCII /NO CONTROLLED VARIABLE AFTER 'FOR'/<15>
ERR26	.ASCII /NO := IN 'FOR' CLAUSE/<15>
ERR27	.ASCII /'DO' EXPECTED AND NOT FOUND/<15>
ERR28	.ASCII /'UNTIL' NOT FOUND WHEN EXPECTED/<15>
ERR29	.ASCII /STACK OVERFLOW/<15>
ERR30	.ASCII /TOO MUCH PRE-SET PROCEDURE INFORMATION/<15>
ERR31	.ASCII /PARITY OR CHECKSUM ERROR OR BUFFER OVERFLOW/<15>
ERR32	.ASCII /ERROR IN 'DATSLOT' DIRECTIVE/<15>
ERR33	.ASCII /NO := AFTER NAME IN SWITCH DECLARATION /<15>
ERR34	.ASCII /END OF SOURCE BEFORE LOGICAL END OF PROGRAM/<15>
ERR37	.ASCII /INVALID KEYWORD/<15>
ERR38	.ASCII /INTEGER OUT OF RANGE/<15>
ERR39	.ASCII /DECIMAL POINT INVALID HERE/<15>
ERR40	.ASCII /@ INVALID HERE/<15>
ERR41	.ASCII /INVALID CHARACTER AFTER @/<15>
ERR42	.ASCII /NO DIGIT AFTER SIGN OF EXPONENT/<15>
ERR43	.ASCII /NO DIGIT AFTER DECIMAL POINT/<15>
ERR44	.ASCII /MORE THAN 15 DECIMAL DIGITS IN MANTISSA/<15>
ERR45	.ASCII /MORE THAN 2 DIGITS IN EXPONENT/<15>
ERR46	.ASCII /ILLEGAL CHAR BETWEEN !'S IN A STRING/<15>
ERR47	.ASCII /ILLEGAL CHARACTER FOUND AND IGNORED/<15>
ERR48	.ASCII /' FOUND IN COMMENT AFTER 'END'/<15>
ERR49	.ASCII /TOO MANY NAMES,PARAMETERS OR ARGUMENTS/<15>
ERR50	.ASCII /NAME REDECLARED AT SAME BLOCK LEVEL/<15>
ERR51	.ASCII /VARIABLE DECN : NAME IN USE AS LABEL/<15>
ERR52	.ASCII /LABEL DECN : NAME IN USE AS VARIABLE/<15>
ERR53	.ASCII /LABEL REF : NAME IN USE AS VARIABLE/<15>
ERR54	.ASCII /VARIABLE REF : NAME IN USE AS LABEL/<15>
ERR55	.ASCII /VARIABLE REF : NAME NOT DECLARED/<15>
ERR56	.ASCII /VARIABLE DECN : NAME ALREADY USED/<15>
ERR57	.ASCII /MORE THAN 31 NESTED PROCEDURES/<15>
ERR58	.ASCII /MORE THAN 62 NESTED BLOCKS WITHIN A PROC/<15>
ERR59	.ASCII /RUN-TIME SIZE OF PROCEDURE TOO LARGE/<15>
ERR60	.ASCII /ARRAY NAME NOT SUBSCRIPTED/<15>
ERR61	.ASCII /SUBSCRIPTED VARIABLE NOT AN ARRAY/<15>
ERR62	.ASCII /WRONG NUMBER OF SUBSCRIPTS/<15>
ERR63	.ASCII /NAME IN SPEC NOT A PARAMETER/<15>
ERR64	.ASCII /SPEC GIVES ILLEGAL FORMAL BY VALUE/<15>
ERR65	.ASCII /NAME IN VALUE PART NOT A PARAMETER/<15>
ERR66	.ASCII /SWITCH LIST MEMBER NOT A LABEL OR SWITCH CALL/<15>
ERR67	.ASCII /NAME IN PROC CALL NOT DECLARED AS PROC/<15>
ERR68	.ASCII /WRONG NUMBER OF PARAMETERS IN PROC CALL/<15>
ERR69	.ASCII /MISMATCH OF ACTUAL AND FORMAL PARAMS/<15>
ERR70	.ASCII /NAME NOT THAT OF A NO-TYPE PROC/<15>
ERR71	.ASCII /RIGHT-HAND ARG NOT INTEGER,REAL OR BOOLEAN/<15>
ERR72	.ASCII /ARGS TO 'IF' EXPRESSION OR ASS INCOMPATIBLE/<15>
ERR73	.ASCII /BOTH ARGS OF ARITH OR RELATIONAL OPERATOR BOOLEAN/<15>
ERR74	.ASCII /ARGS TO LOGICAL OPERATOR NOT BOTH BOOLEAN/<15>
ERR75	.ASCII /NON-INTEGER ARGUMENT(S) TO 'IDIV'/<15>
ERR76	.ASCII /LEFT-HAND ARG NOT INTEGER,REAL OR BOOLEAN/<15>
ERR77	.ASCII /ARITH OR RELATIONAL OPERATOR HAS ONE ARG BOOLEAN/<15>
ERR78	.ASCII /NO SPEC SUPPLIED TO FORMAL PARAMETER/<15>
ERR79	.ASCII /LHS OF ASS NOT INTEGER,REAL OR BOOLEAN/<15>
ERR80	.ASCII /LHS OF ASSIGNMENT AN ARRAY NAME/<15>
ERR81	.ASCII /ASSIGNMENT TO PROC NAME OUT OF SCOPE/<15>
ERR82	.ASCII /INCONSISTENT TYPES TO LHS'S OF MULTIPLE ASS/<15>
ERR83	.ASCII /CONTROLLED VAR IN FOR CLAUSE A PROC OR ARRAY NAME/<15>
ERR84	.ASCII /CONTROLLED VAR IN FOR CLAUSE NOT INT OR REAL/<15>
ERR85	.ASCII /'GOTO' EXPRESSION NOT A LABEL OR SWITCH CALL/<15>
ERR86	.ASCII /EXPRESSION NOT BOOLEAN WHEN EXPECTED/<15>
ERR87	.ASCII /EXPRESSION NOT ARITH WHEN EXPECTED/<15>
ERR88	.ASCII /LABEL NAME IN USE AS VAR IN OUTER BLOCK/<15>
ERR89	.ASCII /'OWN' ARRAY BOUNDS GIVE A NEGATIVE RANGE/<15>
ERR90	.ASCII /INVALID ELEMENT FOR PRE-SET PROC SOURCE/<15>
ERR91	.ASCII /'BEGIN' NOT FOUND AFTER 'DATSLOT' DIRECTIVE/<15>
ERR92	.ASCII /ELEMENT IGNORED AS INVALID HERE/<15>
ERR93	.ASCII /; NOT FOUND BEFORE THIS ELEMENT BUT ASSUMED/<15>
ERR94	.ASCII /LOGICAL END OF PROGRAM BEFORE END OF SOURCE/<15>
ERR95	.ASCII /PROC MODULE EXPECTED IF NO 'DATSLOT' DIRECTIVE/<15>
ERR96	.ASCII /VALUE PART AFTER SPEC(S) OR OTHER VALUE PART/<15>
ERR97	.ASCII /ELEMENT INVALID HERE/<15>
	.EJECT
	.IFUND	%C4
 
/RCOMST
/START PROGRAM:READ COMMAND STRING AND SET UP CONTROL DATA
RCOMST	XX
	.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
	DZM*	10
	LAC*	S00010
	DAC	SYMB
	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	SYMB
	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
CR	LAW	777377	/MARK'RETURN TO MONITOR'
	AND*	AOPTW
	DAC*	AOPTW
ALTM	JMS	FW	/FINISH OFF WORD
	LAC	SP02	
	TAD	K1	
	SAD	SYMB
	JMP	.+4
	LAC	SRC
	DAC*	AXW	/EXTN='SRC' IF NONE GIVEN
	DAC*	SYMB
	LAC*	SYMB
	DAC*	AXW
 
/REST	ROUTINE TO RESTORE COMPILER DATA FROM BULK STORAGE
/	IN DUMP MODE. FILE NAME IN CONTROL AREA
 
 
REST	.INIT DATIN,0,ERMOD
	LAC	K13
	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	/)SET UP WORD HOLDING
	ISZ*	SP01	/)ADDRESS OF STAT TABLE
	DAC	SP04	/HOLD ADDR OF WORD HOLDING ADDR STAT TABLE
	DAC	STATIN
	IDX	STATIN	/ADDR OF STAT TABLE AFTER RESTORE
/	.SEEK	DATIN,RESTFN
	CAL+DATIN&777
	3
RESTFN	0
	LAW	773777
	AND*	AOPTW	/HOLD ALL OPTIONS EXCEPT 'I'
	DAC	SP02
	LAC*	S00103
	AND	S77777
	DAC	SP03	/HOLD ADDR OF TOP OF CORE
/	READ	DATIN,4,RESTCN,4	/READ OPTIONS,FILENAME & EXTN
	CAL+4000 DATIN&777
	10
RESTCN	0
	-4
	LAC	K26
	DAC	RESTL	/LENGTH OF STAT TABLE
	LAC*	SP01
	DAC	RESTCA	/ADDR OF STAT TABLE
REST1	.WAIT	DATIN
/	.READ	DATIN,4,RESTCA,RESTL	/READ STAT TABLE,THEN STACKS
	CAL+4000 DATIN&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
	LAC*	S00102
	TAD	C35
	DAC*	SP01
	DAC	RSTCA1
	LAC	RESTL
	JMS	TCA
	TAD*	SP01	/ADD SIZE TO OUT POINTER
	DAC	SP00	/HOLD OUBASE
	LAC	SP01
	TAD	K1
	DAC	SP01
	LAC	SP00
	DAC*	SP01	/SET OUBASE IN STAT TABLE
	LAC	RESTL
	DAC	RSTL1
	CAL+4000 DATIN&777
	10
RSTCA1	0
RSTL1	0
REST2	.CLOSE DATIN
	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
	32
	LAC	AINBA	/)UPDATE ADDR OF STAT TABLE
	TAD	K2	/TAD K2(LISTAK)
	DAC*	SP04	/)AT BOTTOM OF CORE
	LAC	SRC
	DAC*	AXW
	JMP*	RCOMST
	.ENDC
	.EJECT
/GNC
/SUBROUTINE TO GET THE NEXT CHAR FROM THE SOURCE FILE AND ISSUE 
/IT IN THE LOCATION NC AND IN THE AC TO THE CALLING PROGRAM.
/GNC PROVIDES A SOURCE LISTING AT THE SAME TIME.
/SCRATCHPAD USED:SP00,SP04
 
GNC	XX		/NORMAL ENTRY POINT
 
GNC01	LAC  GNC70	/SWAP BUFFERS
	DAC  SP00
	LAC  GNC71
	DAC  GNC70
	DAC	GNC75
	TAD	K2
	DAC	GNC22	/SELECT BUFFER FOR WRITING
	LAC  SP00
	DAC  GNC71
	JMS  GNC60	/READ IN NEXT BUFFER
	ISZ	LCT1
	LAC	LIST
	SZA		/LISTING REQUIRED?
	JMS	GNC20	/YES,SO WRITE CURR BUFF TO LDEV
	JMP*	GNC
	.EJECT
/GNC20
/SUBROUTINE TO WRITE THE CURRENT BUFFER TO THE LISTING DEVICE
GNC20	XX
	JMS	COPY
	M*4+GNC70	/)COPY HDR WD PR TWO WDS
	M*4+GNC22	/)DOWN CORE
	2
	LAC*	GNC22	/LOAD FIRST WD OF HDR WD PR
	TAD	S01000	/ADD 1 TO WD PR COUNT
	DAC*	GNC22	/REPLACE HDR WD
	LAC	LCT1
	JMS	BDEC	/CONVERT LINE COUNT TO ASCII
	JMS	COPY	/PUT LINE COUNT IN LISTING BUFFER
	NUM3
	M*4+GNC70
	2
	ISZ	LCT	/INCREMENT LINE COUNT
	LAC	LCT	/LOAD LINE COUNT
	SAD	C56	/PAGE FULL?
	JMS	PAGEHD	/YES,SO OUTPUT PAGE HDR
	CAL+2000	-3&777
	.DSA	11
GNC22	.DSA	0
	.DSA	777712
	.WAIT -3
	JMP*	GNC20
	.EJECT
/SUBROUTINE TO INITIATE READING OF NEXT BUFFER
GNC60	XX
	LAC  GNC71
	DAC  GNC61
/	.READ DATIN,IOPS,BUFF2,52
	CAL+2000	DATIN&777
	.DSA 10
GNC61	.DSA 0
	.DSA 777714
	.WAIT DATIN
	JMP* GNC60
	.EJECT
/LOCAL STORAGE FOR ROUTINE GNC
GNC70	.DSA GNC73
GNC71	.DSA GNC74
	0
	0
GNC73	.BLOCK 64	/INPUT BUFFER
	0
	0
GNC74	.BLOCK 64	/INPUT BUFFER
GNC75	GNC73+1	/PTR TO CURRENT WD IN BUFFER
 
 
/GNC00
/INITIAL ENTRY POINT TO GNC(EXECUTED ONCE ONLY)
/
GNC00	XX
	LAC	GNC00
	DAC	GNC
GNC100	LAC	GNC14
	DAC*	AXW
	.ENTER DATOUT,GNC14
	JMS	GNC60
GNC021	JMP	GNC01
GNC14	.SIXBT ZERRZ
 
	.EJECT
/PAGEHD
/ROUTINE TO OUTPUT A FORM-FEED FOLLOWED BY A PAGE HEADING
 
PAGEHD	XX
	ISZ	PAGECT	/INCREMENT PAGE COUNT
	LAC	PAGECT	/LOAD PAGE COUNT
	JMS	BDEC	/CONVERT TO DECIMAL
	JMS	DLZ	/DELETE LEADING ZEROS
	DAC	PAGENO
	LAC	NUM3+1
	XOR	S25132	/INSERT LF AND CR INTO  BUFFER
	DAC	PAGENO+1
	.WRITE	-3,2,HDBUFF,10
	DZM	LCT	/CLEAR LINE COUNT
	JMP*	PAGEHD
 
HDBUFF	5002
	0
FILENM	60000
	0
	0
	22		/HORIZ TAB
	.ASCII	!PAGE !
PAGENO	0
	0
	.EJECT
/PACK
/SUBROUTINE TO PACK THE LINE COUNT AND CHAR COUNT GIVEN
/BY LINE AND LINE+1 INTO THE TWO BUFFER WD PRS
/GIVEN BY BW AND BW+1
 
PACK	XX
	LAC	LINE
	JMS	BDEC	/CONVERT TO ASCII DECIMAL
	JMS	DLZ	/DELETE LEADING ZEROS
	DAC*	BW
	LAC	NUM3+1	/LOAD SECOND ASCII WD
	XOR	S06100	/CONVERT TO COMMA,NULL
	ISZ	BW	/BUMP TO ADDR OF SECOND BUFF WD
	DAC*	BW
	LAC	LINE+1
	JMS	BDEC	/CONVERT TO ASCII DECIMAL
	JMS	DLZ	/DELETE LEADING ZEROS
	ISZ	BW	/BUMP TO ADDR OF THIRD BUFF WD
	DAC*	BW
	LAC	NUM3+1
	XOR	S04532	/CONVERT TO ),NULL
	ISZ	BW	/BUMP TO ADDR OF FOURTH BUFF WD
	DAC*	BW
	JMP*	PACK
 
/DLZ
/SUBROUTINE TO DELETE ANY LEADING ZEROS FROM THE WD-PR NUM3,NUM3+1
/CREATED BY SUBROUTINE BDEC.
 
DLZ	XX
	LAC	LZCT
	SNA!CLL!RAR	/ANY LEADING ZEROS?
	JMP	DLZ2	/NO
	SNL
	XOR	S01401	/DELETE TENS COUNT
	XOR	V00000	/DELETE HUNDREDS COUNT
DLZ2	XOR	NUM3
	JMP*	DLZ
	.EJECT
/MOVEIN
/ROUTINE TO TEST WHETHER OR NOT TEMBAS IS
/BELOW LOCATION MOVEUP. IF IT IS THEN THE
/INTEGER STACK IS MOVED UP BY 400 DEC WORDS
/IF NOT THEN NOTHING IS DONE
/
MOVEIN	XX
	JMS	TCA	/NEGATE INBASE
	TAD	MOVEUP
	SPA		/INBASE BELOW MOVEUP?
	JMP*	MOVEIN	/NO
	LAC	INTEGR	/YES
	CMA		/CALCULATE-(NUMBER OF WORDS)
	TAD	TEMBAS	/TO BE MOVED
	DAC	SHIFT	/HOLD
	LAC	INTEGR	/PUT ADDRESS OF POINTER
	DAC*	S00010	/INTO AUTO INDEX
	TAD	C400	/
	DAC	INTEGR	/NEW POINTER ADDRESS
	DAC*	S00011	/INTO AUTO INDEX
	LAC	TEMBAS	/
	TAD	C400
	DAC	TEMBAS	/NEW BASE ADDRESS
	LAC*	AUTO	/MOVE
	DAC*	AUTO1	/ONE WORD
	ISZ	SHIFT	/MORE WORDS TO MOVE
	JMP	.-3	/YES
	JMP*	MOVEIN	/NO
	.EJECT
/EVA
/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.
	AND*	SP01	/SET IN STACK #
	DAC	SP00	/STORE RESULT: ALSO IN AC
	ISZ	EVA
	JMP*	EVA	/EXIT
 
/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	RL6
 
/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
	LAC	SP00	/LOAD RESULT
	JMP*	VTOA	/EXIT
	.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
/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
	ISZ	TOPT
	SZA		/OPTION REQD?
	ISZ	TOPT	/NO,SKP LOCATION
	JMP*	TOPT	/YES,RETURN
	.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
/R507BT
/ROUTINE TO CONVERT CHAR FROM 6 TO 7 BIT AND PACK
/INTO OUTPUT BUFFER
 
/		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
	.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
	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
	.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
	.EJECT
/TCA
/ROUTINE TO TWO'S COMPLEMENT THE AC
TCA	XX
	CMA
	TAD	C1
	JMP*	TCA
	.EJECT
/BDEC
/ROUTINE TO CONVERT + NO IN AC ON ENTRY TO DECIMAL AND
/5-7 PACK IN WD-PR NUM3,NUM3+1.
/THE NUMBER IS TREATED MODULO 1000(DEC)
/LEADING ZEROS ARE NOT DELETED AND TWO TRAILING SPACES
/ARE PACKED INTO THE WD-PR
 
BDEC	XX
	DZM	LZCT	/CLEAR COUNT OF LEADING ZEROS
	DZM	BDEC10	/CLEAR DECIMAL DIGIT COUNT
	DZM	BDEC11	/          ,,
	TAD	K1000
	SMA
	JMP	.-2
	TAD	C1000
BDEC1	TAD	K100	/SUBTRACT 100(DEC)FROM ERROR NUMBER
	SPA		/NUMBER NEGATIVE?
	JMP	BDEC2	/YES
	ISZ	BDEC10	/NO:INCREMENT HUNDREDS COUNT
	JMP	BDEC1	/LOOP
BDEC2	TAD	C100	/ADD 100 (DEC) TO NUMBER
BDEC3	TAD	K10	/SUBTRCT 10 (DEC) FROM NUMBER
	SPA!STL		/NUMBER NEGATIVE?
	JMP	BDEC4	/YES
	ISZ	BDEC11	/NO:INCREMENT TENS COUNT
	JMP	BDEC3
BDEC4	TAD	C10	/ADD 10 (DEC) TO NUMBER & CLEAR LINK
	RTR
	RTR
	XOR	S20100
	DAC	NUM3+1	/STORE 3 BITS+2 SPACES
	GLK
	DAC	NUM3	/STORE TOP 4 BITS(TOP 3 BITS ZERO)
	LAC	BDEC10	/LOAD HUNDREDS COUNT
	SNA		/ZERO?
	ISZ	LZCT	/YES
	JMS	MES	/)ROTATE LEFT 7
	JMP	L-7	/)
	TAD	BDEC11	/ADD TENS COUNT
	SNA		/STILL ZERO?
	ISZ	LZCT	/YES
	RTL
	RTL		/ROTATE LEFT 4
	XOR	NUM3	/ADD TOP 4 BITS OF UNITS COUNT
	XOR	V01406	/FOLLOWED BY CONVERSION TO ASCII
	DAC	NUM3	/STORE
	JMP*	BDEC	/EXIT
	.EJECT
/BINDEC
/AS BDEC BUT NUMBER TREATED MODULO 10,000
/CARRIAGE RETURN PACKED INTO END OF WORD PAIR
/
BINDEC	XX
	DZM	LZCT	
	DZM	BDEC10
	DZM	BDEC11
	DZM	BDEC12
BIN01	TAD	K1000	/SUBTRACT 1000 DEC
	SPA		/NUMBER NEGATIVE?
	JMP	BIN02	/YES
	ISZ	BDEC12	/NO,INCREMENT THOUSANDS COUNT
	JMP	BIN01	/JUMP BACK
BIN02	TAD	C1000
BIN03	TAD	K100	/SUBTRACT 100 DEC
	SPA	/NUMBER NEGATIVE?
	JMP	BIN04	/YES
	ISZ	BDEC10	/NO,INCREMENT HUNDREDS  COUNT
	JMP	BIN03	/JUMP BACK
BIN04	TAD	C100	
BIN05	TAD	K10	/SUBTRACT TEN DEC
	SPA!STL
	JMP	BIN06	/NUMBER NEGATIVE
	ISZ	BDEC11	/NO,INCREMENT TENS COUNT
	JMP	BIN05	/JUMP BACK
BIN06	TAD	C10	/UNITS COUNT,CLEAR LINK
	JMS	MES
	JMP	L-10
	DAC	NUM3+1
	LAC	BDEC11	/TENS COUNT
	RTR
	RTR		/BOTTOM 3 BITS OF TENS COUNT
	XOR	NUM3+1	/FOLLOWED BY UNITS COUNT
	XOR	S30032	/CONVERT TO ASCII,FOLLOWED BY CR
	DAC	NUM3+1	/HOLD
	GLK
	DAC	NUM3
	LAC	BDEC12	/THOUSANDS COUNT
	JMS	MES
	JMP	L-7
	TAD	BDEC10
	RTL
	RTL
	XOR	NUM3	/TOP 4 BITS OF TENS COUNT
	XOR	V01406	/CONVERT TO ASCII
	DAC	NUM3
	JMP*	BINDEC
	.EJECT
/UNP5.7
/ROUTINE TO UNPACK INPUT BUFFER
 
UNP5.7	XX
GNC07	ISZ	GNC08	/BUMP SWITCH TO NEXT CHAR
	LAC*	GNC75	/LOAD CURRENT WORD OF PR
GNC08	XCT	GNC06+4
GNC10	AND	S00177
	JMP*	UNP5.7	/EXIT WITH 7 BIT CHAR IN AC
GNCH1	ISZ	GNC75
	LAC	GNC06	
	DAC	GNC08	/RESET MULTI-WAY SWITCH
	LAC*	GNC75	/LOAD FIRST WORD OF PR
	RTL		/GET FIRST CHAR TO BOTTOM END
	RTL
GNC04	RTL
	RTL
	JMP	GNC10
GNCH3	RAR		/ENTRY FOR THIRD CHAR IN WD PR
	AND	C7	/GET TOP 4 BITS OF CHAR
	DAC	SP00	/STORE
	ISZ	GNC75	/BUMP PTR TO 2ND WD OF PR
	LAC*	GNC75
	AND	Z00000	/GET BOTTOM 3 BITS OF CHAR
	XOR	SP00	/COMBINE
	JMP	GNC04
GNCH4	RTR
	RTR
GNCH2	RTR
	RTR
	JMP	GNC10
GNC06	XCT	GNC06	/INST TO BE PICKED UP,NOT OBEYED
	JMP	GNCH2
	JMP	GNCH3
	JMP	GNCH4
	RAR
	JMP	GNCH1
	.EJECT
/	VTOA CONVERSION TABLE
 
VTOA02	TAD*	.+1	/SK#
		VOBASE	/0
		VOCAB
		EMBASE	/1
		EMSTK
		INBASE	/2
		INTEGR
		INBASE	/3
		INTEGR
		STBASE	/4
		STRING
		LABASE	/5
		LABEL
		DIBASE	/6
		DICT
		PRBASE	/7
		PROC
		SWBASE	/8
		SWITCH
		RPBASE	/9
		REVPOL
		POBASE	/10
		POLISH
		WKBASE	/11
		WORK
		OWBASE	/12
		OWN
		OUBASE	/13
AOUT              OUT
	.EJECT
/TABLE OF LOCATIONS REQUIRING BANK BIT INITIALISATION
BKINIT    XCT       .+0
	A	PAPER-2
	A	CONTR-7
	A	CONTR-3
	A	INIT+2
          A         AINBA
          A         INSEEK-4
          A         ERSEEK+7
	A	ENTER+2
          A         FINAL+16
          A         TESTOP-4
          .IFNZR    %C1-6
          A         CONTRP+2
          .ENDC
	.IFUND	DOS
          A         CONTRP+4
	.ENDC
          A         BUFPT
          A         MESS8-16
          A         MESS8-5
          A         ENDMES-7
          A         ENDMES-6
          A         READ+3
          A         REDERR+2
          A         PUTEM+2
          A         PUTI+2
          A         COPYIT+3
          A         COPYIT+4
          A         COPYIT+6
          A         PACKFN-4
          A         PACKFN-2
          A         WRITE+2
          A         B1
          A         B2
          A         GNC20+2
          A         GNC20+3
          A         GNC22-11
          A         GNC22-10
          A         GNC70
          A         GNC71
          A         GNC75
          A         GNC021-2
          A         HDBUFF-4
          A         SCV+1
          A         PH2ERR+1
          A         PH2ERR+2
          A         PH2ERR+3
          A         PH2ERR+4
          A         PH2ERR+5
          A         PH2ERR+6
          A         PROCES+1
          A         PROCES+2
          A         PROCES+3
          A         SHIFT+1
          A         SHIFT+2
          A         SHIFT+3
          A         ATABLE
          A         AERTAB
          A         AERTAB+1
          A         AERTAB+2
          A         AERTAB+3
          A         AERTAB+4
          A         AERTAB+5
          A         AERTAB+6
          A         ATABLE
          A         ATABLE
          A         ATABLE
          A         ATABLE
          A         ATABLE
          A         ATABLE
          A         ATABLE
BKEND     A         ATABLE
          A         ERRTAB
          ERRTAB-INBASE+1
          A         VTOA02
          VTOA02-AOUT
BNCT      BKEND-.+1
          .EJECT
	.DEC
C1	1
C2	2
C3	3
C4	4
C5	5
C6	6
C7	7
C8	8
C9	9
C10	10
C11	11
C12	12
C15	15
C21	21
C25	25
C27	27
C32	32
C35	35
C40	40
C41	41
C49	49
C51	51
C52	52
C56	56
C69	69
C80	80
C100	100
C101	101
C125	125
C126	126
C400	400
C1000	1000
K1	-1
K2	-2
K3	-3
K4	-4
K5	-5
K9	-9
K10	-10
K13	-13
K14	-14
K23	-23
K24	-24
K26	-26
K27	-27
K32	-32
K40	-40
K49	-49
K100	-100
K400	-400
K1000	-1000
	.OCT
S00007	7
S00010	10
S00011	11
S00012	12
S00013	13
S00014	14
S00015	15
S00016	16
S00020	20
S00032	32
S00037	37
S00040	40
S00057	57
S00070	70
S00073	73
S00074	74
S00077	77
S00100	100
S00102	102
S00103	103
S00112	112
S00126	126
S00136	136
S00137	137
S00140	140
S00175	175
S00177	177
S00766	766
S00777	777
S01000	1000
S01401	1401
S02766	2766
S02777	2777
S03100	3100
S03777	3777
S04000	4000
S04500	4500
S04532	4532
S04672	4672
S06100	6100
S07400	7400
S07700	7700
S07777	7777
S10000	10000
S14000	14000
S20100	20100
S25132	25132
S30032	30032
S60000	60000
S77777	77777
U00000	200000
U00077	200077
U74000	274000
V00000	300000
V01406	301406
V77777	377777
Y00000	600000
Z00000	700000
Z17777	717777
Z70000	770000
Z70001	770001
Z74000	774000
Z74700	774700
Z77400	777400
Z77700	777700
	.EJECT
/ASSIGNMENTS
M=100000
A=400000
IDX=ISZ
AUTO1=11
AUTO2=12
AUTO3=13
AUTO4=14
DATIN=-11
DATOUT=-12
 
 
MOVEUP	0
BANK	0
PH1END	0
BUFEND	0
STLIM	0
STWDAD	0
PTRADD	0
PACKCT	0
TEMP1	0
TEMPFN	0
	0
	0
TEMBAS	0
TEMPEM	0
CT1	0
TEMP2	0
AOPTW	0
SP00	0
SP01	0
SP02	0
SP03	0
SP04	0
SP05	0
CHAR	0
START	0
INFO	0
LAST	0
WORDCT	0
TEMP02	0
TEMP03	0
TEMP04	0
CHPOS1	0
LCT1	0
PAGECT	0
LCT	0
LZCT	0
COPYCT	0
COPYSV	0
COPYSC	0
NUM3	0
	0
BDEC10	0
BDEC11	0
BDEC12	0
ADDR	0
SIZE	0
R50.1	0
R50.2	0
R50.3	0
SYMB	0
AXW	0
NC	0
NAPTR	0
FIRST	0
LIST	0
ERRNO	0
ERRCT	0
TYPE	0
FINCHA	0
NAME	0
PARAM	0
NUMMES	0
DEPOS	0
TEMP05	0
CRPOS	0
BLKADD	0
	.END
