.TITLE	CC202
	.IDENT	/X01/
 
	.NLIST	BEX
	.ENABL	LC
 
;
; C COMPILER
; CODER, PART I (NON EIS)
;
; VERSION X01
;
; DAVID G. CONROY	29-AUG-78
;
 
	.GLOBL	RCEXPR
	.GLOBL	RJTRUE
	.GLOBL	RJFALS
	.GLOBL	HFPRA
	.GLOBL	HGPRA
	.GLOBL	FHGPR
	.GLOBL	EIS
	.GLOBL	FIS
	.GLOBL	FPP
	.GLOBL	MOVREG
	.GLOBL	INDEX
	.GLOBL	SETUP
	.GLOBL	AS2REG
	.GLOBL	OTHER
 
	.MCALL	CALL
	.MCALL	CALLR
	.MCALL	RETURN
 
;
; HFPRA AND HGPRA CONTAIN THE NUMBER OF THE
; HIGHEST FLOATING POINT AND GENERAL REGISTERS
; AVAILABLE.
; FHGPR IS USED TO REFRESH HGPRA. IT IS SET BY
; CC200 FROM THE N DIRECTIVE.
;
 
HFPRA:	.BLKW	1
HGPRA:	.BLKW	1
FHGPR:	.BLKW	1
 
;
; FLAGS FOR THE CODER.
; TELLS WHAT KIND OF MACHINE YOU HAVE.
; PROBABLY SHOULD BE IN THE ROOT AND BE SETTABLE
; BY OPTIONS.
;

EIS:	.WORD	0		;NO EIS
FIS:	.WORD	0		;NO FIS
FPP:	.WORD	0		;NO FPP

;
; LOCAL DATA
;
 
OTHER:	.WORD	OP.NE		;THE OTHER SENSE OF RELATIONS
	.WORD	OP.EQ		;
	.WORD	OP.GE		;
	.WORD	OP.GT		;
	.WORD	OP.LT		;
	.WORD	OP.LE		;
	.WORD	OP.GEU		;
	.WORD	OP.GTU		;
	.WORD	OP.LTU		;
	.WORD	OP.LEU		;
 
AZERO:	.WORD	OP.CON		;CONSTANT 0
	.BYTE	0,TY.INT	;
	.WORD	0		;
	.WORD	1		;
	.WORD	0		;
 
AONE:	.WORD	OP.CON		;CONSTANT 1
	.BYTE	0,TY.INT	;
	.WORD	0		;
	.WORD	1		;
	.WORD	1		;
 
;
; REGISTER DESCRIPTORS.
;
 
RDESCR:	.WORD	OP.REG		;REGISTER 0
	.BYTE	0, TY.INT	;
	.WORD	0, 0, 0, 0	;
	.WORD	OP.REG		;REGISTER 1
	.BYTE	0, TY.INT	;
	.WORD	0, 0, 0, 1	;
	.WORD	OP.REG		;REGISTER 2
	.BYTE	0, TY.INT	;
	.WORD	0, 0, 0, 2	;
	.WORD	OP.REG		;REGISTER 3
	.BYTE	0, TY.INT	;
	.WORD	0, 0, 0, 3	;
	.WORD	OP.REG		;REGISTER 4
	.BYTE	0, TY.INT	;
	.WORD	0, 0, 0, 4	;
	.WORD	OP.REG		;REGISTER 5
	.BYTE	0, TY.INT	;
	.WORD	0, 0, 0, 5	;
 
;
; LOCAL DATA
;
 
LTYPE:	.BLKB	1		;TYPE OF LEFT
RTYPE:	.BLKB	1		;TYPE OF RIGHT
LKIND:	.BLKB	1		;KIND OF LEFT
RKIND:	.BLKB	1		;KIND OF RIGHT

NSTACK:	.WORD	0		;STACK DEPTH
 
;
; ERROR MESSAGES.
;
 
ERR01:	.ASCIZ	"Botch in getreg"
ERR02:	.ASCIZ	"Botch in setup -- address not indirect"
ERR03:	.ASCIZ	"Missing code table"
ERR04:	.ASCIZ	"Botch in doargs"
ERR05:	.ASCIZ	"Botch in [pla]"
ERR06:	.ASCIZ	"Botch in lrelop -- not r0"
 
;
; CODE STRINGS.
;
 
CXST02:	.ASCIZ	"	mov	r?,-(sp)"<12>
CXST03:	.ASCIZ	"	mov	r?,(sp)"<12>
CXST07:	.ASCIZ	"	jsr	pc,"
 
POPS01:	.ASCIZ	"	tst	(sp)+"<12>
POPS02:	.ASCIZ	"	cmp	(sp)+,(sp)+"<12>
POPS03:	.ASCIZ	"	add	$"
POPS04:	.ASCIZ	",sp"<12>
 
MVRS02:	.ASCIZ	"	mov	r?,r?"<12>
 
TST:	.ASCIZ	"	tst	r?"<12>
TSTD:	.ASCIZ	"	tstd	r?"<12>
CMP0:	.ASCIZ	"	cmp	r?,$0"<12>
ASHC0:	.ASCIZ	"	ashc	$0,r0"<12>
DEC1:	.ASCII	"	sub	$1,r1"<12>
	.ASCIZ	"	sbc	r0"<12>
BIS:	.ASCIZ	"	bis	"
BIS10:	.ASCIZ	"	bis	r1,r0"<12>
CMP:	.ASCIZ	"	cmp	"
MOV:	.ASCIZ	"	mov	"
TST1:	.ASCIZ	"	tst	"
TST0:	.ASCIZ	"	tst	r0"<12>
CR0NL:	.ASCIZ	",r0"<12>
ADC:	.ASCIZ	"adc"
SBC:	.ASCIZ	"sbc"
 
	.EVEN
	.PAGE
;+
; ** RCEXPR - COMPILE AN EXPRESSION
; 
; THIS ROUTINE IS THE TOP LEVEL INTERFACE TO CEXPR. THE GLOBAL
; VARIABLES USED TO CONTROL REGISTER ALLOCATION ARE SET UP AND
; CEXPR IS INVOKED.
;
; INPUTS:
;	R5=TREE
;	R3=TABLE
;
; OUTPUTS:
;	R0=REGISTER WHERE THE RESULT ENDED UP (RTAB ONLY)
;-
 
RCEXPR:	CALL	MODIFY		;FIX UP THE TREE
	CALL	MWCON		;FIX MULTI WORD CONSTANTS
	CALL	SETHI		;SET WEIGHTS
	MOV	#3,HFPRA	;AC0-AC3 AVAILABLE
	MOV	FHGPR,HGPRA	;R0-R? AVAILABLE
	CLR	R4		;FORCE RESULT R0 IF POSSIBLE
	CALLR	CEXPR		;AND CALL CEXPR WITH THE SPECIFIED TABLE
 
;+
; ** RJTRUE - COMPILE A JUMP TRUE
; ** RJFALS - COMPILE A JUMP FALSE
;
; THESE ROUTINES ARE THE TOP LEVEL INTERFACES TO JTRUE AND TO
; JFALSE. THEY SET UP SOME GLOBAL VARIABLES, PERFORM THE TREE
; MODIFICATIONS AND INVOKE THE LOW LEVEL ROUTINES.
;
; INPUTS:
;	R5=TREE
;	R3=LABEL
;-
 
RJTRUE:	CALL	MODIFY		;MODIFY THE TREE
	CALL	MWCON		;FIX MULTI WORD CONSTANTS
	CALL	SETHI		;ASSIGN WEIGHTS
	MOV	#3,HFPRA	;AC0-AC3
	MOV	FHGPR,HGPRA	;R0-R?
	CLR	R4		;R0
	CALLR	JTRUE		;
 
RJFALS:	CALL	MODIFY		;MODIFY THE TREE
	CALL	MWCON		;FIX MULTI WORD CONSTANTS
	CALL	SETHI		;COMPUTE WEIGHTS
	MOV	#3,HFPRA	;AC0-AC3
	MOV	FHGPR,HGPRA	;GENERAL REGISTERS
	CLR	R4		;RESULT TO R0
	CALLR	JFALSE		;DO IT
	.PAGE
;+
; ** CEXPR - COMPILE AN EXPRESSION
;
; GIVEN A TREE, A REGISTER AND A TABLE, THIS ROUTINE COMPILES
; THE REQUIRED CODE.
; 
; INPUTS:
;	R5=TREE
;	R4=REG
;	R3=TABLE
;
; OUTPUTS:
;	R0=REG WHERE THE RESULT ENDED UP (RTAB ONLY)
;-
 
ATREE	=	30		;TREE (R5)
AREG	=	26		;REGISTER (R4)
ATABLE	=	24		;TABLE (R3)
NBARGS	=	16		;NUMBER OF BYTES OF ARGUMENTS
NARGS	=	14		;NUMBER OF ARGUMENTS
LAB1	=	12		;LABEL SAVE 1
LAB2	=	10		;LABEL SAVE 2
TEMP	=	6		;TEMP FOR POINTER TO ROP IN '?'
WTABF	=	4		;WRONG TABLE FLAG
WTABLE	=	2		;WORKING CODE TABLE
RESULT	=	0		;REGISTER WHERE RESULT IS
 
CEXPR:	MOV	R5,-(SP)	;SAVE REGISTERS
	MOV	R4,-(SP)	;
	MOV	R3,-(SP)	;
	MOV	R2,-(SP)	;
	MOV	R1,-(SP)	;
	SUB	#20,SP		;GET SPACE FOR THE LOCALS.
 
	CALL	PFLUSH		;FLUSH PENDING BRANCHES
 
;
; SEQUENTIAL EXECUTION (OP.SEQ)
; JUST CALL CEXPR ON THE SUBTREES.
;
 
	MOV	(R5),R0		;OPERATOR
	CMP	R0,#OP.SEQ	;IS IT SEQUENTIAL EXECUTION
	BNE	10$		;NO
	MOV	E.LOP(R5),R5	;DO LEFT SUBTREE
	CALL	CEXPR		;
	MOV	ATREE(SP),R5	;
	MOV	E.ROP(R5),R5	;DO RIGHT SUBTREE
	CALL	CEXPR		;
	JMP	195$		;DONE
 
;
; QUESTION COLON
; FAKE A CONDITIONAL BRANCH.
;
 
