.IIF	NDF	RSX	RSX	=	1	;Assume RSX	;01+
	.TITLE	CC202
	.ident	/X02.18/

	.NLIST	BEX, CND
	.ENABL	LC, GBL

;
; C COMPILER.
; CODE GENERATOR, PART I.
; INCLUDES EIS, FIS AND FPP CODE.
;
; VERSION X02
;
; DAVID G. CONROY	01-AUG-79
;

	.GLOBL	RCEXPR
	.GLOBL	RJTRUE
	.GLOBL	RJFALS
	.GLOBL	HFPRA
	.GLOBL	HGPRA
	.GLOBL	FHGPR
	.GLOBL	MOVREG
	.GLOBL	INDEX
	.GLOBL	SETUP
	.GLOBL	OTHER
	.GLOBL	MDEBUG						;08
	.GLOBL	FPMINI						;u3
	.GLOBL	ISASG						;u5

	.MCALL	CALLR
; 02 16-May-80 MM	Changed abort exit
; 03 02-Jun-80 jam	Fixed code generation bugs
; 04 03-Jun-80 MM	Some EIS hacks
; 05 24-Jun-80 MM	Changed code generation bug per Conroy's suggestion
; 06 03-Jan-81 RBD	Fixed macro expander to test for TTAB properly
; 07 23-Feb-81 MM	EIS stuff
; 08 05-Mar-81 MM	FPU stuff (well, an attempt anyway)
; 09 28-Jul-81 MM	Removed the last of the C$$EIS stuff
; u1 28-Aug-81 CCG	Fixed [PLA] to handle OP.INX nodes
;			Fixed MATCH to not delete left convert
; u2 02-Sep-81 CCG	Removed register allocation routines to another file.
;			Added code to fully support EIS, FPU
;			Added register allocation/deallocation.
; u3 04-Sep-81 CCG	Added code to automatically set FP modes.
; u4 11-Sep-81 CCG	Removed TTAB stuff, it didn't work right anyway.
;			Also general enhancements.
; u5 14-Sep-81 CCG	Fixed spurious register moves during assigns.
; u6 24-Nov-81 CCG	Fixed sub-optimal handling of char values caused
;			by edit u1.
; u7 04-Dec-81 CCG	Fixed bug in setting condition codes for float.
;			Modified left convert delete in MATCH again.
;			Match int on right if chr fails, only if left is chr.
; 10 10-Feb-82 MM	Merged Unimation sources
; 11 11-Feb-82 MM	Fixed strange problem where code generated in
;			ETAB after CTAB gets condition codes messed up.
;			For example, "while ((n /= 2) > 0)" is optimized
;			in ETAB to an ASR BLE sequence which doesn't work
;			as the ASR sets the V-bit, messing up the BLE.
; 12 07-Mar-82 MM	Mung unsigned long compares into signed ones. There
;			 are no unsigned long compares, there are no
;			 unsigned longs!
; 13 11-Mar-82 MM	Fixed bug with register alloc. with sub. call
;			(Unimation u8)
; u9 14-Apr-82 CCG	Removed call to FREREG.
; u10 19-Apr-82 CCG	Fixed bug in ASG to char register.
; u11 28-Apr-82 CCG	Fixed bug in float reg usage in conditionals.
; u12 23-Jun-82 CCG	Fixed bug in ASG *(int)++ = (char)
; u13 16-Jul-82 CCG	Fixed possible bugs introduced by edit u2, u1.
;			Force [PL] [PR] [PLA] to use R0 as work reg.
; u14 21-Jul-82 CCG	Removed useless code, added comments.
;			Fixed bug in chkreg
; 14  31-Jul-82 MM	Clear IF counters upon <GO.TO>, removed MODF
; 15  01-Aug-82 MM	<T> and <TL> must accept null trees, seen in
;			charp = stringarray[longval / (sizeof (char *))];
; u15 06-Aug-82 CCG	All of edit u1 was not buggy.  Removed part of edit u13.
; u16 28-Sep-82 CCG	Fixed CLASFY bug.  Now has different calling sequence.
; u17 23-Nov-82 CCG	Allow register reallocation while pushing routine args.
; 18  30-Jan-83 MM	Merged Dec and Unimation sources.  No new code.
; End-edit
;

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

FPIMOD:	.BLKB	1		;FLOATING POINT I/L MODE FLAG		;u3+
	FPIF	= 1		;I MODE FLAG
	FPLF	= 2		;L MODE FLAG
FPFMOD:	.BLKB	1		;FLOATING POINT F/D MODE FLAG
	FPFF	= 1		;F MODE FLAG
	FPDF	= 2		;D MODE FLAG				;u3-

NSTACK:	.WORD	0		;STACK DEPTH
DMPS00:	.WORD	RTAB,'r
	.WORD	STAB,'s
	.WORD	TTAB,'t
	.WORD	CTAB,'c
	.WORD	ETAB,'e
	.WORD	0,0,'?		;TERMINATION

;
; ERROR MESSAGES.
;

ERR02:	.ASCIZ	"Botch in setup -- address not indirect"
ERR03:	.ASCII	/Missing code table entry for "/		;04
ER3NAM:	.ASCIZ	/       "/					;04
ERR04:	.ASCIZ	"Botch in doargs"
ERR05:	.ASCIZ	"Botch in [pla]"
ERR06:	.ASCIZ	"Botch in lrelop -- not r0"
ERR07:	.ASCIZ	"Degenerate unsigned/pointer relation"
ERR08:	.ASCIZ	"Code table bug -- if/else count off"		;07
ERR09:	.ASCIZ	"Fpu disabled, pushing other than r0"		;08

DMPS01:	.ASCIZ	<12>"/** dump - "				;08+
DMPS02:	.ASCIZ	"tab, hfpra = "
DMPS03:	.ASCIZ	", hgpra = "
DMPS04:	.ASCIZ	", fhgpr = "
DMPS05:	.ASCIZ	", result = "
DMPS06:	.ASCIZ	"at cexpr"<12>			 		;08-

;
; CODE STRINGS.
;

CXST02:	.ASCIZ	"	mov	r?,-(sp)"<12>
CXST03:	.ASCIZ	"	mov	r?,(sp)"<12>
CXST04:	.ASCIZ	",(sp)"<12>					;u1
CXST07:	.ASCIZ	"	jsr	pc,"

POPS01:	.ASCIZ	"	tst	(sp)+"<12>
POPS02:	.ASCIZ	"	cmp	(sp)+,(sp)+"<12>
POPS03:	.ASCIZ	"	add	$"
POPS04:	.ASCIZ	",sp"<12>

MVRS01:	.ASCIZ	"	ld?	r?,r?"<12>			;u3
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"

CXS04F:	.ASCIZ	"	st?	r?,-(sp)"<12>			;04+ ;u3
REL01F:	.ASCIZ	"	tst?	r0"<12>				;u3
REL02F:	.ASCIZ	"	cfcc"<12>

DARG01:	.ASCII	"	clr	-(sp)"<12>
	.ASCIZ	"	clr	-(sp)"<12>
REL01N:	.ASCIZ	"	jsr	pc,cmp"<176>"d"<12>		;08
REL02N:	.ASCIZ	"	tst	"<176><176>"facc"<12>		;08
FREL04:	.ASCIZ	"	tst	"				;04-
FFIXUP:	.ASCIZ	"	ldd	"<176><176>"facc,r0"<12>	;08+
FGLOBL:	.ASCIZ	"	.globl	"<176><176>"facc"<12>		;08-

