perm filename MIXASM.MAC[B,PMP]1 blob sn#054086 filedate 1973-07-12 generic text, type T, neo UTF8
	TITLE	MIXASM - MIXAL ASSEMBLER FOR THE MIX COMPUTER
	SUBTTL	ALB 6/30/73
;REGISTER DEFINITIONS
	F=0
	T=1
	T1=2
	T2=3
	T3=4
	T4=5
	E=6
	N=7
	W=10
	FP=11
	C=12
	CP=13
	LC=14
	S=15
	P=17
	PAGE
	SUBTTL DEFINITIONS
;I/O CHANNEL DEFINITIONS
	SRC=1
	SCR=2
	LST=3
;FLAG DEFINITIONS
	FL.AER=1B18
	FL.EER=1B19
	FL.FER=1B20
	FL.IER=1B21
	FL.LER=1B22
	FL.OER=1B23
	FL.RER=1B24
	FL.SER=1B25
	FL.TER=1B26
	FL.WER=1B27
	FL.ALF=1B28
	FL.EVC=1B29
	FL.VAC=1B30
	FL.DNI=1B32
	FL.LIT=1B33
	DEFBIT=1B18
	SGNBIT=1B18
	ALLERS=-1B27
	NOTERS=-<ALLERS+1>
	NMBKTS=20
	.JBREL=44
	.JBFF=121
	PAGE
	SUBTTL INITIALIZATION
MIXASM: 			;THE SHOW STARTS HERE
	RESET
	OPEN	SRC,[EXP 0
	SIXBIT	/DSK/
	XWD	0,IIB]
	HALT
	OPEN	SCR,[EXP 13
	SIXBIT	/DSK/
	XWD	SOB,0]
	HALT
	OPEN	LST,[EXP 0
	SIXBIT	/DSK/
	XWD	LOB,0]
	HALT
	LOOKUP	SRC,[SIXBIT	/TEST/
	SIXBIT	/MIX/
	EXP	0,0]
	HALT
	ENTER	SCR,[SIXBIT	/SCRTCH/
	SIXBIT	/MIX/
	EXP	0,0]
	HALT
	ENTER	LST,[SIXBIT	/TEST/
	SIXBIT	/LST/
	EXP	0,0]
	HALT
	INBUF	SRC,2
	OUTBUF	SCR,2
	OUTBUF	LST,2
	SETZ	LC,		;INITIALIZE
	MOVE	FP,.JBFF
	MOVE	P,[-40,,PDLIST]
	JRST	.+12
	PAGE
	SUBTTL PROCESS NEXT LINE
NXTLIN: TLNE	F,FL.DNI	;INCREMENT LC?
	JRST	.+6		;NO - SKIP IT
	SETZB	F,MIXWRD	;INITIALIZE
	AOJ	LC,
	TDZE	LC,[-1B23]
	TLO	F,FL.LER!FL.TER
	JRST	.+2
	SETZB	F,MIXWRD
	MOVEM	LC,OUTLC
	SETZM	AFUTRF
	SETZM	INOPC
	AOS	STMTNO		;BUMP STATEMENT NO.
	PUSHJ	P,INLIN
	JRST	NXTLIN
	PAGE
	SUBTTL PROCESS INPUT LINE
INLIN:				;PROCESS NEXT LINE
	MOVSI	T,-↑D132	;SET UP FOR AOBJN
	MOVE	T1,PT.LBF	;POINTER TO LINE BUFFER (ILDB)
	JSP	T3,IGET 	;GET A CHARACTER
	HALT
	CAIN	C,15		;CARRIAGE RETURN?
	JRST	IL.1		;YES - NEXT STEP
	CAIL	C,141		;LOWER CASE LETTER?
	CAILE	C,172
	JRST	.+2		;NO - SKIP
	MOVEI	C,-" "(C)	;YES - CHANGE TO UPPER CASE
	IDPB	C,T1		;STORE IN LINE BUFFER
	AOBJN	T,INLIN+2	;LOOP FOR MORE
	TLO	F,FL.SER	;LINE TOO LONG - SIZE ERROR
IL.1:	JSP	T3,IGET 	;PULL LINEFEED
	HALT
	SETZ	C,		;PUT NULL AT END OF LINE
	IDPB	C,T1
	HRRZM	T,LINSIZ	;STORE LENGTH OF LINE
	MOVE	CP,PT.LIN	;POINTER TO FIRST CHARACTER (LDB)
	LDB	C,CP		;GRAB IT
	CAIN	C,"*"		;COMMENT CARD?
	JRST	COMCRD		;YES - GO PROCESS IT
	MOVSI	T,-4		;OPCODE FIELD
	MOVE	T1,PT.OPC	;POINTER TO OPCODE FIELD (ILDB)
	MOVE	T2,PT.IOC	; AND POINTER TO INOPC
	ILDB	C,T1		;STORE OPCODE FIELD
	CAIE	C," "		;IGNORE SPACES FOR NOW
	IDPB	C,T2
	AOBJN	T,.-3		;LOOP FOR MORE
	ILDB	C,T1		;CHECK FOR SPACE IN COLUMN 16
	CAIE	C," "
	TLO	F,FL.OER	;OP FIELD ERROR IF NON-BLANK
	LDB	C,CP		;GRAB FIRST CHARACTER
	CAIN	C," "		;LOC FIELD BLANK?
	JRST	LCBLNK		;YES - SKIP AHEAD
	PUSHJ	P,GETSON	;COLLECT SYMBOL
	JRST	LOCERR		;ERROR IN LOC FIELD
	TLNN	F,FL.ALF	;SYMBOL COLLECTED?
	JRST	LOCERR		;ERROR IF NUMBER
	MOVNI	T,(T1)		;CHECK REST OF LOC FIELD FOR BLANKS
	MOVEI	T,13(T)
	LDB	C,CP
	CAIE	C," "
	TLO	F,FL.LER	;ANYTHING BUT SPACE IS ERROR
	IBP	CP
	SOJG	T,.-4		;LOOP THROUGH REST OF LOC FIELD
	MOVEM	LC,SYMVAL	;SET SYMBOL VALUE
	PUSHJ	P,DEFSYM	;DEFINE SYMBOL
	JRST	LOCERR		;ALREADY DEFINED - ERROR IN LOC FIELD
	MOVEI	T,3(S)		;SAVE A(SYMBOL VALUE) FOR EQU OP
	MOVEM	T,T.EQU
	MOVEM	LC,OUTLC	;LOCATION COUNTER FOR PRINTING
	PAGE
	SUBTTL OPCODE TABLE SEARCH
OCSRCH: 			;SEARCH FOR OPCODE IN TABLE
	MOVE	T3,INOPC	;GET OP FIELD
	MOVEI	T1,1B↑L<OPTTOP-OPTBOT>
				;SET UP OFFSET FROM OP CODE TABLE BOTTOM
	MOVEI	T2,1B↑L<OPTTOP-OPTBOT>/2
				;  AND DELTA FOR FIRST CHANGE
OSCH.1: CAMN	T3,OPTBOT-2(T1) ;FOUND IT?
	JRST	OSCH.3		;YES
	CAML	T3,OPTBOT-2(T1) ;NO - WHICH WAY TO MOVE NEXT?
	TDOA	T1,T2		;MOVE DOWN (ADD)
OSCH.2: SUB	T1,T2		;MOVE UP (SUBTRACT)
	ASH	T2,-1		;HALVE DELTA
	JUMPE	T2,OPERR	;ERROR IF NOT FOUND
	CAILE	T1,OPTTOP-OPTBOT;OUT OF BOUNDS?
	JRST	OSCH.2		;YES - MOVE UP
	JRST	OSCH.1		;NO - KEEP LOOKING
