/	EIGHT/S INTERPRETER.    ESI
/	DAVID J. WAKS  
/	APPLIED DATA RESEARCH, INC.
/  
/	EXTENDED FEATURE ESI-X.  
/	OCTOBER 1, 1966
/	REVISED JULY, 1967 --- ROBERT M. SUPNIK 
/  
/	MACROES...  
	DEFINE ROTR4 <RTR; RTR> 
	DEFINE ROTR6 <RTR; RTR; RTR>
	DEFINE ROTR8 <RTL; RTL; RAL>
	DEFINE ROTL5 <RTL; RTL; RAL>
	DEFINE ROTL4 <RTL; RTL> 
	DEFINE ROTR3 <RTR; RAR> 
	DEFINE ROTR5 <RTR; RTR; RAR>
	DEFINE ROTL6 <RTL; RTL; RTL>
	XX=HLT
/  
/  
/	ASSEMBLY PARAMETERS...  
/  
/	NUMBER OF WORDS DEVOTED TO EACH F-P NUMBER IS...
	NUMWD=3
/	NUMBER OF DECIMAL DIGITS OF PRECISION IS...  
	PREC=NUMWD+NUMWD+NUMWD-2
/  
/  
/SYNTAX TABLE DEFINITIONS AND MACROES. 
/  
/FIRST WORD:
/  
DEFINE TERML A 
	<VFD 1:1, 11:A-1>
DEFINE SUBGL A 
	<A-1>
/  
/SECOND WORD:  
/  
/ ALTERNATE:
/	ALTLOC = LOCATION OF ALTERNATE (1-15 WORDS FOLLOWING)
/	SUCLOC = LOC. OF SUCCESSOR (-26 TO +7 WORDS) 
/	       = NOSUC
/	QGEN   = ?NEXT WORD A GENERATOR - "YES" OR "NO" 
/  
	YES=1  
	NO=0
DEFINE	FCALT ALTLOC SUCLOC QGEN
<	NOSUC=.-27 
	VFD 1:QGEN, 2:2, 4:ALTLOC-.-1, 5:SUCLOC-.+27>  
/  
/  
/ OK TO FAIL:  
/  
DEFINE	FCOK SUCLOC QGEN  
<	NOSUC=.-27 
	VFD 1:QGEN, 2:1, 4:0, 5:SUCLOC-.+27>  
/  
/  
/ DEAD:  
/  
DEFINE	FCDEAD SUCLOC QGEN
<	NOSUC=.-27 
	VFD 1:QGEN, 2:3, 4:0, 5:SUCLOC-.+27>  
/  
/  
/ FAIL:  
/  
DEFINE	FCFAIL SUCLOC QGEN  
<	NOSUC=.-27 
	VFD 1:QGEN, 2:0, 4:0, 5:SUCLOC-.+27>  
/  
/  
/WORDS 3-N (GENERATORS):
/  
DEFINE	GEN GENLOC QGEN
	<VFD 1:QGEN, 11:GENLOC>
/STRING MANIPULATION MACROES. 
/  
DEFINE	ADV PTRNAM  
<	JMS I [ADVPS]  
	PTRNAM>
/  
DEFINE	RD PTRNAM
<	JMS I [RDS] 
	PTRNAM>
/  
DEFINE	RDADV PTRNAM
<	JMS I [RDADVS] 
	PTRNAM>
/  
DEFINE	WR PTRNAM  
<	JMS WRS
	PTRNAM>
/  
DEFINE	WRADV PTRNAM
<	JMS I [WRADVS] 
	PTRNAM>
/  
DEFINE	BKPTR PTRNAM  
<	JMS BKPTRS
	PTRNAM>
/  
DEFINE	DIFPTR PTR1 PTR2  
<	JMS I [DIFPS]  
	PTR1  
	PTR2>  
/  
DEFINE	TYSTRG PTRNAM  
<	JMS TYSTRS
	PTRNAM>

DEFINE	CPY A B 
<	TAD A
	DCA B>
/	PAGE 0 ASSIGNMENTS.  
/  
/AUTO-INDEX REGISTERS.  
	*10
AX0,	0  
AX1,	0  
AX2,	0  
AX3,	0  
AX4,	0  
AX5,	0  
/  
/FLOATING-POINT ARITHMETIC REGISTERS...
/  
	*20 
DIGAC,	0		/QUOTIENT ACCUMULATOR  
MQ,	0		/FLOATING MQ REGISTER (FMQ)  
	*MQ+PREC
AC,	0		/FLOATING ACCUMULATOR (FAC)  
	*AC+PREC
ACX,	0		/FAC EXPONENT 
ACS,	0		/FAC SIGN  
IR,	0		/FLOATING INPUT REGISTER (IR)
	*IR+PREC
IRX,	0		/IR EXPONENT  
IRS,	0		/IR SIGN
ALDIG,	0		/ALIGNMENT AND AC OVERFLOW DIGIT
/  
/  
/	TEMPORARIES... 
/  
CRWD,	0  
WDCNT,	0		/WORD COUNTER FOR LOOPS.  
ALCNT,	0		/NUMBER OF SHIFTS FOR REGISTER  
			/ALIGNMENT.
MULCNT,	0		/MULTIPLICATION COUNT  
NORMFR,	0		/"FROM" WORD POINTER. 
NORMTO,	0		/"TO" WORD POINTER.
TMP,	0		/GENERAL TEMPORARY. 
/MAIN CONTROL PAGE 0 ASSIGNMENTS.
/  
ENDPR,	USERPR		/CURRENT END OF USER PROG STORAGE  
ARYNXT,	USEREND		/CURRENT END OF ELEMENT STORAGE.
STKNXT,	0		/CURRENT TOP OF STACK. 
STEPNO,	0		/STEP NUMBER IF INDIRECT  
	*STEPNO+NUMWD
GOAL=16
/  
/  
/FOR VARIABLES:
INDEX,	0		/LOCATION OF "FOR" INDEX VARIABLE.
INCR,	0		/VALUE OF "FOR" INCREMENT
	*INCR+NUMWD
INCRSN,	0		/INCREMENT SIGN. 
TRMVAL,	0		/"FOR" TERMINAL VALUE.
	*TRMVAL+NUMWD 
/  
/LEXICAL ANALYSER TEMPORARIES AND DEFINITIONS.  
/  
NXTTTC=17		/NEXT TERMINAL TYPE CODE.  
NXTLXF,	0		/CURRENT GADGET START. 
QRTF,	0  
XSTEP,	0		/LOC. OF INDIRECT STEP; 0 IF DIRECT 
NXTLXN,	0		/CURRENT CHARACTER BEING EXAMINED  
	0  
CURSYM,	0		/LOCATION OF CURRENT V ARIABLE. 
QANYIN,	0		/?ANY INPUT IN BUFFER OR FAC  
CURCHR,	0		/LAST CHARACTER READ FROM STRING.  
SVLXF,	0		/STRING POINTER USED IN "TYPE".
	0  
VARNAM,	0		/VARIABLE NAME IN SCAN 
VARLOC,	0		/VARIABLE LOCATION IN SCAN
/  
PRVSTP,	0		/PREVIOUS STEP LOCATION
CURSTP,	0		/CURRENT STEP LOC. TEMPORARY 
NXTSTP,	0		/LOCATION OF NEXT STEP POINTER. 
/  
/  
/UNPACKED STRING POINTERS. 
/USED BY STRING MANIPULATION SUBROUTINES. 
/  
ADVAC,	0		/PDP-8 AC STORAGE
PTR1ST,	0		/LOCATION OF CURRENT WORD IN STRING
LPTR1ST, 0		/LOCATION OF STRING WORD POINTER.  
PTR2ND,	0		/LOCATION OF ?RIGHT. 
QADVC,	0		/?ADVANCE AFTER READ OR WRTIE.
QEOL,	0		/END OF LINE FLAG  
QINSTAT, 0		/INTERRUPT STATEMENT FLAG
PAGEKNT, 0  
/  
/  "INTERRUPT" AND "CANCEL" TELETYPE CODE IS: 
	ICODE=375	/ ("ALT MODE").  
/MAJOR LOCATION REFERENCES AND SUBROUTINE CALLS:
DEFINE	GET A 
<	TAD A  
	JMS I [GETNUM]>

DEFINE	STORE A  
<	TAD A  
	JMS I [STPACK]>

	RETURN=JMP I [SUCLP2]
	PUSH=JMS I [PUSH1]
	POP=JMS I [POP1]  
	SWP=JMS I [SWAP]  
	TYPE=JMS I [TYCHAR] 
	CRLF=JMS I [TYCRLF] 
/  
/  
	PAGE 21 
/TYCHAR  
/TYPE AN ASCII CHARACTER.  
/CHARACTER IN 8AC ON ENTRY, LEFT CLEAR ON EXIT. 
/  
TYCHAR,	0  
	TSF		/IS TELEPRINTER READY?  
	JMP .-1		/NO. 
	TLS		/YES.  PRINT CHARACTER.
	CLA
	JMP I TYCHAR
	BP21=.
	LIT
	PAGE 30 
/  
/TYCRLF  
/TYPE CARRIAGE RETURN/LINE FEED. 
/8AC CLEAR ON ENTRY AND EXIT. 
TYCRLF,	0  
	TAD ECR  
	TYPE		/TYPE "CR".
	TAD ELF  
	TYPE		/TYPE "LF".
	ISZ LINEKNT	/IS LINE COUNT ZERO? 
	JMP I TYCRLF	/NO.
	JMS EJECT	/YES, GO TO TOP OF FORM  
	JMS NEWPAGE	/PRINT NEW HEADING. 
	JMP I TYCRLF  
/  
ECR,	215
ELF,	212
	BP30=.
	LIT
	PAGE 1
/ESI-B GENERATORS.
/  
/"SET" GENERATORS.  
/  
PSHCUR,	TAD CURSYM	/PUT "CURSYM" IN STACK.  
GPD,	PUSH  
	RETURN
/  
STOREC,	POP		/GET LOCATION OF VARIABLE.
	DCA CURSYM	/RECOVER VARIABLE LOC.
	CDF 10
	TAD I CURSYM	/GET CONTROL WORD. 
	CDF 0
	TAD (-3777) 
	SNA CLA		/IS IT SUBSCRIPTED?  
	JMP ERRSUB	/YES.  SUBSCRIPT ERROR.
	CDF 10
	STORE CURSYM	/NO, STORE AND PACK AC THERE.
	RETURN
/  
ACTOS,	JMS PUSHAC	/STORE FAC.
	RETURN
/  
PUSHAC,	0		/SUBROUTINE TO STORE FAC. 
	TAD STKNXT  
	TAD [NUMWD-1] 
	CIA CLL  
	TAD ARYNXT	/ARYNXT-(STKNXT+NUMWD-1)
	SNL CLA		/IS IT POSITIVE?  
	JMP ERRSO	/NO.  STACK OVERFLOW.  
	CDF 10
	STORE STKNXT	/YES, STORE PACKED AC IN STACK. 
	TAD STKNXT  
	TAD [NUMWD]	/INCREMENT STACK POINTER.
	DCA STKNXT	/  BY NUMWD.  
	JMP I PUSHAC	/EXIT.  
/  
POPAC,	0		/ROUTINE TO POP STORED AC.
	TAD STKNXT  
	TAD [-NUMWD]	/GET LOC. OF PACKED AC ON  STACK
	DCA STKNXT  
	CDF 10
	GET STKNXT	/UNPACK STACK TO FAC
	JMP I POPAC 
/  
POPDO,	SWP		/SWAP FAC AND IR.
	JMS POPAC	/UNPACK TOP OF STACK TO FAC. 
DO,	POP		/GET LOCATION OF OPERATION.  
	DCA TMP  
	JMP I TMP	/GO TO DELAYED OPERATION. 
/  
TOAC,	CDF 10	/GET FIRST WORD OF VARIABLE.  
	TAD I CURSYM  
	CDF 0
	AND [3777] 
	TAD (-3777) 
	SNA CLA		/IS VARIABLE DEFINED AND SIMPLE? 
	JMP ERRUND	/NO. 
	CDF 10
	GET CURSYM	/GO GET AND UNPACK NUMBER SPEC. BY CURSYM.  
	RETURN
/  
STDIV,	TAD [DFDV-DFMU]  
STMUL,	TAD [DFMU-DFSB]  
STSUB,	TAD [DFSB-DFAD]  
STADD,	TAD (DFAD)	/LOCATION OF "FAD" ROUTINE. 
GPDU,	JMS PUSH1U	/STORE ON STACK UNDER TOP.
	RETURN
/  
/PUSH1U - PUSHES A WORD, GIVEN IN 8AC AT ENTRY, INTO  
/STACK DIRECTLY UNDER TOP WORD.  USED FOR DELAYED GENERATORS
/  
PUSH1U,	0  
	DCA TMP		/SAVE VALUE.  
	POP		/GET TOP WORD OF STACK.
	DCA WDCNT	/SAVE IT.  
	TAD TMP  
	PUSH		/PUSH DOWN NEW WORD.
	TAD WDCNT
	PUSH		/PUSH OLD TOP.
	JMP I PUSH1U	/ESIT.  
/  
/  
DFAD,	JMS FAD  
	RETURN
/  
DFSB,	JMS FSB  
	RETURN
/  
DFMU,	JMS FMU  
	RETURN
/  
DFDV,	JMS FDV  
	RETURN
/  
/PROCESS "LOG ON".  
/  
PRLON,	TAD (LONMES)	/PUT OUT "TITLE: " MESSAGE.
	JMS TYPKST 
	JMS INPUT	/READ INPUT LINE INTO 'BUFF'. 
	CPY [TITBUF],SVLXF 
	CPY [0010],SVLXF+1  
PRLON1,	RDADV NXTLXF	/READ AN INPUT CHAR. 
	TAD (-ICR)	/IS IT CR?
	SNA CLA 
	JMP PRLON1	/YES, IGNORE IT.  
	TAD CURCHR	/NO, WRITE IT IN TITLE BUFFER.
	WRADV SVLXF
	TAD CURCHR	/WAS THE CHAR. EOL?
	SZA CLA 
	JMP PRLON1 
	DCA PAGEKNT
	DCA LINEKNT
PRPAGE,	JMS EJECT	/GO TO TOP OF FORM.  
	JMS NEWPAGE	/PRINT NEW HEADING. 
	RETURN  
/  
LINEKNT, -LINPAG  
PRLOF,	JMP UPRLOF	/GENERATOR IN UPPER 2K. 
	EP1=. 
	LIT  
/  
	PAGE 23 
LONMES,	TEXT /TITLE: /  
/  
/PROCESS "LOG OFF". 
/  
UPRLOF,	JMS EJECT	/GO TO TOP OF FORM.  
	TAD (LF3-1)	/EJECT 3 LINES TO ALIGN TEAR MARKS 
	JMS TYUNPK 
	TAD (LF3-1)	/ACTUALLY, WE MUST EJECT 7 TIMES.  
	JMS TYUNPK 
	DCA PAGEKNT	/CLEAR THE PAGE COUNT. 
	CDF 10
	DCA I [TITBUF]	/CLEAR THE TITLE BUFFER. 
	CDF 0
	JMP PLINE	/DO CRLF AND SET CR SWITCH. 
	BP23=.
	LIT  
	PAGE 34 
/FDTOB
/FLOATING DECIMAL TO BINARY CONVERSION.
/INTEGER PART OF FAC IS CONVERTED TO A SIGNED BINARY INTEGER,  
/WHICH IS LEFT IN THE 8AC AT EXIT.  THE LEGAL RANGE IS -999 
/TO +999;  VIOLATION CAUSES "SUBSCRIPT" ERROR.
/  
FDTOB,	0  
	TAD AC+PREC-1   /GET H-O DIGIT OF FAC
	DCA MULCNT  
	TAD ACX  
	SNA SPA		/IS EXPONENT GT 0?
	JMP FDTOBX	/NO.  INTEGER PART IS 0.  
	TAD [-1]	/YES.  
	SNA CLA		/IS EXPONENT = 1?  
	JMP FDTOB1	/YES.  DONE.  
	JMS BMUL10	/NO.  MULTIPLY MULCNT BY 10. 
	TAD AC+PREC-2   /ADD NEXT AC DIGIT.  
	DCA MULCNT  
	TAD ACX  
	TAD [-2]
	SNA CLA		/IS EXPONENT = 2?
	JMP FDTOB1	/YES.
	JMS BMUL10	/NO. 
	TAD AC+PREC-3   /ADD THIRD AC DIGIT. 
	DCA MULCNT  
	TAD ACX  
	TAD [-3]
	SZA CLA		/IS EXPONENT = 3?  
	JMP ERRSUB	/NO.  SUBSCRIPT ERROR.  
FDTOB1,	TAD ACS  
	SNA CLA		/IS AC SIGN "+"?  
	JMP FDTOB2	/YES.
	TAD MULCNT	/NO. 
	CIA		/COMPLEMENT RESULT. 
	JMP I FDTOB 
/  
FDTOB2,	TAD MULCNT  
	JMP I FDTOB 
/  
FDTOBX,	CLA
	JMP I FDTOB 
/  
BMUL10,	0
	TAD MULCNT	/MULTIPLY MULCNT BY 10.
	CLL RAL  
	DCA MULCNT  
	TAD MULCNT  
	CLL RTL  
	TAD MULCNT  
	JMP I BMUL10
	BP34=.
	LIT  
	PAGE 3  
/PROCESS SUBSCRIPTED VARIABLES.  
/  
/SET ?PERMIT UNDEFINED (QPUND) TO 0 OR 1.  
SQPUN1,	CLA IAC  
SQPUN0,	DCA QPUND	/SET TO 0 OR 1.  
	RETURN
/  
/  
/SAVE QPUN ON STACK. 
STQPUN,	TAD QPUND	/SAVE QPUND.  
	PUSH  
	JMP SQPUN0	/CLEAR QPUND
/  
/STORE FIRST SUBSCRIPT: 
STSUB1,	JMS FDTOB	/GET BINARY VALUE OF SUBS1.  
	PUSH		/SAVE IT ON STACK.  
	CLA IAC		/SET # OF SUBS TO 1.
	PUSH  
	CLA IAC		/SET 2ND SUBSCRIPT TO 1.  
GPD3,	PUSH  
	RETURN
/  
/STORE SECOND SUBSCRIPT:
/  
STSUB2,	POP		/THROW AWAY FALSE SUBS2.  
	POP		/GET  OF SUBS.  
	IAC		/ADD 1. 
	PUSH		/PUT BACK 2.  
	JMS FDTOB	/GET BINARY VALUE OF SUBS2.  
	JMP GPD3	/PUT IT ON STACK.

	BP3=. 
	LIT  
	PAGE 2  
/COMPUTE SUBSCRIPT ELEMENT LOCATION.
/STACK HAS FOLLOWING VALUES AT ENTRY : 
/	TOP - SECOND SUBSCRIPT (SUBS2) 
/	TOP-1 - NUMBER OF SUBSCRIPTS (NUMSUB)
/	TOP-2 - FIRST SUBSCRIPT (SUBS1)
/	TOP-3 - ?PERMIT UNDEFINED ELEMENT (QPUND)
/	TOP-4 - LOC. OF VARB. CONTROL WORD (CURSYM)
/  
/AT EXIT:
/	CURSYM - LOCATION OF ELEMENT IN VARIBLE STORAGE  
/  
/8AC IS CLEAR ON ENTRY AND EXIT. 
/  
CMPSUB,	POP		/GET ALL SAVED VALUES. 
	DCA SUBS2
	POP
	DCA NUMSUB  
	POP
	DCA SUBS1
	POP
	DCA QPUND
	POP
	DCA CURSYM  
	CDF 10
	TAD I CURSYM	/GET VARIABLE CONTROL WORD. 
	CDF 0
	CMA
	SNA		/IS IT "UNDEFINED"? 
	JMP PRU1	/YES.
	TAD [4000]
	SZA CLA		/IS IT "SUBSCRIPTED"?  
	JMP ERRSUB	/NO.  SUBSCRIPT ERROR. 
	ISZ CURSYM	/YES.
	CDF 10
	TAD I CURSYM	/GET # OF SUBSCRIPTS. 
	CDF 0
	CIA
	TAD NUMSUB  
	SZA CLA		/IS IT RIGHT?
	JMP ERRSUB	/NO.  SUBSCRIPT ERROR. 
	ISZ CURSYM	/ADVANCE TO ENTRY LOC. 
CMPL1,	TAD CURSYM  
	CDF 0		/BECAUSE OF FOLLOWING INDIRECT LINK.  
	DCA PREVEL	/SAVE PREDECESSOR LOC. 
	CDF 10
	TAD I CURSYM	/GET POINTER TO NEXT ELEMENT.  
	CDF 0
	CLL  
	TAD (-VBLKEND)	/IS THERE A NEXT ELEMENT?  
	SNL  
	JMP PRU2	/NO.  NOTE: AC NOT CLEAR. 
	TAD (VBLKEND) 
	DCA CURSYM	/YES.  MAKE IT CURRENT.
	TAD CURSYM  
	DCA AX0		/LOCATION OF 1ST SUBSCRIPT.  
	CDF 10
	TAD I AX0	/GET 1ST SUBSCRIPT. 
	CIA
	TAD SUBS1
	SZA CLA		/IS IT DESIRED VALUE?
	JMP CMPL1	/NO. 
	TAD I AX0	/YES.  GET SECOND SUBS.
	CIA
	TAD SUBS2
	SZA CLA		/IS IT DESIRED VALUE.  
	JMP CMPL1	/NO. 
	ISZ AX0		/YES.  SET LOCATION OF VALUE.
	TAD AX0  
	DCA CURSYM  
	CDF 0
	RETURN		/DONE.  