CSETI:	.ASCIZ	"	seti"<12>				;u3+
CSETL:	.ASCIZ	"	setl"<12>
CSETF:	.ASCIZ	"	setf"<12>
CSETD:	.ASCIZ	"	setd"<12>				;u3-

	.EVEN

;+
; ** RCEXPR - COMPILE AN EXPRESSION
;
; THIS ROUTINE IS THE TOP LEVEL INTERFACE TO CEXPR. THE TREE OPTIMIZER IS
; CALLED, THE MULTIWORD CONSTANTS LOCATED AND STORED IN A POOL, THE COSTS
; ARE COMPUTED, THE EXTERNAL VARIABLES THAT CONTROL THE ALLOCATION OF THE
; REGISTERS ARE SET UP, AND CEXPR IS CALLED.
;
; INPUTS:
;	R5=TREE
;	R3=TABLE
;
; OUTPUTS:
;	R0=RESULT REGISTER (IF R3=RTAB)
;-

RCEXPR:	CALL	MODIFY		;FIX UP THE TREE
	CALL	MWCON		;FIX MULTI WORD CONSTANTS
	CALL	SETHI		;SET WEIGHTS
	CALL	TDUMP		;DUMP TREE
	CALL	GRINIT		; INIT GENERAL REG ALLOCATOR		;u2
	CALL	FRINIT		; INIT FLOATING POINT REG ALLOCATOR	;u2
	CLR	R4		;R0
	CALLR	CEXPR		;DO IT.

;+
; ** RJTRUE - COMPILE A JUMP TRUE
; ** RJFALS - COMPILE A JUMP FALSE
;
; THESE ROUTINES ARE THE TOP LEVEL INTERFACES TO JTRUE AND JFALSE.  FIRST
; THE SAME OPTIMIZATIONS AND INITIALIZATIONS PERFORMED BY RCEXPR ARE PER-
; FORMED ON THE TREE. THEN A CALL IS MADE TO JTRUE OR JFALSE TO  ACTUALLY
; DO THE JUMP.
;
; 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
	CALL	GRINIT		; INIT GENERAL REG ALLOCATOR		;u2
	CALL	FRINIT		; INIT FLOATING POINT REG ALLOCATOR	;u2
	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
	CALL	GRINIT		; INIT GENERAL REG ALLOCATOR		;u2
	CALL	FRINIT		; INIT FLOATING POINT REG ALLOCATOR	;u2
	CLR	R4		;RESULT TO R0
	CALLR	JFALSE		;DO IT

;+
; ** CEXPR - COMPILE AN EXPRESSION
;
; CEXPR IS THE PRIMARY CODE GENERATION ROUTINE. GIVEN A TREE, THE ADDRESS
; OF A CODE TABLE AND A WORKING REGISTER IT OUTPUTS THE REQUIRED CODE. IT
; ALWAYS SUCCEEDS; IF THERE IS NO CODE TABLE THAT CAN COMPILE AN OPERATOR
; THE CODE GENERATOR ABORTS.
;
; FIRST A NUMBER OF OPERATOR SPECIFIC OPTIMIZATIONS ARE PERFORMED.  THESE
; TEND TO BE AIMED AT EXPLOITING A QUIRK IN THE PDP-11 INSTRUCTION SET OR
; TO EVALUATE A TREE IN A PARTICULAR ORDER (USUALLY BECAUSE A KEY OPERAND
; IS IN A REGISTER).
;
; IF NONE OF THE SPECIAL CASES HANDLE THE TREE THE OPERATOR AND ITS  LEFT
; AND RIGHT SUBTREES ARE LOOKED UP IN CODE TABLES. FIRST THE TABLE PASSED
; TO CEXPR IS USED. IF THIS FAILS AND THE TABLE IS NOT "RTAB" AN  ATTEMPT
; IS MADE TO USE OTHER TABLES. IF ALL FAIL THE CODER ABORTS.
;
; INPUTS:
;	R5=TREE
;	R4=WORKING REGISTER
;	R3=TABLE
;
; OUTPUTS:
;	R0=RESULT REGISTER (R3=RTAB)
;-

ATREE	=	40		;TREE (R5)				;07+
AREG	=	36		;REGISTER (R4)
ATABLE	=	34		;TABLE (R3)
CX.TMP	=	30		;TEMP STORAGE SIZE
TLEVEL	=	26		;TRUE LEVEL FOR CODE GENERATOR
FLEVEL	=	24		;FALSE LEVEL FOR CODE GENERATOR		;07-
;;MODF	=	22		;FLAG FOR CALL GENERATOR		;14
NSAVE	=	20		;SAVE FOR NSTACK
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)	; @ CX.TMP + 10
	MOV	R4,-(SP)	; @ CX.TMP +  6
	MOV	R3,-(SP)	; @ CX.TMP +  4
	MOV	R2,-(SP)	; @ CX.TMP +  2
	MOV	R1,-(SP)	; @ CX.TMP
	SUB	#CX.TMP,SP	;GET LOCALS				;07+
	MOV	R4,RESULT(SP)	;INIT RESULT SO MDEBUG WORKS		;u2
	CLR	TLEVEL(SP)	;CLEAR TRUE  COUNTER
	CLR	FLEVEL(SP)	;CLEAR FALSE COUNTER 			;07-
	CALL	PFLUSH		;FLUSH PENDING BRANCHES
;
; NOTE, DISABLE THIS SEQUENCE UNLESS YOU'RE COMPLETELY DESPERATE
;
	TSTB	LFLAG		;REALLY DUMPING TREES			;08+
	BEQ	10$		;NO
	MOV	#DMPS06,R2	;YES, FORCE CALL TO DEBUG DUMPER
	CALL	MDEBUG		;OFF WE GO
10$:				;					;08-

;
; OP.SEQ
;

	MOV	(R5),R0		;OPERATOR
	CMP	R0,#OP.SEQ	;IS IT SEQUENTIAL EXECUTION
	BNE	CXPR10		;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	CXDONR		;DONE

;
; A ? B : C
; SIMULATE: IF (A) REG = B; ELSE REG = C;
;