OSCH.3: MOVE	T,OPTBOT-1(T1)	;GET INFORMATION WORD
	HLRZM	T,MIXWRD	;STORE INITIAL MIX WORD
	HRLM	T,STMTNO	;STORE OP TYPE FOR PRINTING
	MOVE	CP,PT.ADR	;POINTER TO ADDR FIELD (LDB)
	JRST	@OPDISP(T)	;GO TO APPROPRIATE ROUTINE
LOCERR: TLO	F,FL.LER	;MARK LOC FIELD ERROR
	JRST	OCSRCH-1	;PROCESS OPCODE FIELD
LCBLNK: MOVE	CP,PT.LBF	;POINTER TO LINE BUFFER (ILDB)
	MOVEI	T,13		;CHECK TO SEE ALL IS BLANK
	ILDB	C,CP
	CAIE	C," "
	TLO	F,FL.LER	;  ERROR OTHERWISE
	SOJG	T,.-3
	JRST	OCSRCH-1	;PROCESS OP FIELD
OPERR:	TLO	F,FL.OER	;MARK OP FIELD ERROR
	SETZ	T,		;USE ZERO FOR INFO WORD
				;  AND GO PROCESS LIKE A MOP
	PAGE
	SUBTTL PROCESS MACHINE OP
PMCHOP: 			;PROCESS MACHINE OP
	LDB	C,CP		;GRAB A CHARACTER
	CAIN	C," "		;SKIP AHEAD IF ADDR FIELD BLANK
	JRST	RSTLIN
	CAIN	C,"("		;SKIP AHEAD IF A- AND I-PARTS VACUOUS
	JRST	PMOP.3+2
	CAIN	C,","		;SKIP AHEAD IF A-PART VACUOUS
	JRST	PMOP.6+3
	PUSHJ	P,FUTREF	;LOOK FOR A FUTURE REFERENCE
	JRST	PMOP.6		;FUTURE REFERENCE FOUND
	MOVE	CP,PT.ADR	;RESET POINTER TO ADDR FIELD
	PUSHJ	P,EXPEVL	;EVALUATE A-PART
	JRST	PMOP.1		;MARK ERRORS AND EXIT
	TDZE	E,[377777,,770000] ;TRUNCATE TO TWO BYTES AND SIGN
	TLO	F,FL.TER
	ASH	E,↑D18		;PUT IN POSITION
	JFCL	17,.+1		;CLEAR POSSIBLE OVERFLOW
	IORM	E,MIXWRD	;STORE MIX WORD
PMOP.6: LDB	C,CP		;NEXT CHARACTER
	CAIE	C,","		;I-PART THERE?
	JRST	PMOP.3		;NO - SKIP AHEAD
	IBP	CP		;BUMP OVER ","
	PUSHJ	P,EXPEVL	;EVALUATE I-PART
	JRST	PMOP.2		;CHECK THINGS
	TDZE	E,[-1B29]	;TRUNCATE TO ONE BYTE (PLUS)
	TLO	F,FL.TER
	ROT	E,↑D12		;PUT IN POSITION
	IORM	E,MIXWRD	;STORE IN MIX WORD
	LDB	C,CP		;NEXT CHARACTER
PMOP.3: CAIE	C,"("		;F-PART THERE?
	JRST	PMOP.4		;NO - SKIP AHEAD
	PUSHJ	P,FPART 	;EVALUATE F-PART
	JRST	PMOP.5		;CHECK THINGS
	TDZE	E,[-1B29]	;TRUNCATE TO ONE BYTE (PLUS)
	TLO	F,FL.TER	;MARK ERROR
	MOVEI	T1,MIXWRD	;STORE IN MIX WORD
	DPB	E,FP.TAB+44
	LDB	C,CP		;NEXT CHARACTER
PMOP.4: CAIE	C," "		;ADDR FIELD DELIMITER FOUND?
	CAIN	C,
	JRST	.+2		;YES - SKIP
	TLO	F,FL.AER	;NO - ADDR FIELD ERROR
	JRST	RSTLIN		;FINISH WITH THIS LINE
PMOP.1: TLO	F,FL.EER!FL.AER ;MARK ERRORS
	JRST	RSTLIN		;FINISH WITH THIS LINE
PMOP.2: TLNE	F,FL.EVC	;EXPRESSION VACUOUS?
	JRST	PMOP.3		;YES - OKAY
	TLO	F,FL.IER	;MARK ERROR
	JRST	RSTLIN		;FINISH WITH THIS LINE
PMOP.5: TLNE	F,FL.EVC	;F-PART VACUOUS (I.E. () )?
	JRST	PMOP.4-5	;YES - OKAY
	TLO	F,FL.FER	;MARK ERROR
	JRST	RSTLIN		;FINISH WITH THIS LINE
	PAGE
	SUBTTL PSEUDO OP PROCESSORS
PALFOP: 			;PROCESS ALF OP
	SETZB	C,T1		;INITIALIZE
	MOVE	CP,PT.ALF	;POINTER TO ADDR FIELD (ILDB)
	MOVEI	T,5		;ALF FIELD LENGTH
ALF.1:	ROT	C,6		;PREPARE FOR NEXT BYTE
	ILDB	T1,CP		;NEXT CHARACTER
	CAIL	T1," "		;DEFINED CHARACTER?
	CAILE	T1,136
	JRST	ALF.3		;UNDEFINED MIX CHARACTER - ERROR
	CAIN	T1,134		;"\" IS UNDEFINED
	TLO	F,FL.AER
ALF.2:	IOR	C,ATMTAB-" "(T1) ;ADD CHARACTER TO MIX WORD
	SOJG	T,ALF.1 	;LOOP FOR MORE
	MOVEM	C,MIXWRD	;STORE MIX WORD
	JRST	RSTLIN		;FINISH WITH THIS LINE
ALF.3:	TLO	F,FL.AER	;MARK ERROR
	MOVEI	T1,"?"		;SET MIX CHARACTER TO "?"
	JRST	ALF.2		;BACK FOR MORE
PCONOP: 			;PROCESS CON OP
	PUSHJ	P,WEVAL 	;EVALUATE THE W-VALUE
	TLO	F,FL.WER!FL.AER ;MARK ERRORS
	MOVEM	W,MIXWRD	;STORE MIX WORD
	JRST	RSTLIN		;FINISH WITH THIS LINE
PORGOP: 			;PROCESS ORIG OP
	PUSHJ	P,WEVAL 	;EVALUATE THE W-VALUE
	TLO	F,FL.WER!FL.AER ;MARK THE ERRORS
	TDZE	W,[-1B23]	;TRUNCATE TO TWO BYTES (PLUS)
	TLO	F,FL.AER!FL.TER
	MOVEI	LC,(W)		;STORE NEW LOCATION COUNTER
	TLO	F,FL.DNI	;DON'T INCREMENT LC
	JRST	RSTLIN		;FINISH WITH THIS LINE
PEQUOP: 			;PROCESS EQU OP
	PUSHJ	P,WEVAL 	;EVALUATE THE W-VALUE
	TLO	F,FL.WER!FL.AER ;MARK ERRORS
	MOVEM	W,@T.EQU	;STORE NEW SYMBOL VALUE
	MOVEM	W,OUTLC 	; AND PRINT IN LC FIELD
	TLO	F,FL.DNI	;DON'T INCREMENT LC
	JRST	RSTLIN		;FINISH WITH THIS LINE
	PAGE
	SUBTTL PROCESS END OP
PENDOP: 			;PROCESS END OP
	PUSHJ	P,WEVAL 	;EVALUATE W-VALUE
	TLO	FL.WER!FL.AER	;MARK ERRORS
	TDZ	W,[-1B23]	;LOOK ONLY AT (4:5) BYTE
	MOVEM	W,OUTLC 	;STORE FOR PRINTING
	TLO	F,FL.DNI	;DON'T INCREMENT LC
	POP	P,T4		;POP OFF RETURN (SO RETURNS HERE)
	PUSHJ	P,RSTLIN	;OUTPUT SCRATCH BLOCK
	PAGE
	SUBTTL SEARCH SYMBOL TABLE FOR LITERALS AND UDS