10$:	CMP	R0,#OP.QRY	;IS IT A QUESTION COLON
	BNE	30$		;NO
 
	CALL	GENLAB		;GENERATE SKIP LABEL
	MOV	R0,LAB1(SP)	;
 
	MOV	R0,R3		;JUMP FALSE ON LOP OF QUESTION
	MOV	E.LOP(R5),R5	;
	CALL	JFALSE		;
 
	MOV	NSTACK,WTABF(SP);SAVE NSTACK

	MOV	ATREE(SP),R5	;LEFT SIDE OF THE ':'
	MOV	E.ROP(R5),R5	;
	MOV	R5,TEMP(SP)	;
	MOV	E.LOP(R5),R5	;
	MOV	ATABLE(SP),R3	;
	CALL	CEXPR		;EVALUATE IT
	MOV	R0,RESULT(SP)	;SAVE WHERE IT ENDED UP
 
	CALL	GENLAB		;BRANCH AROUND THE RIGHT SIDE
	MOV	R0,LAB2(SP)	;
	CALL	BRANCH		;

	MOV	WTABF(SP),NSTACK;RESTORE NSTACK
 
	MOV	LAB1(SP),R0	;RIGHT SIDE OF THE ':'
	CALL	LABEL		;MARK FOR THE PREV. JUMP FALSE
	MOV	TEMP(SP),R5	;':'
	MOV	E.ROP(R5),R5	;
	CALL	CEXPR		;EVALUATE IT
 
	CMP	R0,RESULT(SP)	;TEST IF RESULT IN THE SAME REGISTER
	BEQ	20$		;YES
	CMP	R3,#RTAB	;IF NOT RTAB, IT DOESN'T MATTER
	BNE	20$		;
	MOV	RESULT(SP),R1	;MOVE RIGHT TO DEST. OF LEFT
	MOVB	E.TYPE(R5),R2	;
	CALL	MOVREG		;
 
20$:	MOV	LAB2(SP),R0	;CODE STREAMS MERGE HERE
	CALL	LABEL		;
	JMP	190$		;
 
;
; LOGICAL OPERATIONS HAVE VALUES OF 1 OR 0.
;
 
30$:	CMP	R3,#CTAB	;DON'T DO THIS IF CTAB
	BEQ	50$		;
 
	CMP	R0,#OP.NOT	;NOT (!) IS LOGICAL
	BEQ	40$		;
	CMP	R0,#OP.AA	;LOGICAL AND (&&) IS LOGICAL
	BEQ	40$		;
	CMP	R0,#OP.OO	;SO IS LOGICAL OR
	BEQ	40$		;
	CMP	R0,#OP.EQ	;RELATIONALS
	BLO	50$		;SHOULD I BE CHECKING OPDOPE?
	CMP	R0,#OP.GTU	;
	BHI	50$		;BR IF NOT A LOGICAL OP.
 
40$:	CALL	GENLAB		;GET A SKIP LABEL
	MOV	R0,LAB1(SP)	;
	MOV	R0,R3		;JUMP TO IT ON FALSE
	CALL	JFALSE		;
 
	MOV	NSTACK,WTABF(SP);SAVE NSTACK

	MOV	#AONE,R5	;CONSTANT 1 (TRUE SIDE)
	MOV	ATABLE(SP),R3	;
	CALL	CEXPR		;
 
	CALL	GENLAB		;BRANCH AROUND THE LOAD OF THE 0
	MOV	R0,LAB2(SP)	;
	CALL	BRANCH		;
 
	MOV	WTABF(SP),NSTACK;RESTORE NSTACK

	MOV	LAB1(SP),R0	;CONSTANT 0
	CALL	LABEL		;
	MOV	#AZERO,R5	;
	CALL	CEXPR		;
 
	MOV	LAB2(SP),R0	;CODE STREAMS MERGE HERE.
	CALL	LABEL		;
	MOV	R4,R0		;CORRECT RESULT REGISTER
	JMP	195$		;
 
;
; FUNCTION CALL.
;
 
50$:	CLR	WTABF(SP)	;RESET WRONG TABLE FLAG
 
	CMP	R0,#OP.JSR	;CALL
	BNE	55$		;NO
	MOV	E.ROP(R5),R5	;DO THE ARGS
	CALL	DOARGS		;
	MOV	R0,NBARGS(SP)	;NUMBER OF BYTES
	MOV	R1,NARGS(SP)	;NUMBER OF ARGS
	MOV	ATREE(SP),R5	;GET CALL
	MOV	E.LOP(R5),R5	;
	MOV	#-1,R4		;ANYWHERE
	MOV	#1,R3		;ADDRESS
	CALL	SETUP		;
	MOV	#CXST07,R0	;JSR PC,
	CALL	CODSTR		;
	CLR	R4		;ORD
	CALL	ADDRES		;LOCATION OF THE FUNCTION.
	CALL	CODNL		;
	MOV	NBARGS(SP),R0	;POP OFF THE ARGS.
	CALL	POP		;
	SUB	NARGS(SP),NSTACK;FIX STACK DEPTH
	CLR	RESULT(SP)	;RESULT IS R0
	CMP	ATABLE(SP),#RTAB;TEST IF THE RTAB WAS WANTED
	BEQ	51$		;
	INC	WTABF(SP)	;WE USED THE WRONG TABLE
51$:	JMP	100$		;DONE
 
;
; BIC FOR CONDITION CODES ONLY.
; TRANSFORM INTO BIT.
;
 
55$:	CMP	R0,#OP.BIC	;IS THE OPERATOR A BIC
	BNE	56$		;NO
	CMP	R3,#CTAB	;IS THIS THE CTAB
	BNE	56$		;NO
 
	MOV	#OP.BIT,(R5)	;CHANGE OP TO A BIT
	MOV	E.ROP(R5),R1	;ADD A
	MOV	#OP.COM,R4	;ONES COMPLEMENT NODE
	CALL	NODE		;TO THE
	MOV	R1,E.ROP(R5)	;RIGHT SUBTREE
	CALL	MODIFY		;REOPTIMISE IT
	CALL	SETHI		;RECOMPUTE COSTS
	MOV	R5,ATREE(SP)	;SAVE TREE
	MOV	AREG(SP),R4	;WE DESTROYED R4
	BR	60$		;
 
;
; IF THE EXPRESSION IS OF THE FORM A=B+C, WHERE A IS A REGISTER, C  HAS
; AN ADDRESS (AND IS NOT THE SAME AS A) AND + IS ONE OF + * BIS OR BIC,
; DO IT AS A=B; A=+C;
;
; THERE IS ALSO A SPECIAL LITTLE CHECK FOR REG = CVR B, WHERE THE  CVR
; IS A CHAR-TO-INT. THIS IS WHAT A MOVB DOES.
;
 
56$:	CMP	R0,#OP.ASG	;IS THE OP AN ASSIGNMENT
	BNE	5900$		;NO
 
	MOV	E.LOP(R5),R0	;CHECK OF LEFT A REGISTER
	CMP	(R0),#OP.REG	;
	BNE	5900$		;NO
	MOV	E.REG(R0),R1	;SAVE REGISTER NUMBER
 
;
; CVR SPECIAL.
;

	MOV	E.ROP(R5),R0	;GET RIGHT SUBTREE
	CMP	(R0),#OP.CVR	;IS THE OP RIGHT?
	BNE	5650$		;NO
	CMPB	E.TYPE(R0),#TY.PTR ;WORD RESULT?
	BHIS	5650$		;NO
	MOV	E.LOP(R0),R2	;GET ITS SUBTREE
	CMPB	E.TYPE(R2),#TY.CHR ;IS IT CHAR-TO-INT
	BNE	5650$		;NO

	MOV	R0,R5		;COMPILE USING RTAB
	MOV	R1,R4		;
	MOV	#RTAB,R3	;
	CALL	CEXPR		;
	CMP	R0,R4		;IS THE REGISTER RIGHT?
	BEQ	5605$		;YES
	MOV	R4,R1		;NO, MOVE IT
	MOV	#TY.INT,R2	;
	CALL	MOVREG		;

5605$:	MOV	R4,RESULT(SP)	;SAVE RESULT
	CMP	ATABLE(SP),#RTAB;DID WE WANT THE RTAB
	BEQ	5610$		;YES
	INC	WTABF(SP)	;NO, WRONG TABLE
5610$:	JMP	100$		;COMMON EXIT

;
; BINARY OP.
;

5650$:	CMP	(R0),#OP.ADD	;CHECK FOR GOOD OPERATORS
	BEQ	57$		;
	CMP	(R0),#OP.SUB	;
	BEQ	57$		;
	CMP	(R0),#OP.OR	;
	BEQ	57$		;
	CMP	(R0),#OP.BIC	;
	BNE	5900$		;NOT GOOD
 
57$:	MOV	E.ROP(R0),R0	;GET B
	CMP	(R0),#OP.AUD	;IS IT A LEAF NODE
	BHI	5900$		;NO
	CMP	(R0),#OP.REG	;IS IT THE SAME AS REG
	BLO	58$		;NO
	CMP	E.REG(R0),R1	;
	BEQ	5900$		;YES
 
58$:	MOV	E.ROP(R5),R0	;DO ASSIGNMENT IN THE ETAB
	MOV	R0,ATREE(SP)	;JUST FOR A SECOND
	MOV	E.LOP(R0),E.ROP(R5) ;
	MOV	#ETAB,R3	;
	CALL	CEXPR		;
	MOV	ATABLE(SP),R3	;RECOVER TABLE
	MOV	ATREE(SP),R0	;BUILD ASSIGNMENT
	MOV	R5,ATREE(SP)	;IS THIS NECESSARY?
	MOV	E.ROP(R0),E.ROP(R5) ;
	MOV	(R0),R0		;MAKE CORRECT OPERATOR
	CMP	R0,#OP.BIC	;
	BNE	59$		;
	MOV	#OP.BCA,(R5)	;
	BR	60$		;
 
59$:	ADD	#OP.ADA-OP.ADD,R0 ;
	MOV	R0,(R5)		;
	BR	60$		;
 
;
; A OP (REG = B), WHERE = IS ANY ASSIGNMENT OP, IS BEST SPLIT INTO TWO
; ASSIGNMENTS: REG = B AND A OP REG. THE ASSIGNMENT IS DONE  VIA  ETAB
;

5900$:	MOV	(R5),R0		;GET OP DOPE
	ASL	R0		;
	MOV	OPDOPE(R0),R0	;

	BIT	#LEAF,R0	;DUCK ON LEAVES
	BNE	60$		;

	BIT	#BINOP,R0	;BINARY OP?
	BEQ	5905$		;NO
	MOV	E.ROP(R5),R0	;DO THE RIGHT TREE
	BEQ	5905$		;NO ARGS CALL!!!
	CALL	AS2REG		;
	BCS	5905$		;NOTHING
	MOV	R0,E.ROP(R5)	;

5905$:	MOV	E.LOP(R5),R0	;DO THE LEFT TREE
	CALL	AS2REG		;
	BCS	60$		;NOTHING
	MOV	R0,E.LOP(R5)	;

;
; ORDINARY OPERATOR.
;
; SEARCH FOR A MATCH IN THE CODE TABLES. IF THE DESIRED TABLE IS THE
; STAB AND THERE IS NO MATCH JUST USE THE RTAB AND PUSH  THE  RESULT
; ONTO THE STACK. IF THE DESIRED TABLE IS THE ETAB AND THERE  IS  NO
; MATCH, JUST USE THE RTAB. IF THE DESIRED TABLE IS THE CTAB AND THE
; OPERATOR DOES NOT MATCH TRY FIRST THE ETAB, THEN THE RTAB.
;
; THE ETAB MAY NOT BE USED AS A SUBSTITUTE FOR THE CTAB IF THE  TREE
; HAS A LONG RESULT, OR IF THE OPERATOR IS "++" OR "--" POSTFIX.
;
; THIS ROUTINE MUST WORK OR THERE IS AN ERROR.
;
 
