*20
	PAGE
EXPR,	0			/GET EXPRESSION
	DCA	EXPVAL		/ZERO EXPR VALUE
	DCA	EXPVAL+1
	DCA	EXPVAL+2
	DCA	EXPTYP		/AND TYPE
	CLA IAC			/SET EXPR SWITCH TO NO EXPR
	DCA	EXPSW
	DCA	FPP2WD		/SET FORCE SWITCH OFF
	CLA IAC			/SET LASTOP TO +
	DCA	LASTOP
	JMS I	[CHKLIT		/GO CHECK FOR LITERAL
	JMS I	[GETCHR		/LOOK FOR UNARY+ -
	JMP I	EXPR		/NO EXPRESSION
	TAD	(-255		/IS IT -
	SNA
	ISZ	LASTOP		/SET LAST OPER8R TO -
	SZA
	TAD	(255-253	/IS IT + OR -
	SZA CLA
	JMS I	[BACK1		/NO, PUT CHAR BACK
SYMBOL,	JMS I	[GETNAM		/NOW PICK UP NAME
	JMP	NOSYM		/NONE, TRY OTHER
	JMS I	[LOOKUP		/LOOK IT UP
	JMP	DEFSYM		/NEW SYMBOL
	TAD	(-5		/CHECK FOR BADDIES
	SMA
	JMP	BAD		/BAD EXPRESSION
	TAD	SYMTYP
	DCA	.+1		/STORE JUMP
	0			/JUMP THRU TABLE
SYMTYP,	JMP I	.+6
PUNDEF,	UNDEF			/UNDEFINED
	ADR			/USER ADDRESS
	DP			/USER D.P.
	FP			/USER F.P.
	ONE			/PDP-8 OPERATE
OKEXP,	ISZ	EXPR		/GOOD EXPR, BUMP RETURN
BAD,	CLA
	JMP I	EXPR		/RETURN
NOSYM,	TAD	CHRPTR		/NO NAME, SAVE CHAR POS
	DCA	EXTMP
	TAD	NCHARS
	DCA	EXTMP2
	JMS I	(NUMBER		/LOOK FOR A NUMBER
	JMP	NOTNUM		/NO NUMBER
	JMS I	[GETCHR		/LOOK AT NEXT CHAR
	JMP	ADREXP		/NO NEXT CHAR, USE NUMBER
	TAD	[-256		/IS CHAR "."
	SZA
	TAD	(256-305	/IS IT "E" ?
	SZA
	IAC			/IS IT "D" ?
	SNA CLA
	JMP	GETFPN		/TRY FOR DP NUM
	JMS I	[BACK1		/OTHERWISE PUT IT BACK
	JMP	ADREXP		/GO USE IT
GETFPN,	TAD	EXTMP		/RESET CHAR POINTER
	DCA	CHRPTR
	TAD	EXTMP2
	DCA	NCHARS
	JMP I	(INFP		/TRY FOR FP OR DP NUMBER
NOTNUM,	JMS I 	[GETCHR		/NOT A NUMBER, GET A CHAR
	JMP I	(ENDEXP+1	/NONE LEFT, END
	TAD	[-256		/IS IT "." ?
	SZA CLA
	JMP I	(ENDEXP		/NO, END EXPR
	JMS I	[GETCHR		/LOOK AT NEXT CHAR
	JMP	ISDOT		/NO NEXT CHAR, ITS LOC SYMBOL
	TAD	[-272		/IS NEXT CHAR A DIGIT
	SMA
	JMP	ISDOT-1		/NO
	TAD	[12
	SMA CLA
	JMP	GETFPN		/YES, TREAT ".N" AS FP NUMBER
	JMS I	[BACK1		/OTHERWISE PUT IT BACK
ISDOT,	TAD	LOCTR1		/THIS WAS LOC SYMBOL
	DCA	WORD1		/PUT VALUE INTO WORD1,2
	TAD	LOCTR2
	DCA	WORD2
	JMP	ADREXP		/AND USE VALUE
ADR,	TAD I	LTEMP		/CHECK FORCE BIT FOR THIS SYMBOL
	AND	[40
	SZA CLA
	ISZ	FPP2WD		/AND SET SWITCH IF BIT ON
	TAD I	X10		/GET FIRST WORD OF VALUE
ONE,	DCA	WORD1		/SINGLE WORD SYMBOL, HIGH=0
	TAD I	X10		/GET REST OF SYMBOL
	DCA	WORD2
	CDF	FLD0		/FIX FIELD
ADREXP,	TAD	EXPSW		/FIRST TIME THROUGH ?
	SZA			/IF SO THEN SET TYPE TO ADDR
	DCA	EXPTYP		/OTHERWISE LEAVE IT ALONE
	CLL CMA RAL
	TAD	EXPTYP		/CHECK FOR TYPE CONFLICT
	SMA CLA
	JMP	MXDTYP		/NOT - MEANS FP OR DP
	DCA	EXPSW		/KILL FIRST TIME SWITCH
	TAD	LASTOP		/PICK UP LAST OPERATOR
	TAD	ADROP		/MAKE A JMP I
	DCA	.+1
	0			/DO IT
ADROP,	JMP I	.
	ADRADD
	ADRSUB
	ADRMUL
	BAD			/INTEGER DIVIDE NOT IMPLEMENTED
	ADRAND
	ADROR
MXDTYP,	JMS I	[ERMSG		/MIXED TYPES
	1524			/*MT*
	JMP I	[OPR8R
DEFSYM,	DCA I	NEXT		/NEW SYMBOL, ALLOCATE 2 WORDS
	DCA I	NEXT
	JMP I	PUNDEF		/THEN TREAT LIKE UNDEFINED
	PAGE
UNDEF,	TAD	FPPSWT		/IS THIS AN FPP ADDR ?
	SNA CLA
	JMP	.+5		/NO, SKIP AROUND
	TAD I	LTEMP		/TURN ON FORCE BIT
	AND	(7737		/FOR THIS SYMBOL
	TAD	[40
	DCA I	LTEMP
	DCA	EXPTYP		/SET TYPE TO UNDEFINED
	CDF	FLD0		/FIX FIELD
	DCA	EXPSW		/KILL FIRST TIME SWITCH
	CLL CMA RAL		/-2
	TAD	PASSNO		/IF > PASS 1, UNDEFINED ERROR
	SPA CLA
	JMP	OPR8R		/UNDEFINED HAS VALUE 0
	JMS I	[ERMSG
	2523			/*US*
OPR8R,	TAD	(OPR8RS-1	/SET POINTER
	DCA	X11		/TO OPERATOR TABLE
	DCA	LASTOP		/ZERO LASTOP
	JMS I	[GETCHR		/GET CHAR
	JMP I	(ENDEXP+1	/NONE, DONE
	DCA	EXTMP		/SAVE IT
FINDOP,	TAD I	X11		/GET NEXT LIST ENTRY
	SNA
	JMP I	(ENDEXP		/ZERO IS END OF LIST
	TAD	EXTMP		/COMPARE
	SNA CLA	
	JMP	GOTOP		/THIS IS THE OPERATOR
	ISZ	X11		/NO, BUMP PTR
	JMP	FINDOP		/LOOP
GOTOP,	TAD I	X11		/PICK UP OTHER VALUE
	DCA	LASTOP		/SAVE IN "LASTOP"
	JMP I	(SYMBOL		/LOOK FOR OPERAND
ADRADD,	TAD	EXPVAL+2	/ADD FOR 15 BIT ADDRESS
	CLL			/ZERO LINK
	TAD	WORD2		/ADD LOW WORDS
	DCA	EXPVAL+2	/SAVE RESULT
	RAL			/PUT CARRY INTO BIT 11
	TAD	EXPVAL+1	/ADD HIGH
	TAD	WORD1		/ORDER WORDS
	DCA	EXPVAL+1	/SAVE RESULTT
	JMP	OPR8R		/LOOK FOR OPERATOR
ADRSUB,	TAD	WORD2		/SUBTRACT LOW 12 BITS
	CLL CML CIA
	TAD	EXPVAL+2
	DCA	EXPVAL+2	/SAVE LOW HALF
	RAL
	TAD	WORD1		/SUBTRACT HIGH HALF
	CIA
	TAD	EXPVAL+1
	DCA	EXPVAL+1	/SAVE HIGH HALF
	JMP	OPR8R		/GET OPERATOR
ADRAND,	TAD	WORD1		/AND
	AND	EXPVAL+1	/HIGH
	DCA	EXPVAL+1	/HALF
	TAD	WORD2		/THEN
	AND	EXPVAL+2	/LOW
	DCA	EXPVAL+2	/HALF
	JMP	OPR8R		/THEN COOL IT
ADROR,	TAD	WORD1		/OR IS THE SAME AS
	CMA			/SETTING THE BITS
	AND	EXPVAL+1	/THAT ARE ON IN B AND NOT ON IN A
	TAD	WORD1		/AND THEN SETTING THE BITS
	DCA	EXPVAL+1	/THAT ARE ON IN A
	TAD	WORD2
	CMA
	AND	EXPVAL+2
	TAD	WORD2
	DCA	EXPVAL+2
	JMP	OPR8R		/LOOK FOR OPERATOR
ADRMUL,	DCA	SIGNX		/ZERO SWITCH
	TAD	EXPVAL+1	/IS EXPR NEGATIVE
	SPA CLA
	JMS	COMPL		/YES, COMPLEMENT IT
	TAD	(-31
	DCA	NBITS		/BIT COUNT
	DCA	EXTMP		/ZERO RESULT (HIGH 24 BITS)
	DCA	EXTMP2		/RECEPTACLE
MULOOP,	TAD	EXTMP		/ROTATE 48 BIT REGISTER
	CLL RAR			/RIGHT ONE
	DCA	EXTMP
	TAD	EXTMP2
	RAR
	DCA	EXTMP2
	TAD	EXPVAL+1
	RAR
	DCA	EXPVAL+1
	TAD	EXPVAL+2
	RAR
	DCA	EXPVAL+2
	SNL			/IS LINK ON?
	JMP	NOADD		/NO, DONT ADD
	TAD	EXTMP2		/YES, ADD MULTIPLIER
	CLL			/TO HIGH HALF OF 48 BIT
	TAD	WORD2		/RESULT
	DCA	EXTMP2		/(THIS IS A 2 WORD ADD)
	RAL
	TAD	WORD1
	TAD	EXTMP
	DCA	EXTMP
NOADD,	ISZ	NBITS		/INCREMENT COUNTER
	JMP	MULOOP		/LOOP
	TAD	SIGNX		/CHECK FOR RE-COMPLEMENT
	SZA CLA
	JMS	COMPL		/YES, GO DO IT
	JMP	OPR8R		/LOOK FOR OPERATOR
COMPL,	0
	ISZ	SIGNX		/SET SWITCH
	TAD	EXPVAL+2	/COMPLEMENT
	CLL CML CIA		/THE
	DCA	EXPVAL+2	/TWO
	RAL
	TAD	EXPVAL+1	/WORD
	CIA			/THING
	DCA	EXPVAL+1
	JMP I	COMPL		/RETURN
	SIGNX=LTEMP
	NBITS=X10
	PAGE
CHKLIT,	0			/CHECK FOR LITERAL
	DCA	PAGENO		/ZERO PAGE NUMBER
	DCA	LITRL
	JMS I	[GETCHR		/GET CHARACTER
	JMP I	CHKLIT		/NO LITERAL
	TAD	(-250		/CHECK FOR (
	SNA
	ISZ	PAGENO		/CURRENT PAGE LITERAL
	SZA			/SKIP IF ALREADY ZERO
	TAD	(-63		/CHECK FOR [
	SNA
	ISZ	LITRL		/SET SWITCH
	SZA CLA
	JMS I	[BACK1		/PUT BACK NON ([
	JMP I	CHKLIT
CRLINK,	0			/CREATE LINK
	TAD	CRLINK		/FIX RETURN ADDR
	DCA	CRLIT
	TAD	OPCODE		/SET INDIRECT BIT
	TAD	(400
	DCA	OPCODE
	CLA IAC
	DCA	PAGENO		/SET INDICATOR
	JMS I	[ERMSG		/*LG*
	1407
	JMP	NOTP0
CRLIT,	0			/CREATE LITERAL WITH TYPE EXPTYP
				/VALUE:EXPVAL, IN PAGE:PAGENO
	TAD	FPPSWT		/FP LITERAL ?
	SZA CLA
	JMP I	(FPPLIT
	TAD	PAGENO		/CHECK FOR PAGE 0
	SZA CLA
	JMP	NOTP0		/NOT A PAGE 0 LITERAL
	TAD	(P0LBUF		/SET BASE TO PAGE 0 LIT BUFFER
	DCA	LITBAS
	TAD	(17		/ASSUME FIRST 20 WORDS USED
	JMP	DOLIT		/GO DO LITERAL
NOTP0,	TAD	(CPLBUF		/CURRENT PAGE LIT BUFFER
	DCA	LITBAS
	TAD	LOCTR2		/NUMBER OF WORDS USED IN PAGE
	AND	[177
DOLIT,	DCA	NWUSED
	TAD	PAGENO		/GET POINTER TO
	TAD	[P0LIT		/LITERAL BOUNDARY
	DCA	XPAGE
	TAD I	XPAGE		/DISPLACEMENT OF LIT BUFR - 1
	DCA	LITPTR		/INTO LITPTR
	TAD	EXPTYP		/TYPE IS ACTUALLY SIZE OF LITERAL
	SZA			/CHECK FOR UNDEFINED
	JMP	.+3		/OK, ITS DEFINED
	DCA	EXPVAL+2	/UNDEFINED, ASSUME ZERO
	IAC			/AND ADDRESS TYPE
	CIA
	DCA	EXPTYP		/GET THE COMPLEMENT
	TAD	(EXPVAL+2
	TAD	EXPTYP		/GET POINTER TO VALUE
	DCA	X12		/MINUS ONE INTO X12
NOTIT,	TAD	EXPTYP		/CHECK FOR END OF TABLE
	CIA
	TAD	LITPTR		/POINTER+SIZE
	AND	[200		/SHOULD BE LESS THAN 200
	SZA CLA
	JMP	NEWLIT		/ENTER NEW LITERAL
	TAD	EXPTYP		/PUT COPY OF LENGTH
	DCA	LTEMP		/INTO LTEMP
	TAD	X12		/AND COPY OF PROTOTYPE POINTER
	DCA	X15		/INTO X15
	TAD	LITPTR		/NOW GET POINTER
	TAD	LITBAS		/TO TABLE
	DCA	X11		/FOR COMPARISON
	ISZ	LITPTR		/INCREMENT POINTER
TSTLIT,	TAD I	X11		/GET WORD OF LITERAL
	CIA
	TAD I	X15		/COMPARE WITH PROTOTYPE
	SZA CLA
	JMP	NOTIT		/NOT IT, SLIDE POINTER AND RETRY
	ISZ	LTEMP		/BUMP COUNTER
	JMP	TSTLIT		/LOOP IF MORE
LITADR,	TAD	PAGENO		/PAGE 0 ?
	SZA CLA
	TAD	LOCTR2		/NO, CURRENT PAGE, GET ADDRESS
	AND	[7600
	TAD	LITPTR		/PLUS PAGE DISPLACEMENT
	DCA	EXPVAL+2	/INTO VALUE
	TAD	LOCTR1
RETLIT,	DCA	EXPVAL+1
	CLA IAC			/SET TYPE TO ADDRESS
	DCA	EXPTYP
	JMP I	CRLIT
NEWLIT,	TAD I	XPAGE		/MOVE LITERAL BOUNDARY DOWN
	TAD	EXPTYP
	DCA	X10		/ADDRESS OF NEW LITERAL
	TAD	NWUSED		/CHECK FOR PAGE OVERFULL
	CIA
	TAD	X10
	SMA CLA
	JMP	.+5		/NOT FULL
	JMS I	[ERMSG		/*PO*
	2017
	DCA	EXPVAL+2	/ZERO ADDRESS
	JMP	RETLIT
	TAD	X10
	DCA I	XPAGE
	TAD I	XPAGE		/SET UP POINTER FOR MOVE
	TAD	LITBAS
	DCA	X10
	TAD I	X12		/MOVE LITERAL INTO PLACE
	DCA I	X10
	ISZ	EXPTYP
	JMP	.-3
	TAD I	XPAGE		/SET UP LITERAL ADDRESS
	IAC
	DCA	LITPTR
	JMP	LITADR		/RETURN LITERAL ADDRESS
PAGENO,	0
XPAGE,	0
LITBAS,	0
NWUSED,	0
LITPTR,	0
	PAGE
FPPLIT,	CLA IAC
	DCA	FPP2WD		/FORCE 2 WORD INSTRUCTION
	CLA CMA			/WHAT PASS ?
	TAD	PASSNO
	SNA CLA
	JMP I	(RETLIT		/PASS 1 DONT GENERATE FP LITERALS
	JMS	TYPE3		/SKIP IF FP OR ADDR TYPE
	IAC			/DP TYPE
	TAD	(FPLIST		/POINTER TO FP LITERAL BUCKET
	CDF	FLD1
FPLOOK,	DCA	OLDFP		/START ADDR OF CURRENT BLOCK
	TAD I	OLDFP		/ADDR OF NEXT BLOCK
	SNA
	JMP	NEWFPL		/IF 0 THEN END OF LIST
	DCA	X10
	TAD I	X10		/GET DISPLACEMENT
	DCA	LTEMP		/SAVE IT
	JMS	TYPE3
	JMP	CMP2WD		/DP, ONLUT 2 WORDS
	TAD	EXPVAL		/DO 3 WORD COMPARE
	CIA CLL
	TAD I	X10
	SZA CLA
	JMP	DIFFPL		/NOT THE SAME
CMP2WD,	TAD	EXPVAL+1
	CIA CLL
	TAD I	X10
	SZA CLA
	JMP	DIFFPL
	TAD	EXPVAL+2
	CIA CLL
	TAD I	X10
	SZA CLA
	JMP	DIFFPL
RETFPL,	TAD	LTEMP		/GET LITERAL DISPLACEMENT
	CDF	FLD0
	CLL			/ADD LITORG ADDR
	TAD	LITRG2
	DCA	EXPVAL+2	/AND MAKE IT THE NEW EXPVAL
	RAL
	TAD	LITRG1
	JMP I	(RETLIT
DIFFPL,	SZL
	JMP	NEWFPL		/INSERT NEW LITERAL HERE
	TAD I	OLDFP		/GET START ADDR OF THIS BLOCK
	JMP	FPLOOK
NEWFPL,	TAD I	OLDFP		/HOOK IN NEW FP LITERAL
	DCA I	NEXT
	TAD	NEXT
	DCA I	OLDFP
	TAD	FPLNUM		/PUT IN DISPLACEMENT
	DCA I	NEXT
	JMS	TYPE3		/2 OR 3 WORDS
	JMP	.+3
	TAD	EXPVAL		/STORE VALUE
	DCA I	NEXT
	TAD	EXPVAL+1
	DCA I	NEXT
	TAD	EXPVAL+2
	DCA I	NEXT
	TAD	NEXT		/CHECK FOR ST OVERFLOW
	CLL
	TAD	[12
	SNL CLA
	JMP	.+4		/OK, NOT FULL
	JMS I	[ERMSG1
	2324			/*ST*
	JMP I	(RETSYS		/SINCE ITS FATAL, ABORT
	TAD	FPLNUM		/SAVE DISPLACEMENT
	DCA	LTEMP
	ISZ	FPLNUM		/BUMP DISPLACEMENT BY 3
	ISZ	FPLNUM
	JMS	TYPE3		/OR MAYBE 2
	SKP
	ISZ	FPLNUM
	JMP	RETFPL
DLITS,	0			/DUMP FP LITERALS
	CLL CMA RAL		/2 LISTS
	DCA	TYPE3		/SAVE COUNT IN SUBR ENTRY
DLITS2,	TAD	(FPLIST		/FP LITERAL BUCKET
	CDF	FLD1
FPLDMP,	DCA	OLDFP
	TAD I	OLDFP		/GET ADDR OF NEXT FP LITERAL
	SZA
	JMP	MORFPL
	CDF	FLD0
	CLA IAC			/SET AC=1
	ISZ	TYPE3		/FINISHED YET
	JMP	DLITS2		/NO, DO DP LIST
	CLA
	JMP I	DLITS		/YES, RETURN
MORFPL,	DCA	X10		/SAVE POINTER
	TAD I	X10		/GET DISPLACEMENT
	CLL
	TAD	LITRG2		/ADD LITERAL ORG
	DCA	LOCTR2		/AND PUT IT INTO LOCATION COUNTER
	RAL
	TAD	LITRG1
	DCA	LOCTR1
	TAD	TYPE3		/2 OR 3 WORDS ?
	IAC
	SZA CLA
	JMS	OUTFPL		/THREE
	JMS	OUTFPL
	JMS	OUTFPL
	TAD I	OLDFP		/POINTER TO NEXT BLOCK
	JMP	FPLDMP
OLDFP,	0
FPLNUM,	0
TYPE3,	0			/SKIP ON ADDR OR FP
	CLL CMA RAL		/-2
	TAD	EXPTYP
	SZA CLA
	ISZ	TYPE3		/NOT TYPE 2
	JMP I	TYPE3
OUTFPL,	0			/PUT WORD FROM LITERALS
	TAD I	X10		/GET WORD
	CDF	FLD0
	JMS I	[OUTWRD
	CDF	FLD1
	JMP I	OUTFPL
	PAGE
LOOKUP,	0			/SYMBOL TABLE LOOKUP
	TAD	BUCKET		/GET BUCKET ADDRESS
	TAD	(BUCKTS-1
	DCA	BUCKET		/INTO "BUCKET"
	TAD I	BUCKET		/GET ADDR OF BUCKET BOTTOM
	CDF	FLD1		/GO TO FIELD 1
LOOK,	DCA	OLDN3		/THIS IS PTR OF PREV ENTRY
	TAD I	OLDN3		/THIS IS ADR OF NEXT ENTRY
	SNA			/IF ZERO, THEN
	JMP	HOOKIN		/GO HOOK IN AT THE END
	DCA	X10		/SAVE NEXT NAME PTR
	TAD	NAME1		/COMPARE NAMES
	CIA CLL
	TAD I	X10		/WORD 1
	SZA CLA
	JMP	NOTSAM
	TAD	NAME2
	CIA CLL
	TAD I	X10		/WORD2
	SZA CLA
	JMP	NOTSAM
	TAD I	X10
	AND	(7700		/WORD 3 (ONLY UPPER HALF)
	DCA	LTEMP
	TAD	NAME3
	CIA CLL
	TAD	LTEMP
	SZA CLA
	JMP	NOTSAM
	ISZ	LOOKUP		/IF FOUND BUMP RETURN
	TAD	X10
	DCA	LTEMP		/ADDR OF TYPE WORD
	TAD I	LTEMP		/GET TYPE INTO AC
	AND	[37		/WITHOUT FORCE BIT
	JMP I	LOOKUP		/RETURN
NOTSAM,	SZL			/NAMES DIFFER, IS NAME 1,2,3 < ENTRY
	JMP	HOOKIN		/YES, HOOK IN HERE
	TAD I	OLDN3		/GET ADDR OF LINK INTO AC
	JMP	LOOK		/LOOP
HOOKIN,	TAD I	OLDN3		/GET FORWARD LINK TO
	DCA I	NEXT		/NEXT ENTRY INTO NEW ENTRY
	TAD	NEXT		/PUT FORWARD LINK TO NEW
	DCA I	OLDN3		/ENTRY INTO PREVIOUS ENTRY
	TAD	NAME1		/PUT IN NAME
	DCA I	NEXT
	TAD	NAME2
	DCA I	NEXT
	TAD	NAME3
	DCA I	NEXT
	TAD	NEXT		/X10=NEXT
	DCA	X10
	TAD	NEXT		/LTEMP=NEXT
	DCA	LTEMP
	TAD	NEXT		/CHECK FOR TABLE FULL
	CLL
	TAD	[12
	SNL CLA
	JMP I	LOOKUP		/NO PROBLEMS, RETURN (NO SKIP)
	JMS I	[ERMSG1
	2324			/*ST*
	JMP I	(RETSYS		/ST FULL, ABORT
NUMBER,	0			/GET INTEGER NUMBER (NO SIGN)
	DCA	NSWTCH		/CLEAR SWITCH
	DCA	WORD1		/CLEAR 24 BIT NUMBER
	DCA	WORD2
NUMLUP,	JMS I	[GETCHR		/GET A CHAR
	JMP	NODGT+1		/NONE LEFT
	TAD	[-272		/IS IT A DIGIT?
	SMA
	JMP	NODGT		/NO, TOO BIT
	TAD	[12
	SPA
	JMP	NODGT		/NO, TOO SMALL
	DCA	NUM		/YES, SAVE IT
	TAD	WORD1		/SAVE CURRENT VALUE
	DCA	NUM1		/OF NUMBER
	TAD	WORD2
	DCA	NUM2
	JMS	SHIFT		/SHIFT WORD1,2, LEFT 1 (MULT BY 2)
	JMS	SHIFT		/DO IT AGAIN (MULT BY 4)
	TAD	RADIX		/LOOK AT RADIX (1=DECIMAL)
	SNA CLA
	JMP	OCTNUM		/ITS OCTAL
	CLL			/DECIMAL, ADD IN NUMBER
	TAD	NUM2
	TAD	WORD2		/THUS MULTIPLYING BY 5
	DCA	WORD2
	RAL
	TAD	NUM1
	TAD	WORD1
	DCA	WORD1
OCTNUM,	JMS	SHIFT		/SHIFT LEFT 1 AGAIN, THUS
	TAD	WORD2		/MULTIPLYING BY 8 OR 10
	CLL			/THEN ADD IN NEW DIGIT
	TAD	NUM
	DCA	WORD2
	RAL
	TAD	WORD1
	DCA	WORD1
	ISZ	NSWTCH		/SET SWITCH
	JMP	NUMLUP		/LOOP
NODGT,	JMS I	[BACK1		/PUT BACK NON-DIGIT
	TAD	NSWTCH		/WAS THERE A NUMBER
	SZA CLA
	ISZ	NUMBER		/YES, SKIP
	JMP I	NUMBER		/RETURN
NSWTCH,	0
NUM,	0
NUM1,	0
NUM2,	0
SHIFT,	0			/SHIFT DOUBLE WORD LEFT 1
	TAD	WORD2
	CLL RAL
	DCA	WORD2
	TAD	WORD1
	RAL
	DCA	WORD1
	JMP I	SHIFT
	PAGE
BACK1,	0
	CLA CMA			/BACKUP COUNT
	TAD	NCHARS
	DCA	NCHARS
	CLA CMA			/AND POINTER
	TAD	CHRPTR
	DCA	CHRPTR
	JMP I	BACK1
GETNAM,	0			/GET A NAME
	JMS	GETCHR		/GET FIRST CHAR
	JMP I	GETNAM		/NO CHAR, NO NAME
	JMS	LETTER		/FIRST CHAR MUST BE LETTER
	JMP	NONAME		/OTHERWISE, NO NAME
	AND	[77
	DCA	BUCKET		/THIS CHAR IS BUCKET
	DCA	NAME1
	DCA	NAME2		/ZERO REST
	DCA	NAME3		/OF NAME
	TAD	(NAME1		/SET
	DCA	NPTR		/POINTER
	CLL CMA RTL		/AND
	DCA	NCNT		/COUNTER
PAKLUP,	JMS	GNC		/GET NAME CHAR (LETTER OR DIGIT)
	CLL RTL			/SHIFT TO UPPER HALF
	RTL
	RTL
	DCA I	NPTR		/SAVE HALF
	JMS	GNC		/GET NEXT CHAR
	TAD I	NPTR		/PUT 2 TOGETHER
	DCA I	NPTR		/STORE
	ISZ	NPTR		/BUMP POINTER
	ISZ	NCNT		/AND COUNTER
	JMP	PAKLUP		/LOOP
	JMS	GNC		/SKIP AMY EXTRA CHARS
	CLA
	JMP	.-2
NDONE,	TAD	NAME3		/ZERO TYPE FIELD
	AND	(7700
	DCA	NAME3
	ISZ	GETNAM		/SKIP
	JMP I	GETNAM		/RETURN
NONAME,	JMS	BACK1		/PUT CHAR BACK
	JMP I	GETNAM		/NO-SKIP, RETURN
NPTR,	0
NCNT,	0
LETTER,	0			/IS AC A LETTER?
	TAD	(-301
	SPA
	JMP	NLETR		/NO, TOO SMALL
	TAD	(-32
	SPA
	ISZ	LETTER		/YES, INCR RETURN
	TAD	(333		/RESTORE CHAR
	JMP I	LETTER		/RETURN
NLETR,	TAD	(301		/RESTORE NON-LETTER
	JMP I	LETTER		/RETURN
GNC,	0			/GET A CHAR IF LETTER OR DIGIT
	JMS	GETCHR
	JMP	NDONE		/NONE LEFT
	JMS	LETTER		/IS IT A LETTER?
	JMP	.+3		/NO
	AND	[77		/ONLY 6 BITS
	JMP I	GNC		/RETURN
	TAD	[-272		/CHECK FOR DIGIT
	SMA
	JMP	.+6		/NO, TOO BIG
	TAD	[12
	SPA
	JMP	.+3		/NO, TOO SMALL
	TAD	(60		/OK, MAKE IT 60-71
	JMP I	GNC		/RETURN
	JMS	BACK1		/PUT BACK NON LETTER/DIGIT
	JMP	NDONE		/NAME DONE
GETCHR,	0			/GET NEXT CHAR
	ISZ	NCHARS		/BUMP COUNT
	JMP	.+4		/YES VIRGINIA, THERE ARE MORE
GETC2,	CLA CMA			/RESET COUNT
	DCA	NCHARS		/TO MINUS1
	JMP I	GETCHR		/RETURN WITH NO SKIP
	TAD I	CHRPTR		/GET CHAR
	TAD	[-240		/CHECK FOR BLANK
	SNA
	JMP	BLANK		/YES, BLANK
	TAD	(-7		/CHECK FOR TAB
	SNA
	JMP	BLANK		/SAME AS BLANK
	TAD	(247-273	/CHECK FOR SEMI COLON
	SNA
	JMP	SEMICL		/YUP!
	TAD	(273		/FIX CHAR
	ISZ	GETCHR		/INCR RETURN
	JMP I	GETCHR		/RETURN
BLANK,	ISZ	NCHARS		/GET NEXT CHAR
	SKP
	JMP	GETC2		/BLANKS AT END OF LINE =CR
	TAD I	CHRPTR
	TAD	[-240		/IS IT BLANK?
	SNA
	JMP	BLANK		/YES, TRY AGAIN
	TAD	(-7		/IS IT TAB ?
	SNA
	JMP	BLANK		/YES, TRY AGAIN
	TAD	(-10		/IS IT SLASH ?
	SNA
	JMP	GETC2		/YES, (BLANK.OR.TAB) SLASH=CR
	TAD	(257-273	/IS IT SEMI COLON ?
	SNA CLA
	JMP	SEMICL		/YES
	JMS	BACK1		/NONE OF THESE, PUT IT BACK
	TAD	[240		/AND RETURN A SINGLE BLANK
	ISZ	GETCHR
	JMP I	GETCHR
SEMICL,	CLA IAC			/SET SEMI COLON SWITCH
	DCA	SCSWT
	JMS	BACK1		/PUT BACK SEMI COLON
	JMP I	GETCHR
	PAGE
FIXOPC,	0			/COMBINE OPCODE PARTS
	TAD	INDEX		/CHECK INDEX SWITCH
	SNA CLA
	JMP	ZRONDX		/IF ZERO, NO INDEX REG
	CLA CMA
	TAD	LASTOP		/IF INDEX, CHECK FOR INCR
	SNA CLA
	TAD	[100		/YES, PUT + BIT ON
	TAD	OPCODE		/COMBINE WITH OPCODE
	DCA	OPCODE
	TAD	EXPVAL+2	/GET INDEX REG. EXPR
	AND	[7		/ONLY 3 BITS
	CLL RTL			/SHIFT INTO POSITION
	RAL
ZRONDX,	TAD	OPCODE		/ADD OPCODE
	TAD	(400		/TURN ON TYPE BIT
	DCA	OPCODE		/SAVE OPCODE
	JMP I	FIXOPC		/RETURN
BUCKTS,	ALIST			/BUCKET LIST
	BLIST
	CLIST
	DLIST
	ELIST
	FLIST
	GLIST
	HLIST
	ILIST
	JLIST
	KLIST
	LLIST
	MLIST
	NLIST
	OLIST
	PLIST
	QLIST
	RLIST
	SLIST
	TLIST
	ULIST
	VLIST
	WLIST
	LISTX
	YLIST
	ZLIST
OPR8RS,	-240
	6
	-253
	1
	-255
	2
	-252
	3
	-257
	4
	-246
	5
	-241
	6
	0
CKKILL,	0			/TEST FOR CHAR ON TTY 
	KSF			/CHAR TYPED ?
	JMP I	CKKILL		/NO, RETURN
	KRB			/READ CHAR
	TAD	(-214		/CONTROL L?
	SZA
	JMP	.+4		/NO
	DCA	LISTSW		/YES, STOP LISTING
	DCA	LSTON
	JMP I	CKKILL		/RETURN
	TAD	(214-204	/CONTROL D?
	SZA CLA
	JMP I	CKKILL		/NO, RETURN
	CDF	FLD0
ENDXX,	TAD	BBLOCK		/GET REAL BLOCK NUMBER
	TAD	BFUDGE		/OF LAST BLOCK
	DCA	ENDBLK		/AND WRITE IT OUT
	JMS I	DIALWR
	1
	BINARB
ENDBLK,	0
	1
	TAD	(57		/WRITE OUT CORE USE TABLE
	TAD	BFUDGE
	DCA	USEBLK
	JMS I	DIALWR
	1
	USEB
USEBLK,	0
	1
RETSYS,	CLA
	JMS I	(PAGEJ		/EJECT PAGE
	TSF			/WAIT FOR TTY
	JMP	.-1
	TAD	SFUDGE		/COMPUTE FUDGED BLOCK FOR SYSTEM
	TAD	(-46		/ONLY J.B. KNOWS THE REASON FOR THIS
	DCA	SYSBLK
	JMS I	DIALRD		/READ IN SYSTEM
	0
	36			/INTO 17000
SYSBLK,	0
	2
	6213
	JMP I	(7777		/RETURN TO SYSTEM
P1,	0			/CONVERT TO ASCII AND PRINT
	AND	[77
	SNA
	JMP	.+4		/ZERO CHAR PRINTS AS BLANK
	TAD	(-40
	SPA
	TAD	[100
	TAD	[240
	JMS I	[PRINTC
	JMP I	P1
	PAGE
PRINTC,	0			/PRINT CHAR ON ANALEX, LP08 OR TTY
	SNA
	JMP	CRLF		/ZERO IS CR-LF
	TAD	(-247
	SZA
	JMP	NOTAB
	TAD	[240		/DO TAB
	JMS	PCHR
	ISZ	TABCNT
	JMP	.-3		/KEEP GOING UNTIL TAB STOP
SETTAB,	TAD	(-10
	DCA	TABCNT		/SET TAB COUNTER
	JMP I	PRINTC
NOTAB,	TAD	[247		/FIX CHAR
	JMS	PCHR
	JMS I	[CKKILL		/CHECK FOR ABORT
	ISZ	TABCNT
	JMP I	PRINTC		/RETURN
	JMP	SETTAB		/RESET TAB COUNT
CRLF,	DCA	LSIZE		/MAKE SURE THERES ROOM
	TAD	(215		/OUTPUT CR-LF
	JMS	PCHR
	TAD	(212
	JMS	PCHR
	ISZ	PAGSIZ		/NEW PAGE ?
	JMP	NEJECT		/NO
	TAD	SIZPAG		/RESET COUNT
	DCA	PAGSIZ
	TAD	(214
	JMS	PCHR		/START NEW PAGE
NEJECT,	TAD	WIDTH		/SET WIDTH OF PRINTER
	DCA	LSIZE
	JMP	SETTAB		/RESET TAB SETTING
TABCNT,	-10
LSIZE,	0
WIDTH,	-111			/WIDTH OF PRINTER IN CHARS
PC,	TTY
PCHR,	0			/TAKE CARE OF PRINTER WIDTH
	DCA	ACHR		/SAVE CHAR
	ISZ	LSIZE		/ANY ROOM LEFT
	JMP	NOCRLF		/NO, GO
	CLA CMA			/TRUNCATE LINE
	DCA	LSIZE
	JMP I	PCHR
NOCRLF,	TAD	ACHR
	JMS I	PC
	JMP I	PCHR
ACHR,	0
ANALEX,	0			/ANALEX PRINTER HANDLER
	DCA	ACHR
	TAD	ACHR		/LINE FEED?
	TAD	(-212
	SNA CLA
	JMP I	ANALEX		/YES,IGNORE IT
	6661			/WAIT FOR PRINTER
	JMP	.-1
	6652			/CLEAR FLAG
	TAD	ACHR		/GET CHAR BACK
	TAD	(-215		/END LINE ON CR
	SNA
	JMP	FINLPB
	IAC			/CHECK FOR FORM
	SNA CLA
	JMP	FINLPB-1	/PAGE EJECT ON FORM
	TAD	ACHR		/PRINT CHAR
	6654
	CLA
	JMP I	ANALEX
	TAD	[7		/SET CONTROL
FINLPB,	TAD	(10
	6664
	CLA
	JMP I	ANALEX
TTY,	0
	TSF
	JMP	.-1
	TLS
	CLA
	JMP I	TTY
LP08,	0
	6661
	JMP	.-1
	6666
	CLA
	JMP I	LP08
ERMSG1,	0			/PASS 1 MESSAGES
	CLA
	CDF	FLD0
	TAD	ERMSG1
	DCA	ERMSG		/COMMONIZE CALL
	JMS	PRINTC		/CR-LF
	TAD	LINENO		/PRINT LINE NUMBER
	JMS I	[OCTOUT		/ON PASS 1 MESSAGE
	JMP	PRMSG		/SKIP OVER PASS TEST
ERMSG,	0
	CDF	FLD0		/FIX FIELD
	CLA CMA			/NO MESSAGE ON PASS 1
	TAD	PASSNO
	SNA CLA
	JMP	MSGDUN
	JMS	PRINTC		/PRINT CR-LF
	TAD	LISTSW		/IS LIST ON ?
	SZA CLA
	JMP	.+3		/YES
	TAD	LINENO		/NO, PRINT LINE NUMBER
	JMS I	[OCTOUT
PRMSG,	TAD	(252		/PRINT *
	JMS	PRINTC
	TAD I	ERMSG		/FIRST CHAR OF CODE
	JMS I	(PRINT2		/PRINT THE MESSAGE
	TAD	(252		/PRINT *
	JMS	PRINTC
MSGDUN,	ISZ	ERMSG
	ISZ I	(ERRORS		/BUMP ERROR COUNT
	JMP I	ERMSG
	JMP I	ERMSG
	PAGE
OUTWRD,	0			/OUTPUT ROUTINE
	DCA	WRD		/SAVE WORD
	CLA CMA
	TAD	PASSNO		/CHECK PASS
	SNA CLA
	JMP	ENDOUT
	TAD	LOCTR2		/GET LOW 12 BITS OF LOCATION
	RTL
	RTL
	RTL
	AND	[37		/GET PAGE NUMBER (WITHIN FIELD)
	DCA	OTEMP		/SAVE PAGE NUMBER
	TAD	OTEMP
	SZA CLA			/POINTER TO P0LIT OR CPLIT
	IAC
	TAD	[P0LIT
	DCA	OWTEMP
	TAD	LOCTR2		/GET CURRENT ADDRESS DISPLACEMENT
	AND	[177
	CIA			/COMPARE WITH LITERAL BOUNDARY
	TAD I	OWTEMP
	SMA CLA
	JMP	.+4		/NO PAGE OVER FLOW
	JMS I	[ERMSG
	2017			/*PO*
	JMP	PRNTST		/DONT STORE IF PAGE OVERFLOW
	TAD	OTEMP		/NOW GET SUPER-PAGE NUMBER
	CLL RAR
	DCA	OTEMP		/AND SAVE IT
	TAD	LOCTR1		/GET FIELD BITS
	AND	O1		/ONLY ONE BIT FOR DIAL CRAP
	CLL RTL
	RTL
	TAD	OTEMP		/THIS GIVES TAPE BLOCK NUMBER
	DCA	OTEMP
	TAD	BBLOCK		/GET CURRENT BLOCK
	CIA
	TAD	OTEMP		/COMPARE WITH DESIRED BLOCK
	SNA CLA
	JMP	SAMBLK		/SAME BLOCK
	TAD	BBLOCK		/FIND REAL BLOCK NUMBER
	TAD	BFUDGE
	DCA	WRBLOK
	JMS I	DIALWR		/WRITE OUT OLD BLOCK
	1
	BINARB
WRBLOK,	0
	1
	TAD	OTEMP		/CHECK FOR THIS BLOCK ALREADY USED
	TAD	(USETBL
	DCA	OCNT		/POINTER INTO USE TABLE
	TAD I	OCNT		/GET INDICATOR
	SNA CLA
	JMP	NEWBLK		/FIRST TIME USED
	TAD	OTEMP		/BLOCK WAS USED, FIND REAL BLOCK
	TAD	BFUDGE		/NUMBER AND READ BLOCK
	DCA	BLOCKN
	JMS I	DIALRD
O1,	1
	BINARB
BLOCKN,	0
	1
	JMP	DONT0
NEWBLK,	ISZ I	(USETBL-1	/INCREMENT COUNT OF BLKS IN USE
	TAD	(BINARY
	DCA	CLRBIN		/CLEAR OUT BUFFER
	TAD	(-400
	DCA	OWTEMP
	DCA I	CLRBIN
	ISZ	CLRBIN
	ISZ	OWTEMP
	JMP	.-3
DONT0,	TAD	OTEMP		/RESET CURRENT BLOCK
	DCA	BBLOCK
	CLA CMA			/SET BLOCK IN USE
	DCA I	OCNT
SAMBLK,	TAD	LOCTR2		/GET POINTER FOR STORING WORD
	AND	(377
	TAD	(BINARY
	DCA	OTEMP
	TAD	WRD		/GET WORD
	DCA I	OTEMP		/STORE IT
PRNTST,	TAD	LISTSW		/IS LIST ON ?
	SNA CLA
	JMP	ENDOUT		/NO, DONT PRINT
	JMS I	[PRINTC		/PUT CR-LF
	TAD	OUTSWT		/WAS LINE NUM PRINTED YET?
	SZA CLA
	JMP	.+4
	TAD	LINENO		/NO, PRINT IT
	JMS I	[OCTOUT
	JMP	NOBLNK		/SKIP OVER BLANKS
	JMS I	(PRINT2		/2 BLANKS
	JMS I	(PRINT2		/2 MORE
	TAD	[240
	JMS I	[PRINTC		/1 MORE 4 5
NOBLNK,	TAD	LOCTR1		/PRINT LOCATION COUNTER
	AND	[7
	TAD	[260		/FIRST DIGIT
	JMS I	[PRINTC
	TAD	LOCTR2		/NEXT FOUR DIGITS
	JMS I	[OCTOUT
	TAD	WRD		/NOW WORD
	JMS I	[OCTOUT
	JMS I	(PRNTLN		/PRINT LINE IF NECESSARY
ENDOUT,	ISZ	LOCTR2		/BUMP LOCATION COUNTER
	JMP I	OUTWRD
	ISZ	LOCTR1		/BUMP SECOND WORD
	JMP I	OUTWRD
	JMP I	OUTWRD
WRD,	0
OWTEMP,	0
CLRBIN,	0
	CHAIN	"FPPASM3"