/  
/CREATE NEW ELEMENT IF ALLOWED (ELEMENT IS BEING DEFINED).  
PRU1,	TAD QPUND
	SNA CLA		/CAN IT BE UNDEFINED?
	JMP ERRSUB	/NO.  SUBSCRIPT ERROR. 
	TAD [3777] 
	CDF 10
	DCA I CURSYM	/SET VARIABLE "SUBSCRIPTED".
	ISZ CURSYM  
	TAD NUMSUB	/SET # OF SUBS.  
	DCA I CURSYM
	ISZ CURSYM  
	TAD CURSYM	/REL LOC. OF POINTER.  
	DCA I CURSYM	/GOES TO POINTER WORD. 
	CDF 0
CMPS2,	TAD ARYNXT  
	TAD (-NUMWD-3)  /LOCATION OF NEW ELEMENT. 
	DCA ARYNXT  
	TAD STKNXT  
	CIA CLL 
	TAD ARYNXT 
	SNA  
	JMP ERRSO	/NO ROOM FOR ELEMENT. 
	SNL CLA 
	JMP ERRSO  
	CLA CMA  
	TAD ARYNXT  
	DCA AX0  
	CDF 10
	TAD I CURSYM	/GET POINTER OF LAST ELEMENT. 
	DCA I AX0	/SET INTO NEW ELEMENT. 
	TAD ARYNXT	/MAKE PREVIOUS ELEMENT 
	DCA I CURSYM	/ POINT OT NEW ONE. 
	TAD SUBS1	/STORE SUBSCRIPT VALUES.  
	DCA I AX0
	TAD SUBS2
	DCA I AX0
	CLA CMA  
	DCA I AX0	/SET ELEMENT "UNDEFINED".
	CDF 0
	TAD AX0  
	DCA CURSYM	/SET CURSYM TO NEW ELEMENT LOC. 
	RETURN
/  
PRU2,	CLA
	TAD QPUND
	SNA CLA		/CAN IT BE UNDEFINED
	JMP ERRSUB	/NO.  SUBSCRIPT ERROR. 
	JMP CMPS2	/YES.  CREATE NEW ELEMENT.
/  
/TEMPORARIES:  
NUMSUB,	0		/NUMBER OF SUBSCRIPTS IN REFERENCE 
SUBS1,	0		/FIRST SUBSCRIPT VALUE.
SUBS2,	0		/SECOND SUBSCRIPT VALUE
QPUND,	0		/?PERMIT UNDEFINED ELEMENT.

	EP2=. 
	LIT
	*BP3  
/BUILT-IN FUNCTIONS. 
/  
SPRIP,	TAD (PRIP-PRFP)  
SPRFP,	TAD (PRFP-PRSGN) 
SPRSGN,	TAD (PRSGN-PRABS) 
SPRABS,	TAD (PRABS-PRSIN)  
SPRSIN,	TAD (PRSIN-PRCOS)  
SPRCOS,	TAD (PRCOS-PRSQRT) 
SPRSQRT, TAD (PRSQRT-PREXP)
SPREXP,	TAD (PREXP-PRLOG)  
SPRLOG,	TAD (PRLOG-PRARC)  
SPRARC,	TAD (PRARC-PRLN)
SPRLN,	TAD (PRLN-PRDP)  
SPRDP,	TAD (PRDP-PREP)  
SPREP,	TAD (PREP) 
	JMP GPDU 
/  
/  
PRIP,	JMS IPS		/GET INTEGER PART OF FAC. 
	RETURN
/  
PRFP,	JMS FPS		/GET FRACTION PART.
	RETURN  
/  
FPS,	0
	JMS PUSHAC	/SAVE FAC.  
	JMS IPS		/GET IP OF FAC.  
	SWP		/FAC TO IR.
	JMS POPAC	/GET FAC.  
	JMS FSB		/SUBSTRACT IP FROM FAC.
	JMP I FPS  
/  
PRSGN,	TAD [-PREC]
	JMS CLFACS	/CLEAR ALL FAC DIGITS. 
	ISZ AC+PREC-1   /FORCE H-O DIGIT OF FAC TO 1. 
	CLA IAC  
	DCA ACX		/FORCE ACX TO 1. 
	RETURN
/  
/  
/IPS  
/INTEGER PART OF FAC TO FAC.  
IPS,	0  
	TAD ACX		/AC EXP. IS # OF INTEGER DIGITS.
	SPA CLA		/IS ACX POSITIVE? 
	DCA ACX		/NO.  CLEAR ALL AC DIGITS.
	TAD ACX  
	TAD [-PREC]	/SUBTRACT PRECISION.  
	SMA		/IS ACX 7 OR MORE?
	SKP CLA		/YES.  FAC IS INTEGRAL ALREADY. 
	JMS CLFACS	/NO.  GO CLEAR SPEC.  OF DIGITS.  
	JMP I IPS	/EXIT.  
/  
/  
/CLEAR SPECIFIED  OF LOW-ORDER DIGITS OF FAC.  
CLFACS,	0  
	DCA WDCNT	/SET WORD COUNT FOR # OF DIGITS.
	TAD [AC-1]	/INITIAL CLEAR LOCATION. 
	DCA AX1  
CLFAC1,	DCA I AX1	/CLEAR AN FAC DIGIT.
	ISZ WDCNT
	JMP CLFAC1  
	JMP I CLFACS
/  
/CONDITIONAL CARRIAGE RETURN IN TYPE STATEMENTS.
PLINE,	TAD (CRLF)	/SET SWITCH TO "RETURN".  
PNLINE,	DCA .+1	/SET SWITCH TO "NO RETURN".  
CNLINE,	CRLF	/CONDITIONAL RETURN, EITHER "CRLF" OR "0000=NOP".
	RETURN  
/  
STUPAR,	TAD (DFEXP)	/SAVE ADDR OF ^ GENERATOR.
	JMP GPD3
	EP3=.  
	LIT
	PAGE 4
/"FOR" GENERATORS.  
/  
/SAVE INDEX LOCATION:
SVINDX,	TAD CURSYM	/SAVE CURSYM  
	DCA INDEX
	RETURN
/  
/SAVE INCREMENT VALUE:  
SVINCR,	STORE (INCR)	/SAVE INCREMENT. 
	TAD ACS  
	DCA INCRSN	/SAVE INCREMENT SIGN.  
	RETURN
/  
/STORE TERMINAL VALUE, AND PROCESS FOR.
PRFOR,	STORE (TRMVAL)  /STORE TERMINAL VALUE. 
PRFORL,	GET (TRMVAL)	/TERMINAL VALUE TO FAC.
	SWP		/NOW IN IR.
	CDF 10
	GET INDEX	/INDEX VALUE TO FAC.
	JMS FSB		/INDEX - TRMVAL TO FAC.
	TAD ACS  
	TAD INCRSN  
	AND [0020]	/SIGN(INCR)*SIGN(DIFFERENCE).
	SNA CLA		/IS IT GE 0?
	JMP PRFOR4	/YES.  SEE IF IT IS GT 0. 
PRFOR1,	TAD (INDEX-1)   /NO.  PUSH DOWN INDEX, INCR, 
	DCA AX0		/  INCRSN, TRMVAL.  
	TAD (-NUMWD-NUMWD-5)  /AND LEX. POINTERS. 
	DCA WDCNT
PRFR1L,	TAD I AX0
	PUSH		/PUSH A WORD. 
	ISZ WDCNT	/DONE?
	JMP PRFR1L	/NO. 
	TAD SYNAN	/PUSH SYNAN RETURN LOC.
	PUSH  
	TAD XSTEP
	SZA CLA		/IS THIS A DIRECT STATEMENT?  
	TAD (ISTAT-DSTAT1)	/NO.  MAKE AN <ISTAT>.  
	TAD (DSTAT1-1)	/YES.  MAKE A <DSTAT>.