60$:	MOV	R4,RESULT(SP)	;SET DEFAULT RESULT REG.
	MOV	R3,WTABLE(SP)	;WORK TABLE

	CMP	R3,#TTAB	;LOOK UP TTAB IN STAB
	BNE	61$		;
	MOV	#STAB,R3	;

;
; ADDRESSABLE NODES GET AN OP.LOD NODE PUT
; ON TOP OF THEM.
; THIS IS FOR THE BENEFIT OF MATCH.
;

61$:	CALL	HASADR		;IS THE NODE ADDRESSABLE
	BCC	64$		;YES

	MOVB	E.TYPE(R5),R0	;TRY INDEXING
	CMP	R0,#TY.LNG	;USE R0 IF THE TREE IS
	BLOS	62$		;A FLOATING POINT
	CLR	R4		;TREE
62$:	CALL	INDEX		;WELL?
	BCS	70$		;NO

64$:	MOV	R5,R1		;PREPEND THE LOAD
	MOV	#OP.LOD,R4	;NODE
	CALL	NODE		;
	MOV	R1,R5		;PUT IT IN THE RIGHT PLACE
	MOV	R1,ATREE(SP)	;
 
;
; DO THE MATCH.
;

70$:	CALL	MATCH		;LOOK IT UP IN THE CODE TABLES
	BCC	80$		;FOUND IT
	CMP	R3,#RTAB	;FAILURE IN THE RTAB
	BEQ	95$		;YES, TOTAL FAILURE
 
	INC	WTABF(SP)	;SET USING WRONG TABLE
 
	CMP	R3,#CTAB	;FAIL IN THE CTAB
	BNE	72$		;NO
	CMPB	E.TYPE(R5),#TY.LNG ;IS THE TREE A LONG
	BEQ	72$		;YES, DON'T USE ETAB
	CMP	(R5),#OP.INA	;"++" POSTFIX
	BEQ	72$		;YES, DON'T USE ETAB
	CMP	(R5),#OP.DEA	;"--" POSTFIX
	BEQ	72$		;YES, DON'T USE ETAB
	MOV	#ETAB,R3	;TRY THE ETAB
	MOV	R3,WTABLE(SP)	;
	CALL	MATCH		;
	BCC	80$		;OK
 
72$:	MOV	#RTAB,R3	;NO, TRY THE RTAB
	MOV	R3,WTABLE(SP)	;
	CALL	MATCH		;
	BCS	95$		;NO CODE TABLE FOR OP.
 
;
; EXPAND THE CODE MACRO.
; WATCH FOR "-(SP)" AND "(SP)+"
;
 
80$:	MOVB	(R2)+,R0	;MACRO CHARACTER
	BEQ	100$		;END OF MACRO
	BMI	90$		;SOMETHING SPECIAL

	CMP	R0,#'-		;POSSIBLE "-(SP)"
	BNE	82$		;NO
	CMPB	(R2),#'(	;WELL
	BNE	84$		;NO
	INC	NSTACK		;FIX STACK DEPTH
	CMP	ATABLE(SP),#TTAB;TO TOP?
	BEQ	80$		;YES, TOSS THE "-" AWAY
	BR	84$		;

82$:	CMP	R0,#')		;POSSIBLE "(SP)+"
	BNE	84$		;NO
	CMPB	(R2),#'+	;WELL
	BNE	84$		;NO
	DEC	NSTACK		;FIX STACK DEPTH

84$:	CALL	CODC		;PUT IT OUT
	BR	80$		;
 
90$:	NEG	R0		;CALL SPECIFIC ROUTINE
	ASL	R0		;
	CALL	@200$-2(R0)	;
	BR	80$		;GO BACK FOR MORE
 
95$:	MOV	#ERR03,R0	;NO CODE TABLE FOR OP.
	JMP	CCABRT		;
 
;
; END OF MACRO.
; PERFORM THE PUSH, IF NECESSARY.
;
 
100$:	TST	WTABF(SP)	;BR IF NOT WRONG TABLE
	BEQ	190$		;
 
	MOV	ATABLE(SP),R3	;GRAB TABLE
	CMP	R3,#STAB	;DO PUSH IF STAB OR TTAB
	BEQ	110$		;
	CMP	R3,#TTAB	;
	BNE	190$		;

110$:	MOV	RESULT(SP),R0	;SETUP STRINGS
	ADD	#'0,R0		;
	MOVB	R0,CXST02+6	;
	MOVB	R0,CXST03+6	;

	MOV	ATREE(SP),R5	;GET TREE
	CMPB	E.TYPE(R5),#TY.LNG ;IS IT LONG?
	BNE	120$		;NO
	INCB	CXST02+6	;PUSH R+1
	MOV	#CXST02,R0	;
	CALL	CODSTR		;
	DECB	CXST02+6	;
	INC	NSTACK		;FIX DEPTH

120$:	MOV	#CXST02,R0	;DEFAULT TO -(SP)
	CMP	R3,#STAB	;RIGHT?
	BEQ	130$		;YES
	MOV	#CXST03,R0	;NO, TO (SP)

130$:	CALL	CODSTR		;PUT IT OUT
	INC	NSTACK		;FIX DEPTH
 
;
; DONE.
;
 
190$:	MOV	RESULT(SP),R0	;WHERE IT ENDED UP
195$:	ADD	#20,SP		;DISCARD LOCAL VARIABLES AND
	MOV	(SP)+,R1	;RETURN
	MOV	(SP)+,R2	;
	MOV	(SP)+,R3	;
	MOV	(SP)+,R4	;
	MOV	(SP)+,R5	;
	RETURN			;
 
;
; THIS TRANSFER TABLE SENDS CONTROL TO THE APPROPRIATE MACRO
; EXPANDER WHEN A MACRO (A NEGATIVE BYTE) IS ENCOUNTERED  IN
; THE CODE.
;
 
200$:	.WORD	MM		;-1	[M]
	.WORD	MF		;-2	[F]
	.WORD	MR		;-3	[R]
	.WORD	MR.1		;-4	[R+1]
	.WORD	MAL		;-5	[AL]
	.WORD	MALN		;-6	[ALN]
	.WORD	MAR		;-7	[AR]
	.WORD	MARN		;-10	[ARN]
	.WORD	MOP.0		;-11	[OP.0]
	.WORD	MOP.1		;-12	[OP.1]
	.WORD	MAL.2		;-13	[AL.2]
	.WORD	MAR.2		;-14	[AR.2]
	.WORD	MTL		;-15	[TL]
	.WORD	MT		;-16	[T]
	.WORD	MSRVA		;-17	[SRVA]
	.WORD	MSRV		;-20	[SRV]
	.WORD	MSRAA		;-21	[SRAA]
	.WORD	MSRA		;-22	[SRA]
	.WORD	MSLVA		;-23	[SLVA]
	.WORD	MSLV		;-24	[SLV]
	.WORD	MSLAA		;-25	[SLAA]
	.WORD	MSLA		;-26	[SLA]
	.WORD	MSLAC		;-27	[SLAC]
	.WORD	MLL		;-30	[LL]
	.WORD	MLL.1		;-31	[LL+1]
	.WORD	MLR		;-32	[LR]
	.WORD	MPL		;-33	[PL]
	.WORD	MPLA		;-34	[PLA]
	.WORD	MPR		;-35	[PR]
	.WORD	MV		;-36	[V]
 
;
; [M]		ADJUST RESULT REGISTER AS PER MODULUS (+1)
;
 
MM:	INC	RESULT+2(SP)	;[M]
	RETURN			;
 
;
; [F]		ADJUST RESULT REGISTER AS PER FUNCTION (R0)
;
 
MF:	CLR	RESULT+2(SP)	;[F] SET RETURN REGISTER TO R0
	RETURN			;
 
;
; [R]		CURRENT REGISTER
; [R+1]		CURRENT REGISTER + 1 (FOR LONGS)
;
 
	.ENABL	LSB
 
MR:	MOV	RESULT+2(SP),R1	;[R] GET THE REGISTER
	BR	10$		;
 
MR.1:	MOV	RESULT+2(SP),R1	;[R+1] GET THE REGISTER
	INC	R1		;+1
 
10$:	MOVB	#'r,R0		;THE "R"
	CALL	CODC		;
	MOV	R1,R0		;THEN THE REGISTER NUMBER
	ADD	#'0,R0		;
	CALLR	CODC		;
 
	.DSABL	LSB
 
;
; [AL]		ADDRESS OF LEFT SUBTREE
; [AL+2]	ADDRESS OF LEFT SUBTREE + 2 (FOR LONGS)
; [ALN]		ADDRESS OF LEFT SUBTREE, NO SIDE EFFECTS
;
 
	.ENABL	LSB
 
MAL.2:	MOV	#-1,R4		;[AL+2]
	BR	10$		;
 
MAL:	CLR	R4		;[AL]
	BR	10$		;
 
MALN:	MOV	#1,R4		;[ALN]
 
10$:	MOV	ATREE+2(SP),R5	;GET POINTER TO LEFT SUBTREE
	MOV	E.LOP(R5),R5	;
	CALLR	ADDRES		;AND PUT OUT ITS ADDRESS
 
	.DSABL	LSB
 
;
; [AR]		ADDRESS OF RIGHT SUBTREE
; [AR+2]	ADDRESS OF RIGHT SUBTREE + 2 (FOR LONGS)
; [ARN]		ADDRESS OF RIGHT SUBTREE, NO SIDE EFFECTS
;
 
	.ENABL	LSB
 
MAR.2:	MOV	#-1,R4		;[AR+2]
	BR	10$		;
 
MAR:	CLR	R4		;[AR]
	BR	10$		;
 
MARN:	MOV	#1,R4		;[ARN]
 
10$:	MOV	ATREE+2(SP),R5	;GET RIGHT SUBTREE
	MOV	E.ROP(R5),R5	;
	CALLR	ADDRES		;AND PUT OUT ITS ADDRESS
 
	.DSABL	LSB
 
;
; [OP0]		OPCODE STRING FROM OP0 TABLE
; [OP1]		OPCODE STRING FROM OP1 TABLE
;
 
	.ENABL	LSB
 
MOP.0:	MOV	#OP0,R0		;[OP.0]
	BR	10$		;
 
MOP.1:	MOV	#OP1,R0		;[OP.1]
 
10$:	MOV	ATREE+2(SP),R1	;GET OPERATOR
	MOV	(R1),R1		;
	ASL	R1		;CONVERT TO TABLE INDEX
	ADD	R1,R0		;GET TABLE POINTER
	MOV	(R0),R0		;PULL STRING POINTER FROM TABLE
	CALLR	CODSTR		;AND PUT IT OUT
 
	.DSABL	LSB
 