SYMSRC: 			;SYMBOL TABLE SEARCH FOR:
				;(1) LITERALS
				;(2) UNDEFINED SYMBOLS
	SETZM	AFUTRF		;CLEAR FUTURE REFERENCE ADDR
	SETZB	F,OUTERR	;  AND OUTPUT ERROR FLAGS
	MOVEI	T,NMBKTS	;SET NUMBER ITERATIONS
	SKIPN	T1,BUKETS-1(T)	;GET A BUCKET
	JRST	.+10		;LOOP IF ZERO
	MOVE	T2,1(T1)	;GET FIRST WORD OF SYMBOL
	XOR	T2,[BYTE (7) "="] ;IS FIRST CHAR "="?
	TLNN	T2,774000
	JRST	ENDLIT		;YES - PROCESS LITERAL
	SKIPL	T2,(T1) 	;NO - DEFINED?
	JRST	ENDUDS		;NO - PROCESS UNDEFINED SYMBOL
	MOVEI	T1,(T2)		;STEP
	JUMPG	T1,.-7		;LOOP FOR NEXT SYMBOL
	SOJG	T,.-12		;LOOP FOR NEXT BUCKET
	JRST	PROSCR		;GO PROCESS SCRATCH FILE
ENDLIT: TLOA	F,FL.LIT	;MARK PROCESSING LITERAL
ENDUDS: TLZ	F,FL.LIT	;MARK PROCESSING UNDEF SYMBOL
	MOVE	T2,[
	XWD	[ASCIZ/           CON  0/],OUTLIN]
				;SETUP BLT POINTER
	BLT	T2,OUTLIN+3	;SETUP CON CARD FOR LITERAL
	TLNN	F,FL.LIT	;SKIP AHEAD IF UDS
	JRST	.+11
	MOVE	T2,3(T1)	;STORE MIX WORD FROM SYMBOL VALUE
	MOVEM	T2,MIXWRD
	MOVE	T2,1(T1)	;CHANGE LEADING "=" TO " " AND STORE SYM
	TLZ	T2,"="-" "
	MOVEM	T2,OUTLIN+3
	MOVE	T2,2(T1)
	MOVEM	T2,OUTLIN+4
	JRST	.+2		;SKIP FOR UDS
	SETZM	MIXWRD		;CON 0 TO MIX WORD
	AOJ	LC,		;BUMP LOCATION COUNTER
	TDZE	LC,[-1B23]	;TRUNCATE TO TWO BYTES (PLUS)
	TLO	F,FL.TER!FL.LER
	MOVEM	LC,OUTLC	;  AND STORE FOR PRINTING
	MOVEI	W,CONOP 	;STORE OP TYPE FOR PRINTING
	HRLM	W,STMTNO
	AOS	STMTNO		;INCREMENT STATEMENT NO.
	MOVEM	F,OUTERR	;ERROR FLAGS FOR PRINTING
	MOVE	CP,PT.STB	;POINTER TO SYMBOL (ILDB)
	MOVE	T2,PT.LBF	;POINTER TO LINE BUFFER (ILDB)
	ILDB	C,CP		;GRAB A CHARACTER
	CAIN	C,		;NULL?
	JRST	.+3		;YES - EXIT
	IDPB	C,T2		;NO - DEPOSIT AND LOOP
	JRST	.-4
	MOVE	T2,[-12,,SCRTCH] ;SET AOBJN SCRATCH BLOCK POINTER
	MOVE	C,T2
	PUSHJ	P,RSTLIN+7	;OUTPUT SCRATCH BLOCK
	TLNE	F,FL.LIT	;SKIP IF UDS
	HRRZ	T1,(T1) 	;GET NEXT LINK
	JRST	ENDLIT-3	;LOOP FOR NEXT SYMBOL
	PAGE
	SUBTTL PROCESS REST OF LINE
RSTLIN: 			;PROCESS REST OF LINE
	MOVEM	F,OUTERR	;STORE ERROR FLAGS FOR PRINTING
	MOVE	T2,LINSIZ	;NUMBER OF CHARS IN LINE
	IDIVI	T2,5		;GET NUMBER OF WORDS TO SAVE IN SCRATCH BLOCK
	MOVNI	T2,6(T2)
	MOVSI	C,(T2)
	HRRI	C,SCRTCH	;FORM AOBJN SCRATCH BLOCK POINTER
	MOVE	T2,C
	JSP	T3,SPUT 	;  AND OUTPUT IT
	MOVE	C,(T2)
	JSP	T3,SPUT 	;  ALONG WITH THE SCRATCH BLOCK
	AOBJN	T2,.-2
	POPJ	P,		;RETURN TO CALLER
	PAGE
	SUBTTL PROCESS SCRATCH FILE
PROSCR: 			;PROCESS SCRATCH FILE
	CLOSE	SCR,
	OPEN	SCR,[EXP 13
	SIXBIT	/DSK/
	XWD	0,SIB]
	HALT
	LOOKUP	SCR,[SIXBIT	/SCRTCH/
	SIXBIT	/MIX/
	EXP	0,0]
	HALT
	MOVEM	FP,.JBFF
	INBUF	SCR,2
	MOVE	FP,.JBFF
PS.1:	JSP	T3,SGET
	JRST	FINISH
	MOVE	T,C
	JSP	T3,SGET
	JFCL			;SHOULD NEVER GET HERE
	MOVEM	C,(T)
	AOBJN	T,.-3
	SKIPE	T1,AFUTRF
	JRST	LNKFR		;LINK UP FUTURE REFERENCE
PS.2:	MOVEI	C,11
	CAIN	T,6		;COMMENT CARD?
	JRST	CMBLNK		;YES - BLANK EVERYTHING
	JSP	T3,LPUT
	MOVE	T1,OUTLC
	TLZE	T1,SGNBIT
	SKIPA	C,["-"]
	MOVEI	C," "
	JSP	T3,LPUT
	MOVEI	T2,12
	PUSHJ	P,OCTPNT
	MOVEI	C,11
	JSP	T3,LPUT
	HLRZ	T,STMTNO
	CAIE	T,ENDOP
	CAIN	T,EQUOP
	JRST	MWBLNK
	MOVE	W,MIXWRD
	TLZE	W,SGNBIT
	SKIPA	C,["-"]
	MOVEI	C," "
	JSP	T3,LPUT
	SETZ	T1,
	MOVE	E,[POINT 6,W,5]
	MOVE	T3,[POINT	6,T1,35]
	ILDB	T4,E
	DPB	T4,T3
	ROT	T1,6
	ILDB	T4,E
	DPB	T4,T3
	MOVEI	T2,4
	PUSHJ	P,OCTPNT
	MOVEI	C," "
	JSP	T3,LPUT
	MOVEI	S,3
	SETZ	T1,
	ILDB	T1,E
	MOVEI	T2,2
	PUSHJ	P,OCTPNT
	MOVEI	C," "
	JSP	T3,LPUT
	SOJG	S,.-6
	JSP	T3,LPUT
PS.3:	JSP	T3,LPUT
	JSP	T3,LPUT
	HRRZ	T1,STMTNO
	PUSHJ	P,DECPNT
	MOVE	F,OUTERR
	TDZ	F,[NOTERS,,-1]
	TLNN	F,ALLERS
	JRST	NOERRS
	MOVE	T,F
	JFFO	T,.+2
	JRST	NOERRS
	MOVE	C,ERRTAB(T1)
	JSP	T3,LPUT
	TDZ	T,C
	OUTSTR	[ASCIZ/
πππERROR/]
	JRST	.-6
NOERRS: MOVEI	C,11
	JSP	T3,LPUT
	MOVE	CP,PT.LBF	;(ILDB)
	ILDB	C,CP
	JUMPE	C,.+3
	JSP	T3,LPUT
	JRST	.-3
	MOVEI	C,15
	JSP	T3,LPUT
	MOVEI	C,12
	JSP	T3,LPUT
	JRST	PS.1
