.TITLE	CC202
	.IDENT	/X01/
 
	.NLIST	BEX
	.ENABL	LC
 
;
; C COMPILER
; CODER, PART I (NON EIS)
;
; VERSION X01
;
; DAVID G. CONROY	29-AUG-78
; LAST UPDATED:		20-JUN-79
;			MATCH OF CVR, CVM AND IND MUST LOAD R0 WITH A FAKE
;			VALUE WHEN CALLING CLASFY
;
 
	.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	CALLR
 
;
; 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		;
 
AMONE:	.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"
ERR07:	.ASCIZ	"Degenerate unsigned/pointer relation"
 
;
; 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"
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
	CALL	TDUMP		;DUMP TREE
	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
	CALL	TDUMP		;DUMP TREE
	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
	CALL	TDUMP		;DUMP TREE
	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
 
;
; 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
 
;
; QUERY.
; 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$		;
 
;
; NEED VALUE OF LOGICAL.
; LOAD 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$		;
 
;
; OPTIMISE SXT FOR INT CON. TO LONG.
; ONLY IF NON EIS.
;

50$:	TST	EIS		;HAVE EIS
	BNE	55$		;YES, FORGET THIS
	CMP	R0,#OP.CVR	;IS THIS A CONVERSION
	BNE	55$		;NO
	CMPB	E.TYPE(R5),#TY.LNG ;IS THE RESULT A LONG
	BNE	55$		;NO
	MOV	E.LOP(R5),R1	;GRAB WHAT WE ARE CONVERTING
	CMP	(R1),#OP.CON	;CONSTANT
	BNE	55$		;NO
	CMPB	E.TYPE(R1),#TY.INT ;INTEGER CONSTANT
	BNE	55$		;NO

	CMP	R3,#RTAB	;REGISTER TABLE
	BNE	53$		;NO
	MOV	R1,R5		;LOAD INT INTO ODD REGISTER
	INC	R4		;
	CALL	CEXPR		;
	DEC	R4		;RESTORE REGISTER AND
	BR	54$		;GO EXTEND

53$:	CMP	R3,#STAB	;NOT RTAB, IS IT STAB
	BNE	55$		;NO
	MOV	R1,R5		;COMPILE TO STACK
	CALL	CEXPR		;

54$:	TST	E.VAL(R1)	;TEST THE SIGN OF THE INT
	BMI	540$		;IS NEG.
	MOV	#AZERO,R5	;POSITIVE, EXTEND WITH 0
	BR	542$		;
540$:	MOV	#AMONE,R5	;NEG., EXTEND WITH -1
542$:	CALL	CEXPR		;DO IT
	MOV	AREG(SP),R0	;RESULT IS WHERE WE WANT IT
	JMP	195$		;

;
; CALL.
;
 
55$:	CLR	WTABF(SP)	;RESET WRONG TABLE FLAG
	CMP	R0,#OP.JSR	;CALL
	BNE	5510$		;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	;CALL
	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	5500$		;
	INC	WTABF(SP)	;WE USED THE WRONG TABLE
5500$:	JMP	100$		;DONE
 
;
; BIC FOR CONDITION CODES ONLY.
; TRANSFORM INTO BIT.
;
 
5510$:	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	;

;
; ADDRESSABLES.
; ADD AN OP.LOD TO THE TOP.
; THIS ALLOWS 1 TABLE ENTRY TO HANDLE ALL OF THEM.
;

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	;
	MOV	#-2,R4		;CALL GETREG FOR 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	;
	MOV	#-2,R4		;CALL GETREG FOR 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	;
	MOV	#-2,R4		;CALL GETREG FOR 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	;
	MOV	#-2,R4		;CALL GETREG FOR 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.
; CONVERSIONS ON THE TOPS OF THE SUBTREES ARE INVISABLE TO MATCH. THIS
; IS SO SPECIAL TABLE ENTRIES FOR MIXED TYPE OPERATIONS (ASSIGNING INT
; TO LONG, FOR EXAMPLE) WORK. ANY CVR THAT IS A SHRINK IS NOT  SUBJECT
; TO THIS (MAINLY FOR LONG TO INT IN LONG TO POINTER CONTEXTS).
;
; 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)	;
 