;
; [T]		TYPE
; [TL]		TYPE OF LEFT SUBTREE
;
; THESE MACROS EXPAND INTO ONE OF NOTHING,  A "B" (FOR CHAR) OR A "D"
; (FOR FLOAT AND DOUBLE). [TL] CHECKS ONLY THE LEFT SUBTREE; [T] DOES
; BOTH THE LEFT AND THE RIGHT SUBTREES.
;
 
	.ENABL	LSB
 
MT:	MOV	ATREE+2(SP),R5	;[T]
	MOV	E.ROP(R5),R5	;GET RIGHT SUBTREE
	MOVB	E.TYPE(R5),R5	;TYPE
	MOVB	#'b,R0		;CHECK FOR BYTES
	CMP	R5,#TY.CHR	;
	BEQ	10$		;GOT ONE
	MOVB	#'d,R0		;CHECK FOR FLOATING POINT
	CMP	R5,#TY.LNG	;
	BHI	10$		;GOT ONE
 
MTL:	MOV	ATREE+2(SP),R5	;[TL]
	MOV	E.LOP(R5),R5	;GET LEFT SUBTREE
	MOVB	E.TYPE(R5),R5	;TYPE
	MOVB	#'b,R0		;CHECK FOR BYTES
	CMP	R5,#TY.CHR	;
	BEQ	10$		;GOT ONE
	MOV	#'d,R0		;CHECK FOR FLOATING POINT
	CMP	R5,#TY.LNG	;
	BLOS	20$		;NOT ANYTHING SPECIAL
 
10$:	CALL	CODC		;PUT OUT THE "B" OR "D"
20$:	RETURN			;
 
	.DSABL	LSB
 
;
; [SRV]		SETUP RIGHT VALUE (NEXT REGISTER)
; [SRVA]	SETUP RIGHT VALUE ANYWHERE
; [SRA]		SETUP RIGHT ADDRESS (NEXT REGISTER)
; [SRAA]	SETUP RIGHT ADDRESS ANYWHERE
; [SLV]		SETUP LEFT VALUE (NEXT REGISTER)
; [SLVA]	SETUP LEFT VALUE ANYWHERE
; [SLA]		SETUP LEFT ADDRESS (NEXT REGISTER)
; [SLAA]	SETUP LEFT ADDRESS ANYWHERE
;
; NEXT REGISTER IS OBTAINED BY CALLING GETREG. THIS ONLY WORKS IF  THE
; KIND OF THE SUBTREE IS EASY (A REGISTER IS AVAILABLE). IF YOU  SCREW
; THIS UP YOU WILL GET MULTIPLE REGISTER ALLOCATIONS; I.E. NO CHECKING
; IS DONE BY GETREG.
;
 
	.ENABL	LSB
 
MSRVA:	MOV	ATREE+2(SP),R5	;GET RIGHT SUBTREE
	MOV	E.ROP(R5),R5	;
	MOV	#-1,R4		;ANYWHERE
	CLR	R3		;VALUE
	BR	10$		;

MSRV:	MOV	ATREE+2(SP),R5	;GET RIGHT SUBTREE
	MOV	E.ROP(R5),R5	;
	CALL	GETREG		;A REGISTER
	CLR	R3		;VALUE
	BR	10$		;

MSRAA:	MOV	ATREE+2(SP),R5	;GET RIGHT SUBTREE
	MOV	E.ROP(R5),R5	;
	MOV	#-1,R4		;ANYWHERE
	MOV	#1,R3		;ADDRESS
	BR	10$		;

MSRA:	MOV	ATREE+2(SP),R5	;GET RIGHT SUBTREE
	MOV	E.ROP(R5),R5	;
	CALL	GETREG		;A REGISTER
	MOV	#1,R3		;ADDRESS

10$:	CALL	SETUP		;DO IT
	MOV	ATREE+2(SP),R0	;REPLACE RIGHT SUBTREE
	MOV	R5,E.ROP(R0)	;
	RETURN			;FINIS
 
	.DSABL	LSB
	.ENABL	LSB
 
MSLVA:	MOV	ATREE+2(SP),R5	;GET LEFT SUBTREE
	MOV	E.LOP(R5),R5	;
	MOV	#-1,R4		;ANYWHERE
	CLR	R3		;VALUE
	BR	10$		;

MSLV:	MOV	ATREE+2(SP),R5	;GET LEFT SUBTREE
	MOV	E.LOP(R5),R5	;
	CALL	GETREG		;A REGISTER
	CLR	R3		;VALUE
	BR	10$		;

MSLAA:	MOV	ATREE+2(SP),R5	;GET LEFT SUBTREE
	MOV	E.LOP(R5),R5	;
	MOV	#-1,R4		;ANYWHERE
	MOV	#1,R3		;ADDRESS
	BR	10$		;

MSLA:	MOV	ATREE+2(SP),R5	;GET LEFT SUBTREE
	MOV	E.LOP(R5),R5	;
	CALL	GETREG		;A REGISTER
	MOV	#1,R3		;ADDRESS

10$:	CALL	SETUP		;DO IT
	MOV	ATREE+2(SP),R0	;REPLACE LEFT SUBTREE
	MOV	R5,E.LOP(R0)	;
	RETURN			;FINIS
 
	.DSABL	LSB
 
;
; [LL]		LOAD LEFT SUBTREE (INTO CURRENT REGISTER)
; [LL+1]	LOAD LEFT SUBTREE (INTO CURRENT REGISTER + 1)
; [LR]		LOAD RIGHT SUBTREE (INTO CURRENT REGISTER)
;
 
	.ENABL	LSB
 
MLL:	MOV	RESULT+2(SP),R4	;[LL]
	BR	10$		;
 
MLL.1:	MOV	RESULT+2(SP),R4	;[LL+1]
	INC	R4		;FIX REGISTER GOAL
 
10$:	MOV	ATREE+2(SP),R5	;GET LEFT SUBTREE
	MOV	E.LOP(R5),R5	;
	BR	20$		;GO TO COMMON LOADER
 
MLR:	MOV	RESULT+2(SP),R4	;[LR]
	MOV	ATREE+2(SP),R5	;GET RIGHT SUBTREE
	MOV	E.ROP(R5),R5	;
 
20$:	MOV	R2,-(SP)	;SAVE
	MOV	#RTAB,R3	;USE THE "LOAD REGISTER" CODETABLE
	CALL	CEXPR		;
	CMP	R4,R0		;DID IT END UP IN THE RIGHT REGISTER
	BEQ	30$		;SURE DID
	MOV	R4,R1		;NO, MOVE THE RESULT
	MOVB	E.TYPE(R5),R2	;
	CALL	MOVREG		;
30$:	MOV	(SP)+,R2	;RESTORE
	RETURN			;RETURN
 
	.DSABL	LSB
 
;
; [PLA]		PUSH LEFT ADDRESS
; [PL]		PUSH LEFT (VALUE)
; [PR]		PUSH RIGHT (VALUE)
;
 
	.ENABL	LSB
 
MPLA:	MOV	ATREE+2(SP),R5	;[PLA]
	MOV	E.LOP(R5),R5	;GET LEFT SUBTREE
	CMP	(R5),#OP.IND	;THE TOP OF THE TREE MUST BE "*"
	BNE	20$		;OR WE PANIC
	MOV	E.LOP(R5),R5	;REMOVE THE "*"
	BR	10$		;
 
MPL:	MOV	ATREE+2(SP),R5	;[PL]
	MOV	E.LOP(R5),R5	;GET LEFT SUBTREE
	BR	10$		;
 
MPR:	MOV	ATREE+2(SP),R5	;[PR]
	MOV	E.ROP(R5),R5	;GET RIGHT SUBTREE
 
10$:	MOV	RESULT+2(SP),R4	;USE RESULT REG AS WORK REG
	MOV	#STAB,R3	;USE "PUSH RESULT" CODETABLE
	CMP	WTABLE+2(SP),#TTAB ;UNLESS WORKING TABLE IS
	BNE	15$		;TTAB, WHERE WE USE
	MOV	#TTAB,R3	;IT STILL
15$:	CALLR	CEXPR		;
 
20$:	MOV	#ERR05,R0	;BOTCH IN [PLA]
	JMP	CCABRT		;FLUSH
 
	.DSABL	LSB
 
;
; [SLAC]	SETUP LEFT ADDRESS USING CURRENT REGISTER
;
 
	.ENABL	LSB
 
MSLAC:	MOV	ATREE+2(SP),R5	;GET LEFT SUBTREE
	MOV	E.LOP(R5),R5	;
	MOV	RESULT+2(SP),R4	;REGISTER
	MOVB	E.TYPE(R5),R0	;USE R0 IF FLOATING POINT
	CMP	R0,#TY.LNG	;
	BLOS	10$		;NOT FP
	CLR	R4		;R0
10$:	MOV	#1,R3		;ADDRESS
	CALL	SETUP		;DO IT
	MOV	ATREE+2(SP),R0	;STORE BACK LEFT SUBTREE
	MOV	R5,E.LOP(R0)	;
	RETURN			;FINIS
 
	.DSABL	LSB
 
;
; [V]		SPECIAL FOR LONGS
;
; THIS MACRO EXPANDS INTO EITHER AN "ADC" OR AN "SBC" DEPENDING ON THE
; CURRENT OPERATOR. IT IS USED BY LONG "+", "-", "++" AND "--".
.
;
 
	.ENABL	LSB
 
MV:	MOV	#SBC,R0		;[V]
	MOV	ATREE+2(SP),R5	;GET OPERATOR
	MOV	(R5),R5		;
	CMP	R5,#OP.SUB	;SEE IF SBC IS THE RIGHT OP
	BEQ	10$		;IT IS FOR "-"
	CMP	R5,#OP.SBA	;
	BEQ	10$		;AND FOR "=-"
	CMP	R5,#OP.DEB	;
	BEQ	10$		;AND FOR "--"
	CMP	R5,#OP.DEA	;
	BEQ	10$		;BOTH TYPES
	MOV	#ADC,R0		;OTHERWISE GET AN "ADC"
10$:	CALLR	CODSTR		;PUT IT OUT
 
	.DSABL	LSB
	.PAGE
;+
; ** MATCH - CODE TABLE MATCHER
;
; GIVEN A TREE AND A CODE TABLE, LOOK FOR A MATCH. RETURN A POINTER TO
; THE MACRO IF THE MATCH IS SUCCESSFUL.
;
; INPUTS:
;	R3=TABLE
;	R5=TREE
;
; OUTPUTS:
;	C BIT CLEAR IF FOUND
;	R2=MACRO 
;-
 
MATCH:	MOV	R0,-(SP)	;SAVE ARGS
	MOV	R3,-(SP)	;
	MOV	R4,-(SP)	;
	MOV	R5,-(SP)	;
 