CXPR10:	CMP	R0,#OP.QRY	;IS IT A QUESTION COLON
	BNE	CXPR20		;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,NSAVE(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	NSAVE(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	10$		;YES
	CMP	R3,#RTAB	;IF NOT RTAB, IT DOESN'T MATTER
	BNE	10$		;
	MOV	RESULT(SP),R1	;MOVE RIGHT TO DEST. OF LEFT
	MOVB	E.TYPE(R5),R2	;
	CALL	MOVREG		;

10$:	MOV	LAB2(SP),R0	;CODE STREAMS MERGE HERE
	CALL	LABEL		;
	JMP	CXDONE		;

;
; LOGICAL OP.
; SIMULATE: IF (TREE) REG = 1; ELSE REG = 0;
;

CXPR20:	CMP	R3,#CTAB	;DON'T DO THIS IF CTAB
	BEQ	CXPR30		;
	MOV	R0,R1		;GET OPDOPE
	ASL	R1		;
	BIT	#L01,OPDOPE(R1)	;NEED 0 OR 1?
	BEQ	CXPR30		;NO
	CALL	GENLAB		;GET A SKIP LABEL
	MOV	R0,LAB1(SP)	;
	MOV	R0,R3		;JUMP TO IT ON FALSE
	CALL	JFALSE		;
	MOV	NSTACK,NSAVE(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	NSAVE(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	CXDONR		;

;
; IF NO EIS, CHECK FOR FORCED SIGN EXTEND OF INT CONSTANT.
; COMPILE AN EXPLICIT LOAD OF 0 OR -1.
;

CXPR30:	CLR	WTABF(SP)	;CLEAR WRONG TABLE FLAG

	TSTB	EFLAG		;DOES TARGET HAVE EIS?		;04
	BNE	CXPR40		;BR IF SO (Had "if not before)	;04/07

	CMP	R0,#OP.CVR	;IS THIS A CONVERSION
	BNE	CXPR40		;NO
	CMPB	E.TYPE(R5),#TY.LNG ;IS THE RESULT A LONG
	BNE	CXPR40		;NO
	MOV	E.LOP(R5),R1	;GRAB WHAT WE ARE CONVERTING
	CMP	(R1),#OP.CON	;CONSTANT
	BNE	CXPR40		;NO
	CMPB	E.TYPE(R1),#TY.INT ;INTEGER CONSTANT
	BNE	CXPR40		;NO

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

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

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

;
; CALL.
;

CXPR40:	CMP	R0,#OP.JSR	;CALL
	BNE	CXPR50		;NO
;;	CLR	MODF(SP)	;RESET ARG TO (SP) FLAG	-- never set	;14
	MOV	E.ROP(R5),R5	;DO THE ARGS
	CLR	R4		;USE R0 FOR RESULT			;u8/13
	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		;

;; Note: the following code is never executed as MODF is never set	;14+
;;	TSTB	FFLAG		;-F		;; should this be pflag?
;;	BNE	10$		;IF YES, CANNOT DO THIS.
;;	CMP	(R5),#OP.ID	;NAME
;;	BNE	10$		;NO
;;	TST	MODF(SP)	;ARG TO (SP)	;; Who sets MODF?
;;	BEQ	10$		;NO
;;	MOV	#'*,R0		;PUT OUT "*$"
;;	CALL	CODC		;
;;	MOV	#'$,R0		;
;;	CALL	CODC		;
;;									;14-

10$:	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
	CALL	FRINIT		;DEALLOCATE ALL FP REGS			;u2
	CALL	FPMINI		;SET FP MODE TO "UNKNOWN"		;u3
	TSTB	FFLAG		;IF HARDWARE FPU,			;08+
	BEQ	15$		;(NOPE)
	CMPB	E.TYPE(R5),#TY.FLT	;YEP, BUT IT
	BEQ	12$			;HAD BETTER BE
	CMPB	E.TYPE(R5),#TY.DBL	;FLOAT OR
	BNE	15$			;DOUBLE
12$:	MOV	#FFIXUP,R0	;(YEP) -- RELOAD AC0 FROM $$FACC
	CALL	CODSTR		;
15$:				;					;08-
	CMP	ATABLE(SP),#RTAB;TEST IF THE RTAB WAS WANTED
	BEQ	20$		;
	INC	WTABF(SP)	;WE USED THE WRONG TABLE
20$:	JMP	CXPUSH		;DONE

;
; BIC IN CTAB => BIT.
;

CXPR50:	CMP	R0,#OP.BIC	;IS THE OPERATOR A BIC
	BNE	CXPR60		;NO
	CMP	R3,#CTAB	;IS THIS THE CTAB
	BNE	CXPR60		;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
	JMP	CXPROD		;				;03 jam/05

CXPR60:	CMP	R0,#OP.ASG	;IS THE OP AN ASSIGNMENT
	BNE	CXPR70		;NO
;								;u12+
; Check if ASG from INT AUI or AUD to char.  If so, must use RTAB
; since ETAB will generate MOVB (rn)+,(rn)+.

	CMPB	E.TYPE(R5),#TY.CHR	; IS ASG TO A CHAR?
	BNE	CXPR65		; NO
	MOV	E.ROP(R5),R0	;GET RIGHT
	CMPB	E.TYPE(R0),#TY.CHR	; IS RIGHT A CHAR?
	BEQ	CXPR65		; YES
	CMP	(R0),#OP.AUI	; ++ ?
	BEQ	10$		; SKIP IF YES
	CMP	(R0),#OP.AUD	; -- ?
	BNE	CXPR65		; NO
10$:	CMP	R3,#ETAB	; ARE WE TRYING THE ETAB?
	BNE	CXPR65		; NO
	MOV	#RTAB,R3	; FORCE RTAB			;u12-

; Special check for ASG to REG.  If found, the right subtree is		;u14+
; evaluated using the RTAB.  The destination register is used as
; the work reg unless it is referenced in the tree, in which case
; R0 is used.  (Using R0 avoids trouble in case the work reg is
; modified as in MUL by CON3).						;u14-

CXPR65:
	MOV	E.LOP(R5),R0	;CHECK IF LEFT A REGISTER	;u12
	CMP	(R0),#OP.REG
	BNE	CXPR70		; NO

	MOV	E.REG(R0),R1	;SAVE REGISTER NUMBER		;u5+
	MOVB	E.TYPE(R0),R2	;SAVE REGISTER TYPE
	MOV	E.ROP(R5),R5	;GET RIGHT SUBTREE

	MOV	R1,R4		;COPY REG
	CALL	CHKREG		;IS THIS REG USED BY TREE?
	BCC	5$		;SKIP IF NOT USED
	CLR	R4		;ELSE COMPILE TO R0 (I HOPE THIS IS SAFE)
5$:
	MOV	#RTAB,R3	;
	CALL	CEXPR		;

	MOV	R1,RESULT(SP)	;SAVE RESULT
	CMP	R0,R1		;IS THE REGISTER RIGHT?
	BEQ	10$		;YES
	CALL	MOVREG		;

10$:	CMP	ATABLE(SP),#RTAB;DID WE WANT THE RTAB
	BEQ	20$		;YES
	INC	WTABF(SP)	;NO, WRONG TABLE
20$:	JMP	CXPUSH		;				;u5-

; I have just realized that the following code is never executed.	;u14+
; It would probably not work correctly with mixed mode arithmetic.

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

.if ne 0

 BINARY OP.


30$:
.if ne	0			;Not needed now			;05 MM
	mov	areg(sp),r4	;we destroyed r4		;03 jam
.endc
	CMP	(R0),#OP.ADD	;CHECK FOR GOOD OPERATORS
	BEQ	40$		;
	CMP	(R0),#OP.SUB	;
	BEQ	40$		;
	CMP	(R0),#OP.OR	;
	BEQ	40$		;
	CMP	(R0),#OP.BIC	;
	BNE	CXPR70		;NOT GOOD

40$:	MOV	E.ROP(R0),R0	;GET B
	CMP	(R0),#OP.AUD	;IS IT A LEAF NODE
	BHI	CXPR70		;NO
	CMP	(R0),#OP.REG	;IS IT THE SAME AS REG
	BLO	50$		;NO
	CMP	E.REG(R0),R1	;
	BEQ	CXPR70		;YES

50$:	MOV	E.ROP(R5),R0	;DO ASSIGNMENT IN THE ETAB
	MOV	R0,ATREE(SP)	;JUST FOR A SECOND
;
	mov	e.lop(r0),r0	;get left branch		;02-jam
	cmp	(r0),#op.reg	;is it a register leaf?		;02-jam
	bne	53$		;br if not			;02-jam
	cmp	e.reg(r0),r1	;same as destination?		;02-jam
	beq	58$		;don't assign if so		;02-jam
53$:	mov	r0,e.rop(r5)	;move into position		;02-jam

	MOV	#ETAB,R3	;
	CALL	CEXPR		;
	MOV	ATABLE(SP),R3	;RECOVER TABLE

58$:	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	60$		;
	MOV	#OP.BCA,(R5)	;
	BR	CXPROD		;

60$:	ADD	#OP.ADA-OP.ADD,R0 ;
	MOV	R0,(R5)		;
	BR	CXPROD		;
.endc								;u14-

; CXPR70:

; SPLIT THINGS OF THE FORM "A OP (REG = B)"  WHERE "=" IS ANY  ASSIGNMENT
; TYPE OP, INTO TWO THINGS: REG = B (IN ETAB) AND A OP REG.
;

CXPR70:

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

	BIT	#LEAF,R0	;DUCK ON LEAVES
	BNE	CXPROD		;

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

10$:	MOV	E.LOP(R5),R0	;DO THE LEFT TREE
	CALL	ASGCHK		;
	BCS	CXPROD		;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 compile  code  to 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 there  is
; no match try the ETAB, then the RTAB. The ETAB may not be used in place
; of the CTAB if the tree has a long or float result, or the operator  is
; a postfix "++" or "--".
;
; This routine must work or something is dreadfully wrong.  The  compiler
; dies with a "no code table" message.  Perhaps the operator and the left
; and right classes should be printed also.
;

CXPROD:	MOV	R4,RESULT(SP)	;SET DEFAULT RESULT REG.
	MOV	R3,WTABLE(SP)	;WORK TABLE

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

;
; IF ADDRESSABLE, ADD AN OP.LOD TO THE TOP.
; THIS PERMITS ALL ADDRESSABLES TO SHARE A SINGLE SET OF TABLES.
;

10$:	CALL	HASADR		;IS THE NODE ADDRESSABLE
	BCC	30$		;YES

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

30$:	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.
;

40$:
	CALL	MATCH		;LOOK IT UP IN THE CODE TABLES
	BCC	60$		;FOUND IT
	CMP	R3,#RTAB	;FAILURE IN THE RTAB
	BEQ	100$		;YES, TOTAL FAILURE
	INC	WTABF(SP)	;SET USING WRONG TABLE
	CMP	R3,#CTAB	;FAIL IN THE CTAB
	BNE	50$		;NO
	CMPB	E.TYPE(R5),#TY.LNG ;IS THE TREE A LONG OR FLOAT ?	;u7
	BHIS	50$		;YES, DON'T USE ETAB			;u7
;	CMP	(R5),#OP.INA	;"++" POSTFIX				;11+
;	BEQ	50$		;YES, DON'T USE ETAB
;	CMP	(R5),#OP.DEA	;"--" POSTFIX
;	BEQ	50$		;YES, DON'T USE ETAB
	MOV	(R5),R0		;Get the op code
	ASL	R0		;as an index
	BIT	#NOETAB,OPDOPE(R0) ;Is "can't use the ETAB" set?
	BNE	50$		;'nuff said.				;11-
	MOV	#ETAB,R3	;TRY THE ETAB
	MOV	R3,WTABLE(SP)	;
	CALL	MATCH		;
	BCC	60$		;OK
50$:	MOV	#RTAB,R3	;NO, TRY THE RTAB
	MOV	R3,WTABLE(SP)	;
	CALL	MATCH		;
	BCS	100$		;NO CODE TABLE FOR OP.

;
; EXPAND THE CODE MACRO.
; WATCH FOR "-(SP)" AND "(SP)+"
;

60$:
	MOVB	(R2)+,R0	;MACRO CHARACTER
	BEQ	95$		;END OF MACRO -- GO CHECK LEVELS	;07
	BMI	90$		;SOMETHING SPECIAL

	CMP	R0,#'-		;POSSIBLE "-(SP)"
	BNE	70$		;NO
	CMPB	(R2),#'(	;WELL
	BNE	80$		;NO
	INC	NSTACK		;FIX STACK DEPTH
	CMP	WTABLE(SP),#TTAB;TO TOP? ;Be sure to use "working" table! ;06
	BEQ	60$		;YES, TOSS THE "-" AWAY
	BR	80$		;

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

80$:	CALL	CODC		;PUT IT OUT
	BR	60$		;

90$:
	NEG	R0		;CALL SPECIFIC ROUTINE
	ASL	R0		;
	CALL	@CXJUMP-2(R0)	;
	BR	60$		;GO BACK FOR MORE

95$:	ADD	TLEVEL(SP),FLEVEL(SP) ;DID IF MATCH ELSE?		;07+
	BEQ	CXPUSH		;YES, CONTINUE
	MOV	#ERR08,R0	;URK
	JMP	ABTREE		;DEADLY					;08

100$:								;04+
;
; USE THE TABLES (IN CC207) TO DUMP THE OPERATOR NAME AND TYPE
; (USES ALL REGISTERS AS IT'S A FATAL ERROR ANYWAYS)
; THIS CODE FOLLOWS THE FORMAT OF CC207.
;
	MOV	#ER3NAM,R2	;R2 -> OP TABLE NAME
	MOV	(R5),R0		;GET OPERATOR
	CMP	R0,#OP.SEM	;IS IS REASONABLE?
	BLO	110$		;BR IF SO
	MOV	#OP.SEM,R0	;MAKE IT REASONABLE
110$:
	MOV	R0,R1		;R1 :=
	ASL	R0		;  OPERATOR * 3
	ADD	R0,R1		;
	ADD	#OPNAME,R1	;R1 -> TABLE ENTRY FOR NAME
	MOVB	(R1)+,(R2)+	;MOVE OUT
	MOVB	(R1)+,(R2)+	;  THE
	MOVB	(R1)+,(R2)+	;  NAME
	INC	R2		;SKIP OVER THE BLANK
	MOVB	E.TYPE(R5),R1	;R1 := OPERATOR TYPE
	MOV	R1,R0		;GET TYPE * 3
	ASL	R0		;
	ADD	R0,R1		;
	ADD	#TYNAME,R1	;R1 -> TABLE ENTRY FOR TYPE
	MOVB	(R1)+,(R2)+	;MOVE OUT
	MOVB	(R1)+,(R2)+	;  THE
	MOVB	(R1)+,(R2)+	;  NAME				;04-
	MOV	#ERR03,R0	;NO CODE TABLE FOR OP.
	JMP	ABTREE		;				;02/08

;
; DO PUSH, IF NEEDED.
;

CXPUSH:
	TST	WTABF(SP)	;BR IF NOT WRONG TABLE
	BEQ	CXDONE		;

	MOV	ATABLE(SP),R3	;GRAB TABLE
	CMP	R3,#STAB	;DO PUSH IF STAB OR TTAB
	BEQ	10$		;
	CMP	R3,#TTAB	;
	BNE	CXDONE		;

10$:
	MOV	ATREE(SP),R5	;GET TREE
	MOV	RESULT(SP),R0	;REG
	ADD	#'0,R0		;


	MOVB	R0,CXS04F+6	;PREPARE FOR FLOAT		;u3+
	CMPB	E.TYPE(R5),#TY.FLT ;IS THIS A FLOAT TREE?
	BLO	20$		;NO
	BHI	17$		;DOUBLE

	CALL	MFPF		; SET TO FLOAT MODE
	MOVB	#'f,CXS04F+3
	BR	18$

17$:	CALL	MFPD		; SET TO DOUBLE MODE
	MOVB	#'d,CXS04F+3
18$:	MOV	#CXS04F,R0					;u3-
	BR	40$		;


20$:	MOVB	R0,CXST02+6	;MOV
	MOVB	R0,CXST03+6	;

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

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

40$:	CALL	CODSTR		;PUT IT OUT
	INC	NSTACK		;FIX DEPTH

	MOV	#-1,RESULT(SP)	;RESULT IS ON STACK			;u2
;
; DONE.
;

CXDONE:	MOV	RESULT(SP),R0	;WHERE IT ENDED UP
CXDONR:
	ADD	#CX.TMP,SP	;DISCARD LOCAL VARIABLES AND		;07
	MOV	(SP)+,R1	;RETURN
	MOV	(SP)+,R2	;
	MOV	(SP)+,R3	;
	MOV	(SP)+,R4	;
	MOV	(SP)+,R5	;
	RETURN			;

;
; MACRO TRANSFER TABLE.
;

CXJUMP:	.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]
	.WORD	MF.1		;-37	[F.1]				;07+
	.WORD	MAL.4		;-40	[AL.4]				;08
	.WORD	MAL.6		;-41	[AL.6]				;08
	.WORD	MLL.O		;-42	[LL.O]				;u2+
	.WORD	MLLP.O		;-43	[LLP.O]
	.WORD	MLLP.E		;-44	[LLP.E]				;u2-
	.WORD	MLRP.E		;-45	[LRP.E]				;u3+
	.WORD	MFPI		;-46	[FPI]
	.WORD	MFPL		;-47	[FPL]
	.WORD	MFPF		;-50	[FPF]
	.WORD	MFPD		;-51	[FPD]				;u3-
	.WORD	MGOTO		;-52	[GO.TO] X
	.WORD	MEIS		;-53	[IFEIS]
	.WORD	MFPU		;-54	[IFFPU]
	.WORD	MIFOP		;-55	[IFOP] X
	.WORD	MELSE		;-56	[ELSE]
	.WORD	MEND		;-57	[IFEND]				;07-
	.WORD	MDEBUG		;-60	[DEBUG] X <12>			;08

;
; [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			;

;
; [F.1]		ADJUST RESULT REGISTER TO HACK VALUE IN R1		;07+
;

MF.1:	MOV	#1,RESULT+2(SP)	;[F.1] SET RETURN REGISTER TO R1
	RETURN								;07-

;
; [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)
; [AL+4]	ADDRESS OF LEFT SUBTREE + 4 (FOR DOUBLES)
; [AL+6]	ADDRESS OF LEFT SUBTREE + 6 (FOR DOUBLES)
; [ALN]		ADDRESS OF LEFT SUBTREE, NO SIDE EFFECTS
;

	.ENABL	LSB

MAL.4:	MOV	#-2,R4		;[AL+4]					;08+
	BR	10$		;

MAL.6:	MOV	#-3,R4		;[AL+6]
	BR	10$		;					;08-

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
	BEQ	MTL		;SKIP IF NULL TREE (shouldn't happen)	;15
	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
	BEQ	20$		;SKIP IF NULL TREE (shouldn't happen)	;15
	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)
; [LL.O]	LOAD LEFT SUBTREE (INTO ODD REGISTER)			;u2+
; [LLP.O]	LOAD LEFT SUBTREE (INTO ODD REGISTER OF A PAIR)
; [LLP.E]	LOAD LEFT SUBTREE (INTO EVEN REGISTER OF A PAIR)	;u2-
; [LR]		LOAD RIGHT SUBTREE (INTO CURRENT REGISTER)
; [LRP.E]	LOAD RIGHT SUBTREE (INTO EVEN REGISTER OF A PAIR)	;u2
;


	.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
	BR	10$							;u2+

MLL.O:	BIT	#1,RESULT+2(SP)	;IS THIS REGISTER ODD?
	BNE	MLL		;YES, USE IT
	MOV	#1,RESULT+2(SP)	; ELSE USE R1
	BR	MLL

MLLP.O:	MOV	RESULT+2(SP),R4
	CALL	MREGP		;MAKE A REGISTER PAIR
	MOV	R4,RESULT+2(SP)	; THIS IS NOW THE RESULT
	INC	R4		; LOAD THE ODD ONE
	BR	10$

MLLP.E:	MOV	RESULT+2(SP),R4
	CALL	MREGP		;MAKE A REGISTER PAIR
	MOV	R4,RESULT+2(SP)	; THIS IS NOW THE RESULT

10$:	MOV	ATREE+2(SP),R5	;GET LEFT SUBTREE
	MOV	E.LOP(R5),R5	;
	BR	20$		;GO TO COMMON LOADER

MLRP.E:	MOV	RESULT+2(SP),R4
	CALL	MREGP		;MAKE A REGISTER PAIR
	MOV	R4,RESULT+2(SP)	; THIS IS NOW THE RESULT		;u2-

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	5$		;ELSE CHECK OP.INX		;u1
	MOV	E.LOP(R5),R5	;REMOVE THE "*"
	BR	10$		;

								;u1+
; The optimizer outsmarted itself... An address was really needed but
; it got turned into an index node.  Maybe these addresses would never
; be needed if the floating point stuff was smarter, but...
5$:	CMP	(R5),#OP.INX	;CHECK FOR INDEX NODE
	BNE	20$		;ERROR IF NONE
	MOV	E.REG(R5),R0	;GET THE REGISTER NUMBER
	ADD	#'0,R0
	MOVB	R0,CXST02+6	;FIX UP THE REG PUSH
	MOV	#CXST02,R0	;CODE IT
	CALL	CODSTR
	INC	NSTACK		;FIX STACK DEPTH
	MOV	#POPS03,R0	;CODE AN ADD TO THE STACK
	CALL	CODSTR
	MOV	E.OFFS(R5),R0	;GET THE OFFSET
	CALL	CODNUM
	MOV	#CXST04,R0	;FINISH THE LINE
	CALLR	CODSTR		;AND RETURN			;u1-

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$:	CLR	R4		;USE R0 AS WORK REG		;u13
; 10$:	MOV	RESULT+2(SP),R4	;USE RESULT REG AS WORK REG	;u13
	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	ABTREE		;FLUSH				;02/08

	.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

; [FPI]		Set floating point I mode.				;u3+
; [FPL]		Set floating point L mode.
; [FPF]		Set floating point F mode.
; [FPD]		Set floating point D mode.

MFPI:	BITB	#FPIF,FPIMOD	; ALREADY I MODE?
	BNE	MFPRET		; RETURN IF SO
	MOVB	#FPIF,FPIMOD	; SET IT
	MOV	#CSETI,R0	; CODE THE SETI
	BR	MFPCOD

MFPL:	BITB	#FPLF,FPIMOD	; ALREADY L MODE?
	BNE	MFPRET		; RETURN IF SO
	MOVB	#FPLF,FPIMOD	; SET IT
	MOV	#CSETL,R0	; CODE THE SETL
	BR	MFPCOD

MFPF:	BITB	#FPFF,FPFMOD	; ALREADY F MODE?
	BNE	MFPRET		; RETURN IF SO
	MOVB	#FPFF,FPFMOD	; SET IT
	MOV	#CSETF,R0	; CODE THE SETF
	BR	MFPCOD

MFPD:	BITB	#FPDF,FPFMOD	; ALREADY D MODE?
	BNE	MFPRET		; RETURN IF SO
	MOVB	#FPDF,FPFMOD	; SET IT
	MOV	#CSETD,R0	; CODE THE SETD

MFPCOD:	CALLR	CODSTR		; OUTPUT THE CODE


FPMINI:	CLRB	FPFMOD		; INIT FLOATING POINT MODE, SET TO UNKNOWN
	CLRB	FPIMOD
MFPRET:	RETURN			; NO NEED FOR CODE			;u3-


;
; [DEBUG] X <12>	DEBUG DUMP FROM WITHIN CODE STRING		;08+
;		NOTE: X MUST BE READABLE ASCII -- NO <XXX> CODES.
;
; ** MDUMP	DUMP TREE, SAVES ALL REGISTERS (FOR DEBUGGING)
;

.if ne	0								;15+
MDUMP:	MOV	R0,-(SP)
	CALL	MDUMP1
	MOV	(SP)+,R0
	RETURN
.endc									;15-

MDEBUG:
	MOV	#DMPS01,R0	;GET HEADER
	CALL	CODSTR		;AND OUTPUT IT

10$:
	MOVB	(R2),R0		;GET CODE BYTE
	CALL	CODC		;AND OUTPUT IT
	CMPB	(R2)+,#12	;IS IT <NEWLINE>
	BNE	10$		;NO, CONTINUE
MDUMP1:				;FROM MDUMP				;15
	CALL	TDUMPX		;FORCED TREE DUMP
	MOV	#DMPS00,R0	;TABLE NAME BASE
20$:	CMP	(R0)+,R3	;THIS TABLE
	BEQ	30$		;YES, EXIT
	TST	(R0)+		;NO, AT END?
	BNE	20$		;CONTINUE
30$:	MOVB	(R0),R0		;GET TABLE NAME
	CALL	CODC		;OUTPUT IT
	MOV	#DMPS02,R0	;IDENT
	CALL	CODSTR		;OUTPUT IT
	MOV	HFPRA,R0	;HIGH FLOAT REGISTER
	CALL	CODNUM		;OUTPUT IT
	MOV	#DMPS03,R0
	CALL	CODSTR
	MOV	HGPRA,R0	;HIGH G.P. REGISTER
	CALL	CODNUM		;OUTPUT IT
	MOV	#DMPS04,R0
	CALL	CODSTR
	MOV	FHGPR,R0	;HIGH G.P. REGISTER FROM PARSER
	CALL	CODNUM		;OUTPUT IT
	MOV	#DMPS05,R0	;REGISTER
	CALL	CODSTR
	MOV	RESULT+2(SP),R0	;VALUE
	CALL	CODNUM		;OUTPUT IT
	CALLR	CODNL		;THAT'S ALL				;08-

;									;07+
; [GO.TO] X	BRANCH (RELATIVE) WITHIN CODE MACRO.
; [IFEIS]	COMPILE IF INLINE EIS IS ENABLED
; [IFFPU]	COMPILE IF INLINE FPU IS ENABLED
; [IFOP] X	COMPILE IF THE CURRENT OPCODE IS 'X'
; [ELSE]	REVERSE SENSE OF COMPILATION
; [IFEND]	END IF <IFEIS>/<IFFPU> SECTION
;
; NOTE THAT IF/ELSE MAY BE NESTED.  THE ALGORITHM IS IDENTICAL TO THAT USED
; IN CC001.MAC
;

	.ENABL	LSB
MGOTO:
	MOVB	(R2)+,R0	;GET NEXT BYTE
	ADD	R0,R2		;UP THE "PROGRAM COUNTER"
	CLR	TLEVEL+2(SP)	;Clear TRUE and				;14
	CLR	FLEVEL+2(SP)	;FALSE counters after branch		;14
	RETURN			;AND EXIT

MFPU:
;
; IF THIS IS THE FIRST FPU INSTRUCTION (EITHER FLAVOR) IN THE FUNCTION
; WRITE .GLOBL TO THE CODE STREAM.  IN ANY CASE, SET THE FLAG SO WE
; DON'T RETURN HERE
;
	TSTB	FPFLAG		;FIRST TIME THROUGH
	BMI	5$		;NOT IF BIT IS SET
	BISB	#0200,FPFLAG	;YES, SET THE BIT FOR LATER
	MOV	#FGLOBL,R0	;EMULATOR FPU R0
	CALL	CODSTR		;AND OUTPUT IT
5$:	MOVB	FFLAG,R0	;FPU FLAG
	BR	10$		;TO TEST

MEIS:
	MOVB	EFLAG,R0	;EIS FLAG
10$:
	TST	FLEVEL+2(SP)	;COMPILING?
	BNE	40$		;NO, EXIT AND RAISE FALSE LEVEL

	TST	R0		;YES, FLAG?
	BEQ	40$		;IS OFF.
	BR	20$		;IT'S ON, OFF WE GO.

MIFOP:
	MOVB	(R2)+,R0	;GET CODE BYTE OUT OF THE MACRO STRING
				;DO THIS FIRST SO SKIP DOESN'T GET CONFUSED
	TST	FLEVEL+2(SP)	;COMPILING?
	BNE	40$		;NO EXIT AND RAISE FALSE LEVEL
	CMPB	@ATREE+2(SP),R0	;SAME OPERATOR?
	BNE	40$		;NO
	BR	20$		;YES


MELSE:
	TST	FLEVEL+2(SP)	;COMPILING?
	BEQ	30$		;YES, TURN IT OFF
	DEC	FLEVEL+2(SP)	;NO, DROP COUNTER
	BNE	40$		;NOT AT ZERO, STILL NO COMPILE
;	BR	20$		;AT ZERO, COMPILE TIME

20$:	INC	TLEVEL+2(SP)	;COMPILE, TURN FLAG ON
	RETURN			;AND EXIT

30$:	DEC	TLEVEL+2(SP)	;DROP TRUE COUNT
40$:	INC	FLEVEL+2(SP)	;NO COMPILE NOW
	BR	MSKIP1		;AND SKIP OVER CODE

	.DSABL	LSB

MEND:
	TST	FLEVEL+2(SP)	;<IFEND>, COMPILING?
	BEQ	10$		;YES, DROP TRUE COUNT
	DEC	FLEVEL+2(SP)	;NO, DROP FALSE COUNT
	BR	MSKIP		;AND CHECK FOR MORE SKIPPING

10$:	DEC	TLEVEL+2(SP)	;DROP "COMPILE" COUNT
;	BR	MSKIP		;(SLOW "RETURN")

	.ENABL	LSB
MSKIP:				;CHECK IF WE SKIP OVER CODE NOW
	TST	FLEVEL+2(SP)	;NON-ZERO IF NOT COMPILING
	BEQ	30$		;EXIT
;
; SKIP TO NEXT IF/ELSE/END
;
MSKIP1:
10$:
	MOVB	(R2)+,R0	;GET CODE BYTE
	BEQ	20$		;EXIT AT END (ERROR WILL BE CAUGHT BY MATCH)
	CMP	R0,#<GO.TO>	;SPECIAL BYTE
	BGT	10$		;NO, CONTINUE
	BEQ	40$		;YES -- SKIP OVER NEXT BYTE
20$:	DEC	R2		;BACKUP TO LET MATCH HANDLE THIS
30$:	RETURN			;EXIT FROM MSKIP

40$:
	INC	R2		;SKIP OVER THE BYTE
	BR	10$		;AND EXIT
	.DSABL	LSB

;+
; ** 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.
;
; First check for right converts				;u7+

	MOV	E.LOP(R5),R0	;GET LEFT SUBTREE
	CMPB	E.TYPE(R0),E.TYPE(R5)	;IS TYPE OF LEFT SAME AS TYPE OF OP?
	BNE	3$		;IF NOT, SKIP RIGHT DELETE

	MOV	E.ROP(R5),R0	;GET RIGHT SUBTREE
	BEQ	3$		;UNARY
	CALL	ISCONV		;IS IT A CONVERSION
	BCS	3$		;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

; Check for left convert deletes

3$:	MOV	E.LOP(R5),R0	;GET LEFT SUBTREE
	CALL	ISCONV		;IS THIS A CONVERSION
	BCS	10$		;NO

	MOV	E.ROP(R5),R0	;IS RIGHT SUBTREE DEFINED?
	BEQ	10$		;IF NOT, SKIP DELETE
	CMPB	E.TYPE(R0),E.TYPE(R5)	;IS TYPE OF RIGHT SAME TYPE OF OP?
	BNE	10$		;IF NOT, SKIP DELETE

;    If OP is RELOP and LH is char then					;u5+
;        if RH is not char and
;        if RH is not int/uns cons in range, skip delete left convert	;u5-

	MOV	@R5,R0		;IS THIS A RELATION?
	ASL	R0
	BIT	#RELOP,OPDOPE(R0)
	BEQ	2$		;IF NOT, TRY DELETE

	MOV	E.LOP(R5),R0	;IS LEFT SUBTREE OF TYPE CHAR?
	MOV	E.LOP(R0),R0	;	( IGNORE CONVERT NODE )
	CMPB	E.TYPE(R0),#TY.CHR
	BNE	2$		;IF NOT, TRY DELETE
	MOV	E.ROP(R5),R0	;IS RIGHT SUBTREE DEFINED?
;	BEQ	2$		;NO, TRY DELETE
	CMPB	E.TYPE(R0),#TY.CHR	;IS RIGHT SUBTREE OF TYPE CHAR?
	BEQ	2$		;YES, TRY DELETE
	CMP	@R0,#OP.CON	;IS RIGHT SUBTREE A CONSTANT?
	BNE	10$		;NO, SKIP DELETE
	CMPB	E.TYPE(R0),#TY.LNG	;IS THIS A ONE WORD VALUE?
	BHIS	10$		;NO, SKIP DELETE
	TSTB	E.VAL+1(R0)	;IS HIGH BYTE OF CONSTANT ZERO?
	BNE	10$		;NO, SKIP DELETE

2$:	MOV	E.LOP(R5),R0	;GET LEFT SUBTREE
	MOV	E.LOP(R0),E.LOP(R5)	;AND DELETE CONVERT

	CALL	MATCH		;TRY FOR A MATCH
	BCC	16$		;FOUND IT
	MOV	R0,E.LOP(R5)	;REPLACE THE OLD LEFT OPERAND		;u7-

;
; 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.IND	;INDIRECTION
	BNE	24$		;NONE
22$:	MOV	#AZERO,R0	;SET LEFT ON THE RESULT
	MOV	R5,R1		;					;u16
	CALL	CLASFY		;
	MOVB	R0,LKIND	;
	MOVB	E.TYPE(R5),LTYPE;
	MOV	E.LOP(R5),R5	;SET RIGHT ON THE SOURCE
	MOV	#AZERO,R0	;
	MOV	R5,R1		;					;u16
	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
	MOV	R5,R1		;					;u16
	CALL	CLASFY		;
	MOVB	R0,LKIND	;
	BR	40$		;GO MATCH

30$:	MOV	E.LOP(R5),R1	;CLASSIFY LOP				;u16
	CALL	CLASFY		;
	MOVB	R0,LKIND	;
	MOVB	E.TYPE(R1),LTYPE;					;u16


	MOV	E.LOP(R5),R0	;CLASSIFY ROP				;u16
	MOV	E.ROP(R5),R1	;					;u16
	CALL	CLASFY		;
	MOVB	R0,RKIND	;
	MOVB	E.TYPE(R1),RTYPE;					;u16

;
; SEARCH SECOND LEVEL TABLE.
; CONSTANTS MUST MATCH EXACTLY.
; OTHERWISE ALL CONSTANTS ARE ADDRESSABLE, ADDRESSABLE IS EASY,  AND
; EASY IS ANY.
;

40$:				;REF
42$:	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$		;

;
; PTR => INT.
; UNS => 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	42$		;TRY SOME MORE

54$:	MOVB	RTYPE,R0	;RIGHT SIDE
	CMP	R0,#TY.PTR	;POINTER
	BEQ	55$		;YES, REDUCE
	CMP	R0,#TY.UNS	;UNSIGNED
	BNE	56$		;FAIL				;u7
55$:	MOVB	#TY.INT,RTYPE	;MAP TO INT
	BR	42$		;TRY SOME MORE

; If left is chr and right is chr, try int on right		;u7+

56$:	CMPB	LTYPE,#TY.CHR	; IS LEFT CHAR?
	BNE	70$		; NO, FAIL
	CMPB	RTYPE,#TY.CHR	; IS RIGHT CHAR?
	BNE	70$		; NO, FAIL
	MOVB	#TY.INT,RTYPE	; TRY INT ON RIGHT
	BR	42$		; AND MATCH AGAIN		;u7-

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.
;	R3=TABLE.						;u7
;
; OUTPUTS:
;	C=0 IF DELETABLE.
;-

ISCONV:	MOV	R1,-(SP)	;SAVE R1
	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
	CMP	R3,#ETAB	; IN THE ETAB?			;u7
	BEQ	20$		; YES, TRY DELETE ANYWAY	;u7
10$:	SEC			;NOT DELETABLE
	BR	30$		;
20$:	CLC			;DELETABLE
30$:	MOV	(SP)+,R1	;RETURN
	RETURN			;

;+
; ** 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	;

	MOVB	E.TYPE(R5),R0	;GET TREE TYPE
	BIT	#RELOP,R1	;IS THIS A RELATION?
	BEQ	7500$		;NO
	MOV	E.LOP(R5),R0	;GET TYPE OF SUBTREE
	MOVB	E.TYPE(R0),R0	;

7500$:	CMP	R0,#TY.LNG	;NOW THEN ...
	BLO	77$		;WORD
	BHI	76$		;FLOATING
	CALL	LRELOP		;LONG
	JMP	100$		;

76$:	CALL	FRELOP		;FLOATING
	JMP	100$		;

;
; WORDS AND BYTES.
;

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			;

;+
; ** FRELOP -- FLOATING POINT RELATIONALS.
;
; THIS ROUTINE COMPILES RELATIONAL OPERATIONS FOR FLOATING POINT TREES. A
; MACHINE WITH AN FPP HAS AN EASY TIME; JUST DO A "CMPD" AND A "CFCC". IF
; YOU ARE NOT SO FORTUNATE MORE WORK MUST BE DONE.
;
; INPUTS:
;	R1=DOPE OF OP AT TOP OF TREE.
;	R5=TREE.
;     BROP=BRANCH RELATION.
;-

FRELOP:				;REF
	CLR	R4		; Always compile conditionals using R0	;u11
	MOV	#CTAB,R3	;SET THE CODES
	CALL	CEXPR		;

	CMP	(R5),#OP.JSR	;IF CALL THE CODES ARE BAD
	BNE	10$		;
	CMPB	E.TYPE(R5),#TY.FLT	; FLOAT OR DOUBLE?	;u3+
	BHI	5$		; DOUBLE
	CALL	MFPF		; SET FLOAT
	MOVB	#'f,REL01F+4
	BR	7$

5$:	CALL	MFPD		; SET DOUBLE
	MOVB	#'d,REL01F+4

7$:	MOV	#REL01F,R0	;TST? R0
	CALL	CODSTR						;u3-

10$:
	MOV	#REL02F,R0	;CFCC
	CALL	CODSTR		;

	MOV	ALABEL+2(SP),R0	;GENERATE BRANCH
	MOV	#OP0,R1		;
	MOV	BROP+2(SP),R2	;
	CALLR	CBRNCH		;

;+
; ** 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.
;

;
; THERE ARE NO UNSIGNED COMPARES FOR LONGS ... THERE ARE NO UNSIGNED LONGS!
;
70$:	CMP	BROP+2(SP),#OP.LTU ;IS IT AN UNSIGNED COMPARE?		;12+
	BLT	72$		; BRANCH IF IT IS A SIGNED COMPARE
	SUB	#OP.LTU-OP.LT,BROP+2(SP)

72$:	MOV	BROP+2(SP),R0	;TEST FOR HARD CONDITIONS		;12-
	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!

;
; IF >= AND < USE TST R0.
; IF != AND == USE BIS R1,R0
; <= AND > NEED FULL CODES.
; IF EIS, USE ASHC $0,R0
; 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$:				;REF

	TSTB	EFLAG		;IF NO EIS...				;07
	BEQ	105$		;CONTINUE				;07

	MOV	#ASHC0,R0	;ASHC $0,R0
	CALL	CODSTR		;
	MOV	#OP0,R1		;GENERATE BRANCH VIA OP0
	BR	180$		;

105$:									;07

	MOV	#DEC1,R0	;SUB $1,R1 SBC R0
	CALL	CODSTR		;
	MOV	BROP+2(SP),R0	;GET RELOP.
	MOV	#OP.GE,BROP+2(SP) ;DEFAULT TO >=
	CMP	R0,#OP.GT	;CORRECT?
	BEQ	170$		;YES
	MOV	#OP.LT,BROP+2(SP) ;NO, MAKE IT <
	BR	170$		;


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	ABTREE		;				;02/08

;
; 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)
	CALL	ALLSAV		;SAVE ALLOCATION STATUS			;u17
	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	;DEFAULT TO -(SP)
	MOVB	E.TYPE(R5),R0	;GET TYPE
	CMP	R0,#TY.LNG	;WORD?
	BHIS	45$		;NOPE.
;	TST	NSTACK		;IS THE STACK EMPTY?		;u4+
;	BNE	45$		;NOPE.
;	MOV	#TTAB,R3	;USE (SP) TABLE.		;u4-

45$:				;REF

46$:	CALL	CEXPR		;DO THE PUSH

;
; 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
	CMPB	E.TYPE(R5),#TY.FLT ;IS THIS NORMAL FLOAT?	;u1+
	BEQ	50$		;IF SO, SAME AS LONG
	ADD	#4,R0		;ELSE DOUBLE, 8 BYTES EACH	;u1-
50$:	ADD	#2,R0		;
60$:	ADD	#2,R0		;

70$:	CALL	ALLRES		;RESTORE ALLOCATION STATUS		;u17
	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:	ADD	#'0,R0		;MAKE ASCII NUMBERS
	ADD	#'0,R1		;

	MOVB	R0,MVRS01+6	;SET UP FOR FLOAT		;u3+
	MOVB	R1,MVRS01+11	;

	CMP	R2,#TY.FLT	;FLOAT?
	BLO	30$		;NO.
	BHI	10$		;DOUBLE

	CALL	MFPF		;SET FLOAT
	MOVB	#'f,MVRS01+3
	BR	20$

10$:	CALL	MFPD		;SET DOUBLE
	MOVB	#'d,MVRS01+3

20$:	MOV	#MVRS01,R0	;
	BR	40$						;u3-

30$:	MOVB	#'b,MVRS02+4	;ASSUME BYTE MOVE		;u10+
	MOVB	R0,MVRS02+7	;STUFF MOV INSTRUCTIONS
	MOVB	R1,MVRS02+12	;
	MOV	#MVRS02,R0	;GET POINTER TO THE MOV
	CMP	R2,#TY.CHR	;IS IT A CHAR MOVE?
	BEQ	40$		;YES, SKIP
	MOVB	#' ,MVRS02+4	;SET WORD MOVE			;u10-

	CMP	R2,#TY.LNG	;LONGS NEED 2 MOVES
	BNE	40$		;NOT A LONG
	CALL	CODSTR		;MOV R(R0),R(R1)
	INCB	MVRS02+7	;WITH REG+1			;u10
	INCB	MVRS02+12	;				;u10

40$:	CALLR	CODSTR		;MOV

;+
; ** 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			;u15+
;	CMP	R0,#TY.LNG	;IS IT A FLOATING TREE?
;	BLOS	30$		;NO
;	TSTB	FFLAG		;FPU ENABLED?
;	BNE	30$		; SKIP IF SO
;	CLR	R4		;USE R0				;u15-
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	ABTREE		;				;02/08

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			;

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

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

	MOV	R0,R5		;SAVE TREE PTR			;u4+
	MOV	@R5,R0		;GET OPR
	CALL	ISASG		; IS IT AN ASSIGNMENT ?
	BCS	30$		;EXIT IF NOT

	MOV	E.LOP(R5),R1	;GET DEST OF ASSIGNMENT
	CMP	(R1),#OP.REG	;IS IT A REGISTER?		;u7+
	BEQ	10$		;YES

	CMPB	E.TYPE(R1),#TY.LNG	; IS IT LONG?
	BNE	20$		; NO, NOTHING SPECIAL
	CMP	(R1),#OP.INX	; FITS IN ADDRESS FIELD?
	BHI	20$		; NO

10$:	MOV	#ETAB,R3	;COMPILE IT IN THE ETAB		;u7-
	CALL	CEXPR		;
	MOV	R1,R0		;				;u4-
	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			;

;+
; ISASG	- TEST IF OPERATOR IS AN ASSIGNENT
;
; INPUTS:
;	R0 = OPERATOR
;
; OUTPUTS:
;	C-BIT CLEAR => IS ASSIGNMENT
;
; All registers are preserved
;-

ISASG:	CMP	R0,#OP.ASG	;ASSIGNMENT?
	BEQ	10$		;YES
	CMP	R0,#OP.BCA	;BIT CLEAR ASSIGNMENT
	BEQ	10$		;YES
	CMP	R0,#OP.INB	;INC BEFORE IS OK
	BEQ	10$
	CMP	R0,#OP.DEB	;SO IS DEC BEFORE
	BEQ	10$
	CMP	R0,#OP.ADA	;NO, IS IT ONE OF THE
	BLO	20$		;MORE COMPLEX
	CMP	R0,#OP.XRA	;ASSIGNMENT
	BHI	20$		;OPS

10$:	CLC			; IS ASSIGNMENT
	BR	30$
20$:	SEC			; IS NOT ASSIGMENT
30$:	RETURN

;+
;
; ** chkreg - see if a tree references a register		;u5/u14+
;
; inputs
;	r5 = tree
;	r4 = register to check
;	r2 = type of register in r4
;
; outputs:
;	C-bit set if referenced, else clear.
;
;-

chkreg:	mov	r0,-(sp)	;save the world
	mov	r5,-(sp)
;
	mov	(r5),r0		;opcode
	asl	r0
	mov	opdope(r0),r0	;get dope on it
	bit	#leaf,r0	;is it a leaf?
	bne	chklf		;br if so
;
	mov	e.lop(r5),r5	;left branch
	call	chkreg		;check it
	bcs	chkret		;done if referenced
;
	mov	(sp),r5		;refresh tree pointer
	mov	e.rop(r5),r5	;right branch
	beq	chkret		;done if none
	call	chkreg		;check it
	br	chkret
;
; found a leaf
;
chklf:	cmp	(r5),#op.reg	;is it a register node?
	bne	20$		;ignore if not
	cmp	r4,e.reg(r5)	;same register?
	bne	20$		;ignore if not
	cmpb	e.type(r5),#ty.flt	;Set C-bit if leaf is general reg
	rol	r0		; Save C-bit
	cmpb	#ty.flt-1,r2	; Set C-bit if (r4) is floating reg
	adc	r0		; Add to save (if bit 0 == 1, regs are same)
	ror	r0		; Set C-bit if regs are same
	br	chkret		;return
20$:	clc			;not found
;
chkret:	mov	(sp)+,r5	;restore world
	mov	(sp)+,r0
	return								;u5/u14-

	.END