;
; CONVERSIONS.
;
 
	MOV	E.LOP(R5),R0	;GET LEFT SUBTREE
	CALL	ISCONV		;IS THIS A CONVERSION
	BCS	3$		;NO
	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$		;UNARY
	CALL	ISCONV		;IS IT A CONVERSION
	BCS	10$		;NO
	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$:	MOV	#AZERO,R0	;SET LEFT ON THE RESULT
	CALL	CLASFY		;
	MOVB	R0,LKIND	;
	MOVB	E.TYPE(R5),LTYPE;
	MOV	E.LOP(R5),R5	;SET RIGHT ON THE SOURCE
	MOV	#AZERO,R0	;
	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

;+
; ** ISCONV -- CHECK FOR CONVERSIONS.
;
; GIVEN A TREE, TEST IF IT IS A CONVERSION THAT MAY BE DELETED BY THE
; MATCH.
;
; INPUTS:
;	R0=TREE.
;
; OUTPUTS:
;	C=0 IF DELETABLE.
;-

ISCONV:	MOV	R1,-(SP)	;SAVE R1
	CMP	(R0),#OP.CVM	;IS THIS A CONVERT TO STORE
	BEQ	20$		;YES, ALWAYS GOOD
	CMP	(R0),#OP.CVR	;CONVERT TO REGISTER
	BNE	10$		;NO
	MOV	E.LOP(R0),R1	;YES, GET SUBTREE
	CMPB	E.TYPE(R0),E.TYPE(R1) ;ARE WE SHRINKING
	BHIS	20$		;NO, OK
10$:	SEC			;NOT DELETABLE
	BR	30$		;
20$:	CLC			;DELETABLE
30$:	MOV	(SP)+,R1	;RETURN
	RETURN			;
	.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
OLAB	=	2		;OTHER LABEL (SHARES SPACE)
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
 
;
; QUESTION COLON.
;

20$:	CMP	R2,#OP.QRY	;WELL?
	BNE	22$		;BR IF NOT "?"

	CALL	GENLAB		;GET
	MOV	R0,LAB(SP)	;TWO
	CALL	GENLAB		;NEW
	MOV	R0,OLAB(SP)	;LABELS
	MOV	#JTRUE,R2	;POINT AT
	TST	SEX(SP)		;THE CORRECT
	BNE	21$		;ROUTINE TO
	MOV	#JFALSE,R2	;CALL

21$:	MOV	E.LOP(R5),R5	;DO A JUMP FALSE
	MOV	LAB(SP),R3	;TO THE
	CALL	JFALSE		;FIRST LABEL

	MOV	ATREE(SP),R5	;THE "?" ":" IS
	MOV	E.ROP(R5),R5	;CONTROLLED
	MOV	E.LOP(R5),R5	;BY THE LEFT PART
	MOV	ALABEL(SP),R3	;OF
	CALL	(R2)		;THE ":"
	MOV	OLAB(SP),R0	;SKIP OVER THE
	CALL	BRANCH		;OTHER SIDE

	MOV	LAB(SP),R0	;THIS LABEL IS WHERE
	CALL	LABEL		;THE RIGHT SIDE OF THE ":" IS.
	MOV	ATREE(SP),R5	;GET RIGHT
	MOV	E.ROP(R5),R5	;SIDE OF
	MOV	E.ROP(R5),R5	;THE COLON
	MOV	ALABEL(SP),R3	;AND THE LABEL AND
	CALL	(R2)		;DO IT.

	MOV	OLAB(SP),R0	;PUT OUT THE FINAL
	CALL	LABEL		;LABEL AND
	JMP	100$		;WE ARE DONE

;
; SEQUENTIAL EXECUTION
; JUST COMPILE THE LEFT SUBTREE FOR EFFECT, THEN DO THE JUMP
; ON THE RIGHT SUBTREE
;
 
22$:	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	#OP.NE,BROP(SP)	;DEFAULT BRANCH
	MOV	R2,R1		;RELATION?
	ASL	R1		;
	BIT	#RELOP,OPDOPE(R1)
	BEQ	70$		;NO
	MOV	R2,BROP(SP)	;YES, RESET THE OPERATION
	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
	BR	70$		;
 
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	(R5),R1		;GET OPDOPE OF TOP OF TREE
	ASL	R1		;
	MOV	OPDOPE(R1),R1	;

	CMPB	E.TYPE(R5),#TY.LNG ;IS THIS A LONG TREE
	BEQ	76$		;YES INDEED
	BIT	#RELOP,R1	;PERHAPS, IS IT A RELATIONAL
	BEQ	77$		;NO
	MOV	E.LOP(R5),R0	;YES, LOOK AT SUBTREES
	CMPB	E.TYPE(R0),#TY.LNG
	BNE	77$		;NOT LONG