;
; TRY FOR MATCHES WITH CONVERSIONS DELETED.
;
 
	MOV	E.LOP(R5),R0	;GET LEFT SUBTREE
	CMP	(R0),#OP.CVR	;TEST IF CONVERSION
	BEQ	2$		;YES
	CMP	(R0),#OP.CVM	;
	BNE	3$		;NOT A CONVERSION
2$:	MOV	E.LOP(R0),E.LOP(R5) ;DELETE THE CONVERSION
	CALL	MATCH		;TRY FOR A MATCH
	BCC	16$		;FOUND IT
	MOV	R0,E.LOP(R5)	;REPLACE THE OLD LEFT OPERAND
 
3$:	MOV	E.ROP(R5),R0	;GET RIGHT SUBTREE
	BEQ	10$		;BR IF UNARY
	CMP	(R0),#OP.CVR	;LOOK FOR CONVERSIONS
	BEQ	4$		;YES
	CMP	(R0),#OP.CVM	;
	BNE	10$		;NO
4$:	MOV	E.LOP(R0),E.ROP(R5) ;REMOVE THE CONVERSION
	CALL	MATCH		;TRY FOR A MATCH
	BCC	16$		;FOUND IT
	MOV	R0,E.ROP(R5)	;REPLACE THE OLD RIGHT SUBTREE
 
;
; ORDINARY
; IF THE OP IS A CONVERSION, THE LEFT IS SET ON THE RESULT AND THE
; RIGHT ON THE LEFT OPERAND (THE SOURCE). THE SAME IS DONE FOR THE
; INDIRECTION OPERATOR, WHO ALWAYS HAS TYPE POINTER ON THE   RIGHT
; FOR OTHER OPERATORS, LEFT AND RIGHT ARE SET ON THE TREE NODES.
;
 
10$:	TST	(R3)		;LOOK UP OP IN FIRST LEVEL TABLE
	BEQ	15$		;NO CODE TABLE
	CMP	(R3)+,(R5)	;HERE
	BEQ	20$		;FOUND IT
	TST	(R3)+		;SKIP TO THE NEXT ENTRY
	BR	10$		;
 
15$:	JMP	70$		;NO CODE TABLE
16$:	JMP	80$		;YES CODE TABLE
 
20$:	MOV	(R3)+,R4	;GET POINTER TO SECOND LEVEL TABLE
 
;
; SET LTYPE, LKIND, RTYPE AND RKIND
;
 
	MOV	(R5),R0		;GET THE OPERATOR
	CMP	R0,#OP.CVR	;TEST
	BEQ	22$		;FOR
	CMP	R0,#OP.CVM	;CONVERSIONS
	BEQ	22$		;OR
	CMP	R0,#OP.IND	;INDIRECTION
	BNE	24$		;NONE
22$:	CALL	CLASFY		;SET LEFT ON THE RESULT
	MOVB	R0,LKIND	;
	MOVB	E.TYPE(R5),LTYPE;
	MOV	E.LOP(R5),R5	;SET RIGHT ON THE SOURCE
	CALL	CLASFY		;
	MOVB	R0,RKIND	;
	MOVB	E.TYPE(R5),RTYPE;
	BR	40$		;GO MATCH
 
24$:	MOV	E.ROP(R5),R0	;SEE IF RIGHT OPERAND
	BNE	30$		;YES, BINARY
	MOV	E.LOP(R5),R5	;UNARY, RIGHT IS ALWAYS 'ANY'
	MOVB	E.TYPE(R5),LTYPE;TYPES ARE BOTH SET TO
	MOVB	E.TYPE(R5),RTYPE;THAT OF THE LEFT SUBTREE
	MOVB	#ANY,RKIND	;
	MOV	#AZERO,R0	;ANY LEAF NODE WOULD DO
	CALL	CLASFY		;
	MOVB	R0,LKIND	;
	BR	40$		;GO MATCH
 
30$:	MOV	E.LOP(R5),R5	;CLASSIFY LOP
	CALL	CLASFY		;
	MOVB	R0,LKIND	;
	MOVB	E.TYPE(R5),LTYPE;
 
	MOV	(SP),R5		;CLASSIFY ROP
	MOV	E.LOP(R5),R0	;
	MOV	E.ROP(R5),R5	;
	CALL	CLASFY		;
	MOVB	R0,RKIND	;
	MOVB	E.TYPE(R5),RTYPE;
 
;
; SEARCH SECOND LEVEL TABLE.
; CONSTANTS MUST MATCH EXACTLY.
; OTHERWISE ALL CONSTANTS ARE ADDRESSABLE, ADDRESSABLE IS EASY,  AND
; EASY IS ANY.
;
 
40$:	MOV	R4,R3		;REFRESH TABLE POINTER
45$:	MOV	(R3),R2		;MACRO POINTER
	BEQ	52$		;NO MATCH
 
	CMPB	LTYPE,2(R3)	;TYPES
	BNE	50$		;MUST
	CMPB	RTYPE,4(R3)	;MATCH
	BNE	50$		;EXACTLY
 
	CMPB	3(R3),#ADDR	;IS LEFT KIND A CONSTANT
	BHIS	46$		;NO
	CMPB	LKIND,3(R3)	;IF SO, MUST BE EXACT
	BNE	50$		;
	BR	47$		;
 
46$:	CMPB	LKIND,3(R3)	;OTHERWISE SUBSETS WORK
	BHI	50$		;NO MATCH
 
47$:	CMPB	5(R3),#ADDR	;IS RIGHT KIND A CONSTANT
	BHIS	48$		;NO
	CMPB	RKIND,5(R3)	;IF SO, MUST BE EXACT
	BNE	50$		;
	BR	60$		;MATCH
 
48$:	CMPB	RKIND,5(R3)	;OTHERWISE SUBSETS WORK
	BLOS	60$		;MATCH
 
50$:	ADD	#6,R3		;NEXT ENTRY
	BR	45$		;
 
;
; CONTINUE AS LONG AS PTR AND UNSIGNED CAN BE CHANGED TO INT.
;
 
52$:	MOVB	LTYPE,R0	;LEFT SIDE
	CMP	R0,#TY.PTR	;POINTER
	BEQ	53$		;YES, REDUCE
	CMP	R0,#TY.UNS	;UNSIGNED
	BNE	54$		;NO, GIVE UP ON THIS SIDE
53$:	MOVB	#TY.INT,LTYPE	;MAP TO INT
	BR	40$		;TRY SOME MORE
 
54$:	MOVB	RTYPE,R0	;RIGHT SIDE
	CMP	R0,#TY.PTR	;POINTER
	BEQ	55$		;YES, REDUCE
	CMP	R0,#TY.UNS	;UNSIGNED
	BNE	70$		;FAIL
55$:	MOVB	#TY.INT,RTYPE	;MAP TO INT
	BR	40$		;TRY SOME MORE
 
60$:	CLC			;FOUND IT
	BR	80$		;
70$:	SEC			;NOT FOUND
80$:	MOV	(SP)+,R5	;RETURN
	MOV	(SP)+,R4	;
	MOV	(SP)+,R3	;
	MOV	(SP)+,R0	;
	RETURN			;FINIS
	.PAGE
;+
; ** JTRUE  - JUMP ON TRUE
; ** JFALSE - JUMP ON FALSE
;
; COMPILE CODE TO JUMP TO THE SPECIFIED LABEL IF THE RESULT OF
; THE TREE IS TRUE OR FALSE, AS SPECIFIED.
;
; INPUTS:
;	R5=TREE
;	R4=REG
;	R3=LABEL
;-
 
SEX	=	20		;0 IF FALSE, -1 IF TRUE
ATREE	=	16		;R5
AREG	=	14		;R4
ALABEL	=	12		;R3
BROP	=	2		;BRANCH OP
LAB	=	0		;TEMP LABEL FOR ANDAND AND OROR
 
JTRUE:	MOV	#-1,-(SP)	;SEX
	BR	JUMPC
 
JFALSE:	CLR	-(SP)		;SEX
 
JUMPC:	MOV	R5,-(SP)	;SAVE REGISTERS (ARGS)
	MOV	R4,-(SP)	;
	MOV	R3,-(SP)	;
	MOV	R2,-(SP)	;
	MOV	R1,-(SP)	;
	MOV	R0,-(SP)	;
	SUB	#4,SP		;LOCALS
 
	CALL	PFLUSH		;FLUSH PENDING BRANCHES
 
;
; LOGICAL NOT
; JUST REVERSE THE CONDITION
;
 
10$:	MOV	(R5),R2		;OP
	CMP	R2,#OP.NOT	;IS IT '!'
	BNE	15$		;NO
	COM	SEX(SP)		;FLIP THE BRANCH SEX
	MOV	E.LOP(R5),R5	;DELETE THE
	MOV	R5,ATREE(SP)	;NOT NODE
	BR	10$		;AND START AGAIN
 
;
; CONSTANTS (MOSTLY FOR THE BENEFIT OF WHILE(1))
; COMPILE EITHER AN UNCONDITIONAL BRANCH, OR NOTHING, AS 
; REQUIRED.
;
 
15$:	CMP	R2,#OP.CON	;IS IT A CONSTANT
	BNE	20$		;NO
	MOV	R5,R1		;GET COPY OF THE TREE POINTER
	TST	SEX(SP)		;TEST THE SEX OF THE JUMP
	BEQ	16$		;BR IF JUMP FALSE
 
	CALL	CONZER		;IS IT CONSTANT ZERO
	BCC	18$		;IF YES, DO NOTHING
	BR	17$		;IF NO, PUT OUT A BRANCH
 
16$:	CALL	CONZER		;IS IT CONSTANT ZERO
	BCS	18$		;IF NO, DO NOTHING
17$:	MOV	R3,R0		;PUT OUT
	CALL	BRANCH		;THE BRANCH
18$:	JMP	100$		;DONE
 
;
; SEQUENTIAL EXECUTION
; JUST COMPILE THE LEFT SUBTREE FOR EFFECT, THEN DO THE JUMP
; ON THE RIGHT SUBTREE
;
 
20$:	CMP	R2,#OP.SEQ	;SEQUENTIAL EXECUTION
	BNE	30$		;NO
 
	MOV	E.LOP(R5),R5	;COMPILE THE LEFT
	MOV	#ETAB,R3	;SUBTREE
	CALL	CEXPR		;FOR EFFECT
 
	MOV	ATREE(SP),R5	;THEN CALL
	MOV	E.ROP(R5),R5	;JUMPC
	MOV	R5,ATREE(SP)	;ON THE
	MOV	ALABEL(SP),R3	;RIGHT
	BR	10$		;SUBTREE
 
;
; LOGICAL AND
;
 
30$:	CMP	R2,#OP.AA	;LOGICAL AND
	BNE	40$		;NO
	TST	SEX(SP)		;TEST THE SEX
	BEQ	35$		;BR IF JUMP FALSE
 
	CALL	GENLAB		;JUMP TRUE, BOTH THE
	MOV	R0,LAB(SP)	;TREES MUST BE TRUE
	MOV	R0,R3		;BRANCH ON
	MOV	E.LOP(R5),R5	;FALSE
	CALL	JFALSE		;TO SKIP LABEL
	MOV	ALABEL(SP),R3	;THEN
	MOV	ATREE(SP),R5	;ON TRUE
	MOV	E.ROP(R5),R5	;TO THE
	CALL	JTRUE		;GOAL LABEL
	MOV	LAB(SP),R0	;OUTPUT THE
	CALL	LABEL		;SKIP LABEL
	JMP	100$		;DONE
 