LNKFR:	MOVE	S,AFUTRF
	HRLZ	S,(S)
	IORM	S,MIXWRD
	JRST	PS.2
CMBLNK: JSP	T3,LPUT
	JSP	T3,LPUT
	JRST	PS.3-1
MWBLNK: MOVEI	C,11
	JSP	T3,LPUT
	JSP	T3,LPUT
	MOVEI	C," "
	JRST	PS.3
	PAGE
	SUBTTL FINISH I/O AND EXIT
FINISH: CLOSE	LST,
	CLOSE	SCR,
	CLOSE	SRC,
	RELEAS	SRC,
	RELEAS	SCR,
	RELEAS	LST,
	EXIT			;.....(!)......(!!).  . ...... ..
	PAGE
	SUBTTL I/O MACROS AND ROUTINES
	DEFINE	GET(X,Y)<
X'GET:	SOSGE	X'IB+2
	JRST	X'GETBF
	ILDB	C,X'IB+1
IFDIF	<X><S>,<
	JUMPN	C,1(T3)
	JRST	X'GET	>
IFIDN	<X><S>,<
	JRST	1(T3)	>
X'GETBF:	IN	Y,
	JRST	X'GET
	GETSTS	Y,C
	TRNN	C,74B23
	JRST	X'GTBFE
	HALT
X'GTBFE:	TRNE	C,1B22
	JRST	(T3)
	JRST	X'GET	>
	DEFINE	PUT(X,Y)<
X'PUT:	SOSG	X'OB+2
	JRST	X'PUTBF
X'PUTC: IDPB	C,X'OB+1
	JRST	(T3)
X'PUTBF:	OUT	Y,
	JRST	X'PUTC
	HALT	>
IO:	GET(I,SRC)
	GET(S,SCR)
	PUT(S,SCR)
	PUT(L,LST)
IIB:	BLOCK	3
SIB:	BLOCK	3
SOB:	BLOCK	3
LOB:	BLOCK	3
	PAGE
	SUBTTL CHECK FOR AND PROCESS A FUTURE REFERENCE
FUTREF: 			;HANDLE FUTURE REFERENCES
	CAIN	C,"="		;LITERAL?
	JRST	FR.1		;YES - GO PROCESS
	PUSHJ	P,GETSON	;COLLECT SYMBOL
	JRST	CPOPJ1		;NOTHING THERE - ERROR RETURN
	TLNN	F,FL.ALF	;SYMBOL COLLECTED?
	JRST	CPOPJ1		;NO - ERROR RETURN
	PUSHJ	P,FNDSYM	;SEE IF SYMBOL IS PRESENT
	JRST	FR.4		;NOT THERE - ENTER INTO TABLE
	TLNE	T1,DEFBIT	;DEFINED?
	JRST	CPOPJ1		;YES - ERROR RETURN
	MOVEI	T,3(S)		;NO - IS A FUTURE FEFERENCE
	MOVEM	T,AFUTRF	;  SO SAVE A(SYMBOL VALUE)
	POPJ	P,		;NORMAL RETURN
FR.1:	SETZM	LITSYM		;INITIALIZE SYMBOL
	SETZM	LITSYM+1
	MOVE	T1,PT.LSM	;POINTER TO SYMBOL (ILDB)
	MOVEI	T,13		;SET LENGTH OF SYMBOL
	JRST	.+4		;ENTRY WITH FIRST "="
	ILDB	C,CP		;GET NEXT CHARACTER
	CAIN	C,"="		;CLOSING "="?
	JRST	FR.2		;YES - EXIT
	IDPB	C,T1		;DEPOSIT CHAR IN SYMBOL
	SOJG	T,.-4		;LOOP FOR ANOTHER CHARACTER
	TLO	F,FL.AER!FL.RER ;NO "=" FOUND - MARK ERRORS
	POPJ	P,		;NORMAL RETURN
FR.2:	MOVEM	CP,T.FRCP	;SAVE CHAR POINTER
	MOVE	T2,[LITSYM,,SYM] ;SETUP TO
	BLT	T2,SYM+1
	PUSHJ	P,FNDSYM	;  FIND SYMBOL
	SKIPA	T1,[Z]		;NOT THERE - ZERO, SKIP, AND ENTER
	JRST	FR.1-3		;SAVE A(SYMBOL VALUE)
	PUSHJ	P,ENTSYM	;  ENTER SYMBOL IN TABLE
	JFCL			;HARD TO GET HERE
	MOVE	CP,PT.LS2	;POINTER TO 2ND SYMBOL CHAR (LDB)
	PUSHJ	P,WEVAL 	;EVALUATE THE LITERAL W-VALUE
	JRST	FR.3		;HANDLE ERRORS
	MOVEM	W,3(S)		;STORE W-VALUE AS SYMBOL VALUE (TEMPORARILY)
	MOVE	CP,T.FRCP	;RESTORE CHAR POINTER
	IBP	CP		;BUMP OVER "="
	POPJ	P,		;NORMAL RETURN
FR.3:	TLO	F,FL.WER!FL.RER!FL.AER
				;MARK ERRORS
	JRST	.-5		;CLEAN UP AND LEAVE
FR.4:	SETZ	T1,		;PREPARE TO
	PUSHJ	P,ENTSYM	;  ENTER SYMBOL IN TABLE
	JFCL			;HARD TO GET HERE
	JRST	FR.1-3		;SAVE A(SYMBOL VALUE)
	PAGE
	SUBTTL NUMERIC OUTPUT ROUTINES
OCTPNT: 			;PRINT OCTAL NUMBER
	MOVNI	T3,-14(T2)
	HLLI	T3,
	IMULI	T3,3
	ROT	T1,(T3)
	SETZ	T,
	ROTC	T,3
	JUMPN	T,.+7
	SOJLE	T2,.+6
	MOVEI	C," "
	JSP	T3,LPUT
	JRST	.-6
	SETZ	T,
	ROTC	T,3
	MOVEI	C,"0"(T)
	JSP	T3,LPUT
	SOJG	T2,.-4
	POPJ	P,
DECPNT: MOVEI	C," "
	CAIL	T1,↑D1000
	JRST	.+10
	JSP	T3,LPUT
	CAIL	T1,↑D100
	JRST	.+5
	JSP	T3,LPUT
	CAIL	T1,↑D10
	JRST	.+2
	JSP	T3,LPUT
	IDIVI	T1,12
	PUSH	P,T2
	SKIPE	T1
	PUSHJ	P,.-3
	POP	P,T1
	MOVEI	C,"0"(T1)
	JSP	T3,LPUT
	POPJ	P,
	PAGE
	SUBTTL RANDOM
GETCOR: HRRZ	T3,.JBREL
	ADDI	T3,2000
	CORE	T3,
	HALT
	POPJ	P,
COMCRD: 			;PROCESS COMMENT CARD
	TLO	F,FL.DNI	;DON'T INCREMENT LC
	MOVEI	T,6		;STORE COMMENT OP TYPE FOR PRINTING
	HRLM	T,STMTNO
	JRST	RSTLIN		;FINISH WITH THIS LINE
CPOPJ1: AOS	(P)
	POPJ	P,
	PAGE
	SUBTTL WEVAL - EVALUATE A FULL-WORD MIX CONSTANT