76$:	CALL	LRELOP		;CALL SPECIAL LONG CODE
	JMP	100$		;DONE

;
; THIS CODE IGNORES FLOATS.
; CAVEAT!
;

77$:	MOV	#CTAB,R3	;SET THE
	CALL	CEXPR		;CONDITION CODES
	MOV	R0,LAB(SP)	;SAVE REGISTER (IN CASE RTAB)
 
	BIT	#OKCC,R1	;DO I HAVE FULL CODES
	BNE	89$		;YES

	MOV	BROP(SP),R0	;GRAB OP
	ASL	R0		;IS THERE A FAST OP
	TST	OP1(R0)		;
	BEQ	85$		;NO
	BIT	#OKNZ,R1	;DO I HAVE NZ
	BEQ	85$		;NO
	MOV	#OP1,R1		;YES, USE FAST TABLE
	BR	90$		;

85$:	MOV	#TST,R0		;COMPILE A TST
	CALL	CODSTR		;
	MOV	LAB(SP),R0	;REGISTER
	ADD	#'0,R0		;
	CALL	CODC		;
	CALL	CODNL		;

	MOV	BROP(SP),R0	;GET THE RELATION
	CMP	R0,#OP.LTU	;SEE IF < OR >=
	BEQ	86$		;YES
	CMP	R0,#OP.GEU	;
	BNE	87$		;NO
86$:	MOV	#ERR07,R0	;THESE ARE DEGENRATE
	CALL	ERROR		;
	BR	100$		;

87$:	CMP	R0,#OP.LEU	;MAP <= TO =
	BNE	88$		;
	MOV	#OP.EQ,BROP(SP)	;
	BR	89$		;

88$:	CMP	R0,#OP.GTU	;MAP > TO !=
	BNE	89$		;
	MOV	#OP.NE,BROP(SP)	;

89$:	MOV	#OP0,R1		;TABLE
90$:	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
;     BROP=BRANCH RELATION
;-

LRELOP:	BIT	#RELOP,R1	;IS IT A RELATION
	BEQ	50$		;NO

	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	50$		;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

;
; 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, -2 MEANS CALL GETREG)
;
; OUTPUTS:
;	R5=TREE (MAY BE MODIFIED)
;-

INDEX:	MOV	R5,-(SP)	;SAVE TREE
	MOV	R4,-(SP)	;SAVE REGISTER
	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
	MOV	(R5),R1		;GET OPERATION
	CMP	R1,#OP.ADD	;IS IT "+"
	BEQ	10$		;YES
	CMP	R1,#OP.SUB	;IS IT "-"
	BNE	50$		;NO, GIVE UP

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

20$:	CMP	R1,#OP.SUB	;IF THE OPERATOR IS "-"
	BEQ	50$		;GIVE UP
	MOV	E.LOP(R5),R0	;SEE IF LEFT IS A CONSTANT
	CMP	(R0),#OP.CON	;
	BNE	50$		;NO, GIVE UP
	MOV	E.ROP(R5),R5	;GET OTHER TREE

;
; MAKE INDEX NODE.
;

30$:	MOV	E.VAL(R0),-(SP)	;SAVE INDEX CONSTANT
	CMP	R1,#OP.SUB	;IS THE OPERATOR "-"
	BNE	32$		;NO
	NEG	(SP)		;TURN INDEX CONSTANT AROUND

32$:	TST	R4		;IS THE REGISTER REAL?
	BPL	35$		;YES
	INC	R4		;IS IT -1 (ANY)
	BEQ	35$		;YES, USE R0
	CALL	GETREG		;ALLOCATE REGISTER

35$:	MOV	#RTAB,R3	;LOAD INDEX VALUE
	CALL	CEXPR		;

	CMP	10+2(SP),#-1	;ANY REGISTER
	BEQ	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, -2 MEANS CALL GETREG)
;	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
	MOVB	E.TYPE(R5),R0	;GRAB TYPE
	CMP	R0,#TY.LNG	;IS IT A FLOATING TREE?
	BLOS	30$		;NO
	CLR	R4		;USE R0 (NO FPP ONLY)
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$:	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$:	TST	R4		;REAL REGISTER?
	BPL	85$		;YES
	INC	R4		;IS IT -1 (ANY)
	BEQ	85$		;YES, USE R0
	CALL	GETREG		;ALLOCATE REGISTER

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

	CMP	10+2(SP),#-1	;ANY?
	BEQ	90$		;YES
	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