35$:	MOV	E.LOP(R5),R5	;JUMP FALSE
	CALL	JFALSE		;IS JUST
	MOV	ATREE(SP),R5	;TWO
	MOV	E.ROP(R5),R5	;JUMP
	CALL	JFALSE		;FALSES
	JMP	100$		;DONE
 
;
; LOGICAL OR
;
 
40$:	CMP	R2,#OP.OO	;LOGICAL OR
	BNE	50$		;NO
	TST	SEX(SP)		;TEST THE SEX
	BEQ	45$		;BR ON JUMP FALSE
 
	MOV	E.LOP(R5),R5	;JUMP TRUE
	CALL	JTRUE		;IS
	MOV	ATREE(SP),R5	;JUST
	MOV	E.ROP(R5),R5	;TWO
	CALL	JTRUE		;JUMP
	JMP	100$		;TRUES
 
45$:	CALL	GENLAB		;JUMP FALSE, BOTH MUST BE FALSE
	MOV	R0,LAB(SP)	;JUMP TRUE
	MOV	R0,R3		;TO
	MOV	E.LOP(R5),R5	;SKIP
	CALL	JTRUE		;LABEL
	MOV	ALABEL(SP),R3	;JUMP FALSE
	MOV	ATREE(SP),R5	;TO
	MOV	E.ROP(R5),R5	;GOAL
	CALL	JFALSE		;LABEL
	MOV	LAB(SP),R0	;THEN OUTPUT THE
	CALL	LABEL		;SKIP
	JMP	100$		;LABEL
 
;
; ORDINARY CASES
; LONGS HAVE STRANGE REQUIREMENTS,  AND HAVE THEIR OWN ROUTINE
; A LOT OF THE TROUBLE COMES FROM COMPENSATING THAT ALL PDP-11
; INSTRUCTIONS DO NOT SET THE C AND V BITS CORRECTLY.
;
 
50$:	MOV	R2,R1		;GET
	ASL	R1		;OPERATOR
	MOV	OPDOPE(R1),R1	;DOPE
 
	CMPB	E.TYPE(R5),#TY.LNG ;A LONG IS EITHER
	BEQ	55$		;A TREE WITH A LONG VALUE
	BIT	#RELOP,R1	;OR A RELATIONAL
	BEQ	60$		;THAT
	MOV	E.LOP(R5),R0	;HAS
	CMPB	E.TYPE(R0),#TY.LNG ;LONG
	BNE	60$		;OPERANDS
55$:	CALL	LRELOP		;USE SPECIAL LONG ROUTINE
	JMP	100$		;
 
60$:	MOV	#OP.NE,BROP(SP)	;DEFAULT BRANCH
	BIT	#RELOP,R1	;RELATION?
	BEQ	70$		;NO
	MOV	R2,BROP(SP)	;YES, RESET THE OPERATION
	CMP	R2,#OP.LE	;IF LE OR GT DO NOT DELETE
	BEQ	70$		;CONSTANT ZEROS
	CMP	R2,#OP.GT	;THESE RELATIONS REQUIRE
	BEQ	70$		;FULL CONDITION CODES
	MOV	E.ROP(R5),R1	;GET RIGHT SUBTREE
	CALL	CONZER		;CONSTANT ZERO PERHAPS
	BCS	65$		;NO
	MOV	E.LOP(R5),R5	;DELETE
	BR	70$		;IT
65$:	MOV	E.LOP(R5),R1	;GET LEFT SUBTREE
	CALL	CONZER		;CONSTANT ZERO PERHAPS
	BCS	70$		;NO
	MOV	E.ROP(R5),R5	;DELETE
	SUB	#OP.EQ,R2	;BUT
	ASL	R2		;REVERSE
	MOV	FLIP(R2),BROP(SP) ;THE CONDITION
 
70$:	CMP	(R5),#OP.CVR	;IF A CONVERT TO REGISTER
	BNE	71$		;JUST
	MOV	E.LOP(R5),R5	;DISCARD IT
 
71$:	TST	SEX(SP)		;WHAT SEX OF BRANCH IS THIS
	BNE	75$		;BR IF JUMP TRUE
	MOV	BROP(SP),R0	;SPIN THE
	SUB	#OP.EQ,R0	;BRANCH
	ASL	R0		;CONDITION
	MOV	OTHER(R0),BROP(SP) ;AROUND
 
75$:	MOV	#CTAB,R3	;SET THE
	CALL	CEXPR		;CONDITION CODES
 
	ADD	#'0,R0		;SETUP THE
	MOVB	R0,TST+6	;ASCII
	MOVB	R0,TSTD+7	;CODE
	MOVB	R0,CMP0+6	;STRINGS
 
	MOV	BROP(SP),R1	;GET THE
	ASL	R1		;BRANCH CONDITION
 
;
; THIS CODE NEEDS WORK.
; WHO KNOWS HOW FLOATING POINT TREES WILL SET THE CODES.
; SOMEDAY I WILL.
; UNTIL THEN, CAVEAT.
;
 
	CMPB	E.TYPE(R5),#TY.LNG ;IS THIS A FLOATING POINT
	BHI	76$		;TREE
	MOV	E.LOP(R5),R0
	CMPB	E.TYPE(R0),#TY.LNG
	BLOS	80$		;NO
76$:	CMP	(R5),#OP.JSR	;ONLY THE CALL HAS BAD
	BNE	77$		;CODES
	MOV	#TSTD,R0
	CALL	CODSTR
77$:	MOV	#CFCC,R0	;COPY THE CODES
	CALL	CODSTR
	BR	95$		;AND GO USE THE FULL TABLE
 
80$:	MOV	(R5),R0		;GET THE CC STATUS OF
	ASL	R0		;THE TOP OF
	MOV	OPDOPE(R0),R0	;THE TREE
	BIT	#OKCC,R0	;IF THE CC IS OK (NZVC)
	BNE	95$		;GO USE THE FULL TABLE
	TST	OP1(R1)		;IS THERE AN EASY COMPARE
	BEQ	90$		;NO
	BIT	#OKNZ,R0	;DO WE HAVE NZ SETUP
	BNE	85$		;YES
	MOV	#TST,R0		;NO, PUT OUT
	CALL	CODSTR		;A TST
85$:	MOV	#OP1,R1		;USE SHORT TABLE
	BR	99$		;
 
90$:	MOV	#CMP0,R0	;BAD CASE, NEED A CMP TO $0
	CALL	CODSTR		;SNIFFLE
95$:	MOV	#OP0,R1		;USE FULL TABLE
 
99$:	MOV	ALABEL(SP),R0	;GET LABEL
	MOV	BROP(SP),R2	;GET CONDITION
	CALL	CBRNCH		;PUT OUT CONDITIONAL BRANCH
 
100$:	ADD	#4,SP		;LOCALS
	MOV	(SP)+,R0	;RETURN
	MOV	(SP)+,R1
	MOV	(SP)+,R2
	MOV	(SP)+,R3
	MOV	(SP)+,R4
	MOV	(SP)+,R5
	TST	(SP)+		;THE FLAG
	RETURN

;+
; ** LRELOP - LONG RELATIONS
;
; SPECIAL VERSION OF JUMPC FOR LONGS.
;
; INPUTS:
;	R1=OPDOPE
;	R5=TREE
;-

LRELOP:	MOV	#OP.NE,BROP+2(SP) ;SET DEFAULT RELATION
	BIT	#RELOP,R1	;IS IT A RELATION
	BEQ	40$		;NO

	MOV	(R5),BROP+2(SP)	;SAVE THE ACTUAL RELATION
	MOV	E.ROP(R5),R1	;ZERO ON RIGHT?
	CALL	CONZER		;
	BCS	10$		;NO
	MOV	E.LOP(R5),R5	;JUST USE THE LEFT
	BR	40$		;

10$:	MOV	E.LOP(R5),R1	;ZERO ON LEFT?
	CALL	CONZER		;
	BCS	20$		;NO
	MOV	E.ROP(R5),R5	;JUST USE THE RIGHT
	MOV	BROP+2(SP),R0	;BUT FIX THE RELATION
	SUB	#OP.EQ,R0	;
	ASL	R0		;
	MOV	FLIP(R0),BROP+2(SP) ;
	BR	40$		;

20$:	MOV	E.LOP(R5),R5	;SEE IF BOTH SIDES ARE ADDRESSABLE
	CALL	HASADR		;WELL
	BCS	30$		;THE LEFT ISN'T
	MOV	ATREE+2(SP),R5	;TRY THE RIGHT
	MOV	E.ROP(R5),R5	;
	CALL	HASADR		;

30$:	MOV	ATREE+2(SP),R5	;GET THE TREE BACK (PRESERVES C BIT)
	BCC	40$		;BOTH ARE ADDRESSABLE
	MOV	#OP.SUB,(R5)	;CONVERT TO A SUBTRACTION
	MOVB	#TY.LNG,E.TYPE(R5) ;WITH LONG RESULT
	CALL	SETHI		;FIX REGISTER WEIGHTS

;
; CORRECT SEX OF BRANCH.
;

40$:	MOV	R5,ATREE+2(SP)	;SAVE (NEW?) TREE

	TST	SEX+2(SP)	;JUMP TRUE?
	BNE	50$		;YES
	MOV	BROP+2(SP),R0	;SPIN THE RELATION AROUND
	SUB	#OP.EQ,R0	;
	ASL	R0		;
	MOV	OTHER(R0),BROP+2(SP) ;

;
; IF STILL A RELATIONAL L AND R HAVE ADDRESSES.
; USE 2 COMPARES.
;

50$:	MOV	(R5),R0		;STILL A RELATION?
	ASL	R0		;
	MOV	OPDOPE(R0),R0	;
	BIT	#RELOP,R0	;
	BEQ	70$		;BR IF NOT

	CALL	GENLAB		;GENERATE NO LABEL
	MOV	R0,-(SP)	;

	MOV	BROP+4(SP),R3	;GET POINTER TO TABLE
	SUB	#OP.EQ,R3	;
	ASL	R3		;6 BYTE ENTRIES
	MOV	R3,-(SP)	;
	ASL	R3		;
	ADD	(SP)+,R3	;
	ADD	#LRTAB,R3	;

	MOV	#CMP,R0		;FIRST COMPARE
	CALL	CODSTR		;
	MOV	E.LOP(R5),R5	;L
	CLR	R4		;
	CALL	ADDRES		;
	MOV	#',,R0		;
	CALL	CODC		;
	MOV	ATREE+4(SP),R5	;R
	MOV	E.ROP(R5),R5	;
	CALL	ADDRES		;
	CALL	CODNL		;

	MOV	(R3)+,R2	;OPTIONAL "NO" BRANCH
	BEQ	55$		;
	MOV	(SP),R0		;
	MOV	#OP0,R1		;
	CALL	CBRNCH		;