PRFOR2,	JMS SYNAN	/CALL SYNTACTIC ANALYSER (RECURSION
	POP		/POP UP ALL VARIABLES. 
	DCA SYNAN
	TAD (-NUMWD-NUMWD-5) 
	DCA WDCNT
	TAD (XSTEP) 
	DCA NORMTO  
PRFR2L,	POP
	DCA I NORMTO
	CLA CMA  
	TAD NORMTO  
	DCA NORMTO  
	ISZ WDCNT
	JMP PRFR2L  
	GET (INCR)	/GET INCREMENT.  
	SWP
	CDF 10
	GET INDEX	/GET INDEX VARIABLE VALUE.
	JMS FAD		/ADD INDEX AND INCR.
	CDF 10
	STORE INDEX	/STORE IN INDEX, LEAVE IN FAC.  
	JMP PRFORL  
/  
PRFOR4,	TAD AC+PREC-1   /GET FAC H-O DIGIT.  
	SNA CLA		/IS FAC GT 0?  
	JMP PRFOR1	/NO.  EQUAL TO 0.
	RETURN		/YES.  EXIT.  
/"STOP" GENERATOR.  
/  
PRSTOP,	POP		/REMOVE <ITAIL> AND <ISTAT>
	POP		/FROM THE STACK. 
	CLA
	TAD (STPMSG)
PRSTP1,	JMS TYPKST	/TYPE STOP MESSAGE. 
	TAD (ERST+3) 
	JMS TYPKST	/TYPE "IN STEP". 
	TAD XSTEP	/LOCATION OF THIS STEP.
	JMS TYSNUM	/GO TYPE STEP NUMBER.  
PRSTP3,	CRLF
PRSTP2,	JMS INPUT	/GET A LINE.  
	ISZ QINSTAT
	DCA XSTEP	/SET FOR "DIRECT". 
	TAD (INTST-1)  
	JMS SYNAN	/CALL SYNTACTIC ANALYSER .
	JMP PRSTP2	/CONTINUE IN INTERRUPT MODE. 
/  
STPMSG,	TEXT /"STOP" /
INTMSG,	TEXT /INTERRUPTED /  
/  
/ILLEGAL INTERRUPT COMMAND MESSAGE. 
ILLINT,	TAD (EHMSG)	/TYPE "EH?".  
	JMS TYPKST  
	JMP PRSTP3	/ACCEPT NEXT INTERRUPT MESSAGE. 
/"IF" GENERATORS.
/  
/  
STGT,	TAD (GGT-GLT)  
STLT,	TAD (GLT-GGE)  
STGE,	TAD (GGE-GLE)  
STLE,	TAD (GLE-GEQ)  
STEQ,	TAD (GEQ-GNE)  
STNE,	TAD (GNE)
	JMP GPDU 
	EP4=. 
	LIT  
	PAGE 5  
/  
GGT,	JMS COMP	/COMPARE FAC WITH IR.  
	JMP POPEX	/AC < IR.
	JMP POPEX	/AC = IR 
	RETURN		/AC > IR.  SUCCESS.  
/  
GLT,	JMS COMP 
	RETURN
	JMP POPEX
POPEX,	POP		/POP STACK TO REMOVE <DSTAT>.  
	CLA		/OR <ISTAT>. 
EXIT,	JMP SYNEXIT	/EXIT FROM SYNTACTIC ANALYZER.
/  
GGE,	JMS COMP 
	JMP POPEX
	RETURN
	RETURN
/  
GLE,	JMS COMP 
	RETURN
	RETURN
	JMP POPEX
/  
GEQ,	JMS COMP 
	JMP POPEX
	RETURN
	JMP POPEX
/  
GNE,	JMS COMP 
	RETURN
	JMP POPEX
	RETURN
/COMP 
/COMPARISON SUBROUTINE.  COMPARES FAC WITH IR,	
/ DESTROYING BOTH IN THE PROCESS.  8AC IS 0 ON ENTRY  
/AND EXIT.  
/CALLING SEQUENCE IS:
/	JMS COMP 
/	...		/IF AC < IR.
/	...		/IF AC = IR.
/	...		/IF AC > IR.
/  
COMP,	0  
	JMS FSB	/SUBTRACT IR FROM FAC. 
	TAD ACS  
	SZA CLA		/IS FAC SIGN NEGATIVE?  
	JMP I COMP	/YES.
	ISZ COMP	/NO. 
	TAD AC+PREC-1   /GET H-O FAC DIGIT.  
	SZA CLA		/IS IT 0?
	ISZ COMP	/NO. 
	JMP I COMP	/YES.  THEREFOR FAC IS 0. 
	EP5=. 
	LIT  
	*EP1  
/"TYPE" GENERATORS. 
/  
SAVNXT,	TAD NXTLXF	/SAVE LEXICAL ANALYSER POINTER TO  
	DCA SVLXF	/CURRENT CHARACTER OF INSTRUCTION
	TAD NXTLXF+1	/ STRING.
	DCA SVLXF+1  
	RETURN
	PAGE 6  
/  
PSHNXT,	DIFPTR NXTLXF,SVLXF  /SVLXF-NXTLXF  
	DCA WDCNT	/STORE # OF CHARAS. 
	RETURN  
PSHNX1,	JMS TYEXPR	/GO TYPE SYMBOLIC EXPRESSION
	RETURN		/  AND FAC.
	EP6=. 
	*EP5  
/  
TYEXPR,	0  
	TAD [NUMLSP]	/# OF SPACES BEFORE "=".  
	TAD WDCNT	/SUBTRACT CHAR COUNT.  
	SPA SNA		/SHOULD LEADING SPACES BE PRINTED?  
	JMP PTOT2	/NO.  (NOTE AC NOT 0). 
	JMS TYSPC	/GO TYPE SPACES. 
PTOT2,	DCA TMP		/SAVE WHETHER OR NOT TO TYPE SPACES
			/AFTER = SIGN. 
	JMS PRSTRG	/TYPE CHAR. STRING. 
	TAD TMP  
	JMS TYVAL	/GO TYPE VALUE.  
	JMP I TYEXPR	/EXIT.
NUMLSP=DECIMAL 10 OCTAL  
/TYPE "STRING" GENERATORS.
/  
TSTRG,	TAD ALCNT	/# OF CHARS. DETERMINED BY TCSCRS. 
	SNA		/IS IT 0?
	RETURN		/YES.  DON'T TYPE ANYTHING.
	CIA		/NO.  COMPLEMENT FOR COUNT.  
	DCA WDCNT	/ OF CHARACTERS TO BE TYPED.
	ADV SVLXF	/ADVANCE OVER FIRST ".  
	JMS PRSTRG	/PRING STRING.
	RETURN
/  
/  
/PRSTRG  
/PRINT STRING SUBROUTINE.  
/PRINTS A STRING OF INTERNAL CHARACTERS.  
/FIRST CHARACTER LOCATION IS IN SVLXF AT ENTRY. 
/"WDCNT" HAS COMPLEMENT OF  OF CHARS TO PRINT.
/8AC IS 0 AT EXIT.
/  
PRSTRG,	0  
PRSL,	RDADV SVLXF	/GET NEXT CHARACTER.
	JMS TYINCH	/TYPE CHAR.
	ISZ WDCNT	/END OF LOOP?  
	JMP PRSL	/NO. 
	JMP I PRSTRG	/YES.
/  
/  
/TYSPC
/TYPE NUMBER OF SPACES SPECIFIED BY 8AC AT ENTRY.  
/8AC IS CLEAR AT EXIT.  
/  
TYSPC,	0  
	CIA
	DCA TMP  
TYSPCL,	TAD (240)
	TYPE 
	ISZ TMP	/DONE?
	JMP TYSPCL	/NO. 
	JMP I TYSPC 
	EP5=. 
	LIT  
	*EP2  
/PROCESS UNARY MINUS.
/  
SCHSGN,	TAD (CHSGN) 
	JMP GPD  
/  
CHSGN,	TAD ACS	/COMPLEMENT FAC SIGN.  
	CMA
	AND [0020] 
PRABS,	DCA ACS  
	RETURN
/  
/TYPE FLOATING FAC.  
TYFAC,	IAC  
	JMS TYFP	/TYPE FAC WITHOUT LEADING SPACES.  
	RETURN  
	LIT
	*EP6  
/TYPE ALL VALUES. 
/  
TAVAL,	CRLF		/RETURN CARRIAGE AT START. 
	JMS SCNVRB	/GO TO SCAN VARIABLES. 
	JMP PRLINE	/FINAL EXIT WHEN DONE SCAN.  
	JMS TYPVAR	/PLUGGED IN ROUTINE -- TYPE VAR. 
	NOP		/DONT CARE IF UNDEFINED. 
	JMP SCNRET 
/TYPE ALL "A".
/  
TYARRY,	CPY CURSYM,VARLOC	/COPY VARIABLE LOCATION TO VARLOC 
	RD SVLXF	/AND VARIABLE NAME TO VARNAM.
	DCA VARNAM 
	JMS TYPVAR	/TYPE OUT VARIABLE.  
	JMP ERRUND	/IF UNDEFINED, ERROR.
PRLINE,	CRLF		/RETURN CARRIAGE AND EXIT.
	RETURN  
/  
/TYPE VARIABLE ROUTINE. 
/VARIABLE NAME IN 'VARNAM', LOCATION IN 'VARLOC'.
/  
TYPVAR,	0
	CDF 10
	TAD I VARLOC	/PLUGGED IN ROUTINE FOR VARB.  
	CDF 0
	CMA
	SNA		/IS VARIABLE DEFINED?
	JMP I TYPVAR	/NO, TAKE UNDEFINED EXIT.
	ISZ TYPVAR 
	TAD [-4000]  
	SNA CLA		/IS VARIABLE SIMPLE? 
	JMP TYSUBS	/NO. 
	TAD (NUMLSP-1) 
	JMS TYSPC	/TYPE SPACES. 
	TAD VARNAM	/TYPE VARIABLE NAME.
	JMS TYINCH  
	CDF 10
	GET VARLOC	/UNPACK NUMBER.  
	JMS TYVAL	/GO TYPE VALUE.  
	CRLF		/RETURN CARRIAGE. 
	JMP I TYPVAR	/RETURN.  
/  
/TYPE OUT ALL VALUES OF A SUBSCRIPTED VARIABLE. 
/  
TYSUBS,	TAD VARNAM	/VARIABLE NAME IN PACKED CODE.  
	CLL RTL  
	ROTL4 
	TAD (ILBRAC)
	DCA OUTBUF	/STORE <NAME> AND "[".
	TAD VARLOC  
	IAC
	DCA CURSYM	/SET VARIABLE LOCATION.
	CLA CMA  
	CDF 10
	TAD I CURSYM	/GET  OF SUBSCRIPTS -1.  
	DCA IRX		/SAVE IT.  
	ISZ CURSYM  
TYSUBL,	TAD I CURSYM	/GET CURRENT "NEXT" POINTER.
	CLL  
	TAD (-VBLKEND)	/IS IT LAST ELEMENT? 
	SZL CLA 
	JMP TYSUB1	/NO.  
	CDF 0		/YES.
	JMP I TYPVAR	/FINISHED WITH VARIABLE. 
/  
TYSUB1,	TAD I CURSYM	/LOCATION OF NEW ELEMENT.  
	DCA CURSYM 
	TAD CURSYM  
	DCA AX4  
	TAD (OUTBUF+1)  
	DCA SVLXF	/INITIALISE STRING POINTER.  
	DCA SVLXF+1  
	TAD I AX4	/GET FIRST SUBSCRIPT VALUE.  
	CDF 0
	JMS BTOD	/CONVERT TO DECIMAL.
	TAD IRX  
	SNA CLA		/HOW MANY SUBSCRIPTS?
	JMP TYSUB2	/1.  
	TAD (ICOMMA)	/2.  
	WRADV SVLXF	/WRITE "," INTO STRING.  
	CDF 10
	TAD I AX4	/GET 2ND SUBSCRIPT VALUE. 
	CDF 0
	JMS BTOD	/CONVERT O DECIMAL. 
TYSUB2,	TAD (IRBRAC)
	WRADV SVLXF	/WRITE "]" INTO STRING.
	TAD CURSYM  
	TAD [3]		/LOCATION OF VALUE.
	CDF 10
	JMS I [GETNUM]  /GET VALUE.  
	DIFPTR SVLXF,LBUFF   /GET  OF CHARS.  
	DCA WDCNT
	TAD LBUFF
	DCA SVLXF
	DCA SVLXF+1	/RESET POINTER TO BEGINNING.  
	JMS TYEXPR	/TYPE NAME AND VALUE.  
	CRLF		/RETURN CARRIAGE. 
	CDF 10
	JMP TYSUBL	/GO PROCESS NEXT ELEMENT. 
/  
	OUTBUF=IR 
LBUFF,	OUTBUF	/LOCATION OF BUFFER 
	0	/USED IN LENGTH COMPUTATION.  
/  
/TYPE "SIZE". 
/  
TYPSIZ,	TAD [NUMLSP]	/TYPE OUT LEADING SPACES. 
	JMS TYSPC  
	TAD STKNXT	/COMPUTE AMOUNT OF SPACE LEFT:
	CMA		/AYNXT-STKNXT-1.
	TAD ARYNXT 
	JMS BTODX	/CONVERT RESULT TO DECIMAL AND PRINT.
	JMP PRLINE 
/  
	EP6=. 
	LIT  
	*BP34 
/BINARY TO DECIMAL CONVERSION.
/  
BTOD,	0  
	SPA		/IS VALUE POSITIVE?  
	JMP BTODM	/NO. 
	DCA IRS		/YES.  SVE IT.
BTOD1,	TAD DECIMAL (-100) OCTAL
	JMS BTODDV	/GET THE HUNDREDS DIGIT. SKIP ON 0.
	JMP BTODNZ	/NON-ZERO. 
	TAD DECIMAL [-10] OCTAL
	JMS BTODDV	/GET THE TENS DIGIT.  SKIP ON 0.
BTOD2,	JMS BTODAD	/PUT IN BUFFER.  
	TAD IRS		/GET ONES DIGIT. 
	JMS BTODAD	/PUT IN BUFFER EVEN IF 0. 
	JMP I BTOD	/EXIT.  
/  
BTODNZ,	JMS BTODAD	/NON-ZERO HUNDREDS DIGIT. 
	TAD DECIMAL [-10] OCTAL
	JMS BTODDV	/GET TENS DIGIT. 
	NOP
	JMP BTOD2
/  
BTODM,	CIA		/COMPLEMENT NEGATIVE NUMBER  
	DCA IRS		/ TO GET ITS MAGNITUDE.
	TAD [IMINUS-60]  
	JMS BTODAD	/PUT "-" IN BUFFER.
	JMP BTOD1
/  
/DIVIDES IRS BY NUMBER IN AC AT ENTRY.  RESULT LEFT IN AC.  
BTODDV,	0  
	DCA ALDIG	/SAVE DIVISOR.
	DCA DIGAC	/CLEAR QUOTIENT. 
BTODD1,	CLL 
	TAD IRS 
	TAD ALDIG	/SUBTRACT DIVISOR
	SNL		/IS RESULT POSITIVE?
	JMP BTODD2	/NO. 
	DCA IRS		/YES.
	ISZ DIGAC	/INCREMENT QUOTIENT.
	JMP BTODD1	/LOOP.  
BTODD2,	CLA
	TAD DIGAC
	SNA		/IS QUOTIENT 0?
	ISZ BTODDV	/YES.  SKIP NEXT INXTRUCTION.
	JMP I BTODDV	/EXIT.  
/  
/TAKES DECIMAL DIGIT (0-11 OCTAL), WRITES TO BUFFER.  
BTODAD,	0  
	TAD (60) 
	WRADV SVLXF	/WRITE INTOP BUFFER.
	JMP I BTODAD

/  
/BTODX -- EXTENDED BINARY TO DECIMAL WITH PRINTING.
/	INPUT:  BINARY IN 8AC.
/	OUTPUT: CHARS. ON TELETYPE  
/  
/RANGE: 0-4095.
/  
BTODX,	0 
	DCA IRS		/SAVE INPUT IN IRS (FOR BTOD),
	CPY (MQ),SVLXF	/SET UP POINTER FOR BTOD. 
	DCA SVLXF+1 
	CPY (BTXRTN),BTOD	/SET UP RETURN FOR BTOD.  
	TAD DECIMAL (-1000) OCTAL 
	JMS BTODDV	/DIVIDE INPUT BY 1000.  
	SKP		/WAS INPUT < 1000?
	JMP BTOD1	/YES, TREAT LIKE NORMAL NUMBER.
	JMS BTODAD	/NO, STORE 1000'S DIGIT. 
	TAD DECIMAL (-100) OCTAL  
	JMS BTODDV	/GET 100'S DIGIT
	NOP		/AND STORE EVEN IF ZERO. 
	JMP BTODNZ 
/  
BTXRTN,	WRADV SVLXF	/WRITE EOL AFTER LAST NUMBER.  
	TAD (MQ)	/TYPE OUT PACKED STRING.  
	JMS TYPKST 
	JMP I BTODX	/RETURN 
/  
/"END OF LINE" PROCESSOR. 
PREOL,	DCA QEOL	/SET END OF LINE FLAG TO "EOL".
	RDADV NXTLXN	/GET CURRENT CHAR. 
	SNA		/IS IT EOL?
	JMP RCSUC	/YES, SUCCESS.  
	TAD (-ISEMI)	/NO, IS IT SEMICOLON?  
	SZA CLA 
	JMP RCFAIL	/NO, FAILURE.  
	CLA CMA 
	DCA QEOL	/YES, SET END OF LINE FLAG TO "SEMICOLON". 
	JMP RCSUC  
	LIT
	PAGE 7
/TYVAL
/TYPE VALUE OF A NUMBER.
/PASSES 8AC VALUE ON ENTRY TO TYFP.  8AC CLEAR AR EXIT.  
/  
TYVAL,	0  
	JMS TYSES	/GO TYPE " = ".  
	JMS TYFP	/TYEP VALUE.  
	JMP I TYVAL 
/  
/TYSES
/TYPE " = ".
/SAVES INPUT AC.  
TYSES,	0  
	DCA TMP  
	TAD (240)	/TYPE " = ".  
	TYPE 
	TAD (275)
	TYPE 
	TAD (240)
	TYPE 
	TAD TMP  
	JMP I TYSES 
/
/
/"TYPE ALL PARTS" GENERATOR. 
/  
TYAP,	TAD DECIMAL (-9) OCTAL  
	DCA MULCNT	/SET PART COUNTER.  
	TAD (PRTLST)
	DCA AX4		/SET PART LIST START. 
TYAPS1,	TAD AX4		/GET PART START LOCATION. 
	DCA CURSTP  
	CDF 10
	TAD I CURSTP  
	CDF 0
	SNA CLA		/IS PART EMPTY?
	JMP TYAPS3	/YES.
	CRLF		/LEAVE BLANK LINE.
TYAPS2,	JMS GNSTP	/GO TO NEXT STEP.
	JMP TYAPS3	/END OF PART. 
	JMS TYSTPS	/TYPE STEP.
	JMP TYAPS2  
/  
TYAPS3,	ISZ AX4  
	ISZ MULCNT	/END OF PART LIST?
	JMP TYAPS1	/NO.  TYPE NEXT PART.  
	RETURN		/YES.  EXIT.  
/  
/  
/TYSTPS  
/TYPE STEP WHOSE LOCATION IS GIVEN BY CURSTP.
/  
TYSTPS,	0  
	TAD CURSTP	/GET LOC. OF STEP.  
	JMS TYSNUM	/GO TYPE STEP #. 
	TAD (240)
	TYPE 
	TAD CURSTP  
	TAD (NUMWD+1)   /GET LOC OF 1ST WORD OF STEP. 
	JMS TYPKUP	/GO TYPE STEP. 
	TAD (256)
	TYPE		/TYPE ".". 
	CRLF 
	JMP I TYSTPS	/EXIT.  
/  
/  
/TYSNUM  
/TYPE STEP NUMBER.  8AC CONTAINS LOC. OF STEP.  
/  
TYSNUM,	0  
	IAC
	CDF 10
	JMS I [GETNUM]  /GET STEP #. 
	CLA IAC  
	DCA ACX		/FORCE ACX"1.  
	IAC		/FORCE AC NON-0. 
	JMS TYFP	/TYPE STEP #. 
	JMP I TYSNUM
/TYPKST  
/TYPE PACKED STRING. 
/LOCATION OF STRING IS IN 8AC ON ENTRY.  AC CLEAR ON EXIT.  
/  
TYPKST,	0  
	DCA NORMFR	/STORE STRING POINTER.
	DCA NORMTO	/SET ?RIGHT TO 0.
	TYSTRG NORMFR   /TYPE STRING. 
	JMP I TYPKST
/  
/  
/TYSTRS  
/TYPE STRING SUBROUTINE.  TYPES STRING UNTIL 
/ AN END CHARCTER (00). 
/  
/CALLING SEQUENCE:
/	JMS TYSTRS  
/	PTRNAM	/LOCATION OF STRING POINTER. 
/MACRO:  TYSTRG PTRNAM  
/8AC CLEAR ON INPUT AND OUTPUT.  
/  
TYSTRS,	0  
	TAD I TYSTRS	/GET STRING POINTER.
	ISZ TYSTRS	/ADVANCE OVER POINTER. 
	DCA .+2		/STORE IN "RDADV" CALL.
TYSTR1,	RDADV 0  
	SNA		/IS IT END OF STRING?
	JMP I TYSTRS	/YES.  EXIT.  
	JMS TYINCH	/NO.  TYPE CHARACTER.  
	JMP TYSTR1  
/  
/  
/TYPE INTERNAL CHARACTER
/CHARACTER IN 8AC AT ENTRY, 8AC CLEAR AT EXIT.  
/  
TYINCH,	0  
	TAD (-40)
	SPA		/IS IT BETWEEN 0 AND 37?
	TAD (100)	/YES.  ADD 300 TO GET 301 TO 337.  
	TAD (240)	/NO.  ADD 200 TO GET 240 TO 277.
	TYPE 
	JMP I TYINCH
/  
TYPKUP,	0		/TYPE UPPER MEMORY INTERNAL STRING.
	DCA NORMFR 
	CPY [0010],NORMTO  
	TYSTRG NORMFR 
	JMP I TYPKUP  
/SCNVRB - SCAN ALL VARIABLES. 
/8AC CLEAR ON ENTRY AND BOTH EXITS.  MUST ALSO BE 0 AT RETURN
/AT EACH INTERMEDIATE EXIT TO PLUGGED-IN ROUTINE,	
/  "VARLOC" CONTAINS LOCATION OF VARIABLE
/   "VARNAM" CONTAINS VARIABLE NAME IN ASCII.  
/  
SCNVRB,	0  
	TAD SCNVRB	/GET LOCATION OF PLUGGED-IN  
	IAC		/ROUTINE  AND SAVE IT. 
	DCA PSENT
	DCA VARNAM	/INITIALISE VARIABLE NAME.
	TAD DECIMAL (-26) OCTAL 
	DCA SCNCNT  
	TAD (VRBLOC-NUMWD)
	SKP
SCNL1,	TAD VARLOC  
	TAD [NUMWD]
	DCA VARLOC  
	ISZ VARNAM  
	JMP I PSENT	/GO TO PLUGGED-IN ROUTINE.
/PLUGGED-IN ROUTINE RETURNS HERE:
SCNRET,	ISZ SCNCNT	/LAST VARIABLE?
	JMP SCNL1	/NO. 
	JMP I SCNVRB	/YES.  FINAL EXIT.  
/  
PSENT,	0		/PLUGGED-IN ROUTINE ENTRY.
SCNCNT,	0		/VARIABLE COUNTER.  
/
/
/"DELETE" GENERATORS.  
/  
/DELETE ALL VALUES.  
/  
DLAVAL,	TAD (USEREND)  
	DCA ARYNXT	/RESET START OF ELEMENT STORAGE.
	JMS SCNVRB	/SCAN ALL VARIABLES.
	RETURN		/FINAL EXIT.  
	CLA CMA  
	CDF 10
	DCA I VARLOC	/STORE 7777 IN VARIABLE. 
	CDF 0
	JMP SCNRET	/RETURN TO SCAN. 
/  
/  
	EP7=.  
	LIT
	PAGE 10  
/XEQS 
/EXECUTE STEP GENERATOR.  CALLS SUBROUTINE SPECIFIED  
/ BY XEQSUB FOR STEP SPECIFIED BY FAC. 
/  
XEQS,	JMS FNDSTP	/FIND LOCATION OF STEP.
	JMP ERRSTP	/ERROR IN STEP NUMBER. 
	JMS I XEQSUB	/GO TO EXECTION SUBROUTINE.  
	RETURN
/  
/  
/XEQP 
/EXECUTE PART GENERATOR.  CALLS SUBROUTINE
/SPECIFIED BY XEQSUB ONCE FOR EACH STEP OF PART 
/SPECIFIED BY PARTNO AT ENTRY.
/  
XEQP,	TAD PARTNO  
	TAD (PRTLST-1) 
	DCA CURSTP	/LOCATION OF PART CONTROL WORD. 
XEQPL,	JMS GNSTP	/GET NEXT STEP LOC. 
	RETURN		/END OF LOOP. 
	JMS I XEQSUB	/CALL EXECUTION SUBROUTINE.  
	JMP XEQPL
/  
XEQSUB,	0		/EXECUTION SUBROUTINE LOCATION. 
/  
/  
/INITIALISE XEQSUB GENERATORS.
/  
STDLST,	TAD (DLSTPS-TYSTPS)  
STTYST,	TAD (TYSTPS-DOSTPS)  
STDOST,	TAD (DOSTPS)
	DCA XEQSUB  
	RETURN
/DLSTPS  
/DELETE STEP SUBROUTINE.  DELETE STEP WHOSE LOCATION  
/IS IN CURSTP AND WHOSE PREDECESSOR IS IN PRVSTP.  
/8AC IS CLEAR AT ETNRY AND EXIT. 
/  
DLSTPS,	0  
	CDF 10
	TAD I CURSTP	/GET POINTER OF CURSTP 
	DCA I PRVSTP	/PUT IN PREDECESSOR.
	TAD CURSTP  
	JMS GLGSTP	/GET STEP LENGTH.
	DCA ALCNT
	TAD CURSTP  
	CIA CLL  
	TAD PRVSTP  
	SNL CLA		/IS PREVIOUS STEP FOLLOWING CURRENT
	JMP DLSTP0	/NO. 
	TAD ALCNT	/YES.
	TAD PRVSTP	/DECREMENT POINTER. 
	DCA PRVSTP  
DLSTP0,	CLA CMA		/INITIALISE PACK-DOWN LOOP.  
	TAD CURSTP  
	DCA AX1		/"TO" LOACTION FOR LOOP. 
	TAD AX1  
	TAD MULCNT  
	DCA AX0		/"FROM" LOCATION.  
	TAD CURSTP	/INITIAL STEP LOCATION.
	DCA NORMTO  
	TAD PRVSTP  
	DCA CURSTP  
/PACK DOWN ONE STEP. 
DELLP1,	TAD NORMTO	/ADVANCE OVER PREVIOUS STEP. 
	TAD MULCNT  
	DCA NORMTO  
	TAD NORMTO  
	CIA
	TAD ENDPR
	SNA CLA		/END OF STEP STORAGE?
	JMP DLST3	/YES.  GO DELETE SPACE.
	TAD NORMTO	/GET PART LOCATION. 
	TAD [NUMWD]
	DCA TMP  
	TAD I TMP
	AND (0017)  
	TAD (PRTLST-1) 
	DCA CRWD 
DELLP2,	TAD I CRWD  
	CIA
	TAD NORMTO  
	SNA CLA		/IS CURRENT STEP POINTING TO WANTED
	JMP DLST1	/YES.
	TAD I CRWD	/NO. 
	DCA CRWD	/GO ON TO NEXT STEP.
	JMP DELLP2  
DLST1,	TAD ALCNT	/SET POINTER TO POINT TO  
	TAD NORMTO	/NEW LOCATION.
	DCA I CRWD  
	TAD NORMTO  
	JMS GLGSTP	/GET LENGTH OF CURRENT STEP. 
	DCA WDCNT	/STORE COMPLEMENT OF LENGTH. 
DLST2,	TAD I AX0	/MOVE STEP DOWN "ALCNT" WORDS. 
	DCA I AX1
	ISZ WDCNT
	JMP DLST2
	JMP DELLP1	/GO ON TO NEXT STEP IN STORAGE. 
/  
DLST3,	TAD ALCNT	/DECREMENT "END OF USER AREA"  
	TAD ENDPR	/ENDPR-ALCNT  
	DCA ENDPR	/TO ENDPR  
	CDF 0
	JMP I DLSTPS	/EXIT.  
/  
/GLGSTP - GET LENGTH OF STEP SUBROUTINE.  
/AT ENTRY, 8AC HAS LOCATION OF STEP.
/AT EXIT, MULCNT CONTAINS LENGTH, AND 8AC CONTAINS 
/ COMPLEMENT OF LENGTH. 
/  
GLGSTP,	0  
	IAC		/ADVANCE TO LENGTH WORD.  
	DCA TMP  
	TAD I TMP	/GET LENGTH WORD.
	ROTR5 
	AND [0077]	/EXTRACT LENGTH.
	DCA MULCNT	/STORE LENGTH.
	TAD MULCNT  
	CIA		/GET COMPLEMENT OF LENGTH. 
	JMP I GLGSTP	/IN 8AC AT EXIT. 
	EP10=. 
	LIT
	PAGE 11  
/"DELETE" <VARIABLE>. 
/  
DELCUR,	CLL
	CDF 10
	TAD CURSYM	/GET VARIABLE LOCATION.
	TAD (-USERPR)   /SUBTRACT BEGINNING OF USER AREA.  
	SZL CLA		/IS VARIABLE A SUBSCRIPT ELEMENT?
	JMP DELCR1	/YES.
	TAD I CURSYM	/NO. 
	TAD (-3777) 
	SZA CLA		/IS VARIABLE "SIMPLE" 
	JMP DELCUN	/YES.
DELSUB,	TAD CURSYM	/NO. 
	TAD [2] 
	DCA PREVEL	/POINTER LOC. 
DLSUB1,	TAD I PREVEL	/GET "NEXT ELEMENT" LOC. 
	CLL  
	TAD (-VBLKEND)	/IS IT "END"? 
	SNL  
	JMP DELSBX	/YES. 
	TAD (VBLKEND) 
	DCA CURSYM  
	JMS DELELS	/DELETE ELEMENT. 
	JMP DLSUB1  
/  
DELSBX,	CLA		/NOW DELETE CONTROL WORD. 
	TAD PREVEL  
	TAD [-2]
	DCA CURSYM	/LOCATION OF CONTROL WORD.
DELCUN,	CLA CMA  
	DCA I CURSYM	/SET VARIABLE "UNDEFINED".  
	CDF 0
	RETURN
/  
DELCR1,	TAD CURSYM	/LOCATION OF VALUE. 
	TAD [-3]
	DCA CURSYM	/LOCATION OF POINTER WORD.
	JMS DELELS	/DELETE ELEMENT. 
	CDF 0
	RETURN
/  
PREVEL,	0		/PREDECESSOR ELEMENT.  
/DELELS  
/DELETE SUBSCRIPTED VARIABLE ELEMENT.  
/	CURSYM - LOC. OF POINTER WORD. 
/	PREVEL - LOC. OF PREDECESSOR POINTER WORD. 
/  
DELELS,	0  
	TAD I CURSYM	/GET POINTER OF DELETED ELEMENT.
	DCA I PREVEL	/STORE IN PREDECESSOR. 
	TAD CURSYM  
	CIA
	TAD ARYNXT  
	SNA CLA		/IS DELETED ELEMENT LAST IN STORE? 
	JMP DELELX	/YES.
	TAD ARYNXT	/NO.  SET UP LOOP TO
	DCA CRWD	/ SEARCH FOR POINTER TO
DELEL1,	TAD I CRWD	/ LAST ELEMENT.  
	CLL  
	TAD (-VBLKEND)	/IS CURRENT ELEMENT "END"?
	SNL  
	JMP DELEL2	/YES. 
	TAD (VBLKEND) 
	DCA CRWD	/NO.  ADVANCE TO NEXT ELEMENT.  
	JMP DELEL1	/CONTINUE SEARCH 
/  
DELEL2,	TAD (VBLKEND)	/NOW AT CONTROL WORD.  
	DCA CRWD	/LOCATION OF CONTROL POINTER.
DELEL3,	TAD I CRWD  
	CIA
	TAD ARYNXT  
	SNA CLA		/IS THIS POINTER TO LAST ELEMENT?
	JMP DELEL4	/YES.
	TAD I CRWD	/ADVANCE TO NEXT ELEMENT. 
	DCA CRWD 
	JMP DELEL3  
/  
DELEL4,	TAD CURSYM	/SET PREDECESSOR TO POINT TO 
	DCA I CRWD	/ LOC. OF DELETED ONCE.
	CLA CMA  
	TAD ARYNXT  
	DCA AX0		/FROM LOCATION.  
	CLA CMA  
	TAD CURSYM  
	DCA AX1		/"TO" LOCATION  
	TAD [-NUMWD-3]
	DCA WDCNT
DELEL5,	TAD I AX0	/MOVE LAST ELEMENT TO REPLACE
	DCA I AX1	/DELETED ONE. 
	ISZ WDCNT
	JMP DELEL5  
DELELX,	TAD ARYNXT	/SET NEW ELEMENT STORE 
	TAD [NUMWD+3]	/END LOCATION.  
	DCA ARYNXT  
	JMP I DELELS	/EXIT.  
/"DELETE ALL PARTS" GENERATOR.  
/  
DALPRT,	TAD (USERPR)	/RESET START  
	DCA ENDPR	/ OF USER PROGRAM AREA.
	TAD DECIMAL (-9) OCTAL  
	DCA WDCNT
	TAD (PRTLST-1)  /INITIALIZE CLEAR LOOP.
	DCA AX0  
DALPR1,	CDF 10		/CLEAR PART LIST.  
	DCA I AX0  
	CDF 0
	ISZ WDCNT
	JMP DALPR1  
	RETURN
/
/
/"DEMAND" GENERATOR.
/  
PRDMD,	JMS PRSTRG	/TYPE STRING WITH VARB. NAME. 
PRDMD1,	JMS TYSES	/TYPE " = ".  
	TAD CURSYM  
	PUSH		/SAVE VAR. LOC.  
	JMS SAVSYN	/SAVE SYNAN VARIABLES.  
	JMS INPUT	/CALL INPUT ROUTINE TO GET EXPRESSION.  
	DCA QEOL
	TAD (INVAL-1)  
	JMS SYNAN	/GET VALUE OF EXPRESSION. 
	JMS GETSYN	/RESTORE SYNAN VARIABLES.  
	POP		/GET VARB LOCATION. 
	CDF 10
	JMS I [STPACK]  /STORE NUMBER IN "CURSYN". 
	RETURN
/  
SCREOL,	JMP PREOL	/GO PROCESS END OF LINE.

	LIT
	*EP10 
/"DO" GENERATORS.
/  
DOPRT,	TAD NXTSTP  
	PUSH  
	TAD PARTNO  
	TAD (PRTLST-1) 
	DCA CURSTP	/FIRST STEP POINTER.
	CDF 10
	TAD I CURSTP	/GET FIRST STEP POINTER. 
	CDF 0
	SNA CLA		/IS PART EMPTY?  
	JMP ERRPRT	/YES.  PART # ERROR.
DOPRT1,	JMS GNSTP	/NO, GET NEXT STEP. 
	JMP DOPRTX	/DONE WITH PART. 
	TAD CURSTP  
	DCA NXTSTP	/NEXT STEP POINTER. 
	JMS DOSTPS	/DO THE CURRENT STEP. 
	TAD NXTSTP	/GET THE NEXT STEP. 
	DCA CURSTP	/STORE POINTER TO NEXT STEP. 
	JMP DOPRT1	/LOOP.  
/  
DOPRTX,	POP
	DCA NXTSTP	/SET NEXT STEP FOR HIGHER LEVEL 
	RETURN		/OF RECURSION AND EXIT.
/  
PARTNO,	0		/CURRENT PART NUMBER.  
	LIT  
	*EP5  
/  
/  
/DOSTPS  
/INVOKE A STEP SUBROUTINE.  STEP LOC. IS IN CURSTP.
/  
DOSTPS,	0  
	TAD CURSTP	/SET STEP LOCATION  
	DCA XSTEP	/  FOR ERROR ANALYSIS. 
	TAD DOSTPS  
	PUSH		/PUSH DOWN EXIT FROM
	JMS SAVSYN	/DOSTPS AND SYNAN FOR RECURSION. 
	TAD CURSTP  
	TAD (NUMWD+1)
	DCA NXTLXF	/SCAN START.  
	CPY [0010],NXTLXF+1 
	DCA QEOL
	TAD (ISTAT-1)   /SCAN INDIRECT STATEMENT. 
	JMS SYNAN
	KSF		/IS KEYBOARD FLAG SET?  
	JMP DOSTP2	/NO. 
	KRS		/READ KEYBOARD STATIC (DON'T  
	TAD (-ICODE)	/  CLEAR FLAG.)  
	SNA CLA		/IT CHARACTER "ALT MODE"? 
	JMP INTRPT	/YES.  GO INTO INTERRUPT STATE. 
DOSTP2,	DCA QINSTAT	/RESTORE SAVED LOCATIONS.
	JMS GETSYN 
	POP
	DCA DOSTPS  
	JMP I DOSTPS	/EXIT.  
/  
/SAVSYN -- SAVE SYNTACTIC ANALYZER VARIABLES.
SAVSYN,	0
	TAD SYNAN	/SAVE EXIT FROM SYNAN,
	PUSH		/EOL FLAG,	
	TAD QEOL
	PUSH 
	TAD NXTLXF	/AND LEXICAL ANALYZER POINTERS.  
	PUSH 
	TAD NXTLXF+1
	PUSH 
	JMP I SAVSYN  
/GETSYN -- GET SYNTACTIC ANALYZER VARIABLES. 
GETSYN,	0
	POP		/RESTORE VARIABLES FROM STACK. 
	DCA NXTLXF+1
	POP  
	DCA NXTLXF 
	POP  
	DCA QEOL
	POP  
	DCA SYNAN  
	JMP I GETSYN  
	LIT  
	*EP4  
/  
INTRPT,	KCC		/CLEAR TELETYPE FLAG.  
	TAD (INTMSG)	/GET SET TO TYPE "INTERRUPTED".
	JMP PRSTP1	/GO INTO INTERRUPT MODE.  

	LIT  
	*EP3  
/"TO" GENERATORS:
/  
/"TO STEP" GENERATOR.  
PRTOS,	JMS FNDSTP	/FIND STEP LOCATION.
	JMP ERRSTP	/ERROR - STEP #. 
	TAD CURSTP	/GOOD - GET STEP LOC.  
PRDONE,	CDF 10		/STORE NEXT STEP LOCATION INTO 
	DCA I (TOSTPN)	/UPPER MEMORY.
	CDF 0
	TAD (TOSTPN)
PRTOS1,	DCA NXTSTP	/FORCE TRANSFER OF CONTROL.  
	RETURN
/  
/  
/"TO PART" GENERATOR.  
PRTOP,	TAD PARTNO  
	TAD (PRTLST-1)  /LOCATION OF 1ST STEP OF PART.  
	JMP PRTOS1  
/  
/  
/"CANCEL" GENERATOR.
CANCEL,	CRLF		/ENTERED FROM "ALT MODE" IN INPUT.
PRCANC,	TAD (CANMSG)	/ENTERED FROM "CANCEL" STATEMENT. 
	JMS TYPKST	/TYPE "CANCELLED". 
	DCA QINSTAT
	JMP MAIN 

CANMSG,	TEXT /CANCELLED/

	LIT
	PAGE 12 
/ESI-B SYNTAX. 
/  
DSTAT,	TERML TLOG	/LOG ON OR OFF 
	FCALT DSTAT1,.+1,NO  
	TERML TON  
	FCALT .+3,NOSUC,YES  
	GEN PRLON,YES 
	GEN EXIT,NO
	TERML TOFF 
	FCDEAD NOSUC,YES 
	GEN PRLOF,YES 
	GEN EXIT,NO
DSTAT1,	TERML TSTAR	/COMMENT  
	FCALT .+2,NOSUC,YES  
	GEN EXIT,NO
	SUBGL IFCLSE	/DIRECT STATEMENT  
	FCALT .+1,.+1,NO 
	SUBGL DTAIL 
	FCDEAD NOSUC,YES  
	GEN EXIT,NO 
/  
DTAIL,	SUBGL FORCLS
	FCALT .+1,NOSUC,NO 
	SUBGL DOIST 
	FCALT .+1,NOSUC,NO 
	SUBGL DONLY 
	FCDEAD NOSUC,NO
/  
DOIST,	SUBGL SETST	/DIRECT OR INDIRECT 
	FCALT .+1,NOSUC,NO 
	SUBGL DOST  
	FCALT .+1,NOSUC,NO 
	SUBGL TYPST 
	FCALT .+1,NOSUC,NO 
	TERML TLINE 
	FCALT .+2,NOSUC,YES  
	GEN PLINE,NO  
	TERML TNLINE  
	FCALT .+2,NOSUC,YES  
	GEN PNLINE,NO 
	TERML TPAGE
	FCFAIL NOSUC,YES 
	GEN PRPAGE,NO 
/  
DONLY,	SUBGL DDELST	/DIRECT ONLY  
	FCALT DONLY1,NOSUC,NO
DONLY1,	SUBGL ARITH 
	FCDEAD NOSUC,NO
/  
ISTAT,	TERML TSTAR	/COMMENT
	FCALT .+2,NOSUC,YES  
	GEN EXIT,NO
	SUBGL IFCLSE	/INDIRECT STATEMENT.  
	FCALT .+1,.+1,NO 
	SUBGL ITAIL 
	FCDEAD NOSUC,YES  
	GEN EXIT,NO 
/  
ITAIL,	SUBGL FORCLS
	FCALT .+1,NOSUC,NO 
	SUBGL DOIST 
	FCALT .+1,NOSUC,NO 
	SUBGL IONLY 
	FCDEAD NOSUC,NO
/  
IONLY,	SUBGL TOST	/INDIRECT ONLY.  
	FCALT .+1,NOSUC,NO 
	TERML TDONE 
	FCALT IONLY1,NOSUC,YES  
	GEN PRDONE,NO  
IONLY1,	TERML TSTOP 
	FCALT IONLY2,NOSUC,YES  
	GEN PRSTOP,NO  
IONLY2,	SUBGL DEMDST
	FCALT .+1,NOSUC,NO 
	SUBGL IDELST
	FCDEAD NOSUC,NO
/  
IFCLSE,	TERML TIF	/IF CLAUSE 
	FCFAIL .+1,NO
	SUBGL AREX  
	FCDEAD .+1,NO
	SUBGL RELOP 
	FCDEAD IFCL1,YES  
	GEN ACTOS,NO
IFCL1,	SUBGL AREX  
	FCDEAD .+1,NO
	TERML TCOMMA
	FCDEAD NOSUC,YES  
	GEN POPDO,NO
/  
RELOP,	TERML TEQUAL	/RELATIONAL OPERATORS. 
	FCALT .+2,NOSUC,YES
	GEN STEQ,NO 
	TERML TLT2  
	FCALT .+2,NOSUC,YES
	GEN STLT,NO 
	TERML TGT2  
	FCALT .+2,NOSUC,YES
	GEN STGT,NO 
	TERML TGE
	FCALT .+2,NOSUC,YES
	GEN STGE,NO 
	TERML TLE
	FCALT .+2,NOSUC,YES
	GEN STLE,NO 
	TERML TNE
	FCDEAD NOSUC,YES  
	GEN STNE,NO 
/  
FORCLS,	TERML TFOR	/FOR CLAUSE.  
	FCFAIL .+2,YES  
	GEN SQPUN1,NO  
	SUBGL VARB  
	FCDEAD .+1,NO
	TERML TEQUAL
	FCDEAD FORCL1,YES 
	GEN SQPUN0,YES 
	GEN PSHCUR,YES 
	GEN SVINDX,NO  
FORCL1,	SUBGL AREX  
	FCDEAD .+1,NO
	TERML TLPAR 
	FCDEAD .+2,YES  
	GEN STOREC,NO  
	SUBGL AREX  
	FCDEAD .+1,NO
	TERML TRPAR 
	FCDEAD .+2,YES  
	GEN SVINCR,NO  
	SUBGL AREX  
	FCDEAD .+1,NO
	TERML TCOMMA
	FCDEAD NOSUC,YES  
	GEN PRFOR,NO
/  
SETST,	TERML TSET	/"SET" STATEMENT.  
	FCFAIL .+2,YES  
	GEN SQPUN1,NO  
	SUBGL VARB  
	FCDEAD .+1,NO
	TERML TEQUAL
	FCDEAD SETST1,YES 
	GEN SQPUN0,YES 
	GEN PSHCUR,NO  
SETST1,	SUBGL AREX  
	FCDEAD .+1,NO
	TERML TEOL  
	FCDEAD NOSUC,YES  
	GEN STOREC,NO  
/  
AREX,	SUBGL TERM	/ARITHMETIC EXPRESSION.
	FCFAIL AREX1,NO
AREX1,	SUBGL ADOP  
	FCOK .+2,YES 
	GEN ACTOS,NO
	SUBGL TERM  
	FCDEAD AREX1,YES  
	GEN POPDO,NO
/  
TERM,	SUBGL FACT  
	FCFAIL TERM1,NO
TERM1,	SUBGL MULOP 
	FCOK .+2,YES 
	GEN ACTOS,NO
	SUBGL FACT  
	FCDEAD TERM1,YES  
	GEN POPDO,NO
/  
FACT,	TERML TMINUS	/FACTOR 
	FCALT FACT1,.+2,YES
	GEN SCHSGN,NO  
	SUBGL FACT2 
	FCDEAD NOSUC,YES  
	GEN DO,NO
FACT1,	TERML TPLUS 
	FCALT .+1,.+1,NO 
	SUBGL FACT2 
	FCFAIL NOSUC,NO
/  
FACT2,	SUBGL PRIMRY
	FCFAIL FACT3,NO
FACT3,	TERML TUPAR 
	FCOK .+3,YES
	GEN STUPAR,YES
	GEN ACTOS,NO  
	SUBGL PRIMRY  
	FCDEAD FACT3,YES 
	GEN POPDO,NO  
/  
PRIMRY,	SUBGL VARB  
	FCALT .+2,NOSUC,YES
	GEN TOAC,NO 
	TERML TSCRN 
	FCALT .+1,NOSUC,NO 
	TERML TLPAR 
	FCALT PRIM1,.+1,NO 
	SUBGL AREX  
	FCDEAD .+1,NO
	TERML TRPAR 
	FCDEAD NOSUC,NO
PRIM1,	SUBGL FUNC  
	FCFAIL .+1,NO
	TERML TLPAR 
	FCDEAD .+1,NO
	SUBGL AREX  
	FCDEAD .+1,NO
	TERML TRPAR 
	FCDEAD NOSUC,YES  
	GEN DO,NO
/  
VARB,	TERML TSCRV 
	FCFAIL .+1,NO
	TERML TLBRAC
	FCOK .+3,YES 
	GEN PSHCUR,YES 
	GEN STQPUN,NO  
	SUBGL AREX  
	FCDEAD .+2,YES  
	GEN STSUB1,NO  
	TERML TCOMMA
	FCALT VARB1,.+1,NO 
	SUBGL AREX  
	FCDEAD VARB1,YES  
	GEN STSUB2,NO  
VARB1,	TERML TRBRAC
	FCDEAD NOSUC,YES  
	GEN CMPSUB,NO  
/  
MULOP,	TERML TSTAR	/MULTIPLYING OPERATORS.
	FCALT .+2,NOSUC,YES
	GEN STMUL,NO
	TERML TSLASH
	FCFAIL NOSUC,YES  
	GEN STDIV,NO
/  
ADOP,	TERML TPLUS	/ADDING OPERATORS.  
	FCALT .+2,NOSUC,YES
	GEN STADD,NO
	TERML TMINUS
	FCFAIL NOSUC,YES  
	GEN STSUB,NO
/  
FUNC,	TERML TABS	/FUNCTION NAMES. 
	FCALT .+2,NOSUC,YES
	GEN SPRABS,NO  
	TERML TIP
	FCALT .+2,NOSUC,YES
	GEN SPRIP,NO
	TERML TFP
	FCALT .+2,NOSUC,YES
	GEN SPRFP,NO
	TERML TSGN  
	FCALT .+2,NOSUC,YES  
	GEN SPRSGN,NO 
	TERML TSIN 
	FCALT .+2,NOSUC,YES  
	GEN SPRSIN,NO 
	TERML TCOS 
	FCALT .+2,NOSUC,YES  
	GEN SPRCOS,NO 
	TERML TSQRT
	FCALT .+2,NOSUC,YES  
	GEN SPRSQRT,NO
	TERML TLOG 
	FCALT .+2,NOSUC,YES  
	GEN SPRLOG,NO 
	TERML TEXP 
	FCALT .+2,NOSUC,YES  
	GEN SPREXP,NO 
	TERML TARCTAN 
	FCALT .+2,NOSUC,YES  
	GEN SPRARC,NO 
	TERML TLN  
	FCALT .+2,NOSUC,YES  
	GEN SPRLN,NO  
	TERML TDP  
	FCALT .+2,NOSUC,YES  
	GEN SPRDP,NO  
	TERML TEP  
	FCFAIL NOSUC,YES 
	GEN SPREP,NO  
/  
DOST,	TERML TDO	/"DO" STATEMENT.
	FCFAIL .+2,YES  
	GEN STDOST,NO  
	SUBGL DOTAIL
	FCDEAD NOSUC,NO
/  
DOTAIL,	TERML TPART 
	FCALT DOTL1,.+1,NO 
	TERML TSCRI 
	FCDEAD .+1,NO
	TERML TEOL  
	FCDEAD NOSUC,YES  
	GEN DOPRT,NO
DOTL1,	TERML TSTEP 
	FCFAIL .+1,NO
	SUBGL AREX 
	FCDEAD .+1,NO
	TERML TEOL  
	FCDEAD NOSUC,YES  
	GEN XEQS,NO 
/  
TYPST,	TERML TTYPE	/"TYPE" STATE,ENT. 
	FCFAIL .+3,YES  
	GEN STTYST,YES 
	GEN SAVNXT,NO  
	SUBGL TYTAIL
	FCDEAD NOSUC,NO
/  
TYTAIL,	SUBGL TYAREX
	FCALT TYTL1,.+1,NO 
	TERML TEOL  
	FCDEAD NOSUC,YES  
	GEN CNLINE,NO 
TYTL1,	SUBGL TYNOTA
	FCFAIL NOSUC,NO
/  
TYAREX,	SUBGL TYAR1 
	FCFAIL TYARXL,NO  
TYARXL,	TERML TCOMMA
	FCOK .+3,YES 
	GEN CNLINE,YES
	GEN SAVNXT,NO  
	SUBGL TYAR1 
	FCDEAD TYARXL,NO  
/  
TYAR1,	SUBGL AREX  
	FCALT TYAR11,.+4,YES 
	GEN PSHNXT,YES 
	GEN PSHNX1,YES
	GEN SAVNXT,NO  
	SUBGL TYAR2 
	FCDEAD NOSUC,NO
TYAR11,	TERML TQUOTE
	FCFAIL .+1,NO
	TERML TSCRS 
	FCDEAD .+1,NO
	TERML TQUOTE
	FCDEAD .+3,YES  
	GEN TSTRG,YES  
	GEN SAVNXT,NO  
	SUBGL TYAR3 
	FCDEAD NOSUC,NO
/  
TYAR2,	TERML TQUOTE
	FCOK .+1,NO  
	TERML TSCRS 
	FCDEAD .+1,NO
	TERML TQUOTE
	FCDEAD .+3,YES  
	GEN TSTRG,YES  
	GEN SAVNXT,NO  
	SUBGL TYAR3 
	FCDEAD TYAR2,NO
/  
TYAR3,	SUBGL AREX  
	FCOK .+3,YES 
	GEN TYFAC,YES  
	GEN SAVNXT,NO  
	SUBGL TYAR2 
	FCDEAD TYAR3,NO
/  
TYNOTA,	TERML TSIZE  
	FCALT .+2,NOSUC,YES  
	GEN TYPSIZ,NO 
	TERML TSTEP
	FCALT TYNTA2,.+1,NO
	TERML TSCRN 
	FCDEAD .+1,NO
	TERML TEOL  
	FCDEAD NOSUC,YES  
	GEN XEQS,NO 
TYNTA2,	TERML TPART 
	FCALT TYNTA3,.+1,NO
	TERML TSCRI 
	FCDEAD .+1,NO
	TERML TEOL  
	FCDEAD NOSUC,YES  
	GEN XEQP,NO 
TYNTA3,	TERML TALLE 
	FCALT TYNTA4,NOSUC,YES  
	GEN TYAP,YES
	GEN TAVAL,NO
TYNTA4,	TERML TALL  
	FCDEAD .+2,YES 
	GEN SAVNXT,NO 
	TERML TVALSE
	FCALT .+2,NOSUC,YES
	GEN TAVAL,NO
	TERML TPRTSE
	FCALT .+2,NOSUC,YES  
	GEN TYAP,NO 
	TERML TSCRV
	FCDEAD .+1,NO  
	TERML TEOL 
	FCDEAD NOSUC,YES 
	GEN TYARRY,NO 
/  
INVAL,	SUBGL AREX  
	FCDEAD NOSUC,YES  
	GEN EXIT,NO 
/  
DDELST,	TERML TDELETE   /"DELETE" STATEMENT - DIRECT ONLY 
	FCFAIL .+2,YES  
	GEN STDLST,NO  
	SUBGL DELTAIL  
	FCDEAD NOSUC,NO
/  
DELTAIL, SUBGL DELLST
	FCALT DLTL1,.+1,NO 
	TERML TEOL  
	FCDEAD NOSUC,NO
DLTL1,	TERML TSTEP 
	FCALT DLTL2,.+1,NO 
	TERML TSCRN 
	FCDEAD .+1,NO
	TERML TEOL  
	FCDEAD NOSUC,YES  
	GEN XEQS,NO 
DLTL2,	TERML TPART 
	FCALT DLTL3,.+1,NO 
	TERML TSCRI 
	FCDEAD .+1,NO
	TERML TEOL  
	FCDEAD NOSUC,YES  
	GEN XEQP,NO 
DLTL3,	TERML TALLE 
	FCALT DLTL4,NOSUC,YES
	GEN DALPRT,YES 
	GEN DLAVAL,NO  
DLTL4,	TERML TALL  
	FCDEAD .+1,NO
	TERML TVALSE
	FCALT .+2,NOSUC,YES
	GEN DLAVAL,NO  
	TERML TPRTSE
	FCDEAD NOSUC,YES  
	GEN DALPRT,NO  
/  
DELLST,	SUBGL VARB  
	FCFAIL DLLST1,YES 
	GEN DELCUR,NO  
DLLST1,	TERML TCOMMA
	FCOK .+1,NO  
	SUBGL VARB  
	FCDEAD DLLST1,YES 
	GEN DELCUR,NO  
/  
IDELST,	TERML TDELETE   /"DELETE" STATEMENT - INDIRECT ONLY  
	FCFAIL DT2,NO  
DT2,	SUBGL DELLST
	FCALT DT3,.+1,NO
	TERML TEOL  
	FCDEAD NOSUC,NO
DT3,	TERML TALL  
	FCDEAD .+1,NO
	TERML TVALSE
	FCDEAD NOSUC,YES  
	GEN DLAVAL,NO  
/  
ARITH,	TERML TNULL	/ARITHMETIC ASSIGNMENT.
	FCDEAD .+2,YES  
	GEN SQPUN1,NO  
	SUBGL VARB  
	FCDEAD .+1,NO
	TERML TEQUAL
	FCDEAD .+3,YES  
	GEN SQPUN0,YES 
	GEN PSHCUR,NO  
	SUBGL AREX  
	FCDEAD NOSUC,YES  
	GEN STOREC,NO  
/  
TOST,	TERML TTO	/"TO" STATE,ENT 
	FCFAIL TOTAIL,NO  
TOTAIL,	TERML TSTEP 
	FCALT TOTL1,.+1,NO 
	SUBGL AREX 
	FCDEAD .+1,NO
	TERML TIEOL
	FCDEAD NOSUC,YES  
	GEN PRTOS,NO
TOTL1,	TERML TPART 
	FCDEAD .+1,NO
	TERML TSCRI 
	FCDEAD .+1,NO
	TERML TIEOL
	FCDEAD NOSUC,YES  
	GEN PRTOP,NO
/  
DEMDST,	TERML TDEMAND   /"DEMAND" STATEMENT.  
	FCFAIL .+3,YES  
	GEN SAVNXT,YES 
	GEN SQPUN1,NO  
	SUBGL VARB  
	FCDEAD .+2,YES 
	GEN PSHNXT,NO 
	TERML TEOL  
	FCDEAD NOSUC,YES  
	GEN SQPUN0,YES 
	GEN PRDMD,NO
/  
INTST,	TERML TGO
	FCALT .+2,NOSUC,YES
	GEN DOSTP2,NO  
	TERML TCANC 
	FCALT .+2,NOSUC,YES
	GEN PRCANC,NO  
	SUBGL TYPST 
	FCALT .+2,NOSUC,YES
	GEN EXIT,NO 
	TERML TNULL 
	FCDEAD NOSUC,YES  
	GEN ILLINT,NO  
/TERMINAL SYMBOLS AND CLASSES.
/  
/INTERNAL CHARACTER DEFINITIONS. 
/  
IA=01  
IB=02  
IC=03  
ID=04  
IE=05  
IF=06  
IG=07  
IH=10  
II=11  
IJ=12  
IK=13  
IL=14  
IM=15  
IN=16  
IO=17  
IP=20  
IQ=21  
IAR=22 
IS=23  
IT=24  
IU=25  
IV=26  
IW=27  
IX=30  
IY=31  
IZ=32  
I0=60  
I1=61  
I2=62  
I3=63  
I4=64  
I5=65  
I6=66  
I7=67  
I8=70  
I9=71  
IEOL=00
ICOMMA=54 
IEQUAL=75 
ILPAR=50  
IRPAR=51  
ILBRAC=33 
IRBRAC=35 
ILT=74 
IGT=76 
IUPAR=36  
ISLASH=57 
ISTAR=52  
IPLUS=53  
IMINUS=55 
IQUOTE=42 
ICOLON=72 
ISEMI=73  
ICR=37 
ISPACE=40 
/TERMINAL SYMBOL DEFINITIONS: 
/  
TNLINE,	-IN; -IO
TLINE,	-IL; -II; -IN; -IE; SCREOL 
TGO,	-IG; -IO
TIEOL,	IEOL 
TDONE,	-IE; -IN; -ID; IEOL  
TSTOP,	-IS; -IT; -IO; -IP; IEOL 
TIF,	-II; IF
TCOMMA,	ICOMMA
TGT2,	IGT
TLT2,	ILT
TGE,	-IG
TE,	IE 
TLE,	-IL; IE
TNE,	-IN; IE
TFOR,	-IF; -IO; IAR 
TSCRV,	TCVARB
TEQUAL,	IEQUAL
TLPAR,	ILPAR 
TRPAR,	IRPAR 
TSET,	-IS; -IE; IT  
TUPAR,	IUPAR 
TSCRN,	TCFPN 
TLBRAC,	ILBRAC
TRBRAC,	IRBRAC
TSTAR,	ISTAR 
TSLASH,	ISLASH
TPLUS,	IPLUS 
TMINUS,	IMINUS
TIP,	-II; IP
TFP,	-IF; IP
TABS,	-IA; -IB; IS  
TSGN,	-IS; -IG; IN  
TCANC,	-IC; -IA; -IN; -IC; -IE; -IL; IEOL  
TDO,	-ID; IO
TPART,	-IP; -IA; -IAR; IT
TSTEP,	-IS; -IT; -IE; IP 
TTYPE,	-IT; -IY; -IP; IE 
TSIZE,	-IS; -II; -IZ; -IE  
TEOL,	SCREOL
TQUOTE,	IQUOTE
TSCRS,	TCSTRG
TPRTSE,	-IP; -IA; -IAR; -IT; -IS; SCREOL 
TVALSE,	-IV; -IA; -IL; -IU; -IE; -IS; SCREOL 
TALLE,	-IA; -IL; -IL; SCREOL  
TALL,	-IA; -IL; IL  
TDELETE, -ID; -IE; -IL; -IE; -IT; IE  
TSCRI,	TCINTG
TCOLON,	ICOLON
TNULL,	TCNULL
TTO,	-IT; IO
TDEMAND, -ID; -IE; -IM; -IA; -IN; ID  
TON,	-IO; -IN; IEOL 
TOFF,	-IO; -IF; -IF; IEOL  
TPAGE,	-IP; -IA; -IG; -IE; SCREOL 
TLOG,	-IL; -IO; IG  
TEXP,	-IE; -IX; IP  
TSIN,	-IS; -II; IN  
TCOS,	-IC; -IO; IS  
TSQRT,	-IS; -IQ; -IAR; IT  
TARCTAN,	-IA; -IAR; -IC; -IT; -IA; IN 
TLN,	-IL; IN 
TDP,	-ID; IP 
TEP,	-IX; IP 
/TERMINAL CLASS PROCESSOR FOR "SCRIPT V".
/  
TCVARB,	RDADV NXTLXN	/GET CURRENT CHAR.  
	SNA		/IS IT "END OF LINE"?  
	JMP RCFAIL	/YES.
	TAD (-33)
	SMA		/IS IT A LETTER?  
	JMP RCFAIL	/NO. 
	TAD (33)	/YES.  SAVE IT TEMPORARILY
	DCA TMP  
	RD NXTLXN	/GET NEXT CHAR.  
	SNA		/IS IT END OF LINE?  
	JMP TCV1	/YES.. 
	TAD (-33)	/NO.  SUBTRACT 33.  
	SPA		/IS IT A LETTER?  
	JMP RCFAIL	/YES.  NO GOOD.  
	TAD (-25)	/SUBTRACT TOTAL OF 60  
	SPA		/IS IT SPECIAL CHAR.
	JMP TCV1	/YES.  OK  
	TAD [-12]	/NO.  SUBTRACT TOTAL OF 72. 
	SPA		/IS IT A NUMBER?  
	JMP RCFAIL	/YES.  NO GOOD.  
TCV1,	CLA		/NO. NOT A LETTER OR DIGIT.  
	TAD [-NUMWD]  
	DCA WDCNT	/MULTIPLY LETTER BY NUMWD.
TCV1L,	TAD TMP  
	ISZ WDCNT
	JMP TCV1L	/NOW HAVE REL LOC OF VARIABLE.  
	TAD (VRBLOC-NUMWD)   /ADD VARIABLE BASE.  
	DCA CURSYM	/THIS IS LOCATION OF VARIABLE.
	JMP RCSUC1  

/PROCESS TERMINAL CLASS "SCRIPT S" - STRING.
/  
TCSTRG,	RD NXTLXN	/GET CURRENT CHARACTER.
	SNA		/IS IT EOL? 
	JMP TCSTR1	/YES.
	TAD (-37)
	SNA		/IS IT "CR"?  
	JMP TCSTR1	/YES.
	TAD [-3]
	SNA CLA		/IS IT "QUOTE". 
	JMP TCSTR1	/YES.
	ADV NXTLXN  
	JMP TCSTRG	/TRY NEXT CHARACTER.
/  
TCSTR1,	DIFPTR SVLXF,NXTLXN   /GET STRING LENGTH. 
	TAD [-1]
	DCA ALCNT	/STORE LENGTH.
	JMP STLXF
/
/
/PROCESS TERMINAL CLASS "SCRIPT I" -  
/ DECIMAL INTEGER 1 - 9 
/  
TCINTG,	0  
	JMS TSTDEC	/IS CURRENT CHAR DECIMAL DIGIT?  
	JMP RCFAIL	/NO. 
	SNA		/YES.  IS IT ZERO?
	JMP RCFAIL	/YES.
	DCA PARTNO	/NO. 
TCNULL,	JMP RCSUC	/DONE.  
/PROCESS TERMINAL CLASS "SCRIPT N".
/  
TCFPN,	DCA ACX		/CLEAR AC EXPONENT. 
	DCA ACS		/CLEAR AC SIGN.  
	DCA QANYIN	/CLEAR "ANY IN" FLAG. 
	DCA QDCPT	/CLEAR "DECIMAL POINT YET" FLAG.  
	TAD [-PREC-1] 
	DCA ALCNT	/NUMBER OF AC DIGITS + 1.  
	TAD [AC+PREC-1]  /HIGH ORDER AC DIGIT. 
	DCA CRWD 
TCFGDG,	JMS TSTDEC	/IS CURRENT CHAR A DECIMAL DIGIT?
	JMP TCF1	/NO. 
	SNA		/YES.  IS DIGIT ZERO?
	JMP TCFTQA	/YES.
TCFAAC,	JMS ADACS	/ADD DIGIT TO FLOATING AC.
	NOP		/"AC FULL" EXIT.
	TAD QDCPT
	SNA CLA		/HAS A DECIMAL POINT BEEN REACHED?  
	ISZ ACX		/NO.  INCREMENT AC EXPONENT. 
	JMP TCFGDG  
/  
TCFTQA,	TAD QANYIN  
	SZA CLA		/HAVE ANY DIGITS BEEN PUT IN FAC?
	JMP TCFAAC	/YES.  SO PUT IN THE ZERO.
	TAD QDCPT	/NO. 
	SNA CLA		/HAS A DECIMAL POINT BEEN REACHED?  
	JMP TCFGDG	/NO. 
	CMA
	TAD ACX		/SUBTRACT ONE FROM AC EXPONENT. 
	DCA ACX  
	JMP TCFGDG  
/  
TCF1,	TAD CURCHR	/GET CURRENT CHAR.  
	TAD (-56)
	SZA		/IS IT A DECIMAL POINT? 
	JMP TCF2	/NO. 
	TAD QDCPT	/YES.
	SZA CLA		/HAS DECIMAL PT. BEEN REACHED?
	JMP TCF2	/YES.
	ISZ QDCPT	/NO, SET "DEC. PT. REACHED" FLAG.
	ADV NXTLXN	/ADVANCE OVER DECIMAL POINT. 
	JMP TCFGDG  
/  
TCF2,	CLA
	TAD QANYIN  
	SZA CLA		/HAVE ANY DIGITS BEEN PUT IN FAC?
	JMP TCFFAC	/YES.  RESULT IS NON-ZERO.
	DIFPTR NXTLXF,NXTLXN /NO.  
	SNA CLA		/HAS INPUT POINTER CHANGED?
	JMP RCFAIL	/NO. 
TCFFAC,	JMS ADACS	/ADD ZERO TO FAC.
	JMP TCF3	/"AC FULL" EXIT. GO TEST FOR "E".
	JMP TCFFAC	/"FAC NOT FULL" EXIT. 
/  
QDCPT,	0		/?DECIMAL POINT REACHED YET.  
	EP17=. 
	LIT
	PAGE 25  
/  
TCF3,	TAD CURCHR	/GET CURRENT CHARACTER.
	TAD (-IE)
	SZA CLA		/IS IT "E"?  
	JMP TCF8	/NO.  DONE.
	ADV NXTLXN	/YES.  PROCESS EXPONENT.  
	CLA CMA		/SET EXP SIGN SWITCH TO +.  
	DCA IRS 
	RD NXTLXN	/GET NEW CHAR.
	TAD (-IPLUS)
	SNA		/IS IT "+"? 
	JMP TCF4	/YES.
	TAD [-IMINUS+IPLUS]  
	SZA CLA		/IS IT "-"?
	JMP TCF5	/NO. 
	DCA IRS		/YES, SET EXP SIGN SWITCH TO -.  
TCF4,	ADV NXTLXN	/ADVANCE OVER + OR -.
TCF5,	JMS TSTDEC	/IS CHAR DECIMAL DIGIT? 
	JMP RCFAIL	/NO. 
TCF9,	DCA MULCNT	/YES. STORE DIGIT. 
	TAD MULCNT  
	DCA IRX  
	JMS TSTDEC	/IS NEXT CHAR DEC. DIGIT?  
	JMP TCF6	/NO. 
	DCA TMP		/YES.  SAVE SECOND DIGIT. 
	JMS BMUL10	/MULTIPLY 1ST DIGIT BY 10.
	TAD TMP		/ADD 2ND DIGIT.  
	JMP TCF9	/GET NEXT DIGIT. 
TCF6,	TAD IRX		/GET "E" EXPONENT.
	ISZ IRS		/WAS EXP SIGN +? 
	CIA		/NO, COMPLEMENT EXPONENT.
	TAD ACX		/TO OR FROM FAC EXPONENT. 
	DCA ACX  
	JMS CHKEXP	/CHECK FOR EXPONENT OVERFLOW. 
TCF8,	TAD AC+PREC-1
	SNA CLA		/IS H-O AC DIGIT = 0? 
	DCA ACX		/YES.  CLEAR EXPONENT. 
	JMP RCSUC	/DONE.  
/  
/  
ADACS,	0  
	DCA I CRWD	/STORE DIGIT. 
	TAD ALCNT
	SNA CLA		/IS AC FULL?
	JMP I ADACS	/YES.  TAKE "AC FULL" EXIT. 
	CMA
	TAD CRWD 
	DCA CRWD	/CRWD-1 TO CRWD. 
	ISZ ALCNT	/IS AC NOW FULL?  
	JMP ADACS1	/NO. 
	JMS ROUND	/YES.  ROUND AC BY H-O MQ DIGIT.
	JMP I ADACS	/TAKE "AC FULL" EXIT. 
/  
ADACS1,	ISZ ADACS
	ISZ QANYIN  
	JMP I ADACS	/TAKE "AC NOT FULL" EXIT.
/TSTDEC  
/SUBROUTINE TO TEST CURRENT CHARACTER FOR DECIMAL DIGIT. 
/IF IT IS, CONVERTS IT TO RANGE 00-11 OCTAL. 
/CALLING SEQUENCE; 
/	JMS TSTDEC  
/	...		/NOT DECIMAL DIGIT.  8AC CLEAR. 
/	...		/DECIMAL DIGIT, IN 8AC.
/  
TSTDEC,	0  
	RD NXTLXN	/GET NEXT CHAR.  
	TAD (-60)
	SPA CLA		/IS IT GE 0?
	JMP I TSTDEC	/NO.  FAIL EXIT. 
	TAD CURCHR	/YES.
	TAD (-72)
	SMA CLA		/IS IT <72?  
	JMP I TSTDEC	/NO.  FAIL EXIT. 
	ADV NXTLXN	/YES.  ADVNCE OVER DIGIT. 
	TAD CURCHR  
	TAD (-60)	/GET OCTAL EQUIV OF DIGIT.
	ISZ TSTDEC	/SUCCESS EXIT.
	JMP I TSTDEC
/  
PAGMES,	TEXT /*PAGE / 
/LEXICAL ANALYSER.
/CALLING SEQUENCE:
/	TAD (TERM)  
/	JMS RECOG
/	...		/SUCCESS EXIT. 
/	...		/FAIL EXIT.
/  
RECOG,	0  
	DCA NXTTTC	/NEXT TERMINAL TYPE CODE (AX7). 
	TAD NXTLXF	/CURRENT TERMINAL CHARCTER POSITION
	DCA NXTLXN	/STORE IN RUNNING POINTER.
	TAD NXTLXF+1 
	DCA NXTLXN+1 
RECOGL,	TAD I NXTTTC	/GET TTC.  
	SPA		/IS IT A NON-LAST WORD OF MULTI?  
	JMP NLC		/YES.
	RAL		/NO.  SHIFT LEFT 1. 
	SMA		/IS IT LAST WORD OF TTC?
	JMP LC		/YES.
	RAR		/NO.  MUST BE TERMINAL CLASS PTR.  
	DCA TMP		/GET SUBROUTINE ENTRY LOCATION. 
	JMP I TMP	/ENTER TERMINAL CLASS SUBROUTINE.  
/  
NLC,	RDADV NXTLXN	/ADD CURRENT INPUT CHARACTER.
	SZA CLA		/IS IT EQUAL TO DESIRED CHAR? 
	JMP RCFAIL	/NO.  FAILURE.
	JMP RECOGL	/GO ON TO NEXT INPUT CHARACTER. 
/  
LC,	RAR		/SHIFT CHARACTER BACK. 
	CIA		/- CHAR.
	RDADV NXTLXN	/ADD CURRENT INPUT CHARACTER.
	SZA CLA		/IS IS EQUAL TO DESIRED CHAR? 
	JMP RCFAIL	/NO. 
RCSUC,	RD NXTLXN	/GRT NEXT INPUT CHAR.  
	CLA
RCSUC1,	TAD CURCHR	/GET CHAR. 
	TAD (-ISPACE)   /IS IT "SPACE" CODE?
	SNA CLA  
	JMP RCSUC2	/YES.  SKIP SPACE.  
STLXF,	TAD NXTLXN	/NO.  ADVANCE "PERMANENT"
	DCA NXTLXF	/CHARACTER POINTER. 
	TAD NXTLXN+1 
	DCA NXTLXF+1 
	JMP I RECOG	/"SUCCESS" EXIT.
/  
RCFAIL,	ISZ RECOG	/FAILURE RETURN AT (N+2).  
	CLA
	JMP I RECOG 
/  
RCSUC2,	ADV NXTLXN	/ADVANCE OVER SPACE.
	JMP RCSUC
/  
	LIT


/NOTE THAT TERMINAL CLASS PROCESSORS RETURN TO MAIN
/LEXICAL ANALYSER IN ONE OF THREE WAYS:
/	RCSUC2 - ADVANCE INPUT STRING, THEN
/	RCSUC  - READ CHRACTER, THE 
/	RCSUC1 - TEST FOR SPACES.
	PAGE 20  
/	FLOATING POINT ARITHMETIC PACKAGE.  
/  
/  
/GETNUM - UNPACK A NUMBER AND PUT IT IN FAC.   LOCATION OF  
/NUMBER IS SPECIFIED IN AC AT ENTRY.   AC IS CLEAR AT EXIT. 
/  
GETNUM,	0  
	DCA CRWD	/LOCATION OF WORD 0 
	RDF		/PRESERVE INITIAL DATA BANK.
	TAD (CDF 0)
	DCA GTXX
	CPY GTXX,GTXX1
	CPY GTXX,GTXX2
	TAD I CRWD	/GET FIRST WORD  
	RAL		/ROTATE AC SIGN TO LINK.  
	AND [7700]	/CLEAR NON-EXISTANT BITS. 
	SZL		/IS EXPONENT NEGATIVE?  
	TAD [0077]	/YES - FORCE ALL ONES.
	ROTR6		/RIGHT ALIGN EXPONENT  
	DCA ACX  
	TAD I CRWD	/GET FIRST WORD AGAIN.
	AND [0020]	/EXTRACT MANTISSA SIGN.  
	DCA ACS	/SAVE.  
	TAD [AC-1] 
	DCA AX0  
	TAD [-NUMWD+1]	/NUMBER OF 3-DIGIT WORDS.  
	DCA WDCNT
	TAD I CRWD	/GET FIRST WORD AGAIN. 
	AND (0017)	/GET LOW-ORDER DECIMAL DIGIT.
	CDF 0
	DCA I AX0  
GTLP,	ISZ CRWD	/GO TO N-TH WORD. 
GTXX,	XX 
	TAD I CRWD	/GET WORD. 
	CDF 0
	ROTR8 
	AND (0017)	/EXTRACT DIGIT 1.
	DCA I AX0
GTXX1,	XX
	TAD I CRWD 
	CDF 0
	ROTR4 
	AND (0017)	/EXTRACT DIGIT 2.
	DCA I AX0
GTXX2,	XX
	TAD I CRWD 
	CDF 0
	AND (0017)  
	DCA I AX0	/EXTRACT DIGIT 3 
	ISZ WDCNT	/WAS IT LAST WORD?
	JMP GTLP	/NO.  GO BACK FOR NEXT.
	JMP I GETNUM	/YES.  DONE.  
	CP20=.
	LIT
/FAD, FSB
/FLOATING DECIMAL ADD AND SUBTRACT SUBROUTINES. 
/ADD OR SUBTRACT CONTENTS OF IR TO OR FROM FAC, LEAVING  
/NORMALISED RESULT IN FAC.  PDP-8 AC IS CLEAR AT ENTRY
/AND AT EXIT.  
/  
	PAGE 27 
FAD,	0  
	JMS FDADDS	/ADD AC TO IR.
	JMP I FAD
FSB,	0  
	TAD IRS  
	CMA
	AND [0020] 
	DCA IRS		/COMPLEMENT IR SIGN.
	JMS FDADDS	/SUBTRACT IR FROM FAC. 
	JMP I FSB
	BP27=.
	LIT
	*CP20 
/  
/  
/FDADDS  
/FLOATING DECIMAL ADD SUBROUTINE.
/ADDS IR AND FAC.  ASSUMES BOTH ARE SIGNED-MAGNITUDE  
/FLOATING-POINT DECIMAL NUMBERS.  LEAVES NORMALISED RESULT  
/IN FAC.  PDP-8 AC IS CLEAR AT ENTRY, NOT NECESSARILY 
/LEFT CLEAR AT EXIT. 
/  
FDADDS,	0  
	TAD IR+PREC-1
	SNA CLA		/IS IR = 0?  
	JMP I FDADDS	/YES.  EXIT.  
	TAD AC+PREC-1
	SZA CLA		/IS FAC = 0? 
	JMP FDAD1	/NO. 
	SWP		/YES.  SWAP AC AND IR. 
	JMP I FDADDS	/EXIT.  
FDAD1,	TAD IRX		/IR EXPONENT. 
	CIA		/COMPLEMENT IT.  
	TAD ACX		/ACX-IRX
	SPA CLA		/IS AC MAGNITUDE GE IR MAGNITUDE?
	SWP		/NO.  SWAP FAC AND IR VALUES. SIGNS
			/AND EXPONENTS.  
	DCA ALDIG	/SET ALIGNMENT DIGIT TO 0.
	TAD IRS  
	CIA
	TAD ACS		/ACS-IRS
	SNA CLA		/ARE THEY EQUAL?  
	JMP TSTEXP	/YES.
	TAD [IR-1]	/NO.
	JMS COMP10	/COMPLEMENT IR.  
	TAD DECIMAL (9) OCTAL
	DCA ALDIG	/SET ALIGNMENT DIGIT TO 9.
TSTEXP,	TAD IRX  
	CIA
	TAD ACX		/ACX-IRX
	SNA		/IS DIFFERENCE 0? 
	JMP FDADM	/YES.  GO ADD MAGNITUDES. 
	TAD [-PREC]
	SMA		/IS IR NON-SIGNIFICANT 
	JMP FDADX	/EXIT, FORCE AC CLEAR.
	TAD [PREC]	/NO.
	DCA ALCNT	/STORE ALIGNMENT COUNT.  
	TAD [IR-1] 
	JMS ALIGN	/ALIGN IR. 
FDADM,	TAD ALDIG
	SNA CLA		/ARE SIGNS EQUAL OR UNEQUAL? 
	JMP FDSE	/EQUAL. 
FDSU,	TAD [IR-1]	/ADD DECIMAL, SIGNS UNEQUAL.
	JMS ADSUB	/ADD IR TO FAC.  
	SZA CLA		/IS THERE A CARRY?
	JMP FDNORM	/YES.  NO CHANGE IN AC SIGN.  
	TAD ACS		/NO.  COMPLEMENT AC SIGN. 
	CMA
	AND [0020] 
	DCA ACS  
	TAD [AC-1] 
	JMS COMP10	/COMPLEMENT AC VALUE.  
FDNORM,	JMS NORM10	/GO NORMALISE FAC, IF NECESSARY.
	JMP I FDADDS	/EXIT.  
/  
FDSE,	TAD [IR-1]	/ADD DECIMAL, SIGNS EQUAL.  
	JMS ADSUB	/ADD IR TO FAC.  
	SNA		/IS THERE A CARRY?
	JMP I FDADDS	/NO.  EXIT.
	DCA ALCNT	/YES.  SET SHIFT COUNTER TO 1.  
	DCA ALDIG	/SET ALDIG TO 0. 
	CPY AC,MQ+PREC-1	/SAVE HIGH ORDER AC DIGIT FOR ROUNDING.  
	TAD [AC-1] 
	JMS ALIGN	/SHIFT AC RIGHT 1.  H-O DIGIT IS 0.
	ISZ AC+PREC-1   /SET H-O DIGIT TO 1. 
	JMS ROUND	/ROUND PRODUCT TO 7 DIGITS. 
	ISZ ACX		/INCREMENT AC EXPONENT.
FDADX,	CLA		/SUPPRESS SKIP ON 7777, CLEAR AC. 
	JMP I FDADDS	/EXIT.  
	EP20=. 
	LIT
	*BP21 
/FMU  
/FLOATING DECIMAL MULTIPLY SUBROUTINE. 
/MULTIPLIES FAC BY IR, LEAVING NORMALISED AND ROUNDED RESULT
/IN FAC.  8AC IS 0 AT EXIT AND ENTRY.  
/  
FMU,	0  
	TAD [AC-1]	/MOVE AC TO MQ AND CLEAR AC.
	DCA AX0  
	TAD [MQ-1] 
	DCA AX1  
	TAD [AC-1] 
	DCA AX2  
	TAD [-PREC]
	DCA WDCNT
FMUL1,	TAD I AX0	/MOVE A DIGIT.
	DCA I AX1
	DCA I AX2	/CLEAR AN AC DIGIT. 
	ISZ WDCNT	/DONE?
	JMP FMUL1	/NO. 
	TAD [-PREC]	/YES.  INITIALISE COUNTER FOR  
			/MAIN LOOP.
	DCA MULCNT  
FMUL3,	DCA ALDIG	/ALDIG HOLDS FAC CARRY DIGIT.
FMUL4,	TAD MQ		/GET L-O DIGIT OF MQ.  
	SNA		/IS IT 0?
	JMP FMULSR	/YES. SHIFT RIGHT.  
	TAD [-1]	/NO.  SUBTRACT 1.  
	DCA MQ		/AND STORE. 
	TAD [IR-1] 
	JMS ADSUB	/ADD FIR TO FAC. 
	TAD ALDIG	/ACCUMULATE CARRY DIGIT.  
	DCA ALDIG
	JMP FMUL4	/TRY AGAION.  
/  
FMULSR,	TAD (MQ)	/SHIFT FAC-FMQ RIGHT 1 DIGIT.  
	DCA AX0  
	TAD [MQ-1] 
	DCA AX1  
	TAD (-PREC-PREC+1) 
	DCA WDCNT
FMUL5,	TAD I AX0	/MOVE A DIGIT.
	DCA I AX1
	ISZ WDCNT	/DONE?
	JMP FMUL5	/NO. 
	TAD ALDIG	/YES.
	DCA AC+PREC-1   /MOVE IN CARRY DIGIT.
	ISZ MULCNT	/END OF MULTIPLY LOOP?  
	JMP FMUL3	/NO.  WORK ON NEXT DIGIT. 
	TAD AC+PREC-1   /YES.  GET H-O AC DIGIT.
	SZA CLA		/IS IT 0?
	JMP FMUL6	/NO. 
	JMS NORM10	/YES.  NORMALISE RESULT.  
	TAD AC+PREC-1
	SNA CLA		/IS H-O AC DIGIT STILL 0?  
	JMP I FMU	/YES.  WHOLE PRODUCT MUST BE 0. 
	TAD AC-1	/NO.  GET H-O MQ DIGIT,
	DCA AC		/PUT IT IN L-O AC
	TAD AC-2 
	DCA AC-1 
FMUL6,	JMS ROUND	/ROUND PRODUCT.  
	TAD ACX  
	TAD IRX		/COMPUTE NEW AC EXPONENT. 
	DCA ACX  
	TAD ACS		/COMPUTE NEW AC SIGN.  
	TAD IRS		/BY EXCLUSIVE OR OF 
	AND [0020]	/IR AND AC SIGNS.  
	DCA ACS  
	JMP I FMU	/EXIT.  
/STPACK  
/STORES FLOATING AC IN ITS PACKED FORM.
/STORAGE LOCATION IS SPECIFIED BY AC AT ENTRY. AC IS 0 AT
/EXIT.
/  
STPACK,	0  
	TAD [-1]
	DCA AX1		/SET FIRST STOARAGE LOCATION.
	RDF		/PRESERVE CALLING DATA BANK.
	TAD (CDF 0)
	DCA STXX
	CPY STXX,STXX1
	CDF 0		/SET DATA BANK 0 TO BEGIN.
	TAD [AC-1] 
	DCA AX0		/SET FIRST AC LOCATION.
	TAD [-NUMWD+1]	/NUMBER OF 3-DIGIT WORDS.  
	DCA WDCNT
	JMS CHKEXP	/CHECK FOR EXPONENT OVERFLOW. 
	TAD ACX  
	ROTL5		/CONSTRUCT FIRST WORD OF  
	AND (7740)	/PACKED FORM, WITH EXPONENT, 
	TAD ACS		/SIGN,	
	TAD I AX0	/AND LOW-ORDER AC DIGIT.  
STXX,	XX		/SET OUTPUT DATA BANK.  
	DCA I AX1	/STORE FIRST WORD.  
	CLL  
STPL,	CDF 0		/GET AN AC DIGIT. 
	TAD I AX0  
	ROTL4 
	TAD I AX0	/GET A SECOND AC DIGIT.
	ROTL4
	TAD I AX0	/GET A THIRD DIGIT. 
STXX1,	XX		/STORE AS PACKED WORD. 
	DCA I AX1  
	CDF 0
	ISZ WDCNT	/IS IT END OF LOOP?  
	JMP STPL	/NO.  GO PACK ANOTHER WORD.  
	JMP I STPACK	/YES.  EXIT.  
/  
/CHECK FOR EXPONENT OVERFLOW OF ACX.
CHKEXP,	0
	TAD ACX 
	SPA		/TAKE ABSOLUTE VALUE OF ACX.
	CIA  
	AND [7700]
	SZA CLA		/IS EXPONENT LEGAL.  
	JMP ERREXP 
	JMP I CHKEXP	/YES, RETURN.
	EP21=.
	LIT
	PAGE 22  
/FDV  
/FLOATING DECIMAL DIVIDE SUBROUTINE.
/DIVIDES FAC BY IR, LEAVING ROUNDED QUOTIENT IN FAC.  
/PDP-8 AC IS 0 ON ENTRY AND EXIT.
/  
FDV,	0  
	TAD IR+PREC-1   /GET H-O IR DIGIT.
	SNA CLA		/IS IT 0?
	JMP ERRD0	/YES.  DIVISION BY 0.  
	TAD AC+PREC-1   /GET H-O FAC DIGIT.  
	SNA CLA		/IS IT 0?
	JMP I FDV	/YES.  DIVIDEND IS 0, SO EXIT.  
	TAD [-PREC]	/MOVE IR TO IRP, CLEAR FMQ. 
	DCA WDCNT
	TAD [IR-1] 
	DCA AX0  
	TAD (IRP-1) 
	DCA AX1  
	TAD [MQ-1] 
	DCA AX2  
FDVL0,	TAD I AX0	/GET AN IR DIGIT.
	DCA I AX1	/STORE IN IRP.
	DCA I AX2	/CLEAR AN FMQ DIGIT.
	ISZ WDCNT	/DONE?
	JMP FDVL0	/NO. 
	DCA ALDIG	/YES.  CLEAR FAC OVERFLOW DIGIT.
	TAD [-PREC-1] 
	DCA SHCNTR	/INITIALIZE SHIFT COUNTER.
	TAD [IR-1] 
	JMS COMP10	/TAKE 10'S COMPLEMENT OF IR.  
FDVL1,	DCA DIGAC	/CLEAR QUOTIENT DIGIT ACCUMULATOR. 
FDVL2,	TAD [IR-1] 
	JMS ADSUB	/ADD IR TO FAC.  
	SZA CLA		/IS THERE A CARRY?
	JMP FDVAD1	/YES.
	CLA CMA	/NO. 
	TAD ALDIG	/SUBTRACT 1 FROM AC OVERFLOW DIGIT.
	SPA		/IS RESULT POSITIVE? 
	JMP FDVTMQ	/NO. 
	DCA ALDIG	/YES.  STORE NEW OVERFLOW DIGIT.
FDVAD1,	ISZ DIGAC	/INCREMENT QUOTIENT DIGIT.
	JMP FDVL2
/  
/GETS HERE WHEN AC OVERFLOW DIGIT GOES NEGATIVE.
FDVTMQ,	CLA
	TAD (IRP-1) 
	JMS ADSUB	/ADD IRP TO FAC. 
	CLA		/CLEAR CARRY, IF ANY
	TAD MQ+PREC-1   /GERT HO MQ DIGIT.
	SZA CLA		/IS IT ZERO?
	JMP FDVMV	/NO. 
	TAD AC+PREC-1   /YES.  MOVE FAC H-O DIGIT. 
	DCA ALDIG	/TO FAC OVERFLOW DIGIT.
	TAD (-PREC-PREC+1)   /SHIFT FAC,FMQ LSFT 19
	DCA WDCNT
	TAD [AC+PREC-1]
	DCA NORMTO  
	TAD (AC+PREC-2) 
	DCA NORMFR  
FDVL3,	TAD I NORMFR	/MOVE A DIGIT.
	DCA I NORMTO
	CLA CMA  
	TAD NORMFR  
	DCA NORMFR  
	CLA CMA  
	TAD NORMTO  
	DCA NORMTO  
	ISZ WDCNT	/END OF LOOP?  
	JMP FDVL3	/NO. 
	TAD DIGAC	/YES.  MOVE ACCUMULATED QUOTIENT
	DCA MQ		/DIGIT TO L-O MQ DIGIT.
	ISZ SHCNTR	/INCREMENT SHIFT COUNTER. 
	JMP FDVL1	/DON'T CARE ON OVERFLOW.
	JMP FDVL1
/  
FDVMV,	TAD [MQ-1]	/MOVE FMQ TO FAC
	DCA AX0  
	TAD [AC-1] 
	DCA AX1  
	TAD [-PREC]
	DCA WDCNT
FDVL4,	TAD I AX0
	DCA I AX1
	ISZ WDCNT
	JMP FDVL4
	TAD DIGAC	/MOVE EXTRA DIGIT TO H-O MQ. 
	DCA AC-1 
	JMS ROUND	/ROUND QUOTIENT. 
	TAD IRX		/COMPUTE NEW EXPONENT. 
	TAD SHCNTR  
	CIA
	TAD ACX  
	DCA ACX  
	TAD ACS  
	TAD IRS  
	AND [0020] 
	DCA ACS  
	JMP I FDV
/  
SHCNTR,	0		/DIVISION SHIFT COUNTER.  
IRP,	0		/POSITIVE IR VALUE. 
	*IRP+PREC  
/ADSUB
/DECIMAL ADD SUBROUTINE.
/ADDS MAGNITUDE OF SPECIFIED REGISTER (IR OR IRP)  
/TO FAC.  CARRY OUT OF HIGH-ORDER
/FAC DIGIT IS IN 8AC ON EXIT.
/CALLING SEQUENCE IS:
/	TAD [REG-1]
/	JMS ADSUB
/  
ADSUB,	0  
	DCA AX0		/INITIALISE FIRST OPERAND LOCATION.
	TAD [AC-1]	/INITIALISE SECOND OPERAND LOC.
	DCA AX1  
	TAD [AC-1]	/INITIALISE THIRD OPERAND LOC. 
	DCA AX2  
	TAD [-PREC]	/INITIALISE COUNT. 
	DCA WDCNT
ADLP,	TAD I AX0	/ADD TWO DIGITS. 
	TAD I AX1
	TAD DECIMAL [-10] OCTAL /SUBTRACT 10. 
	SPA		/IS RESULT GE 10? 
	JMP ADBK	/NO. 
	DCA I AX2	/YES.  STORE RESULT-10.
	CLA IAC		/PUT CARRY DIGIT IN AC.
	JMP ADISZ
/  
ADBK,	TAD DECIMAL [10] OCTAL /ADD BACK 10. 
	DCA I AX2	/STORE RESULT.
ADISZ,	ISZ WDCNT	/END OF LOOP?  
	JMP ADLP	/NO.  GO DO NEXT DIGIT.
	JMP I ADSUB	/YES.  EXIT WITH AC= 0 OR 1.  

	LIT
	*BP23 
/SWAP 
/SWAPS IR AND FAC DIGIT FOR DIGIT.  
/SWAPS VALUES, SIGNS, AND EXPONENTS.
/ASSUMES 8AC CLEAR ON ENTRY AND EXIT.  
/  
SWAP,	0  
	TAD [IR-1]	/INITIALIZE LOOP.
	DCA AX0 
	TAD [IR-1]
	DCA AX2 
	TAD [AC-1]
	DCA AX1 
	TAD [AC-1]
	DCA AX3 
	TAD (-PREC-2) 
	DCA WDCNT	/COUNT OF DIGITS +SIGN+EXPONENT. 
SWAPL,	TAD I AX0	/GET DIGIT OF IR.  
	DCA TMP		/SAVE IT.
	TAD I AX1	/GET A DIGIT OF AC.
	DCA I AX2	/STORE IT IN IR.
	TAD TMP		/GET SAVED IR DIGIT. 
	DCA I AX3	/STORE IT IN FAC.  
	ISZ WDCNT	/END OF LOOP? 
	JMP SWAPL	/NO.
	JMP I SWAP	/YES. 
/COMP10  
/10'S COMPLEMENT SUBROUTINE.
/TAKES 10'S COMPLEMENT OF REGISTER SPECIFIED BY 8AC 
/AT ENTRY.  8AC IS 0 AT EXIT.  FORM OF CALL IS
/	TAD [REG-1]
/	JMS COMP10  
/  
COMP10,	0  
	DCA AX0		/INITIALISE WORD INDICIES.
	TAD AX0  
	DCA AX1  
	TAD [-PREC]	/SET COUNTER.
	DCA WDCNT
C10L1,	CLA IAC		/SET CARRY TO 1. 
C10L2,	DCA TMP		/SAVE CARRY.  
	TAD I AX0	/GET A DIGIT. 
	CMA		/COMPLEMENT IT. 
	TAD TMP		/ADD CARRY. 
	SMA		/IS (9-DIGIT+CARRY-10) POSITIVE?  
	JMP C10ST	/YES.
	TAD DECIMAL [10] OCTAL /NO.  ADD 10 BACK.  
	DCA I AX1	/STORE DIGIT. 
	ISZ WDCNT	/DONE YET?  
	JMP C10L2	/NO.  MAKE CARRY 0. 
	JMP I COMP10	/YES.  EXIT.  
/  
C10ST,	DCA I AX1	/STORE DIGIT. 
	ISZ WDCNT	/DONE YET?  
	JMP C10L1	/NO.  MAKE CARRY 1. 
	JMP I COMP10	/YES. EXIT.
/ALIGN
/ALIGNMENT SUBROUTINE.  
/SHIFTS REGISTER SPECIFIED BY INPUT 8AC RIGHT NUMBER  
/OF PLACES SPECIFIED BY ALCNT.
/8AC IS CLEAR ON EXIT.   THE CONTENTS OF "ALDIG" IS USED TO
/LEFT FILL. 
/  
ALIGN,	0  
	DCA AX1		/STORE "TO" REGISTER ADDRESS.  
	TAD AX1  
	TAD ALCNT
	DCA AX0		/STORE "FROM" REGISTER ADDRESS.
	TAD [-PREC]
	TAD ALCNT	/ALCNT-PREC
	DCA WDCNT	/SET COUNT.
ALL1,	TAD I AX0	/GET A DIGIT. 
	DCA I AX1	/STORE IT MOVED. 
	ISZ WDCNT	/END OF LOOP?  
	JMP ALL1	/NO. 
	TAD ALCNT	/YES.
	CIA
	DCA WDCNT	/SET COUNT OF LEFT FILL IDGITS. 
ALL2,	TAD ALDIG
	DCA I AX1	/STORE AN ALIGNMENT DIGIT.
	ISZ WDCNT	/END OF FILL LOOP?
	JMP ALL2	/NO. 
	JMP I ALIGN	/YES.  EXIT.  
/NORM10  
/FLOATING DECIMAL NORMALISE ROUTINE.
/NORMALISES FLOATING AC.
/ASSUMES 8AC IS 0 ON ENTRY AND EXIT.
/  
NORM10,	0  
	TAD [-PREC]	/SET LIMIT FOR ALL DIGITS = 0.  
	DCA WDCNT
	TAD [AC+PREC-1]	/SET H-O DIGIT LOCATION.
	DCA NORMFR  
NLP1,	TAD I NORMFR	/GET AN AC DIGIT 
	SZA CLA		/IS IT ZERO?
	JMP NLP1E	/NO.  END LOOP 1.
	CLA CMA		/BACK UP WORD POINTER. 
	TAD NORMFR  
	DCA NORMFR  
	ISZ WDCNT	/LOOKED AT EACH AC DIGIT?  
	JMP NLP1	/NO. 
	DCA ACX		/YES.  THEREFORE ALL 0. CLEAR ACX. 
	DCA ACS		/CLEAR ACS.
	JMP I NORM10	/EXIT.  
/  
NLP1E,	TAD [PREC]	/FOUND NON-ZERO DIGIT.
	TAD WDCNT	/PREC-# OF NON-ZERO DIGITS.  
	SNA		/WAS H-O DIGIT 0? 
	JMP I NORM10	/YES.  SO EXIT.  
	CIA
	DCA TMP		/NO.  SAVE # OF TRAILING ZEROES 
	TAD [AC+PREC-1]
	DCA NORMTO	/SET MOVE "TO" LOCATION. 
NLP2,	TAD I NORMFR	/GET A DIGIT. 
	DCA I NORMTO	/STORE IT. 
	CLA CMA		/DECREMENT LOC. COUNTERS.
	TAD NORMFR  
	DCA NORMFR  
	CLA CMA  
	TAD NORMTO  
	DCA NORMTO  
	ISZ WDCNT	/END OF LOOP?  
	JMP NLP2	/NO. 
	TAD ACX		/SUBTRACT # OF SHIFTS FROM
	TAD TMP		/AC EXPONENT. 
	DCA ACX  
NLP3,	DCA I NORMTO	/SET AN AC DIGIT TO 0. 
	CLA CMA		/DECREMENT LOCATION.
	TAD NORMTO  
	DCA NORMTO  
	ISZ TMP		/END OF LOOP?  
	JMP NLP3	/NO. 
	JMP I NORM10	/YES.  EXIT.  
	EP23=. 
	LIT
	PAGE 33 
/ROUND
/ROUNDS FAC ACCORDING TO HIGH-ORDER FMQ DIGIT.  
/8AC IS 0 AT ENTRY AND EXIT.  
/  
ROUND,	0  
	TAD MQ+PREC-1   /GET H-O MQ DIGIT.
	TAD (-5) 
	SPA CLA		/IS H-O FMQ DIGIT 5 OR MORE?  
	JMP I ROUND	/NO.  EXIT.
	TAD [AC-1]	/YES.  INITIALISE ADD AND CARRY
			/LOOP.  
	DCA AX0  
	TAD [AC-1] 
	DCA AX1  
	TAD [-PREC]	/MAXIMUM NUMBER OF CARRY 
	DCA WDCNT	/PROPAGATIONS.
ROUNDL,	TAD I AX0
	IAC		/ADD 1 TO AN AC DIGIT. 
	TAD DECIMAL [-10] OCTAL
	SPA		/IS SUM BETWEEN 1 AND 9?
	JMP ROUNDE	/YES.  ALMOST DONE. 
	DCA I AX1	/NO. IT'S 0.  THUS THERE'S A CARRY.  
	ISZ WDCNT	/DONE EVERY DIGIT OF FAC?  
	JMP ROUNDL	/NO.  DO NEXT DIGIT.
	ISZ AC+PREC-1   /YES.  FAC HAS OVERFLOWED. 
			/MUST BE ALL 0'S.  THEREFORE SET 
			/HIGH-ORDER FAC DIGIT TO 1.  
	ISZ ACX		/INCREMENT AC EXPONENT.
	NOP		/TO COVER CASE OF .99999995! 
	JMP I ROUND	/EXIT.  
/  
ROUNDE,	TAD DECIMAL [10] OCTAL 
	DCA I AX1	/STORE INCREMENTED DIGIT. 
	JMP I ROUND	/EXIT.  

	BP33=.
	LIT
/TYFP 
/TYPE A FLOATING-POINT NUMBER.
/TYPES CONTENTS OF FAC ON TELETYPE. 
/PDP-8 AC AT ENTRY SPECIFIES WHETHER OR NOT TO INSERT 
/LEADING BLANKS FOR ALGINMENT ABOUT = SIGN.
/	0 - INSERT  
/	1 - DON'T INSERT.  
/PDP8 AC IS 0 AT EXIT.  
/  
	PAGE 24  
TYFP,	0  
	DCA QPRSP	/STORE "?DON'T PRINT SPACES". 
	TAD AC+PREC-1   /GET H-O AC DIGIT.
	SNA CLA		/IS IT 0?
	JMP TYZERO	/YES.  THEREFORE WHOLE # IS 0.  
	TAD [AC-1]	/NO.  COUNT # OF TRAILING ZEROES. 
	DCA AX0  
	DCA ALCNT	/CLEAR "NUMBER OF 0'S". 
TYFPL1,	TAD I AX0	/GET AN AC DIGIT.
	SZA CLA		/IS IT 0?
	JMP TYFP1E	/NO. 
	ISZ ALCNT	/ADD 1 TO COUNT. 
	JMP TYFPL1	/GO TO LOOK AT NEXT.
/  
TYFP1E,	TAD ACX		/GET AC EXPONENT.
	SPA		/IS IT NEGATIVE?  
	JMP TYFPEF	/YES.  TYPE IN "E" FORMAT.  
	TAD [-10]	/NO.  
	SMA CLA		/IS IT > 8?  
	JMP TYFPEF	/YES.  TYPE IN "E" FORMAT.  
	TAD ACX		/NO, BETWEEN 0 AND 7.
TYFPFF,	JMS TYFPS	/TYPE IN "F" FORMAT.  
	JMP I TYFP	/EXIT.  
/  
TYFPEF,	CLA IAC	/SET AC = 1.
	JMS TYFPS	/TYPE 1 DIGIT BEFORE DEC. PT.
	TAD (305)	/TYPE "E".
	TYPE 
	TAD ACX  
	SMA CLA		/IS AC EXP. NEGATIVE?
	JMP TYFPEP	/NO. 
	TAD (255)	/YES.  TYPE "-".
	TYPE 
	DCA TMP		/CLEAR TENS DIGIT OF EXP. 
	TAD ACX  
	CIA
	IAC		/ADD 1. 
TYFPL2,	TAD DECIMAL [-10] OCTAL
	SPA		/IS DIFFERENCE POSITIVE?
	JMP TYFP2E	/NO.  END OF SUBTRACT LOOP.  
	ISZ TMP		/ADD 1 TO TENS DIGIT.  
	JMP TYFPL2  
/  
TYFP2E,	TAD DECIMAL [10] OCTAL 
	DCA ALDIG	/SAVE UNITS DIGIT.  
	TAD TMP		/GET TENS DIGIT. 
	SNA		/IS IT ZERO?
	JMP TYFPTU	/YES.  DON'T PRINT IT.  
	TAD (260)	/NO.  CONVERT TO ASCII.
	TYPE		/PRINT IT.  
TYFPTU,	TAD ALDIG	/GET UNITS DIGIT 
	TAD (260)	/CONVERT TO ASCII.  
	TYPE 
	JMP I TYFP	/EXIT.  
/  
TYFPEP,	TAD (253)	/TYPE "+". 
	TYPE 
	DCA TMP  
	CLA CMA  
	TAD ACX		/GET EXPONENT.
	JMP TYFPL2  
/  
TYZERO,	TAD [PREC-1]  
	DCA ALCNT	/SET "# OF 0'S" TO (PREC-1).
	IAC		/SET "EXP" TO 1.
	JMP TYFPFF	/GO TYPE IN "F" FORMAT.  
/  
QPRSP,	0		/?DON'T PRINT SPACES BEFORE NUMBER.  
/TYFPS
/FLOATING POINT OUTPUT SUBROUTINE.  INPUTS ARE  
/	A) NUMBER OF TRAILING ZEROES, IN "ALCNT";  
/	B) NUMBER OF DIGITS BEFORE DECIMAL POINT "N", STORED  
/	IN PDP-8 AC AT ENTRY. 
/IT TYPES OUT THE FOLLOWING:  
/	A) (4-N) SPACES; 
/	B) "-" IF ACS IS -, "SPACE" IF ACS IS "+";
/	C) N LEADING DIGITS OF FAC;  
/	D) IF ALCNT GE (PREC-N), EXITS; 
/	E) OTHERWISE, TYPES "." FOLLOWED BY (PREC-N-ALCNT) 
/	MORE DIGTS OF FAC. 
/  
TYFPS,	0  
	DCA DIGAC	/SAVE  OF LEADING DIGITS.
	TAD QPRSP
	SNA CLA		/SHOULD SPACES BE PRINTED?  
	JMP TYFPS0	/YES. 
	TAD ACS		/NO, GET AC SIGN. 
	SNA CLA		/IS IT +?  
	JMP TYFP2B	/YES, NO SPACE BEFORE NUMBER. 
	JMP TYFP2A	/NO, GO TO TYPE "-".

TYFPS0,	TAD DIGAC	/# LEADING DIGITS. 
	TAD [-PREC]  
	CIA		/NUMBER OF SPACES BEFORE . 
	SZA		/IS IT 0?  
	JMS TYSPC	/NO, GO PRINT APPROPR. # OF SPACES.  
TYFPS2,	TAD ACS		/YES, GET FAC SIGN. 
	SNA CLA		/IS IT +?  
	TAD (-15)	/YES, TYPE "SPACE".  
TYFP2A,	TAD (255)	/NO, TYPE "-".
	TYPE 
TYFP2B,	TAD [AC+PREC-1]	/SET UP H-O FAC DIGIT LOCATION.  
	DCA NORMFR 
	TAD DIGAC	/GET OF LEADING FAC DIGITS.
	SNA		/IS IT 0?  
	JMP TYFPS4	/YES, DONT TYPE LEADING DIGITS.  
	CIA  
	DCA WDCNT  
TYFPS3,	TAD I NORMFR	/GET AN AC DIGIT  
	TAD (260)  
	TYPE 
	CLA CMA		/GO ON TO NEXT FAC DIGIT.  
	TAD NORMFR 
	DCA NORMFR 
	ISZ WDCNT	/END OF LOOP?  
	JMP TYFPS3	/NO. 
	TAD DIGAC	/GET COUNT OF LEADING DIGITS.
TYFPS4,	TAD ALCNT	/ADD COUNT OF ZEROES.  
	TAD [-PREC]
	SMA		/ANYTHING LEFT TO TYPE? 
	JMP TYFPSX	/NO.  EXIT.
	DCA WDCNT	/YES.  STORE COUNT. 
	TAD (256)	/TYPE "." 
	TYPE 
	TAD [PREC]	/FORCE EXIT FROM PRINT LOOP.
	DCA ALCNT
	JMP TYFPS3  
/  
TYFPSX,	CLA
	JMP I TYFPS 
/  
/INSTALLATION CODE LOCATION:  
INSCOD,	0  
	EP24=. 
	LIT
	PAGE 26  
/MAIN 
/ESI MAIN CONTROL ROUTINE. 
/8AC IS CLEAR AT ENTRY. 
/  
ESI,	TLS		/SET TTY OUTPUT FLAG.  
MAIN,	CRLF		/RETURN CARRIAGE.  
	JMS INPUT	/READ A LINE OF INPUT.
	TAD NXTLXN	/CALCULATE LENGTH OF INPUT.
	TAD (-BUFF)
	DCA LENBUF 
	TAD ENDPR	/INITIALISE STACK POINTER 
	DCA STKNXT	/TO END OF USER PROGRAM AREA.
	DCA XSTEP	/SET "DIRECT STATEMENT IN PROCESS".  
	TAD (TSCRN-1)   /DOES RECOGNISER HAVE A NUMBER?  
	JMS RECOG
	JMP STIND	/YES.  INDIRECT STATEMENT.  
	TAD (DSTAT-1)   /NO.  MUST BE DIRECT STATEMENT. 
	JMS SYNAN	/CALL SYNTACTIC ANALYSER. 
	JMP MAIN+1	/GET NEXT STATEMENT.  
/  
/  
/INDIRECT STATEMENT PROCESSOR.
/  
/STIND
/STORE INDIRECT STATEMNET. 
/  
STIND,	JMS FNDSTP	/SEE IF STEP IS ALREADY PRESENT.
	SKP		/NOT PRESENT. 
	JMS DLSTPS	/PRESENT, DELETE IT.
	TAD ENDPR
	DCA STKNXT	/RESTORE STACK IN CASE OF DELETION.
	TAD ARYNXT	/CHECK FOR POSSIBLE OVERFLOW. 
	CIA CLL 
	TAD STKNXT 
	TAD LENBUF 
	SZL CLA 
	JMP ERRSO  
	CDF 10
	TAD I PRVSTP	/GET POINTER OF PRVST. 
	CDF 0
	PUSH		/STORE IN FIRST WORD OF STEP.
	TAD ENDPR
	CDF 10
	DCA I PRVSTP	/SET PREVIOUS STEP TO PT. TO NEW ONE.
	CDF 0
	TAD STKNXT  
	DCA ALCNT	/SAVE LOC. OF STEP .  
	GET (STEPNO)
	JMS PUSHAC	/SAVE STEP   
	TAD STKNXT	/	GET NEXT STACK LOCATION.
	DCA SVLXF	/SET LOC. OF STEP STORAGE.
	CPY [0010],SVLXF+1  
STIND1,	RDADV NXTLXF	/GET CHAR. FROM BUFFER. 
STIND2,	WRADV SVLXF	/WRITE IT IN STEP STORE.  
	TAD CURCHR	/GET CURRENT CHARACTER.
	SNA CLA		/IS IT END? 
	JMP STIND3	/YES.
	JMP STIND1  
/  
STIND3,	TAD SVLXF+1	/GET?RIGHT.  
	RAR		/IS IT RIGHT? 
	SZL CLA 
	JMP STIND2	/YES.  FORCE LEFT.  
	TAD ENDPR	/NO.  LEFT.
	CMA
	TAD SVLXF	/SVLXF-ENDPR-1.  
	CLL RAL  
	ROTL4		/SHIFT TO EXP. POSITION.  
	CDF 10
	TAD I ALCNT	/ADD STEP  WORD WITH EXP OF 1. 
	DCA I ALCNT	/STORE BACK WITH WORD COUNT. 
	CDF 0
	TAD SVLXF
	DCA ENDPR	/SET NEW END OF PROGRAM
	JMP MAIN+1  
/  
LENBUF,	0	/BUFFER LENGTH
/FNDSTP  
/FIND STEP LOCATION GIVEN STEP #.
/STEP # IN FAC AT ENTRY, 8AC CLEAR. 
/AT EXIT:
/	CURSTP - CURRENT STEP LOCATION (IF IT'S PRESENT)  
/	PRVSTP - PREVIOUS STEP LOCATION
/	STEPNO - STEP  
/  
/CALLING SEQUENCE:
/	JMS FNDSTP  
/	...		/NOT FOUND 
/	...		/FOUND  
/  
FNDSTP,	0  
	CLA CMA  
	TAD ACX  
	SZA CLA		/IS ACX = 1? 
	JMP ERRSTP	/NO. 
	TAD ACS	/YES.
	SZA CLA		/IS ACS = 0? 
	JMP ERRSTP	/NO. 
	STORE (STEPNO)  /SAVE FAC IN STEPNO.
	TAD AC+PREC-1   /GET PART .
	TAD (PRTLST-1)  /GET PART LOCATION. 
	DCA CURSTP  
FNDSTL,	JMS GNSTP	/GET NEXT STEP LOCATION.  
	JMP I FNDSTP	/EXIT AT "NOT FOUND". 
	TAD CURSTP  
	IAC		/GET LOC. OF STEP .
	CDF 10
	JMS I [GETNUM]  /UNPACK STEP NUMBER.  
	CLA IAC  
	DCA ACX		/SET ACX TO 1.
	SWP
	GET (STEPNO)
	JMS COMP	/COMPARE DESIRED WITH CURRENT STEP
	JMP I FNDSTP	/D<C. "NOT FOUND" EXIT.
	SKP		/D=C. FOUND STEP. 
	JMP FNDSTL	/D>C.  NOT YET FOUND.
	ISZ FNDSTP  
	JMP I FNDSTP	/"FOUND" EXIT.  
/  
/  
/PROCESS "DIGIT PART". 
/  
PRDP,	CLA IAC		/SET ACX TO 1.  
	DCA ACX 
	RETURN  
/  
/PROCESS EXPONENT PART. 
/  
PREP,	TAD [-PREC]	/CLEAR THE FAC.  
	JMS CLFACS 
	CLA IAC		/SET AC MANTISSA TO 1.  
	DCA AC+PREC-1  
	DCA ACS 
	JMP PRLOG	/GO TAKE LOG OF RESULT.  
	EP26=. 
	LIT
	*BP33 
/GNSTP
/GET NEXT STEP SUBROUTINE. 
/AT ENTRY, CURSTP HAS LOC. OF CURRENT STEP.  
/AT EXIT; 
/	CURSTP - NEXT STEP (IF NOT LAST OF PART)
/	PRVSTP - PREVIOUS STEP LOC. 
/  
/CALLING SEQUENCE:
/	JMS GNSTP
/	...		/LAST STEP.
/	...		/NOT LAST. 
/  
GNSTP,	0  
	TAD CURSTP  
	DCA PRVSTP  
	CDF 10
	TAD I PRVSTP
	SNA		/IS CURRENT STEP LAST?  
	JMP GNEXT	/YES.  
	DCA CURSTP	/NO. 
	ISZ GNSTP
GNEXT,	CDF 0
	JMP I GNSTP	/TAKE "NOT LAST" EXIT.

	BP33=.
	LIT  
	*BP27 
/ERROR PROCESSOR. 
/  
/ 1) STORAGE EXCEEDED:  
/  
ERRSO,	JMS ERRG	/GO TO GENERAL ERRROR TYPEOUT.  
	TEXT /STORAGE/ 
/  
/ 2) DIVISION BY 0:  
/  
ERRD0,	JMS ERRG 
	TEXT /0 DIVISOR/  
/  
/ 3) SYNTACTIC ERROR:
/  
ERRSYN,	JMS ERRG 
EHMSG,	TEXT /EH?/
/  
/ 4) UNDEFINED VARIABLE:
/  
ERRUND,	JMS ERRG 
	TEXT /UNDEFINED/  
/  
/ 5) EXPONENT OVER/UNDERFLOW: 
/  
ERREXP,	JMS ERRG 
	TEXT /EXPONENT/
/  
/ 6) SUBSCRIPT ERROR:
/  
ERRSUB,	JMS ERRG 
	TEXT /SUBSCRIPT/  
/  
/ 7) PART  ERROR:
/  
ERRPRT,	JMS ERRG 
	TEXT /PART /  
/  
/ 8) STEP  ERROR:
/  
ERRSTP,	JMS ERRG 
	TEXT /STEP /  
/  
/GENERAL ERROR TYPEOUT: 
/  
ERRG,	0  
	TAD XSTEP
	SZA CLA		/IS CURRENT STATEMENT DIRECT? 
	JMP ERRIND	/NO, INDIRECT,
	TAD (ERAB)	/TYPE "ERROR ABOVE"
ERRG1,	JMS TYPKST  
	TAD ERRG 
	JMS TYPKST	/TYPE SPECIFIC MESSAGE.
	JMP MAIN	/GO GET NEW LINE.
ERAB,	TEXT /ERROR ABOVE: / 
/  
ERRIND,	TAD (ERST)  
	JMS TYPKST	/TYPE "ERROR IN STEP "
	TAD XSTEP
	JMS TYSNUM	/TYPE STEP NUMBER.  
	TAD (LCOL)	/TYPE ": ".  
	JMP ERRG1
ERST,	TEXT /ERROR IN STEP / 
LCOL,	TEXT /: /

	LIT
/INPUT
/MAIN INPUT SUBROUTINE - USED FOR ALL KEYBOARD INPUT. 
/8AC IS 0 AT ENTRY AND AT EXIT.  
/AT EXIT, NXTLXF CONTAINS LOCATION OF FIRST CHARACTER OF 
/BUFFER;  LAST CHARACTER IS EITHER 00 ("PERIOD-CR") OR 
/37("CR") FOLLOWED BY 00. 
/  
/  
/INPUT LINE BUFFER.  
/  
BLENG=DECIMAL 36 OCTAL
BUFF,	0  
*BUFF+BLENG
/  
	*BP30 
INPUT,	0  
	TAD (207)	/RING BELL.
	TYPE 
	TAD (337)
	TYPE 
ININIT,	TAD (BUFF)	/INITIALISE READ BUFFER.  
	DCA NXTLXN  
	DCA NXTLXN+1 
	TAD (-BLENG-BLENG+2) /LIMIT # OF CHARACTERS TO 70.  
	DCA WDCNT
	TAD (BUFF)  
	DCA NXTLXF	/INITIALISE LEXICAL ANALYSER.
	DCA NXTLXF+1 
	DCA QANYIN	/CLEAR "?ANY INPUT YET".  
CGET,	KSF		/GET A CHARACTER FROM KEYBOARD. 
	JMP .-1		/WAIT FOR CHARACTER.
	KRB		/READ CHAR.
	DCA TMP		/SAVE CHAR.
	TAD (-NSPCHR)	/SET UP SPECIAL CHARACTER COMPARE LOOP.  
	DCA MULCNT 
	TAD (SPCTB-1) 
	DCA AX0 
INPL1,	TAD I AX0	/GET A CHAR. CODE. 
	TAD TMP		/ADD INPUT CHAR.  
	SNA CLA		/IS IT A SPECIAL ONE? 
	JMP I AX0	/YES, GO TO SPECIAL ROUTINE.
	ISZ AX0		/NO, ADVANCE OVER ENTRY LOC.  
	ISZ MULCNT	/END OF LOOP?
	JMP INPL1	/NO.
	ISZ QANYIN	/YES, SET "?ANY INPUT YET".
INP1,	TAD TMP		/STORE "STRIPPED" CHAR.  
	AND [0077]	/IN BUFFER.  
	WRADV NXTLXN
	TAD ADVAC	/ECHO INTERNAL CHAR.
	JMS TYINCH	/ TO TELEPRINTER.
	ISZ WDCNT	/IS BUFFER FULL?  
	JMP CGET	/NO. 
/  
/GETS HERE OR BUFFER FULL OR ON "CR". 
/  
NDLIN,	CRLF 
	TAD QANYIN  
	SNA CLA		/HAS ANYTHING BEEN PUT IN BUFFER?
	JMP INPUT+1	/NO.  GO GET A NEW LINE.
	BKPTR NXTLXN	/BACK UP POINTER.
	RD NXTLXN	/READ LAST CHAR. STORED IN BUFFER. 
	TAD (-56)
	SNA		/IS IT "."?
	JMP INP2	/YES.
	TAD (-77+56) 
	SNA CLA		/IS IT "?"? 
	JMP INPUT+1	/YES.  FORGET LINE.  
	ADV NXTLXN	/ADVANCE OVER LAST CHAR.  
	TAD (37) 
	WRADV NXTLXN	/STORE CR AT END OF LINE. 
INP2,	WR NXTLXN	/STORE 00 AT END OF LINE. 
	JMP I INPUT	/EXIT.  
/  
/GETS HERE ON "RUBOUT".
/  
PRRO,	DIFPTR NXTLXF,NXTLXN 
	TAD [-1]
	SNA SPA CLA	/IS THERE MORE THAN 1 CHAR IN UBFFR
	JMP INPUT+1	/NO.  
	ISZ WDCNT	/ADVANCE COUNTER.
	BKPTR NXTLXN	/BACK UP POINTER.  
	TAD (337)
	TYPE		/TYPE "_".  
	JMP CGET 
/  
/  
/GETS HEREON DPACE.  
PRSPC,	TAD QANYIN 
	SZA CLA		/HAVE ANY CHARACTERS BEEN READ?  
	JMP INP1	/YES.
	JMP CGET	/NO. 
/  
/SPECIAL CHARACTER TABLE:  
SPCTB,	-215		/C-R  
	JMP NDLIN  
	-240		/SPACE
	JMP PRSPC  
	-ICODE		/ALT MODE OR "ESC"
	JMP CANCEL 
	-377		/RUBOUT  
	JMP PRRO
	-337		/BACK ARROW 
	JMP CGET
	-300 
	JMP CGET
	-200		/L-T  
	JMP CGET
	-207		/BELL 
	JMP CGET
	-212		/LINE FEED  
	JMP CGET
	0 
	JMP CGET

NSPCHR=DECIMAL 10 OCTAL  
/  
	EP30=. 
	LIT
	PAGE 31  
/SYNAN
/SYNTACTIC ANALYSER. 
/CALLED WITH MAJOR GOAL LOCATION IN AC.
/EXITS WITH 8AC CLEAR.  
/  
SYNAN,	0  
STGL,	DCA GOAL	/GAOL IS AN AUTO-INDEX.
SYNLP,	TAD I GOAL	/GET "LOOKFOR" WORD.  
	SPA		/IS GOAL TERMINAL?
	JMP TRMGL	/YES.
	DCA TMP		/SAVE NEW GOAL
	TAD GOAL	/GET OLD GOAL.
	JMS PUSH1	/PUT IT ON STACK.
	TAD TMP  
	JMP STGL	/SET NEW SUBGOAL.
/  
TRMGL,	AND [3777]	/EXTRACT TERMINAL LOCATION. 
	JMS RECOG	/CALL RECOGNISER.  IS THAT CURRENT? 
	JMP SUCLP	/YES.  SUCCESS.
TSTFAL,	TAD I GOAL	/NO, FAULURE.  GET 2ND WORD. 
	DCA TMP		/SAVE IT.  
	TAD TMP  
	AND (3000)	/GET FAIL CODE.  
	SNA		/IS IT 0 - FAIL?  
	JMP POPGL	/YES.  GO REPORT FAILURE TO TO  
	TAD (-1000)	/ SUPER-GOAL. 
	SNA		/IS IT 1 - OK? 
	JMP NWGL	/YES.  GO REPORT SUCCESS  
	TAD (-1000)	/ TO SUPER-GOAL. 
	SZA CLA		/IS IT 2 - ALTERNATE?
	JMP ERRSYN	/NO.  3 - DEAD.  SYNTAX ERROR.  
	TAD TMP		/YES.
	AND (0740)	/EXTRACT "ALTERNATE" LOC.
	CLL RTR  
	ROTR3 
	TAD GOAL	/LOCATION OF NEW GOAL  
	JMP STGL	/SET NEW GOAL.
/  
POPGL,	JMS POP1	/POP SUPER-GOAL. 
	DCA GOAL	/REPORT FAILURE. 
	JMP TSTFAL  
/  
NWGL,	JMS POP1	/GET PARENT GOAL.
	DCA GOAL	/SET GOAL.  REPORT BACK SUCESS. 
SUCLP,	TAD I GOAL	/GET REL LOC OF SUCCESSOR.
	AND (0037)  
	DCA SUCLOC	/SAVE IT.  
	TAD GOAL 
	DCA GOALT	/TEMPORARY GOAL POINTER.  
SUCLP2,	TAD I GOALT	/ALL GENERATORS RETURN HERE. 
	SMA CLA		/IS NEXT LOC. A GENERATOR? 
	JMP SETSUC	/NO.  GO SET SUCESSOR. 
	ISZ GOALT	/ADVANCE TO GENERATOR WORD,P 
	TAD I GOALT	/GET GENERATOR POINTER.
	AND [3777]	/EXTRACT GEN. LOC.  
	DCA TMP  
	JMP I TMP	/GO TO GENERATOR.  AC = 0. 
/  
SETSUC,	TAD SUCLOC	/GET SUCESSOR LOC.  
	SNA		/IS THERE A SUCESSOR?
	JMP NWGL	/NO. 
	TAD (-30)	/YES.  GET REL LOC OF CUCESSOR. 
	TAD GOAL 
	JMP STGL	/NEW GOAL. 
/  
GOALT,	0  
SUCLOC,	0  
/  
/  
PUSH1,	0  
	CDF 10
	DCA I STKNXT	/STORE WORD ON STACK. 
	CDF 0
	TAD STKNXT  
	CMA		/WAS LAST STACK ENTRY AT  
	TAD ARYNXT	/LAST WORD BEFORE ARRAY VALUES?  
	SNA CLA  
	JMP ERRSO	/YES.  STACK OVERFLOW. 
	ISZ STKNXT	/NO.  ADVANCE TO NEXT WORD.  
	JMP I PUSH1 
/  
POP1,	0		/AC NOT NECESSARILY CLEAR AT ENTRY.
	CLA CMA  
	TAD STKNXT  
	DCA STKNXT	/BACK UP STACK.  
	CDF 10
	TAD I STKNXT	/GET TOP OF STACK. 
	CDF 0
	JMP I POP1  

	LINPAG=DECIMAL 56 OCTAL	/LINES PER PAGE.  
/  
/EJECT -- TOP OF FORM ROUTINE.
/  
EJECT,	0 
	TAD LINEKNT	/IS THE LINE COUNT ZERO?
	SNA CLA		/NO.  
	JMP NOLF	/YES, DONT FEED LINES. 
	TAD ELF 
	TYPE		/EJECT LINES UNTIL PAGE COUNT EXHAUSTED.  
	ISZ LINEKNT
	JMP .-3 
NOLF,	CPY (-LINPAG),LINEKNT /RESET LINE COUNTER.
	TAD (JEQSEQ-1)	/TYPE OUT END OF PAGE SEQUENCE. 
	JMS TYUNPK 
	JMP I EJECT
/  
/  
SYNEXIT, TAD QEOL	/IS END OF LINE FLAG "EOL"?
	SNA CLA 
	JMP I SYNAN	/YES, EXIT.
	DCA QEOL
	TAD QINSTAT	/ARE WE IN INTERRUPT MODE.
	SZA CLA		/YES, TRY FOR <INSTST>.
	JMP SYNEX1 
	TAD XSTEP	/ARE WE TRYING FOR <DSTAT>.
	SZA CLA 
	TAD (ISTAT-DSTAT) /NO, TRY FOR NEW <ISTAT>.
	TAD (DSTAT-INTST)
SYNEX1,	TAD (INTST-1)
	JMP STGL
/  
/TYUNPK -- TYPE UNPACKED STRING. 
/	ADDR-1 OF STRING IN AC.  
/  
TYUNPK,	0
	DCA AX0		/GET STRING ADDRESS-1.  
TYUN1,	CDF 10
	TAD I AX0	/GET NEXT CHARACTER.  
	CDF 0
	SNA		/IS IT EOL?
	JMP I TYUNPK	/YES, EXIT.  
	TYPE		/NO, TYPE IT OUT. 
	JMP TYUN1  
	LIT  
/STRING POINTER MANIPULATION SUBROUTINES. 
/  
/THIS SET OF MACROES AND SUBROUTINES PROVIDE FOR THE EASY
/MANIPULATION OF PACKED TWO-BYTE-PER-WORD CHARCTER STRINGS. 
/THE MACRO DEFINITIONS ARE AT THE BEGINNING OF THE PROGRA.  
/ALL OF THESE SUBROUTINES ARE CALLED BY MEANS OF MACROES.
/THE FORMS AND MEANINGS OF THESE MACROES ARE AS FOLLOWS: 
/  
/ 1) ADVNCE PTRNAM
/	ADVANCE POINTER "PTRNAM" TO NEXT CHAR. OF STRING. 
/  
/2) RDADV PTRNAM  
/	READ CURRENT CHAR. AND ADVANCE PTRNAM. 
/  
/3) WRADV PTRNAM  
/	WRITE 8AC TO CURRENT CHAR. AND ADVANCE PTRNAM.
/  
/4) RD PTRNAM  
/	READ CURRENT CHAR. TO 8AC; SAVE IN CURCHR. 
/  
/5) WR PTRNAM  
/	WRITE 8AC TO CURRENT CHAR. 
/  
/6) BKPTR PTRNAM  
/	BACK UP POINTER PTRNAM  
/  
/7) DIFPTR PTR1,PTR2 
/	TAKE DIFFERENCE BETWEEN PTR2 AND PTR1 TO 8AC.
/  
/SUBROUTINES.  
/  
/ALL SUBROUTINES MANIPULATE STRING POINTERS, EACH OF WHICH  
/IS A PAIR OF WORDS;  THE FIRST WORD IS THE ADDRESS OF THE
/CURRENT WORD IN THE STRING, THE SECOND IS 0000 OR 0001  
/ACCORDING AS THE CURRENT CHARACTER IS THE LEFT OR RIGHT 
/ONE OF THE CURRENT WORD.  
/  
/ALL SUBROUTINES ARE CALLED BY A SEQUENCE OF THE FORM:
/	JMS SUBR 
/	PTRNAM	/POINTER LOCATION.  
/  
	PAGE 32 
/GTPTRS  
/USED BY ALL OTHER SUBROUTINES TO GET THE 2-WORD STRING  
/POINTERS UNPACKED TO STANDARD LOCATION.  
/THE LOCATION OF THE POINTER IS IN THE 8AC AT ENTRY.  
/CALLING SEQUENCE:
/	JMS GTPTRS  
/	...		/IF ?RIGHT IS 0.  
/	...		/IF ?RIGHT IS 1.  
/OUTPUTS ARE : 
/PTRSTR - LOCATION OF CURRENT WORD OF STRING.
/QRIGHT - ?RIGHT FOR STRING.
/PTRLOC - LOCATION OF WORD POINTER FOR STRING.  
/QLOC - LOCATION OF WORD POINTER+1 FOR STRING.
/  
/GTPTRS ALSO SETS THE DBR TO THE PROPER VALUE.  
/  
	PTRSTR=PTR1ST  
	QRIGHT=PTR2ND  
	PTRLOC=LPTR1ST 
QLOC,	0  
/  
GTPTRS,	0	/ENTRY. 
	DCA PTRLOC	/SAVE LOCATION OF POINTER. 
	TAD I PTRLOC	/SAVE FIRST WORD OF POINTER 
	DCA PTRSTR	/IN PTRSTR. 
	TAD PTRLOC 
	IAC  
	DCA QLOC	/CALCULATE ADDRESS OF ?RIGHT. 
	TAD I QLOC 
	AND (0030)	/SET THE DBR FROM ?RIGHT.
	TAD (CDF 0)
	DCA GETPTX 
	CLA IAC		/GET ?RIGHT FROM QRIGHT  
	AND I QLOC 
	SZA		/DOES QRIGHT = 1 = RIGHT?
	ISZ GTPTRS	/NO, EXIT AT (N+1).
	DCA QRIGHT	/SAVE ?RIGHT IN QRIGHT.  
GETPTX,	XX  
	JMP I GTPTRS	/EXIT TO CALLER.
/  
/SUBROUTINE REPACK -- REPACK PREVIOUSLY UNPACKED POINTERS.  
/CALLING SEQUENCE:
/	JMS REPACK
/REPACK IS CALLED BY EVERY ROUTINE WHICH HAS MODIFIED THE
/INPUT POINTERS.  REPACK PUTS THE UNPACKED POINTER BACK INTO
/THE PROPER FORM AND SETS THE DBR TO 0.
/  
REPACK,	0
	RDF		/GET THE DATA BANK FOR ?RIGHT. 
	CDF 0
	TAD QRIGHT 
	DCA I QLOC	/PUT NEW ?RIGHT BACK IN POINTER.  
	TAD PTRSTR	/PUT REVISED STRING POINTER
	DCA I PTRLOC	/INTO POINTER.  
	JMP I REPACK  
/ADVS 
/ADVANCE PREVIOUSLY UNPACKED POINTERS. 
/CALLED BY ADVPS, WRADVS, RDADVS.
/  
ADVS,	0  
	TAD QRIGHT 
	SNA CLA		/IS IT LEFT OR RIGHT?
	JMP ADVLFT	/LEFT.  
	DCA QRIGHT	/RIGHT. SET IT LEFT. 
	ISZ PTRSTR 
	JMP I ADVS  
/  
ADVLFT,	ISZ QRIGHT	/SET IT TO RIGHT.
	JMP I ADVS	/EXIT . 
/  
/  
/ADVPS (CALLED BY "ADVNCE" MACRO). 
/ADVANCE PACKED POINTERS TO NEXT CHAR. OF STRING.  
/  
ADVPS,	0  
	TAD I ADVPS	/BET POINTER LOC.
	ISZ ADVPS	/ADVANCE OVER POINTE.  
	JMS GTPTRS	/UNPACK POINTER.  
	OPR  
	JMS ADVS	/ADVANCE POINTER.
	JMS REPACK	/REPACK POINTER.  
	JMP I ADVPS	/EXIT.  
/  
/NEWPAGE -- TYPE NEW PAGE HEADING ROUTINE.
/  
NEWPAGE,	0  
	ISZ PAGEKNT	/INCREMENT PAGE COUNT. 
	TAD (PAGMES)	/TYPE OUT "*PAGE ".
	JMS TYPKST	/NOTE THAT "*" WILL CAUSE PAPER TAPE
	TAD PAGEKNT	/TO DISREGARD THIS ON INPUT. 
	JMS BTODX	/CONVERT PAGE COUNT TO DECIMAL AND PRINT.  
	TAD (5) 
	JMS TYSPC	/TYPE 5 SPACES. 
	TAD [TITBUF]	/TYPE OUT TITLE BUFFER. 
	JMS TYPKUP 
	TAD (CRLF3-1)	/RETURN THE CARRIAGE AND SPACE.  
	JMS TYUNPK 
	JMP I NEWPAGE 
/  
/  
/RDS -- READ CHARACTER SUBROUTINE.  
/USED BY "RD" AND "RDADV" MACROES.
/  
RDS,	0
	DCA ADVAC	/SAVE INPUT AC. 
	CLA CMA		/SET ADVANCE SWITCH TO NO ADVANCE.  
RDS1,	DCA QADVC
	TAD I RDS  
	ISZ RDS 
	JMS GTPTRS	/UNPACK INPUT POINTER.  
	JMP RDSLFT	/IF LEFT, GO PROCESS.
	TAD I PTRSTR	/FETCH CURRENT WORD
RDMASK,	AND [0077]	/AND GET LOW ORDER SIX BITS.
	DCA CURCHR 
	ISZ QADVC	/IF ADVANCE FLAG IS SET, 
	JMS ADVS	/ADVANCE INPUT.  
	JMS REPACK	/REPACK INPUT. 
	TAD CURCHR 
	TAD ADVAC	/LEAVE RESULT IN AC.  
	JMP I RDS  
/  
RDSLFT,	TAD I PTRSTR	/LEFT.  MOVE LEFT TO RIGHT.
	ROTR6
	JMP RDMASK	/GO FETCH CHARACTER. 
/  
/RDADVS -- READ ADVANCE SUBROUTINE. 
/USED BY "RDADV" MACRO.
/  
RDADVS,	0
	DCA ADVAC	/SAVE INPUT AND SET ADVANCE SWITCH.  
	CPY RDADVS,RDS
	JMP RDS1
/WRS (CALLED BY "WR" MACRO)  
/  
WRS,	0  
	DCA ADVAC	/SAVE INPUT 8AC. 
	CLA CMA		/SET ?ADVANCE TO NO ADVANCE.
WRS1,	DCA QADVC
	TAD I WRS	/GET POINTER LOC.
	ISZ WRS		/ADVANCE OVER POINTER. 
	JMS GTPTRS	/UNPACK POINTERS AND TEST ?RIGHT. 
	JMP WRSLFT	/LEFT CHAR.
	TAD I PTRSTR	/RIGHT CHAR. GET WORD.
	AND [7700]
	TAD ADVAC
WRS2,	DCA I PTRSTR	/STORE NEW WORD. 
	ISZ QADVC	/IF ?ADVANCE IS SET,
	JMS ADVS	/ADVANCE POINTER.
	JMS REPACK 
	JMP I WRS  
/  
WRSLFT,	TAD ADVAC	/GET CHARACTER.  
	ROTL6		/CLEAR RIGHT-HAND CHARACTER. 
	JMP WRS2 
/  
/  
/WRADVS (CALLED BY "WRADV" MACRO)  
/ ALTERNALTE ENTRY TO WRS. 
/  
WRADVS,	0  
	DCA ADVAC	/SAVE INPUT AD.  
	CPY WRADVS,WRS
	JMP WRS1 
	*BP33 
/DIFPS (CALLED BY "DIFPTR" MACRO)  
/GET DIFFERENCE OF TWO POINTERS. 
/(PTR2-PTR1) TO 8AC. 
/CALLING SEQUENCE 
/	JMS DIFPS
/	PTR1  
/	PTR2  
/  
DIFPS,	0  
	TAD I DIFPS 
	JMS GTPTRS 
	OPR
	TAD PTRSTR 
	CLL RAL  
	TAD QRIGHT 
	CIA		/GET ROL. CHAR. POSITON OF PTR1 
	DCA ADVAC	/SAVE (-PTR1) 
	ISZ DIFPS
	CDF 0
	TAD I DIFPS 
	JMS GTPTRS	/UNPACK PTR2.  
	OPR
	TAD PTRSTR 
	CLL RAL  
	TAD QRIGHT 
	TAD ADVAC	/REL. POS. OF PTR2 - PTR1.  
	ISZ DIFPS  
	CDF 0
	JMP I DIFPS
/  
/BKPTRS -- BACK UP POINTERS.  
/USED BY "BKPTR" MACRO.
/  
BKPTRS,	0
	TAD I BKPTRS	/UNPACK INPUT POINTER 
	ISZ BKPTRS	/AND TEST ?RIGHT.  
	JMS GTPTRS 
	JMP BKLFT	/LEFT.  GO PROCESS.
	DCA QRIGHT	/RIGHT. MAKE PTR POINT TO LEFT.  
	JMP BKEXIT 
BKLFT,	ISZ QRIGHT	/LEFT.  MAKE PTR POINT TO RIGHT  
	CLA CMA		/OF PREVIOUS WORD.
	TAD PTRSTR 
	DCA PTRSTR 
BKEXIT,	JMS REPACK	/REPACK MODIFIED POINTER. 
	JMP I BKPTRS  
	EP33=.
	LIT  
/UPPER MEMORY ORGANIZATION.
/  
/PAGE 0...USED BY SYSTEM.  
/  
	TOSTPN=0001	/NEXT STEP POINTER.  
	TITBUF=0002	/TITLE BUFFER. 
	HASCON=TITBUF+BLENG	/HASTINGS CONSTANTS.
/  
/PAGES 1...37  USER MEMORY.
/  
/ 1) PART LIST 
/  
	PRTLST=200  
/  
/  
/ 2) VARIABLE STORAGE
/  
	VRBLOC=DECIMAL PRTLST+10 OCTAL 
	VBLKEND=DECIMAL VRBLOC+78 OCTAL
/  
/  
/ 3) ARRAY STORAGE
/  
	USERPR=VBLKEND 
	USEREND=7740
/END OF PROGRAM.  
/