WEVAL:				;EVALUATE A W-VALUE (FULL WORD CONSTANT)
	SETZ	W,		;SET INITIAL W-VALUE TO +ZERO
	LDB	C,CP		;GET FIRST CHARACTER
	CAIE	C," "		;SPACE?
	CAIN	C,		;  OR NULL (END MARK)?
	JRST	CPOPJ1		;YES -	NORMAL RETURN
	CAIN	C,","		;VACUOUS?
	JRST	WEVL.3		;YES - BUMP AND LOOK AGAIN
	CAIN	C,"("		;EXPRESSION PART VACUOUS?
	JRST	WEVL.1		;YES - SKIP AHEAD
	PUSHJ	P,EXPEVL	;EVALUATE EXPRESSION
	JRST	WEVL.4		;EXPRESSION ERROR (CAN'T BE VACUOUS)
	MOVEM	E,W.TEMP	;SAVE EXPRESSION
	LDB	C,CP		;GET NEXT CHARACTER
	CAIE	C,"("		;IS F-PART THERE?
	JRST	WEVL.7		;IF VACUOUS, USE (0:5)
WEVL.1: PUSHJ	P,FPART 	;GO EVALUATE F-PART
	JRST	WEVL.5		;CHECK ON THINGS
	CAIG	E,55		;TOO BIG?
	JUMPGE	E,.+2		;  OR TOO SMALL?
	JRST	WEVL.6		;YES - ERROR  N F-PART
WEVL.2: MOVEI	T1,W.TEMP	;SET A(TEMPORARY W-VALUE)
	SKIPN	T4,FP.TAB(E)	;SET FIELD POINTER - ZERO?
	JRST	WEVL.6		;YES - ERROR IN F-PART
	LDB	T3,T4		;GET BYTE FROM W.TEMP
	MOVEI	T1,W		;SET A(RECEIVER OF W-VALUE)
	DPB	T3,T4		;PUT W-VALUE IN W (NATURALLY...)
	JRST	WEVAL+1 	;LOOP FOR MORE PRIMITIVES
WEVL.3: IBP	CP		;BUMP OVER COMMA
	JRST	WEVAL+1 	;LOOK FOR MORE PRIMITIVES
WEVL.4: TLO	F,FL.EER		;EXPRESSION ERROR
	POPJ	P,		;  AND ERROR RETURN
WEVL.5: TLNE	F,FL.EVC	;EXPRESSION VACUOUS (I.E. ())?
	JRST	WEVL.2		;YES - USE F-PART OF ZERO
WEVL.6: TLO	F,FL.FER	;NO - F-PART ERROR
	POPJ	P,		;  AND ERROR RETURN
WEVL.7: MOVEI	E,5		;DEFAULT F-PART IS (0:5)
	JRST	WEVL.2		;PUT IT IN
	PAGE
	SUBTTL FPART - EVALUATE THE F-PART OF A MIXAL INSTRUCTION
FPART:				;EVALUATE F-PART
	IBP	CP		;SKIP OVER "(" (HAS TO BE THERE)
	PUSHJ	P,EXPEVL	;EVALUATE EXPRESSION
	JRST	FPRT.1		;CHECK ON CLOSING PAREN
	CAIE	C,")"		;CLOSING PAREN THERE?
	JRST	FPRT.2		;NO - F-PART ERROR BUT NORMAL RETURN
	IBP	CP		;YES - SKIP OVER
	JRST	CPOPJ1		;  AND NORMAL RETURN
FPRT.1: CAIN	C,")"		;CLOSING PAREN THERE?
	JRST	.+3		;YES - SKIP
	TLO	F,FL.FER	;NO - F-PART ERROR
	POPJ	P,		;ERROR RETURN
	IBP	CP		;BUMP OVER ")"
	POPJ	P,		;ERROR RETURN
FPRT.2: TLO	F,FL.FER	;F-PART ERROR
	JRST	CPOPJ1		;  BUT NORMAL RETURN (ONLY FORMAT ERROR)
	PAGE
	SUBTTL GETSON - COLLECT SYMBOL OR NUMBER
GETSON: 			   ;COLLECT SYMBOL OR NUMBER
	TLZ	F,FL.VAC!FL.ALF ;INITIALIZE
	 SETZB	 T1,SYM 	   ;INITIALIZE SYMBOL TO ZERO
	 SETZB	 T2,SYM+1	   ;T1=CHARS IN SYMBOL,T2=CUMULATIVE NUMBER
	 MOVSI	 T1,-13 	   ;SET UP FOR AOBJP
	 MOVE	 T4,PT.SYM	   ;POINTER TO SYMBOL OUTPUT
GTSN.1: LDB	C,CP		;GET A CHARACTER
	 CAIL	 C,"0"		   ;NUMBER?
	 CAILE	 C,"9"
	 JRST	 GTSN.2 	   ;NO - TRY LETTER
	 AOBJP	 T1,GTSN.3	   ;EXIT IF TOO LONG
	 IDPB	 C,T4		   ;STORE AS PART OF SYMBOL
	 TLNE	 F,FL.ALF	   ;LETTER FOUND YET?
	 JRST	 GTSN.4 	   ;YES - SKIP CUMULATIVE NUMBER
	 IMULI	 T2,12		   ;SUM = SUM*10 + DIGIT
	 ADDI	 T2,-"0"(C)	   ;CONVERT ASCII TO DIGIT AND ADD IN
GTSN.4: IBP	CP		;BUMP BYTE POINTER
	 JRST	 GTSN.1 	   ;LOOP FOR MORE
GTSN.2:  CAIL	 C,"A"		   ;LETTER?
	 CAILE	 C,"Z"
	 JRST	 GTSN.5 	   ;NO - EXIT
	 AOBJP	 T1,GTSN.3	   ;EXIT IF TOO LONG
	 IDPB	 C,T4		   ;STORE AS PART OF SYMBOL
	 TLO	 FL.ALF 	   ;MARK AS SYMBOL
	 JRST	 GTSN.4 	   ;CHECK REST OF STUFF
GTSN.5:  TRNE	 T1,-1		   ;COLLECTED ANYTHING?
	 JRST	 CPOPJ1 	   ;YES - NORMAL RETURN
	TLO	F,FL.VAC	;MARK AS VACUOUS
GTSN.3:  POPJ	 P,		   ;NO - ERROR RETURN
	PAGE
	SUBTTL ATOMIC EXPRESSION EVALUATOR
ATOMIC: 			   ;EVALUATE ATOMIC EXPRESSION
	 SETZ	 N,		   ;SET NUMBER TO +ZERO
	LDB	C,CP		;GET THE FIRST CHARACTER
	 CAIN	 C,"*"		   ;LOCATION COUNTTR?
	 JRST	 ATOM.1 	   ;YES - GO HANDLE IT
	 PUSHJ	 P,GETSON	   ;NO - GO COLLECT SYMBOL OR NUMBER
	 POPJ	 P,		   ;ERROR RETURN TO CALLER
	 TLNE	 F,FL.ALF	   ;SYMBOL COLLECTED?
	 JRST	 ATOM.2 	   ;YES - FIND VALUE
	 TLZE	 E,370000	   ;TRUNCATE TO 30 MAGNITUDE BITS
	 TLO	 F,FL.TER	   ;SET TRUNCATION ERROR FLAG
	 JOV	 .-1		   ;OVERFLOW IS TRUNCATION ERROR
	 MOVE	 N,T2		   ;MAGNITUDE OF NUMBER TO N
	 JRST	 CPOPJ1 	   ;NORMAL RETURN
ATOM.2:  PUSHJ	 P,FNDSYM	   ;GO FIND SYMBOL ENTRY
	 POPJ	 P,		   ;SYMBOL NOT FOUND - ERROR RETURN
	SKIPL	(S)		;DEFINED BIT ON?
	 POPJ	 P,		   ;NO - ERROR RETURN
	 MOVE	 N,3(S) 	   ;YES - VALUE TO N
	 JRST	 CPOPJ1 	   ;NORMAL RETUUN
ATOM.1:  MOVE	 N,LC		   ;LOCATION COUNTER TO N
	IBP	CP		;BUMP CHARACTER POINTER
	 JRST	 CPOPJ1 	   ;NORMAL RETURN
	PAGE
	SUBTTL DEFSYM - DEFINE A SYMBOL (INC. ENTSYM, JUST ENTER)
DEFSYM: PUSHJ	P,FNDSYM	;GO FIND SYMBOL OR END
	SKIPA	T1,[DEFBIT,,0]	;END FOUND - MARK AS DEFINED AND SKIP
	JRST	DFSM.1		;SYMBOL FOUND - GO CHECK IF DEFINED
ENTSYM: MOVEM	T1,(FP) 	;STORE END MARK IN NEW ENTRY
	HRRM	FP,(S)		;SET LINK TO NEW ENTRY
	MOVEI	S,(FP)		;A(NEW ENTRY) TO S
	MOVEI	FP,4(FP)	;BUMP FREE POINTER
	CAMLE	FP,.JBREL	;NEED MORE CORE?
	PUSHJ	P,GETCOR	;YES - GO GET SOME MORE
	MOVE	T2,SYM		;ENTER SYMBOL
	MOVEM	T2,1(S)
	MOVE	T2,SYM+1
	MOVEM	T2,2(S)
	JUMPGE	T1,CPOPJ1	;EXIT IF DONE
ENTVAL: MOVE	T1,SYMVAL	;ENTER SYMBOL VALUE
	MOVEM	T1,3(S)
	JRST	CPOPJ1		;NORMAL RETURN
DFSM.1: SKIPGE	T1,(S)		;ALREADY DEFINED?
	POPJ	P,		;YES - ERROR RETURN
	TLO	T1,DEFBIT	;NO - MARK AS DEFINED AND STORE
	MOVEM	T1,(S)
	JRST	ENTVAL		;  AND ENTER THE VALUE
	PAGE
	SUBTTL FNDSYM - FIND A SYMBOL
FNDSYM: 			   ;FIND A SYMBOL
LCSMCK:  MOVE	 T2,SYM 	   ;CHECK FOR LOCAL SYMBOLS
	 TDNE	 T2,[401437,,-1]   ;TEST FOR ZEROES IN (N)(H,F,B)
	 JRST	 HASHIT 	   ;CAN'T BE LOCAL SYMBOL, SO GO ON
	 SETZ	 T1,		   ;PREPARATION FOR DIGIT
	 ROTC	 T1,7		   ;CHECK FOR DIGIT
	 CAIG	 T1,"9" 	   ;TOO BIG?
	 CAIGE	 T1,"0" 	   ;OR TOO SMALL?
	 JRST	 HASHIT 	   ;YES - NOT LOCAL, SO GO ON
	 MOVEI	 T3,-"0"(T1)	   ;NO - MAKE IT A NUMBER & SAVE DIGIT
	MOVE	T4,LCSMNO(T3)	;GET LOCAL SYMBOL N SERIAL NUMBER
	 SETZ	 T1,		   ;PREPARE FOR LETTER
	 ROTC	 T1,7		   ;CHECK LETTER
	 CAIN	 T1,"F" 	   ;IS IT F?
	JRST	LCSM.F		;YES - PROCESS IT
	 CAIN	 T1,"B" 	   ;NO - IS IT B?
	 JRST	 LCSM.B 	   ;YES - PROCESS IT
	 CAIE	 T1,"H" 	   ;NO - IS IT H?
	 JRST	 HASHIT 	   ;NO - NOT LOCAL, SO GO ON
LCSM.H:  AOSA	 T4,LCSMNO(T3)	   ;BUMP & STORE SERIAL NUMBER
LCSM.F:  MOVEI	 T4,1(T4)	   ;BUMP SERIAL NUMBER
;
;CONSTRUCT A UNIQUE SYMBOL OF THE FORM "(N)H  XXXX"
;
LCSM.B:  MOVE	 T1,PT.SYM	   ;GET POINTER TO SYM
	 MOVEI	 T2,"0"(T3)	   ;GET ASCII DIGIT IN T2
	 IDPB	 T2,T1		   ;STORE N
	 MOVEI	 T2,"H" 	   ;AND H
	 IDPB	 T2,T1
	 MOVEI	 T2," " 	   ;AND ONE SPACE
	 IDPB	 T2,T1
	 MOVSI	 T2,-4		   ;SET UP AOBJN COUNTER
	 MOVEI	 T3,(T4)	   ;PREPARATION
LCSM.1:  IDIVI	 T3,10		   ;TURN SERIAL NUMBER TO FOUR CHAR OF ASCII
	 MOVEI	 T4,"0"(T4)	   ;MAKE IT ASCII
	 PUSH	 P,T4		   ;SAVE IT
	 AOBJN	 T2,LCSM.1	   ;LOOP FOR MORE
LCSM.2:  POP	 P,T4		   ;GET CHARACTER
	 IDPB	 T4,T1		   ;STORE IT
	 SOJG	 T2,LCSM.2	   ;LOOP FOR MORE
HASHIT:  MOVE	 T1,SYM 	   ;FIGURE HASH CODE
	XOR	T1,SYM+1
	MUL	T1,[EXP	475026675661]
	SETZ	T1,
	ROTC	T1,-<↑L<NMBKTS>-43>
	MOVEI	S,BUKETS(T1)	;GET A(BUK
	MOVEI	S,BUKETS(T1)	;GET A(BUCKET HASHED)
	 SKIPN	 (S)		   ;BUCKET INITIALIZED?
	 POPJ	 P,		   ;NO - ERROR RETURN
	 MOVE	 T1,SYM 	   ;YES - A(FIRST ENTRY) IN S
	 MOVE	 T2,SYM+1	   ;GET ASCII FOR CHECKING
	JRST	.+4		;ENTER LOOP
FDSM.1: HRRZ	T3,(S)		;SYMBOL BLOCK HEADER
	JUMPN	T3,.+2		;SKIP IF NOT END
	POPJ	P,		;ERROR RETURN
	MOVE	S,(S)		;GET NEXT LINK
	CAMN	T1,1(S) 	;SYMBOL HERE?
	CAME	T2,2(S)
	JRST	FDSM.1		;NO - LOOP FOR ANOTHER BLOCK
	JRST	CPOPJ1		;SYMBOL FOUND - NORMAL RETURN
	PAGE
	SUBTTL EXPEVL - EXPRESSION EVALUATOR
EXPEVL: 			   ;EVALUATE AN EXPRESSION
	TLZ	F,FL.EER!FL.EVC ;TURN OFF FLAGS
	JFCL	17,.+1		;TURN OFF ANY POSSIBLE OVERFLOWS
	 SETZB	 E,N		   ;EXPRESSION & ATOMIC VALUE TO +ZERO
	LDB	C,CP		;GET FIRST CHARACTER
	CAIE	C,"+"		;IS IT UNARY PLUS?
	CAIN	C,"-"		;  OR UNARY MINUS?
	JRST	EXP.OP+4	;YES - GO PROCESS IT
	 PUSHJ	 P,ATOMIC	   ;NO - EVALUATE FIRST ATOMIC EXPRESSION
	 JRST	 EXPNFD 	   ;EXPRESSION NOT FOUND - ERROR RETURN
	 MOVE	 E,N		   ;PUT FIRST ATOMIC IN E
	JRST	.+4
EXP.OP: TLZE	E,370000	;TRUNCATE TO 30 MAGNITUDE BITS
	TLO	F,FL.TER	;TRUNCATION ERROR
	JOV	.-1		;OVERFLOW MEANS TRUNCATION ERROR
	LDB	C,CP		;GET NEXT CHARACTER
	 MOVSI	 T1,-5		   ;SET UP FOR OPERATOR SEARCH
EXP.1:	CAMN	C,E.OPCH(T1)	;OPERATOR FOUND?
	 JRST	 EXP.2		   ;YES - GO PROCESS IT
	 AOBJN	 T1,EXP.1	   ;NO - LOOP FOR MORE
	 JRST	 CPOPJ1 	   ;NEXT OPERATOR NOT FOUND - NORMAL EXIT
EXP.2:	IBP	CP		;BUMP OVER OPERATOR
	JRST	@E.OPRT(T1)	;GO TO PROPER ROUTINE
E.ADD:	 PUSHJ	 P,ATOMIC	   ;GET SECOND OPERAND
	 JRST	 EXPERR 	   ;EXPRESSION ERROR
	 TLZE	 N,SGNBIT	   ;GET OPERANDS INTO TWO'S COMPLEMENT FORM
	 MOVN	 N,N
	 TLZE	 E,SGNBIT
	 MOVN	 E,E
	 ADD	 E,N		   ;ADD
	JUMPGE	E,EXP.OP	;SKIP IF NON-NEGATIVE
	 MOVN	 E,E		   ;FORM MAGNITUDE
	 TLO	 E,SGNBIT	   ;MARK AS NEGATIVE
	 JRST	 EXP.OP 	   ;LOOK FOR NEXT OPERATOR
E.SUB:	 PUSHJ	 P,ATOMIC	   ;GET SECOND OPERAND
	 JRST	 EXPERR 	   ;EXPRESSION ERROR
	 TLC	 N,SGNBIT	   ;CHANGE SIGN
	 JRST	 E.ADD+2	   ;GO ADD NORMALLY
E.MUL:	 PUSHJ	 P,ATOMIC	   ;GET SECOND OPERAND
	 JRST	 EXPERR 	   ;EXPRESSION ERROR
	 TLZE	 N,SGNBIT	   ;GET OPERANDS INTO TWO'S COMPLEMENT FORM
	 MOVN	 N,N
	 TLZE	 E,SGNBIT
	 MOVN	 E,E
	 IMUL	 E,N		   ;MULTIPLY
	JUMPGE	E,EXP.OP	;SKIP IF NON-NEGATIVE
	 MOVN	 E,E		   ;FORM MAGNITUDE
	 TLO	 E,SGNBIT	   ;MARK AS NEGATIVE
	 JRST	 EXP.OP 	   ;LOOK FOR NEXT OPERATOR
E.DIV:	 PUSHJ	 P,ATOMIC	   ;GET SECOND OPERAND
	 JRST	 ED.1		   ;ATOMIC NOT FOUND - MAY BE "//"
	 TLZE	 N,SGNBIT	   ;GET OPERANDS INTO TWO'S COMPLEMENT FORM
	 MOVN	 N,N
	 TLZE	 E,SGNBIT
	 MOVN	 E,E
	 IDIV	 E,N		   ;DIVIDE
	JUMPGE	E,EXP.OP	;SKIP IF NON-NEGATIVE
	 MOVN	 E,E		   ;FORM MAGNITUDE
	 TLO	 E,SGNBIT	   ;MARK AS NEGATIVE
	 JRST	 EXP.OP 	   ;LOOK FOR NEXT OPERATOR
ED.1:	TLNN	F,FL.VAC	;WAS ATOOIC VACUOUS?
	JRST	EXPERR		;YES - EXPRESSION ERROR
E.DDIV:  LDB	 C,CP		   ;GET NEXT CHARACTER
	 CAIE	 C,"/"		   ;IS IT A SECOND SLASH?
	 JRST	 EXPERR 	   ;NO - EXPRESSION ERROR
	IBP	CP		;BUMP CHARACTER POINTER
	 PUSHJ	 P,ATOMIC	   ;GET SECOND OPERAND
	 JRST	 EXPERR 	   ;EXPRESSION ERROR
	 TLZE	 N,SGNBIT	   ;GET OPERANDS INTO TWO'S COMPLEMENT FORM
	 MOVN	 N,N
	 TLZE	 E,SGNBIT
	 MOVN	 E,E
	 SETZ	 T2,		   ;PREPARE FOR DOUBLE LENGTH DIVISION
	 MOVE	 T1,E
	 ASHC	 T1,-5		   ;PUT IN POSITION AS E*(2**30)
	 DIV	 T1,N		   ;DIVIDE
	 MOVE	 E,T1
	JUMPGE	E,EXP.OP	;SKIP IF NON-NEGATIVE
	 MOVN	 E,E		   ;FORM MAGNITUDE
	 TLO	 E,SGNBIT	   ;MARK AS NEGATIVE
	 JRST	 EXP.OP 	   ;LOOK FOR NEXT OPERATOR
E.COL:	 PUSHJ	 P,ATOMIC	   ;GET SECOND OPERAND
	 JRST	 EXPERR 	   ;EXPRESSION ERROR
	 TLZE	 E,SGNBIT	   ;GET OPERAND'S INTO TWO'S COMPLEMENT FORM
	 MOVN	 E,E
	 TLZE	 N,SGNBIT
	 MOVN	 N,N
	 ASH	 E,3		   ;FIRST OPERAND * 8
	 ADD	 E,N		   ;PLUS SECOND OPERAND
	JUMPGE	E,EXP.OP	;SKIP IF NON-NEGATIVE
	 MOVN	 E,E		   ;MAKE MAGNITUDE SIGN FORM
	 TLO	 E,SGNBIT
	 JRST	 EXP.OP 	   ;LOOK FOR NEXT OPERATOR
EXPNFD: TLNN	F,FL.VAC	;ATOMIC VACUOUS?
	JRST	.+2		;NO - EXPRESSION ERROR
	TLOA	F,FL.EVC	;MARK EXPRESSION VACUOUS
EXPERR:  TLO	 F,FL.EER	   ;SET EXPRESSION ERROR FLAG
	 POPJ	 P,		   ;ERROR RETURN
	PAGE
	SUBTTL RANDOM GARBAGE
;BYTE POINNERS
PT.LBF: POINT	7,OUTLIN
PT.OPC: POINT	7,OUTLIN+2,6
PT.IOC: POINT	7,INOPC
PT.ADR: POINT	7,OUTLIN+3,13
PT.SYM: POINT	7,SYM
PT.STB:	POINT	7,3(T1)
PT.LIN: POINT	7,OUTLIN,6
PT.ALF: POINT	7,OUTLIN+3,6
PT.LSM:	POINT	7,LITSYM
PT.LS2:	POINT	7,LITSYM,13
;RANDOM MEMORY LOCATIONS
;SCRATCH BLOCK
SCRTCH:
AFUTRF: Z
OUTLC:	Z
MIXWRD: Z
STMTNO: Z
OUTERR: Z
OUTLIN: BLOCK	33
;SYMBOL TABLE BUCKETS
BUKETS: BLOCK	NMBKTS
;LOCAL SYMBOL SERIAL NUMBER TABLE
LCSMNO: BLOCK	12
LINSIZ: Z
INOPC:	Z
T.EQU:	Z
W.TEMP: Z
SYMVAL: Z
SYM:	BLOCK	2
LITSYM:	BLOCK	40
PDLIST: BLOCK	40
T.FRCP: Z
	PAGE
	SUBTTL TABLES
IF1,<	PRINTX TABLES ON PASS 1>
IF2,<	PRINTX TABLES ON PASS 2>
OPDISP: PHASE	0		;OPCODE TYPE DISPATCH TABLE
MACHOP: PMCHOP
EQUOP:	PEQUOP
ORIGOP:	PORGOP
CONOP:	PCONOP
ALFOP:	PALFOP
ENDOP:	PENDOP
	DEPHASE
E.OPCH: EXP	":","+","-","*","/"	;TABLE OF OPERATORS
E.OPRT: EXP	E.COL,E.ADD,E.SUB,E.MUL,E.DIV	;OPERATOR PROCESSOR ADDRESSES
;ERROR FLAG TABLE
	DEFINE	Z5(FLAG)<IRP	FLAG<
	XWD	FL.'FLAG'ER,"FLAG"	>>
ERRTAB: Z5<A,E,F,I,L,O,R,S,T,W>
	DEFINE	Z1(N)<IRP	N<
	L=↑D'N/10
	R=↑D'N-<L*10>
IFGE	<R-L>,<
IFGE	<5-R>,<
	POINT	<<R-L+1>*6>,(T1),<<R*6>+5>	>>
IFL	<<R-L>!<5-R>>,< Z>	>>
FP.TAB: Z1<0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,∨
24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45>
	DEFINE Z3(N)<IRP N<
	EXP	↑D'N	>>
ATMTAB: Z3<0,20,21,56,49,57,58,55,42,43,46,44,41,45,40,47,30,31132,33,34,35,∨
36,37,38,39,54,53,50,48,51,10,52,1,2,3,4,5,6,7,8,9,11,12,13,14,15,16,17,18,19,∨
22,23,24,25,26,27,28,29,59,10,60,61>
	RADIX	10
	IFNDEF	FLTOPS,<FLTOPS= -1>
	IFNDEF	BINOPS,<BINOPS= -1>
	IFNDEF	EXTMEM,<EXTMEM= -1>
	IFNDEF	RNDOPS,<RNDOPS= -1>
	DEFINE	MOP(OPNAME,OPCODE,DEFLTF)
<	ASCII	/OPNAME/
	IFIDN	<DEFLTF><>,<
	XWD	 320+OPCODE,	0	>
	IFDIF	<DEFLTF><>,<
	XWD	<DEFLTF*64>+OPCODE,	0>	>
	DEFINE	AOP(AOPNAM,TYPE)
<	ASCII	/AOPNAM/
	EXP	TYPE >
OPTBOT:
	MOP(ADD,1)
	AOP(ALF,ALFOP)
IFN	BINOPS,<
	MOP(AND,5,3)
					>
	MOP(CHAR,5,1)
	MOP(CMP1,57)
	MOP(CMP2,58)
	MOP(CMP3,59)
	MOP(CMP4,60)
	MOP(CMP5,61)
	MOP(CMP6,62)
	MOP(CMPA,56)
	MOP(CMPX,63)
	AOP(CON,CONOP)
	MOP(DEC1,49,1)
	MOP(DEC2,50,1)
	MOP(DEC3,51,1)
	MOP(DEC4,52,1)
	MOP(DEC5,53,1)
	MOP(DEC6,54,1)
	MOP(DECA,48,1)
	MOP(DECX,55,1)
	MOP(DIV,4)
	AOP(END,ENDOP)
	MOP(ENN1,49,3)
	MOP(ENN2,50,3)
	MOP(ENN3,51,3)
	MOP(ENN4,52,3)
	MOP(ENN5,53,3)
	MOP(ENN6,54,3)
	MOP(ENNA,48,3)
	MOP(ENNX,55,3)
	MOP(ENT1,49,2)
	MOP(ENT2,50,2)
	MOP(ENT3,51,2)
	MOP(ENT4,52,2)
	MOP(ENT5,53,2)
	MOP(ENT6,54,2)
	MOP(ENTA,48,2)
	MOP(ENTX,55,2)
	AOP(EQU,EQUOP)
IFN	FLTOPS,<
	MOP(FADD,1,6)
	MOP(FCMP,56,6)
	MOP(FDIV,4,6)
	MOP(FIX,5,8)
	MOP(FLOT,5,6)
	MOP(FMUL,3,6)
	MOP(FSUB,2,6)
					>
	MOP(HLT,5,2)
	MOP(IN,36,0)
	MOP(INC1,49,0)
	MOP(INC2,50,0)
	MOP(INC3,51,0)
	MOP(INC4,52,0)
	MOP(INC5,53,0)
	MOP(INC6,54,0)
	MOP(INCA,48,0)
	MOP(INCX,55,0)
IFN	EXTMEM,<
	MOP(INT,5,7)
					>
	MOP(IOC,35,0)
	MOP(J1N,41,0)
	MOP(J1NN,41,3)
	MOP(J1NP,41,5)
	MOP(J1NZ,41,4)
	MOP(J1P,41,2)
	MOP(J1Z,41,1)
	MOP(J2N,42,0)
	MOP(J2NN,42,3)
	MOP(J2NP,42,5)
	MOP(J2NZ,42,4)
	MOP(J2P,42,2)
	MOP(J2Z,42,1)
	MOP(J3N,43,0)
	MOP(J3NN,43,3)
	MOP(J3NP,43,5)
	MOP(J3NZ,43,4)
	MOP(J3P,43,2)
	MOP(J3Z,43,1)
	MOP(J4N,44,0)
	MOP(J4NN,44,3)
	MOP(J4NP,44,5)
	MOP(J4NZ,44,4)
	MOP(J4P,44,2)
	MOP(J4Z,44,1)
	MOP(J5N,45,0)
	MOP(J5NN,45,3)
	MOP(J5NP,45,5)
	MOP(J5NZ,45,4)
	MOP(J5P,45,2)
	MOP(J5Z,45,1)
	MOP(J6N,46,0)
	MOP(J6NN,46,3)
	MOP(J6NP,46,5)
	MOP(J6NZ,46,4)
	MOP(J6P,46,2)
	MOP(J6Z,46,1)
IFN	RNDOPS,<
	MOP(JAE,40,6)
					>
	MOP(JAN,40,0)
	MOP(JANN,40,3)
	MOP(JANP,40,5)
	MOP(JANZ,40,4)
IFN	RNDOPS,<
	MOP(JAO,40,7)
					>
	MOP(JAP,40,2)
	MOP(JAZ,40,1)
	MOP(JBUS,34,0)
	MOP(JE,39,5)
	MOP(JG,39,6)
	MOP(JGE,39,7)
	MOP(JL,39,4)
	MOP(JLE,39,9)
	MOP(JMP,39,0)
	MOP(JNE,39,8)
	MOP(JNOV,39,3)
	MOP(JOV,39,2)
	MOP(JRED,38,0)
	MOP(JSJ,39,1)
IFN	RNDOPS,<
	MOP(JXE,47,6)
					>
	MOP(JXN,47,0)
	MOP(JXNN,47,3)
	MOP(JXNP,47,5)
	MOP(JXNZ,47,4)
IFN	RNDOPS,<
	MOP(JXO,47,7)
					>
	MOP(JXP,47,2)
	MOP(JXZ,47,1)
	MOP(LD1,9)
	MOP(LD1N,17)
	MOP(LD2,10)
	MOP(LL2N,18)
	MOP(LD3,11)
	MOP(LD3N,19)
	MOP(LD4,12)
	MOP(LD4N,20)
	MOP(LD5,13)
	MOP(LD5N,21)
	MOP(LD6,14)
	MOP(LD6N,22)
	MOP(LDA,8)
	MOP(LDAN,16)
	MOP(LDX,15)
	MOP(LDXN,23)
	MOP(MOVE,7,1)
	MOP(MUL,3)
	MOP(NOP,0,0)
	MOP(NUM,5,0)
IFN	BINOPS,<
	MOP(OR,5,4)
					>
	AOP(ORIG,ORIGOP)
	MOP(OUT,37,0)
	MOP(SLA,6,0)
	MOP(SLAX,6,2)
IFN	BINOPS,<
	MOP(SLB,6,6)
					>
	MOP(SLC,6,4)
	MOP(SRA,6,1)
	MOP(SRAX,6,3)
IFN	BINOPS,<
	MOP(SRB,6,7)
					>
	MOP(SRC,6,5)
	MOP(ST1,25)
	MOP(ST2,26)
	MOP(ST3,27)
	MOP(ST4,28)
	MOP(ST5,29)
	MOP(ST6,30)
	MOP(STA,24)
	MOP(STJ,32,2)
	MOP(STX,31)
	MOP(STZ,33)
	MOP(SUB,2)
IFN	RNDOPS,<
	MOP(XCT,5,9)
					>
IFN	BINOPS,<
	MOP(XOR,5,5)
					>
OPTTOP: -1B36
	RADIX	8
	LIT
	VAR
	SUPPRESS L,R
	END	MIXASM