55$:	MOV	(R3)+,R2	;OPTIONAL "YES" BRANCH
	BEQ	60$		;
	MOV	ALABEL+4(SP),R0	;
	MOV	#OP0,R1		;
	CALL	CBRNCH		;

60$:	CALL	PFLUSH		;FORCE BRANCHES OUT
	MOV	#CMP,R0		;SECOND COMPARE
	CALL	CODSTR		;
	MOV	ATREE+4(SP),R5	;L+2
	MOV	E.LOP(R5),R5	;
	MOV	#-1,R4		;
	CALL	ADDRES		;
	MOV	#',,R0		;
	CALL	CODC		;
	MOV	ATREE+4(SP),R5	;R+2
	MOV	E.ROP(R5),R5	;
	MOV	#-1,R4		;
	CALL	ADDRES		;
	CALL	CODNL		;

	MOV	ALABEL+4(SP),R0	;FINAL "YES" BRANCH
	MOV	#OP0,R1		;
	MOV	(R3),R2		;
	CALL	CBRNCH		;

	MOV	(SP)+,R0	;NO LABEL
	CALL	LABEL		;
	BR	190$		;

;
; NOT A RELATIONAL.
;

70$:	MOV	BROP+2(SP),R0	;TEST FOR HARD CONDITIONS
	CMP	R0,#OP.LE	;<= IS HARD
	BEQ	90$		;
	CMP	R0,#OP.GT	;>  IS HARD
	BEQ	90$		;

	CALL	HASADR		;EASY, IS IT ADDRESSABLE
	BCS	90$		;NO

;
; ADDRESSABLE LONG.
;

	MOV	BROP+2(SP),R0	;GET BRANCH RELATION
	CMP	R0,#OP.LT	;<
	BEQ	80$		;YES
	CMP	R0,#OP.GE	;>=
	BEQ	80$		;YES

	MOV	#MOV,R0		;MOV U,R0
	CALL	CODSTR		;
	CLR	R4		;
	CALL	ADDRES		;
	CALL	210$		;,R0
	MOV	#BIS,R0		;BIS L,R0
	CALL	CODSTR		;
	MOV	#-1,R4		;
	CALL	ADDRES		;
	CALL	210$		;,R0
	BR	170$		;BR VIA OP1

80$:	MOV	#TST1,R0	;TST U
	CALL	CODSTR		;
	CLR	R4		;
	CALL	ADDRES		;
	CALL	CODNL		;
	BR	170$		;BR VIA OP1

;
; NOT ADDRESSABLE.
;

90$:	CLR	R4		;R0
	MOV	#RTAB,R3	;
	CALL	CEXPR		;
	TST	R0		;SHOULD BE R0
	BNE	200$		;ARGH!

;
; <= AND > NEED FULL CODES.
; ASHC $0,R0 IF EISBOX.
; ELSE MAP A>0 TO A-1>=0; A<=0 TO A-1<0 AND USE BPL OR BMI.
;

	MOV	BROP+2(SP),R0	;OP
	CMP	R0,#OP.LE	;<=
	BEQ	100$		;YES
	CMP	R0,#OP.GT	;>
	BNE	130$		;NO

100$:	TST	EIS		;HAVE EIS
	BEQ	110$		;NO
	MOV	#ASHC0,R0	;ASHC $0,R0
	CALL	CODSTR		;
	MOV	#OP0,R1		;GENERATE BRANCH VIA OP0
	BR	180$		;

110$:	MOV	#DEC1,R0	;SUB $1,R1 SBC R0
	CALL	CODSTR		;
	CMP	BROP+2(SP),#OP.GT ;FIX RELATION
	BNE	120$		;
	MOV	#OP.GE,BROP+2(SP) ;
	BR	170$		;

120$:	MOV	#OP.LT,BROP+2(SP) ;
	BR	170$		;

;
; FOR >= AND < USE TST R0.
; FOR == AND != USE BIS R1,R0.
;

130$:	CMP	R0,#OP.GE	;>=
	BEQ	140$		;YES
	CMP	R0,#OP.LT	;<
	BNE	150$		;NO

140$:	MOV	#TST0,R0	;TST R0
	CALL	CODSTR		;
	BR	170$		;

150$:	MOV	#BIS10,R0	;BIS R1,R0
	CALL	CODSTR		;

;
; DO THE BRANCH.
; ENTRY AT 170$ FOR OP1 TABLE.
; ENTRY AT 180$ FOR TABLE POINTER IN R1.
;

170$:	MOV	#OP1,R1		;GET TABLE
180$:	MOV	ALABEL+2(SP),R0	;LABEL
	MOV	BROP+2(SP),R2	;OP
	CALL	CBRNCH		;PUT IT OUT

190$:	RETURN			;DONE

200$:	MOV	#ERR06,R0	;NOT R0 FROM CEXPR
	JMP	CCABRT		;

;
; PUT OUT ",R0<NL>".
;

210$:	MOV	#CR0NL,R0	;EASY
	CALLR	CODSTR		;

;
; LONG RELATION TABLE.
;

LRTAB:	.WORD	OP.NE		;OP.EQ
	.WORD	0		;
	.WORD	OP.EQ		;

	.WORD	0		;OP.NE
	.WORD	OP.NE		;
	.WORD	OP.NE		;

	.WORD	OP.GT		;OP.LT
	.WORD	OP.LT		;
	.WORD	OP.LTU		;

	.WORD	OP.GT		;OP.LE
	.WORD	OP.LT		;
	.WORD	OP.LEU		;

	.WORD	OP.LT		;OP.GE
	.WORD	OP.GT		;
	.WORD	OP.GEU		;

	.WORD	OP.LT		;OP.GT
	.WORD	OP.GT		;
	.WORD	OP.GTU		;

;+
; ** POP - POP THE STACK
;
; GENERATE CODE TO POP THE SYSTEM STACK. USED TO COMPILE CODE TO MAKE
; FUNCTION ARGUMENTS GO AWAY.
;
; INPUTS:
;	R0=NUMBER OF BYTES TO POP
;-
 
POP:	TST	R0		;DO NOTHING IF ZERO BYTES
	BEQ	40$		;
 
	CMP	R0,#2		;2 BYTES, TST (SP)+
	BNE	10$		;
	MOV	#POPS01,R0	;
	BR	30$		;
 
10$:	CMP	R0,#4		;4 BYTES, CMP (SP)+,(SP)+
	BNE	20$		;
	MOV	#POPS02,R0	;
	BR	30$		;
 
20$:	MOV	R0,-(SP)	;MUST USE ADD INSTRUCTION
	MOV	#POPS03,R0	;ADD $
	CALL	CODSTR		;
	MOV	(SP)+,R0	;BYTES TO POP
	CALL	CODNUM		;
	MOV	#POPS04,R0	;,SP
30$:	CALL	CODSTR		;
 
40$:	RETURN			;
 
;+
; ** DOARGS - PUSH ARGUMENTS ONTO THE STACK
;
; GIVEN THE ARGUMENT LIST OF A FUNCTION, THIS ROUTINE ARRANGES
; TO PUSH THE ARGUMENTS (IN RIGHT TO LEFT ORDER) ON THE STACK.
; IT DOES THIS BY CALLING CEXPR WITH THE STAB.
;
; THE NUMBER OF BYTES PUSHED IS RETURNED, FOR FUTURE POPPING.
;
; INPUTS:
;	R5=ARG LIST TREE
;	R4=REG FOR THE CALL TO CEXPR
;
; OUTPUTS:
;	R0=NUMBER OF BYTES OF ARGS.
;	R1=NUMBER OF ARGS
;-
 
DOARGS:	MOV	R3,-(SP)	;SAVE REG. (TABLE)
	TST	R5		;NO NOTHING IF NULL LIST
	BNE	10$		;NOT NULL
	CLR	R0		;NOTHING PUSHED
	CLR	R1		;
	BR	70$		;
 
10$:	CMP	(R5),#OP.CMA	;CHECK FOR BOTH TYPES OF ','
	BEQ	20$		;
	CMP	(R5),#OP.SEQ	;BECAUSE SOMETIMES WE GET
	BNE	30$		;AN SEQ HERE
 
20$:	MOV	R5,-(SP)	;CALL YOURSELF ON THE RIGHT.
	MOV	E.ROP(R5),R5	;
	CALL	DOARGS		;
	MOV	(SP)+,R5	;THEN PUSH THE LEFT
	MOV	E.LOP(R5),R5	;
	MOV	R0,-(SP)	;NBYTES
	MOV	R1,-(SP)	;NARGS
	BR	40$		;
 
30$:	CLR	-(SP)		;A LEAF, START COUNTING BYTES
	CLR	-(SP)		;AND ARGS
 
40$:	MOV	#STAB,R3	;PUSH ARGUMENT
	TST	NSTACK		;USE TTAB IF NSTACK=0 AND WORD
	BNE	45$		;
	CMPB	E.TYPE(R5),#TY.LNG ;
	BHIS	45$		;
	MOV	#TTAB,R3	;
45$:	CALL	CEXPR		;
 
;
; ADJUST NUMBER OF BYTES OF ARGUMENTS.
; INTS ARE 2.
; LONGS ARE 4.
; DOUBLES ARE 8.
;
 
	MOV	(SP)+,R1	;NARGS
	INC	R1		;
	MOV	(SP)+,R0	;NBYTES OF ARGS.
	CMP	R3,#TTAB	;IF TTAB
	BEQ	70$		;DONE
	CMPB	E.TYPE(R5),#TY.LNG ;IS THIS A LONG
	BLO	60$		;WORDS, 2 BYTES EACH
	BEQ	50$		;LONGS, 4 BYTES EACH
	ADD	#4,R0		;FLOATING POINT, 8 BYTES EACH
50$:	ADD	#2,R0		;
60$:	ADD	#2,R0		;
 
70$:	MOV	(SP)+,R3	;RETURN
	RETURN			;
 
;+
; ** MOVREG - REGISTER TO REGISTER MOVEMENT
;
; MOVE THE CONTENTS OF R(R0) TO R(R1). THE TYPE OF THE OPERANDS
; IS SPECIFIED BY R2.
;
; USES:
;	R0, R1
;-
 
MOVREG:	CMP	R2,#TY.LNG	;MOVING A FLOAT
	BLOS	10$		;NO
	MOV	#ERR04,R0	;YES, ABORT NON EIS COMPILER
	JMP	CCABRT		;
 
10$:	ADD	#'0,R0		;MAKE REGISTER NUMBERS
	ADD	#'0,R1		;
	MOVB	R0,MVRS02+6	;STUFF MOV INSTRUCTIONS
	MOVB	R1,MVRS02+11	;
	MOV	#MVRS02,R0	;GET POINTER TO THE MOV
 
	CMP	R2,#TY.LNG	;LONGS NEED 2 MOVES
	BNE	30$		;NOT A LONG
	CALL	CODSTR		;MOV R(R0),R(R1)
	INCB	MVRS02+6	;WITH REG+1
	INCB	MVRS02+11	;
 
30$:	CALLR	CODSTR		;MOV
 
;+
; ** GETREG - GET A REGISTER
;
; USING INFORMATION IN HFPRA AND HGPRA,  ALLOCATE A REGISTER OF
; THE CORRECT TYPE TO HOLD THE RESULT OF THE SPECIFIED TREE. NO
; CHECKING FOR REGISTER OVERFLOW IS PERFORMED AS THIS WILL HAVE
; BEEN CHECKED EARLIER BY MATCH
;
; INPUTS:
;	R5=TREE
;
; OUTPUTS:
;	R4=REGISTER
;-
 
GETREG:	MOV	#1,R4		;TEST IF THE TREE HAS TOP LEVEL '*'
	CMP	(R5),#OP.IND	;SUCH TREES NEED 1 REGISTER
	BEQ	10$		;
 
	CMPB	E.TYPE(R5),#OP.LNG ;IS THE TREE FLOATING POINT
	BHI	20$		;YES, ABORT
 
	CALL	NPAIR		;NEED A PAIR
	BCS	10$		;NO
	INC	R4		;NEED 2 REGISTERS
 
10$:	SUB	R4,HGPRA	;GET REGISTER
	MOV	HGPRA,R4	;
	INC	R4		;FIX REGISTER NUMBER
	RETURN			;
 
20$:	MOV	#ERR01,R0	;GO AWAY
	JMP	CCABRT		;
 
;+
; ** INDEX -- EXPLOIT MODE 6 ADDRESSING.
;
; THIS ROUTINE EXAMINES A TREE TO SEE IF MODE 6 ADDRESSING IS USABLE.
; IF IT IS IT GENERATES THE CODE TO LOAD UP THE INDEX REGISTER   AND
; RETURNS A POINTER TO AN INDEX NODE. THE C BIT IS CLEAR. IF MODE  6
; ADDRESSING IS NOT USABLE IT DOES NOTHING, AND RETURNS WITH   CARRY
; SET.
;
; INPUTS:
;	R5=TREE.
;	R4=REGISTER (-1 MEANS ANY)
;
; OUTPUTS:
;	R5=TREE (MAY BE MODIFIED)
;-

INDEX:	MOV	R5,-(SP)	;SAVE TREE

	MOV	R4,-(SP)	;SAVE REGISTER
	BPL	10$		;SET R0 IF ANY REGISTER
	CLR	R4		;

10$:	MOV	R3,-(SP)	;SAVE THE REST OF THE REGISTERS
	MOV	R2,-(SP)	;
	MOV	R1,-(SP)	;
	MOV	R0,-(SP)	;

	CMP	(R5),#OP.IND	;IS THE TOP OF THE TREE A "*"
	BNE	50$		;NO, GIVE UP
	MOV	E.LOP(R5),R5	;GET SUBTREE
	CMP	(R5),#OP.ADD	;IS IT "+"
	BNE	50$		;NO, GIVE UP

	MOV	E.LOP(R5),R0	;SEE IF LEFT IS A CONSTANT
	CMP	(R0),#OP.CON	;
	BNE	20$		;NO
	MOV	E.ROP(R5),R5	;GET OTHER TREE
	BR	30$		;

20$:	MOV	E.ROP(R5),R0	;SEE IF RIGHT IS A CONSTANT
	CMP	(R0),#OP.CON	;
	BNE	50$		;NO, GIVE UP
	MOV	E.LOP(R5),R5	;GET OTHER TREE

;
; MAKE INDEX NODE.
;

30$:	MOV	E.VAL(R0),-(SP)	;SAVE INDEX CONSTANT

	MOV	#RTAB,R3	;LOAD INDEX VALUE
	CALL	CEXPR		;

	TST	10+2(SP)	;ANY REGISTER
	BMI	40$		;YES
	CMP	R0,R4		;NO, IS IT THE RIGHT REGISTER
	BEQ	40$		;YES
	MOV	R4,R1		;MOVE THE RESULT
	MOV	#TY.INT,R2	;1 WORD MOVE
	CALL	MOVREG		;
	MOV	R4,R0		;RESULT HERE

40$:	MOV	#ES.REG,R4	;GET A TREE NODE
	CALL	TREESP		;
	MOV	#OP.INX,(R4)	;E.OP
	MOV	(SP)+,E.OFFS(R4);OFFSET
	MOV	12(SP),R5	;SET TYPE FROM TREE
	MOVB	E.TYPE(R5),E.TYPE(R4) ;
	MOV	R0,E.REG(R4)	;BASE REGISTER
	MOV	R4,12(SP)	;SET RETURN VALUE

	CLC			;OK
	BR	60$		;

50$:	SEC			;NO INDEX.

60$:	MOV	(SP)+,R0	;RETURN
	MOV	(SP)+,R1	;
	MOV	(SP)+,R2	;
	MOV	(SP)+,R3	;
	MOV	(SP)+,R4	;
	MOV	(SP)+,R5	;
	RETURN			;

;+
; ** SETUP -- SETUP TREE NODES.
;
; THIS ROUTINE MAKES A TREE USABLE IN THE ADDRESS PART OF AN INSTRUCTION.
; IT RETURNS A POINTER TO A NEW, ADDRESSABLE, TREE.
;
; INPUTS:
;	R5=TREE
;	R4=REGISTER (-1 MEANS ANY)
;	R3=FLAG (0=VALUE 1=ADDRESS)
;
; OUTPUTS:
;	R5=ADDRESSABLE TREE.
;-

SETUP:	MOV	R5,-(SP)	;SAVE THE WORLD
	MOV	R4,-(SP)	;
	MOV	R3,-(SP)	;
	MOV	R2,-(SP)	;
	MOV	R1,-(SP)	;
	MOV	R0,-(SP)	;

;
; DUCK IF ADDRESSABLE.
; INDEXING.
;

	CALL	HASADR		;ADDRESSABLE?
	BCC	70$		;YES

	CALL	INDEX		;INDEXABLE?
	BCS	10$		;NO
	MOV	R5,12(SP)	;RESET R5
	BR	70$		;

;
; TREE WITH A "*" ON TOP.
;

10$:	CMP	(R5),#OP.IND	;"*"
	BNE	40$		;NO
	TST	R4		;ANY REGISTER
	BMI	20$		;YES
	MOVB	E.TYPE(R5),R0	;NO, FLOATING POINT TREE
	CMP	R0,#TY.LNG	;
	BLOS	30$		;NO
20$:	CLR	R4		;YES, USE R0
30$:	MOV	E.LOP(R5),R5	;GET LEFT SUBTREE OF "*"
	CALL	80$		;LOAD IT UP
	MOV	12(SP),R5	;STORE POINTER IN LOP OF "*"
	MOV	R1,E.LOP(R5)	;
	BR	70$		;DONE

;
; ORDINARY.
; PANIC IF ADDRESS IS DESIRED.
;

40$:	TST	6(SP)		;ADDRESS DESIRED
	BEQ	50$		;NO
	MOV	#ERR02,R0	;PANIC
	JMP	CCABRT		;

50$:	TST	R4		;DEFAULT TO R0
	BPL	60$		;
	CLR	R4		;R0
60$:	CALL	80$		;LOAD IT UP
	MOV	R1,12(SP)	;RESET R5

70$:	MOV	(SP)+,R0	;RETURN
	MOV	(SP)+,R1	;
	MOV	(SP)+,R2	;
	MOV	(SP)+,R3	;
	MOV	(SP)+,R4	;
	MOV	(SP)+,R5	;
	RETURN			;

;
; LOCAL ROUTINE TO LOAD A TREE AND
; GET REGISTER DESCRIPTOR ADDRESS.
;

80$:	MOV	#RTAB,R3	;GET RIGHT TABLE
	CALL	CEXPR		;DO IT

	TST	10+2(SP)	;DO WE CARE
	BMI	90$		;NO
	CMP	R0,R4		;IS IT RIGHT
	BEQ	90$		;YES
	MOV	R4,R1		;MOVE IT
	MOV	12+2(SP),R5	;GET TYPE
	MOVB	E.TYPE(R5),R2	;
	CALL	MOVREG		;
	MOV	R4,R0		;

90$:	MOV	R0,R1		;GET OFFSET INTO RDESCR
	MOV	#ES.REG,-(SP)	;* SIZEOF(RDESCR)
	CALL	$MULR1		;
	TST	(SP)+		;
	ADD	#RDESCR,R1	;GET ADDRESS
	RETURN			;

;+
; ** AS2REG - REGISTER ASSIGNMENT SPECIAL CHECK
;
; THIS ROUTINE IS CALLED FROM INSIDE "CEXPR". IF SPECIFIED TREE IS ANY
; SORT OF ASSIGNMENT INTO A REGISTER VARIABLE, DO THE ASSIGNMENT USING
; THE "ETAB" AND RETURN A REGISTER TREE NODE (FROM "RDESCR").
;
; INPUTS:
;	R0=TREE
;	R4=REGISTER FOR CEXPR CALL
;
; OUTPUTS:
;	R0=NEW TREE (IF C=0), ELSE R0=JUNK
;-

AS2REG:	MOV	R5,-(SP)	;SAVE WORLD
	MOV	R4,-(SP)	;
	MOV	R3,-(SP)	;
	MOV	R2,-(SP)	;
	MOV	R1,-(SP)	;

	MOV	(R0),R1		;PICK UP OP.
	CMP	R1,#OP.ASG	;ASSIGNMENT?
	BEQ	10$		;YES
	CMP	R1,#OP.ADA	;NO, IS IT ONE OF THE
	BLO	20$		;MORE COMPLEX
	CMP	R1,#OP.XRA	;ASSIGNMENT
	BHI	20$		;OPS

10$:	MOV	R0,R5		;SAVE ASSIGNMENT TREE
	MOV	E.LOP(R5),R0	;GET DEST OF ASSIGNMENT
	CMP	(R0),#OP.REG	;REGISTER?
	BNE	20$		;NO

	MOV	E.REG(R0),R1	;SAVE REGISTER NUMBER
	MOV	#ETAB,R3	;COMPILE IT IN THE ETAB
	CALL	CEXPR		;
	MOV	#ES.REG,-(SP)	;GET REGISTER DESCRIPTOR PTR
	CALL	$MULR1		;
	TST	(SP)+		;
	ADD	#RDESCR,R1	;
	MOV	R1,R0		;
	CLC			;GOOD
	BR	30$		;

20$:	SEC			;BAD

30$:	MOV	(SP)+,R1	;RETURN
	MOV	(SP)+,R2	;
	MOV	(SP)+,R3	;
	MOV	(SP)+,R4	;
	MOV	(SP)+,R5	;
	RETURN			;

	.END