.IIF	NDF	RSX	RSX	=	1	;Assume RSX	;01
	.TITLE	CC103
	.ident	/X01.U6/

	.NLIST	BEX, CND
	.ENABL	LC, GBL
	.LIST	MEB						;01-

;
; C COMPILER.
; EXPRESSION TO TREE
;
; VERSION X01
;
; DAVID G. CONROY	14-NOV-77
; LAST UPDATED:		08-MAY-79
;
; Edit history
; 01 04-Mar-80 MM	Updated for RT11
; 02 23-Jul-80 MM	Tree size := 750.
; 03 02-Jun-81 MM	No inline EIS, fixed sick get size of expression bug
; u1 24-Aug-81 CCG	Changed default mode to float from double
; u2 03-Sep-81 CCG	Fixed bug in RETURN value type.
; u3 14-Sep-81 CCG	Changed around statements in FOR
; u4 28-Sep-81 CCG	Added code to distinguish members of different structs
; u5 11-Dec-81 CCG	Force ASG op's to be type of left. (No CVM's).
; 04 09-Feb-82 MM	Merged Unimation sources, FFLAG=0 undoes u1
; 05 21-Mar-82 MM/DGC	Added "Used" bit to local symbols
; u6 15-Apr-82 CCG	Fixed bug in ?= operators.
;			Eliminated spurious register move for char compares.
;			Eliminated CVR's between identical types.
; u7 21-Jul-82 CCG	Added OP.MLL, removed OP.CVM references.
;			Pass OP.COT information to pass 2.
; u8 24-Nov-82 CCG	Tree size := 800.
;

	.GLOBL	EXPR
	.GLOBL	RCVN
	.GLOBL	GTYPE
	.GLOBL	CLRTRE
	.GLOBL	PSHTRE						;u3
	.GLOBL	POPTRE						;u3
	.GLOBL	CONXPR
	.GLOBL	TREES1						;01
	.GLOBL	OUTREE
	.GLOBL	INITFG

.IF NE	RSX							;01
	.MCALL	CALLR
.ENDC								;01

;
; EQUIVALENCES
;

.IIF NDF C$$EIS	C$$EIS = 0	;DEFAULT TO NON-FANCY CODE	;01
C$$EIS	=	0		;NO EIS (there are bugs)	;03

PRIO	=	000077		;BITS IN THE OPDOPE VECTOR
BINOP	=	000100		;BINARY OP
RASSOC	=	000200		;RIGHT ASSOCIATIVE OP
HLV	=	000400		;RESULT HAS LVALUE
NLV	=	001000		;LVALUE REQUIRED ON LEFT
LW	=	002000		;WORD REQUIRED ON LEFT
RW	=	004000		;WORD REQUIRED ON RIGHT
NF	=	010000		;NO FLOATS
NP	=	020000		;NO POINTERS

SSIZE	=	20.		;SIZE OF THE EXPRESSION STACKS
TSIZE	=	800.		;SIZE OF THE TREE SPACE		;u8

;
; DATA.
;

	.PSECT	LD103,OVR,GBL					;01
ONE:	.WORD	OP.CON		;A CONSTANT 1 TREE
	.BYTE	0,TY.INT	;CLASS AND TYPE
	.WORD	0		;DIMP
	.WORD	0		;STRUCTURE SIZE
	.WORD	1		;CONSTANT VALUE

FV:	.WORD	OP.REG		;STUFFED FOR RCVN CONVERSION
	.BYTE	CL.REG		;CLASS
FV1:	.BLKB	1		;STUFFED BY TYPE
FV2:	.BLKW	1		;STUFFED BY DIMP
FV3:	.BLKW	1		;STUFFED BY SIZE
	.WORD	0		;OFFSET
	.WORD	0		;REGISTER R0

INITFG:	.WORD	0		;INIT FLAG, MAKES "," AMD ":" SPECIAL.
TPTR:	.WORD	TREE		;POINTER TO NEXT FREE TREE BYTE
TRBASE:	.WORD	TREE		;BASE OF TREE, STARTS AT "TREE"		;u3
OPXPCT:	.BLKW	1		;OPERATOR EXPECTED FLAG
NPTR:	.BLKW	1		;OPERAND STACK POINTER
OPTR:	.BLKW	1		;OPERATOR STACK POINTER
PPTR:	.BLKW	1		;PRIORITY STACK POINTER
NEND:	.BLKW	1		;POINTER TO END OF NSTACK.
OEND:	.BLKW	1		;POINTER TO END OF OSTACK.
TREE:	.BLKW	TSIZE		;TREE SPACE

;
; ERRORS
;

	.PSECT	ER103						;01
ERR01:	.ASCIZ	"Expression too complex"
ERR02:	.ASCIZ	"Out of tree space"
ERR03:	.ASCIZ	"Expression syntax"
ERR04:	.ASCIZ	"Illegal structure/union operation"
ERR05:	.ASCIZ	"Lvalue required"
ERR06:	.ASCIZ	"Mismatched "<140>"?' and "<140>":'"
ERR07:	.ASCIZ	"Call of non function"
ERR08:	.ASCIZ	"Illegal indirection"
ERR09:	.ASCIZ	"Structure/union member required"
ERR10:	.ASCIZ	"Type clash"
ERR11:	.ASCIZ	"Constant expression required"
ERR12:	.ASCIZ	"Class not permitted in cast"
ERR13:	.ASCIZ	"Type is required in cast"
ERR14:	.ASCIZ	"Missing "<140>"]' in cast"
ERR15:	.ASCIZ	"Missing "<140>")' in cast"
ERR16:	.ASCIZ	"Build botch -- cast"

	.EVEN


	.PSECT	CC103						;01
CC103::								;01
;+
; ** EXPR - EXPRESSION TO TREE
;
; READ IN AN EXPRESSION AND BUILD A TREE IN THE TREE SPACE. IT'S  THE
; CLASSICAL PRIORITY DRIVEN, BOTTOM UP APPROACH. MOST OF THE CODE WAS
; STOLEN FROM DMR.
;
; INPUTS:
;	LEX0=THE FIRST TOKEN OF THE EXPRESSION
;
; OUTPUTS:
;	R5=POINTER TO TREE
;	LEX0=TOKEN THAT STOPPED THE SCAN
;-

EXPR:	MOV	R0,-(SP)	;SAVE REGISTERS
	MOV	R1,-(SP)	;
	MOV	R2,-(SP)	;
	MOV	R3,-(SP)	;
	MOV	R4,-(SP)	;

	MOV	LSTRUC,-(SP)	;SAVE LAST STRUCTURE ID			;u4
	MOV	NPTR,-(SP)	;SAVE
	MOV	NEND,-(SP)	;THE
	MOV	OPTR,-(SP)	;OLD
	MOV	OEND,-(SP)	;STACK
	MOV	PPTR,-(SP)	;JUNK
	MOV	OPXPCT,-(SP)	;SAVE THIS FLAG TOO.

	MOV	SP,OEND		;END OF OP STACK.
	SUB	#2*SSIZE,SP	;CLAIM
	MOV	SP,OPTR		;OP STACK
	MOV	#OP.EOF,(SP)	;INITIALISE TO EOF.
	SUB	#2*SSIZE,SP	;CLAIM
	MOV	SP,PPTR		;PRIO. STACK
	MOV	#6,(SP)		;INITIALISE TO PRIO(EOF).
	MOV	SP,NEND		;END OF NAME STACK.
	SUB	#2*SSIZE,SP	;CLAIM
	MOV	SP,NPTR		;NAME STACK.
	SUB	#2,NPTR		;POINT AT RIGHT PLACE.

	CLR	OPXPCT		;NOT EXPECTING OPERATOR
	MOV	LEX0,R0		;PICK UP TOKEN AND ...
	BR	20$		; ... GO

10$:	CALL	SCAN		;RE ENTER TO GET NEXT TOKEN

;
; OPERANDS
; IDENTIFIERS
; CONSTANTS
; STRINGS
;

20$:	CMP	R0,#OP.ID	;IDENTIFIER
	BNE	25$		;NO
	MOV	VAL0,R5		;PTR TO SYMBOL NODE
	TSTB	S.CLAS(R5)	;UNDEFINED
	BNE	40$		;NO
	CMP	LEX1,#OP.LPA	;IS THE NEXT TOKEN A '('
	BNE	30$		;NO
	MOV	#D.LENG,R0	;YES, MAKE FUNCTION RETURNING INT
	CALL	$ALLOC		;
	CLR	D.LINK(R0)	;
	CLR	D.BOUN(R0)	;
	MOV	#DT.FUN,D.TYPE(R0)
	MOV	R0,S.DIMP(R5)	;SET INTO DIM LIST OF THE SYMBOL
	BR	32$		;FINISH IN COMMON CODE

30$:	TST	INITFG		;NOT FUNCTION, ARE WE DOING INITIALISERS
	BEQ	35$		;NO
32$:	MOVB	#CL.GBR,S.CLAS(R5) ;DEFAULT TO GLOBAL REFERENCE
	MOVB	#TY.INT,S.TYPE(R5) ;INT
	BISB	#SF.PRM,S.FLAG(R5) ;AND NON DELETABLE			;05
	BR	40$
35$:	CALL	UNDEF		;IT UNDEFINED, COMPLAIN
	MOVB	#CL.AUT,S.CLAS(R5)
	MOVB	#TY.INT,S.TYPE(R5)

40$:	BISB	#SF.USE,S.FLAG(R5) ; MARK "SYMBOL REFERENCED"		;05
	MOVB	S.CLAS(R5),R0	;GET THE CLASS OF THE NAME
	MOV	S.ADDR(R5),R1	;AND THE ADDRESS FROM THE NODE
	CMP	R0,#CL.AUT	;AUTO
	BNE	42$		;NO
	MOV	#ES.REG,R2	;BUILD
	CALL	TREES1		;INDEX				;01
	MOV	#OP.INX,(R2)	;NODE
	MOV	#5,E.REG(R2)	;OFF
	MOV	R1,E.OFFS(R2)	;REGISTER R5
	BR	47$

25$:	BR	50$		;MAKE BRANCH REACH		;05

42$:	CMP	R0,#CL.REG	;REGISTER
	BNE	43$		;NO
	MOV	#ES.REG,R2	;BUILD REGISTER NODE
	CALL	TREES1						;01
	MOV	#OP.REG,(R2)
	MOV	R1,E.REG(R2)
	BR	47$

43$:	CMP	R0,#CL.MOS	;MEMBER OF STRUCTURE
	BNE	45$		;NO
	MOV	R1,R0		;YES, BUILD
	CALL	BCONST		;CONSTANT
	BITB	#SF.FLD,S.FLAG(R5) ;AND IF THE SYMBOL		;05
	BEQ	47$		;IS A FIELD
	MOV	R2,-(SP)	;THEN
	MOV	#ES.FLD,R2	;BUILD A FIELD
	CALL	TREES1		;NODE				;01
	MOV	#OP.FLD,(R2)	;TO SIT
	MOV	(SP)+,E.LOP(R2)	;ON TOP OF
	MOVB	S.WIDE(R5),E.WIDE(R2) ;THE
	MOVB	S.BOFS(R5),E.BOFS(R2) ;CONSTANT
	BR	47$		;HARUMPH.

45$:	CMP	R0,#CL.SIN	;STATIC
	BNE	46$		;NO
	MOV	#ES.LID,R2	;BUILD LOCAL ID NODE
	CALL	TREES1						;01
	MOV	#OP.LID,(R2)
	MOV	R1,E.LAB(R2)
	BR	47$

46$:	MOV	#ES.ID,R2	;BUILD ID NODE
	CALL	TREES1						;01
	MOV	#OP.ID,(R2)
	MOV	R5,R3
	ADD	#S.NAME,R3
	MOV	R2,R4
	ADD	#E.NAME,R4
460$:	MOVB	(R3)+,(R4)+
	BNE	460$

47$:	MOVB	S.CLAS(R5),E.CLAS(R2) ;COPY SYMBOL CLASS
	MOV	S.DIMP(R5),E.DIMP(R2) ;AND DIMENSIONS
	MOVB	S.TYPE(R5),R0	;COPY THE TYPE INTO THE
	MOVB	R0,E.TYPE(R2)	;TREE NODE
	CMP	R0,#TY.STR	;AND IF THE TYPE IS STRUCT (OR UNION)
	BLO	70$		;THEN
	MOV	S.DOPE(R5),R0	;SET THE STRUCTURE DOPE			;u4+
	MOV	R0,E.DOPE(R2)	;FROM THE SYMBOL DOPE
	MOV	S.STID(R0),LSTRUC ; STRUCTURE SEEN, SAVE ID		;u4-
	BR	70$		;AND GO TO COMMON CODE

50$:	CMP	R0,#OP.CON	;CONSTANT
	BNE	52$		;NO
	MOV	#TY.INT,R0	;SET TYPE
	BR	58$		;

52$:	CMP	R0,#OP.LCN	;LONG CONSTANT
	BNE	54$		;NO
	MOV	#TY.LNG,R0	;SET TYPE
	BR	58$		;

54$:	CMP	R0,#OP.FCN	;FLOATING CONSTANT?		;u1+
	BNE	55$		;NO
	TSTB	FFLAG		;SHOULD FLOATS BECOME DOUBLE	;04
	BEQ	56$		;YES (C STANDARD)		;04
	MOV	#TY.FLT,R0	;SET TYPE
	BR	58$

55$:	CMP	R0,#OP.DCN	;DOUBLE CONSTANT		;u1-
	BNE	60$		;NO
56$:				;FORCE FLOATS TO DOUBLE		;04
	MOV	#TY.DBL,R0	;SET TYPE

58$:	MOV	#ES.CON,R2	;GET A CONSTANT NODE
	CALL	TREES1		;				;01
	MOV	#OP.CON,(R2)	;SET OPERATOR
	MOVB	R0,E.TYPE(R2)	;SET TYPE
	MOV	VAL0,E.VAL(R2)	;SET VALUE
	MOV	VAL02,E.VAL+2(R2)				;01
	MOV	VAL04,E.VAL+4(R2)				;01
	MOV	VAL06,E.VAL+6(R2)				;01
	BR	70$		;GO PUSH IT

60$:	CMP	R0,#OP.CST	;C STRING?
	BNE	80$		;NO
	CALL	GETSTR		;GOBBLE UP THE STRING
	MOV	#D.LENG,R2	;MAKE A LOCAL ID, ARRAY+CHAR
	CALL	TREES1		;MAKE DIM NODE IN TREE SPACE	;01
	MOV	#DT.ARY,D.TYPE(R2) ;TYPE IS ARRAY
	MOV	R2,R5		;THEN
	MOV	#ES.LID,R2	;GET THE LOCAL
	CALL	TREES1		;ID NODE			;01
	MOV	#OP.LID,(R2)	;OP
	MOVB	#TY.CHR,E.TYPE(R2) ;TYPE
	MOV	R5,E.DIMP(R2)	;DIMP
	MOV	R0,E.LAB(R2)	;LABEL OF THE STRING

70$:	TST	OPXPCT		;WAS AN OPERATOR EXPECTED?
	BNE	94$		;YES, ERROR

	CALL	BUMPN		;PUSH ONTO OPERAND STACK
	MOV	R2,@NPTR
	INC	OPXPCT		;SET OPERATOR EXPECTED
	JMP	10$

;
; OPERATORS
; MODIFY CERTAIN OPERATORS TO THEIR UNARY MEANINGS
; SET '++' AND '--' TO PREFIX OR POSTFIX FORM, AS REQUIRED.
;

80$:	CMP	R0,#OP.INB	;PREFIX '++' OR '--'
	BEQ	82$
	CMP	R0,#OP.DEB
	BNE	90$
82$:	TST	OPXPCT		;IF EXPECTING OPERATOR
	BEQ	83$							;u4
	INC	R0		;CHANGE TO 'AFTER' FORM.
83$:	JMP	150$							;u4

90$:	CMP	R0,#OP.NOT	;MAKE SURE '!'
	BEQ	92$
	CMP	R0,#OP.SIZ	;AND SIZEOF
	BEQ	92$
	CMP	R0,#OP.COM	;AND TILDE
	BNE	100$
92$:	TST	OPXPCT		;ARE BEING USED IN UNARY SENSE
	BEQ	150$
94$:	JMP	270$

100$:	CMP	R0,#OP.SUB	;'-', MAY BE NEGATION
	BNE	110$
	TST	OPXPCT
	BNE	102$
	MOV	#OP.NEG,R0	;CHANGE TO UNARY FORM
102$:	CLR	OPXPCT		;IN ANY CASE, NEED OPERAND NOW
	BR	150$

110$:	CMP	R0,#OP.AND	;CHANGE AND AND MUL TO ADR AND IND
	BEQ	112$
	CMP	R0,#OP.MUL
	BNE	120$
112$:	TST	OPXPCT		;IF EXPECTING OPERAND
	BEQ	114$
	CLR	OPXPCT		;IF BINARY, NEED OPERAND NOW
	BR	150$
114$:	CMP	R0,#OP.AND	;MAKE THE CHANGE
	BNE	116$
	MOV	#OP.ADR,R0
	BR	150$
116$:	MOV	#OP.IND,R0
	BR	150$

120$:	CMP	R0,#OP.LPA	;'('
	BNE	130$		;NO.
	TST	OPXPCT		;ARE WE EXPECTING AN OPERATOR?
	BEQ	122$		;NO.
	CMP	LEX1,#OP.RPA	;IS IT THE '()' OF A NO ARGS CALL?
	BNE	121$		;NO
	CALL	SCAN		;YES, SKIP OVER THE ')'
	MOV	#OP.NAC,R0	;MAKE OPERATOR A NO ARGS CALL
	BR	150$		;GO PUSH

121$:	MOV	#OP.JSR,R0	;MAKE OPERATOR NORMAL CALL
	CLR	OPXPCT		;OP NOT EXPECTED.
	BR	150$		;GO PUSH

122$:	CALL	CAST		;TRY FOR A CAST.
	BCS	150$		;DIDN'T GET ONE, DONE.
	MOV	#ES.OP,R2	;ALLOCATE A NEW
	CALL	TREES1		;TREE NODE.			;01
	MOV	#OP.COT,(R2)	;OP = CAST OF TYPES.
	MOVB	R3,E.TYPE(R2)	;TYPE AND
	MOV	R4,E.DIMP(R2)	;DIMS AND
	CMP	R3,#TY.STR	;IF THIS IS A STRUCT
	BLO	1220$		;THEN
	MOV	R5,E.DOPE(R2)	;SET STRUCTURE DOPE			;u4
1220$:	CALL	BUMPN		;THEN SHOVE THE NODE
	MOV	R2,@NPTR	;ON THE NAME STACK.

	CMP	@OPTR,#OP.SIZ	;IS THIS SIZEOF(TYPE)?
	BNE	123$		;NOPE.
	TST	OPXPCT		;IF OPERATOR IS EXPECTED THEN
	BNE	94$		;THE EXPRESSION WENT SIZEOF I (TYPE).
	INC	OPXPCT		;ITS NEEDED NOW.
	JMP	10$		;START AGAIN.

123$:	MOV	#OP.COT,R0	;OP = CAST OF TYPES.
	BR	150$		;AND GO DO OP.

130$:	CMP	R0,#OP.RSQ	;']' MUST BE AT CORRECT TIME
	BEQ	132$
	CMP	R0,#OP.RPA	;')' DITTO
	BNE	140$
132$:	TST	OPXPCT
	BNE	150$
134$:	JMP	270$

140$:	TST	OPXPCT		;ALL BINARIES
	BEQ	134$		;ERROR IF NOT EXPECTING OPERATOR
	CLR	OPXPCT		;NEED OPERAND NOW
;

; PUSH OPERATOR ONTO STACK
; POP LOWER PRIORITY OPERATORS INTO THE TREE
;

150$:	MOV	R0,R1		;GET DOPE
	ASL	R1
	MOV	OPDOPE(R1),R1
	MOV	R1,R2		;AND PRIORITY
	BIC	#^C<PRIO>,R2

	CMP	R0,#OP.CMA	;LOWER STRENGTH OF ","
	BEQ	155$		;AND OF
	CMP	R0,#OP.CLN	;":" WHEN THE
	BNE	160$		;EXPRESSION
155$:	TST	INITFG		;IS IN AN
	BEQ	160$		;INITIALISATION
	MOV	#5,R2		;CONTEXT

160$:	CMP	R2,@PPTR	;COMPARE THIS OP TO STACK OP
	BHI	170$		;HIGHER, PUSH
	BLO	200$		;LOWER, POP STACK INTO TREE
	BIT	#RASSOC,R1	;EQUAL, POP IF LEFT ASSOCIATIVE
	BEQ	200$

170$:	CMP	R0,#OP.INA	;ADJUST STRENGTHS BEFORE THE PUSH
	BEQ	172$
	CMP	R0,#OP.DEA
	BNE	174$
172$:	MOV	#37,R2
	BR	180$

174$:	CMP	R0,#OP.LPA
	BEQ	176$
	CMP	R0,#OP.LSQ
	BEQ	176$
	CMP	R0,#OP.JSR
	BNE	180$
176$:	MOV	#4,R2

180$:	ADD	#2,OPTR
	CMP	OPTR,OEND	;ROOM?
	BHIS	185$
	MOV	R0,@OPTR
	ADD	#2,PPTR
	MOV	R2,@PPTR
	JMP	10$

185$:	MOV	#ERR01,R0	;EXPRESSION TOO COMPLEX
	CALL	ERROR1						;01
	JMP	CCABR1						;01

;
; POP OPERATOR OFF THE STACK AND INTO THE TREE.
; R0=INPUT OP
; R1=DOPE OF INPUT OP
; R2=PRIORITY OF INPUT OP
; MUST NOT ALTER ANY OF THESE
;

200$:	SUB	#2,PPTR		;SLUFF
	MOV	@OPTR,R3	;OP FROM TOP OF STACK
	SUB	#2,OPTR

	CMP	R3,#OP.EOF	;IF EOF
	BEQ	300$		;YES, DONE

	CMP	R3,#OP.CMA	;',' NOT IN AN ARGLIST IS SEQ.
	BNE	210$
	CMP	@OPTR,#OP.JSR
	BEQ	260$
	MOV	#OP.SEQ,R3
	BR	260$

210$:	CMP	R3,#OP.JSR	;CALL MUST BE POPPED BY ')'
	BNE	220$
	CMP	R0,#OP.RPA
	BNE	270$
	CALL	BUILD		;MAKE TREE NODE
	JMP	10$

220$:	CMP	R3,#OP.NAC	;FAKE ARGLIST FOR NAC
	BNE	230$
	CALL	BUMPN
	CLR	@NPTR
	MOV	#OP.JSR,R3
	BR	260$

230$:	CMP	R3,#OP.INA	;CONSTANT 1 ROP FOR '++', '--'
	BEQ	232$
	CMP	R3,#OP.INB
	BEQ	232$
	CMP	R3,#OP.DEA
	BEQ	232$
	CMP	R3,#OP.DEB
	BNE	240$
232$:	CALL	BUMPN
	MOV	#ONE,@NPTR
	BR	260$

240$:	CMP	R3,#OP.LPA	;CHECK FOR BALANCED PARENS.
	BNE	250$		;AND DELETE BOTH
	CMP	R0,#OP.RPA
	BNE	270$
	JMP	10$

250$:	CMP	R3,#OP.LSQ	;CHECK FOR BALANCED BRACKETS.
	BNE	260$		;AND DELETE BOTH
	CMP	R0,#OP.RSQ
	BNE	270$
	CALL	BUILD		;AFTER BUILDING THE TREE NODE
	JMP	10$

260$:	CALL	BUILD		;MAKE THE NODE, AND
	JMP	160$		;TRY TO POP AGAIN

;
; SYNTAX ERROR
; PRINT THE DIAGNOSTIC, THEN SKIP TO A DELIMITER.
;

270$:	MOV	#ERR03,R0	;EXPRESSION SYNTAX
	CALL	ERROR1						;01
	CLR	R5		;RETURN VALUE IS A NULL POINTER
	MOV	LEX0,R0

280$:	CMP	R0,#OP.EOF	;STOP ON EOF
	BEQ	310$
	CMP	R0,#OP.SEM	;SEMICOLON
	BEQ	310$
	CMP	R0,#OP.LBR	;OPEN BRACE
	BEQ	310$
	CMP	R0,#OP.RBR	;CLOSE BRACE
	BEQ	310$
	CALL	ESCAN
	BR	280$

;
; END OF EXPRESSION
; THE TREE IS ON THE TOP OF THE OPERAND STACK
;

300$:	CALL	BUILD		;FLUSH OUT CONVERSIONS
	MOV	@NPTR,R5	;GET TREE

310$:	ADD	#6*SSIZE,SP	;DISCARD STACKS.

	MOV	(SP)+,OPXPCT	;FLAG

	MOV	(SP)+,PPTR	;RESTORE
	MOV	(SP)+,OEND	;ALL
	MOV	(SP)+,OPTR	;OF
	MOV	(SP)+,NEND	;THE
	MOV	(SP)+,NPTR	;STACKS
	MOV	(SP)+,LSTRUC	;RESTORE LAST STRUC SEEN		;u4

	MOV	(SP)+,R4	;RETURN
	MOV	(SP)+,R3
	MOV	(SP)+,R2
	MOV	(SP)+,R1
	MOV	(SP)+,R0
	RETURN

;+
; ** BUMPN - BUMP NSTACK POINTER (NPTR)
;
; THIS ROUTINE IS CALLED FROM ALL OVER BUILD AND EXPR TO SEE
; IF THERE IS ROOM ON THE OPERAND STACK, AND TO ADVANCE  THE
; POINTER. IF THERE IS NO ROOM WE BLOW UP.
;-

BUMPN:	ADD	#2,NPTR
	CMP	NPTR,NEND
	BLO	10$

	MOV	#ERR01,R0
	CALL	ERROR1						;01
	JMP	CCABR1						;01

10$:	RETURN

;+
; ** BUILD - BUILD TREE NODE
;
; THIS ROUTINE TAKES  OPERANDS OFF THE TOP OF THE OPERAND STACK
; AND BUILD A TREE NODE.  THE POINTER TO THE TREE NODE IS  THEN
; RETURNED ON THE TOP OF THE OPERAND STACK.
;
; MOST OF THE WORK IS THE INSERTION OF THE NECESSARY CONVERSION
; OPERATORS AND MAKING SURE THE DIMS ARE SET UP PROPERLY.
;
; INPUTS:
;	R3=OPERATOR
;-

ROP	=	6		;RIGHT OPERAND
RT	=	4		;RIGHT OPERAND TYPE
LOP	=	2		;LEFT OPERAND
LT	=	0		;LEFT OPERAND TYPE

BUILD:	MOV	R5,-(SP)	;SAVE THE REGISTERS
	MOV	R4,-(SP)
	MOV	R3,-(SP)
	MOV	R2,-(SP)
	MOV	R1,-(SP)
	MOV	R0,-(SP)
	SUB	#10,SP		;AND GET 4 WORDS OF LOCALS

;
; A[B] IS CONVERTED TO *(A+B)
;

	CMP	R3,#OP.LSQ	;IS IT A SUBSCRIPTING OP
	BNE	10$		;NO
	MOV	#OP.ADD,R3	;BUILD UP
	CALL	BUILD		;A+B
	MOV	#OP.IND,R3	;THEN '*' THROUGH THE RESULT

;
; PERFORM THE REQUIRED TRANSFORMATIONS ON NAMES OF ARRAYS AND
; OF FUNCTIONS.
;

10$:	MOV	R3,R4		;GET
	ASL	R4		;OFFSET AND
	MOV	OPDOPE(R4),R4	;GET THE DOPE

	CLR	ROP(SP)		;SET DEFAULTS FOR THE
	CLR	RT(SP)		;RIGHT SIDE

	BIT	#BINOP,R4	;BINARY OP
	BEQ	20$		;NO
	MOV	@NPTR,R2	;YES, GET THE
	SUB	#2,NPTR		;OPERAND
	TST	R2		;MAY BE NULL IN
	BEQ	20$		;FUNCTION CALL
	CALL	CHARY		;CHECK FOR ARRAYS
	CALL	CHFUN		;AND FUNCTIONS
	MOV	R2,ROP(SP)	;SAVE POINTER TO THE RIGHT SIDE
	CALL	GTYPE		;AND
	MOV	R0,RT(SP)	;THE TYPE OF THE RIGHT SIDE

20$:	MOV	@NPTR,R2	;GET LEFT (OR ONLY) OPERAND
	SUB	#2,NPTR		;BACK UP OPERAND STACK POINTER
	CMP	R3,#OP.SIZ	;SIZEOF
	BNE	30$		;NO
	CALL	ELENG		;GET SIZE (TREE IN R2)
	CALL	BCONST		;MAKE UP THE INTEGER CONSTANT
25$:	JMP	400$		;AND RETURN IT

30$:	CMP	R3,#OP.ADR	;IS THE OPERATOR '&'
	BEQ	40$		;YES
	CALL	CHARY		;NO, DO THE ARRAY GAME
	CMP	R3,#OP.JSR	;AND IF THE OPERATOR IS NOT A CALL
	BEQ	40$		;THEN
	CALL	CHFUN		;PLAY THE FUNCTION GAME

40$:	CMP	R3,#OP.EOF	;ARE WE FLUSHING CONVERSIONS
	BEQ	25$		;YES, FINISHED (YES, ITS BACKWARD)

	MOV	R2,LOP(SP)	;SAVE LEFT OPERAND
	CALL	GTYPE		;AND
	MOV	R0,LT(SP)	;THE LEFT TYPE

;
; CHECK FOR OPERANDS INCOMPATABLE WITH OPERATORS.
; IF ANY FUNNYNESSES ARE FOUND, THE TYPES ARE CHANGED INTO
; HARMLESS INTEGERS. THIS PREVENTS MORE TYPE CLASH  ERRORS
; FROM BEING GENERATED LATER ON (WHEN THE NODE IS BUILT).
;

	CMP	R3,#OP.ADR	;'&'
	BEQ	60$
	CMP	R3,#OP.DOT	;'.'
	BEQ	60$
	CMP	R3,#OP.ARO	;'->'
	BEQ	60$
	CMP	LT(SP),#TY.STR	;CHECK IF LOP A STRUCTURE
	BEQ	50$		;ERROR IF YES
	CMP	RT(SP),#TY.STR	;CHECK IF ROP A STRUCTURE
	BNE	60$		;BR IF NOT
50$:	MOV	#ERR04,R0	;ILLEGAL STRUCTURE OP
	CALL	ERROR1						;01

60$:	BIT	#NLV,R4		;LVALUE REQUIRED ON LEFT
	BEQ	80$		;NO
	MOV	@LOP(SP),R0	;GET LEFT SUBTREE OPERATOR
	CMP	R3,#OP.ADR	;CANNOT
	BNE	65$		;TAKE
	CMP	R0,#OP.REG	;ADDRESS OF
	BEQ	70$		;REGISTER
65$:	ASL	R0		;OTHERWISE CHECK
	BIT	#HLV,OPDOPE(R0)	;IF THE OPERATOR
	BNE	80$		;HAS AN LVALUE RESULT
70$:	MOV	#ERR05,R0	;LVALUE REQUIRED
	CALL	ERROR1						;01

80$:	MOV	LT(SP),R0	;GET THE TYPES
	MOV	RT(SP),R1	;OF THE OPERANDS
	BIT	#LW,R4		;WORD OPERAND REQUIRED ON LEFT
	BEQ	90$		;NO
	CMP	R0,#TY.LNG	;ERROR IF LONG, FLOAT, DOUBLE
	BHIS	120$

90$:	BIT	#RW,R4		;WORD OPERAND REQUIRED ON RIGHT
	BEQ	100$		;NO
	CMP	R1,#TY.LNG	;ERROR IF LONG, FLOAT, DOUBLE
	BHIS	120$

100$:	BIT	#NF,R4		;NON FLOAT REQUIRED ON BOTH
	BEQ	110$		;NO
	CMP	R0,#TY.FLT	;ERROR IF LEFT
	BHIS	120$		;IS FLOAT OR DOUBLE
	CMP	R1,#TY.FLT	;ERROR IF RIGHT
	BHIS	120$		;IS FLOAT OR DOUBLE

110$:	BIT	#NP,R4		;NON POINTER REQUIRED ON BOTH
	BEQ	130$		;NO
	CMP	R0,#TY.PTR	;ERROR IF LEFT
	BEQ	120$		;IS POINTER
	CMP	R1,#TY.PTR	;ERROR IF RIGHT
	BNE	130$		;IS POINTER

120$:	CALL	CLASH		;TYPE CLASH
	MOV	#TY.INT,LT(SP)	;CHANGE BOTH TYPES TO
	MOV	#TY.INT,RT(SP)	;HARMLESS INTEGERS

;
; BEGIN CONSTRUCTION OF THE TREE NODE
; R3=OP	  R4=LEFT  R5=RIGHT
;

130$:	MOV	LOP(SP),R4	;SET UP REGISTERS
	MOV	ROP(SP),R5	;IN STANDARD WAY

	CMP	R3,#OP.QRY	;QUESTION
	BNE	140$		;NO
	CMP	(R5),#OP.CLN	;THE QUESTION MUST MATCH WITH A COLON
	BEQ	142$		;OR
	MOV	#ERR06,R0	;ILLEGAL CONDITIONAL
	CALL	ERROR1						;01
	BR	142$

140$:	CMP	R3,#OP.SEQ	;SEQUENTIAL EXECUTION
	BNE	150$		;NO
142$:	MOV	RT(SP),R0	;GETS TYPE AND DIMS
	MOV	E.DIMP(R5),R1	;FROM ROP
	BR	178$		;AND GO BUILD NODE

150$:	CMP	R3,#OP.CMA	;COMMA IN ARGLIST
	BNE	160$		;NO
	CLR	R0		;IS UNDEFINED
	CLR	R1		;IN BOTH TYPE AND DIMS
	BR	178$		;GO BUILD NODE

160$:	CMP	R3,#OP.AA	;LOGICAL AND
	BEQ	162$
	CMP	R3,#OP.OO	;LOGICAL OR
	BEQ	162$
	CMP	R3,#OP.NOT	;LOGICAL NOT
	BNE	170$
162$:	MOV	#TY.INT,R0	;RETURN SCALAR INT
	CLR	R1		;FOR ALL OPERANDS
	BR	178$		;GO BUILD NODE

;
; CALL
; FIDDLE THE DIMS TO REMOVE THE FUNCTION NODE.
; CHECK TYPE FOR CHARS AND FLOATS AND ADJUST TO CORRESPOND
; WITH REALITY.
;

170$:	CMP	R3,#OP.JSR	;CALL
	BNE	180$		;NO
	MOV	E.DIMP(R4),R1	;TEST FOR CALL OF NON FUNCTION
	BEQ	172$		;CANNOT CALL A SCALAR
	CMP	D.TYPE(R1),#DT.FUN ;OR
	BNE	172$		;A POINTER OR ARRAY
	MOV	(R1),R1		;RESULT DIMS IS DECREF(DIMS)
	BR	174$
172$:	MOV	#ERR07,R0	;CALL OF NON FUNCTION
	CALL	ERROR1						;01

174$:	MOVB	E.TYPE(R4),R0	;GET RESULT TYPE
	TST	R1		;IS THE RESULT A SCALAR
	BNE	178$		;NO
	CMP	R0,#TY.CHR	;FUNCTIONS NEVER RETURN CHAR
	BNE	176$
	MOV	#TY.INT,R0
	BR	178$
176$:								;u1+/04+
	TSTB	FFLAG		;KEEP FLOAT AS FLOAT?
	BNE	178$		;YES.
	CMP	R0,#TY.FLT	;MAKE FLOAT func() return double
	BNE	178$
	MOV	#TY.DBL,R0					;u1-/04-
178$:	JMP	300$

;
; INDIRECTION
; CHANGE 'POINTER TO X' TO PLAIN 'X' IN THE DIM
;

180$:	CMP	R3,#OP.IND	;INDIRECTION
	BNE	190$		;NO
;	CMP	(R4),#OP.ADR	;DELETE
;	BNE	182$		;'*'
;	MOV	E.LOP(R4),R2	;OF
;	JMP	400$		;'&'

182$:	MOV	E.DIMP(R4),R1	;CHECK FOR ILLEGAL INDIRECTION
	BEQ	184$		;CANNOT INDIRECT THROUGH A SCALAR
	CMP	D.TYPE(R1),#DT.FUN ;OR
	BEQ	184$		;A FUNCTION
	MOV	(R1),R1		;DECREF
	BR	194$		;DIMENSIONS
184$:	MOV	#ERR08,R0	;ILLEGAL INDIRECTION
	CALL	ERROR1						;01
	BR	194$

;
; ADDRESS
; CHANGE PLAIN 'X' TO 'POINTER TO X'
;

190$:	CMP	R3,#OP.ADR	;ADDRESS
	BNE	200$		;NO
;	CMP	(R4),#OP.IND	;DELETE
;	BNE	192$		;'&'
;	MOV	E.LOP(R4),R2	;OF
;	JMP	400$		;'*'

192$:	CALL	MPTR		;MAKE A POINTER NODE
	MOV	E.DIMP(R4),(R2)	;MAKE X INTO POINTER TO X
	MOV	R2,R1		;THIS IS THE NEW DIMP
194$:	JMP	290$		;GO PICK UP TYPE AND BUILD NODE

;
; STRUCTURE OPS
; A.B GETS TRANSFORMED INTO &A->B
; A->B IS DONE AS *(A+CONST OFFSET OF B), WHERE THE ADDITION IS
; DONE WITHOUT CONVERSIONS
; SETYPE IS USED TO FIDDLE ALL OF THE TYPES DOWN THE LEFT
; SUBTREE.
; THE TYPE OF THE RIGHT SUBTREE (THE CONSTANT) IS  FORCED
; TO INT.
;

200$:	CMP	R3,#OP.DOT	;STRUCTURE DOT
	BNE	210$		;NO
	CALL	BUMPN		;GET THE ADDRESS OF THE LOP
	MOV	R4,@NPTR	;BY USING BUILD
	MOV	#OP.ADR,R3	;THEN
	CALL	BUILD		;PRETEND ITS AN
	MOV	@NPTR,R4	;'->'
	SUB	#2,NPTR		;OPERATOR
	BR	211$

210$:	CMP	R3,#OP.ARO	;STRUCTURE POINTER ARROW
	BNE	220$		;NO
211$:	CMPB	E.CLAS(R5),#CL.MOS ;THE
	BEQ	213$		;CLASS
	MOV	#ERR09,R0	;MUST BE
	CALL	ERROR1		;MEMBER OF STRUCTURE		;01

213$:	CALL	MPTR		;MAKE A POINTER DIM ENTRY
	MOV	E.DIMP(R5),(R2) ;ADD TO FRONT OF THE DIMS
	MOV	R2,-(SP)	;SAVE IT AWHILE
	MOV	#ES.OP,R2	;BUILD A '+' NODE
	CALL	TREES1						;01
	MOV	#OP.ADD,(R2)	;ADDING IN THE OFFSET
	MOVB	E.TYPE(R5),E.TYPE(R2) ;THE RESULT IS POINTER TO ROP
	MOV	E.DOPE(R5),E.DOPE(R2) ;WITH THE SAME STRUCTURE ATTRIBUTES ;u4
	MOV	(SP),E.DIMP(R2) ;AS
	MOV	R4,E.LOP(R2)	;THE ROP
	CLR	(SP)		;USED AS A FLAG
	CMP	(R5),#OP.FLD	;SELECTING FROM A FIELD?
	BNE	214$		;NO
	MOV	R5,(SP)		;SAVE REF. TO FIELD.
	MOV	E.LOP(R5),R5	;REMOVE IT.
214$:	MOV	R5,E.ROP(R2)	;THIS IS THE CONSTANT NODE
	MOVB	#TY.INT,E.TYPE(R5) ;FORCE THE CONSTANT TO
	CLR	E.DIMP(R5)	;SCALAR INT
	CLR	E.DOPE(R5)	;(DOPE COULD PROBABLY BE LEFT)		;u4
	CALL	BUMPN		;THEN '*' THROUGH IT
	MOV	R2,@NPTR	;THIS LEAVES THE RESULT ON THE TOP
	MOV	#OP.IND,R3	;OF THE
	CALL	BUILD		;OPERAND STACK
	CALL	SETYPE		;FORCE THE TYPE AND DIMP
	MOV	(SP)+,R5	;FIELD?
	BEQ	215$		;NO
	MOV	@NPTR,E.LOP(R5)	;ADD THE FIELD NODE
	MOV	R5,@NPTR	;TO THE TOP
215$:	JMP	410$		;TO AGREE

;
; CAST OF TYPES.
;

220$:	CMP	R3,#OP.COT	;CAST OF TYPES?
	BNE	221$		;NO

	MOV	@NPTR,R2	;PULL THE OP.COT NODE THAT
	SUB	#2,NPTR		;IS HOLDING
	MOV	R2,ROP(SP)	;THE GOAL TYPE OF
	CALL	GTYPE		;OF THE CAST
	MOV	R0,RT(SP)	;INTO THE RIGHT OP.

	MOV	@ROP(SP),R0	;THE OP
	CMP	R0,R3		;MUST BE A CAST
	BEQ	2200$		;OR
	MOV	#ERR16,R0	;SOMETHING IS VERY NASTY
	CALL	ERROR1		;IN THE NURSERY			;01
	JMP	CCABR1		;				;01

2200$:	MOV	LOP(SP),R4	;GET TREE TO CONVERT.
	MOV	ROP(SP),R5	;AND THE CAST.

	CMP	LT(SP),RT(SP)	; Are the two sides the same?		;u6
	BEQ	2205$		; If so, it's easy			;u6
	MOV	LT(SP),R0	;IF BOTH
	SUB	#TY.INT,R0	;SIDES
	CMP	R0,#TY.LNG-TY.INT ;OF THE CAST
	BHIS	2210$		;ARE
	MOV	RT(SP),R0	;ONE WORD
	SUB	#TY.INT,R0	;ITEMS
	CMP	R0,#TY.LNG-TY.INT ;THEN THE CAST
	BHIS	2210$		;IS EASY
2205$:	MOVB	E.TYPE(R5),E.TYPE(R4) ;COPY OVER THE			;u6
	MOV	E.DOPE(R5),E.DOPE(R4) ;VITAL
	MOV	E.DIMP(R5),E.DIMP(R4) ;INFORMATION
	CALL	BUMPN		;SHOVE IT ON
	MOV	R4,@NPTR	;THE NAME STACK AND
	CALL	SETYPE		;MAKE SURE ALL THE TYPES JIVE.
	JMP	410$		;DONE.

2210$:	MOV	RT(SP),R1	;HARD CAST, BUILD A
	CALL	CVRCOT		;CONVERSION.				;u7
	JMP	400$		;AND GO PUSH IN ON THE NAME STACK.

;
; OTHER OPS.
;

221$:	CMP	R3,#OP.LT	;USE UNSIGNED RELATIONS
	BLO	224$		;IF
	CMP	R3,#OP.GT	;NECESSARY
	BHI	224$

	MOV	LT(SP),R0	;REQUIRED FOR POINTERS AND UNSIGNEDS
	CMP	R0,#TY.PTR
	BEQ	222$
	CMP	R0,#TY.UNS
	BEQ	222$

	MOV	RT(SP),R0
	CMP	R0,#TY.PTR
	BEQ	222$
	CMP	R0,#TY.UNS
	BNE	224$

222$:	ADD	#OP.LTU-OP.LT,R3

224$:	TST	RT(SP)		;IF THE RIGHT TYPE IS UNDEFINED
	BNE	225$		;AS IT IS FOR UNARY OPS
	MOV	LT(SP),RT(SP)	;MAKE SURE CONVERSIONS WORK

225$:	MOV	LT(SP),R1	;GET ENTRY FROM
	SUB	#TY.CHR,R1	;CONVERSION TABLE

.IF NE	C$$EIS							;01

	MUL	#7,R1		;7 WORDS PER ROW

.IFF

	MOV	#7,-(SP)	;7 WORDS PER ROW
	CALL	$MULR1		;
	TST	(SP)+		;

.ENDC

	ADD	RT(SP),R1
	SUB	#TY.CHR,R1
	MOV	CVTAB(R1),R1	;GET ENTRY FROM CONVERSION TABLE
	BNE	226$		;LEGAL COMBINATION

	CALL	CLASH		;IF 0, ITS A TYPE CLASH
	MOV	#TY.INT,R1	;FORCE TO INTEGER RESULT

226$:	CMP	R3,#OP.ASG	;NO CONVERSIONS APPLY TO
	BEQ	227$		;WORD ASSIGNMENTS
	CMP	R3,#OP.EQ	;OR
	BLO	228$		;WORD
	CMP	R3,#OP.GTU	;RELATIONAL
	BHI	228$		;OPS
227$:	CMP	LT(SP),RT(SP)	;No convert if types are same!		;u6
	BEQ	240$							;u6
	MOV	LT(SP),R0
	SUB	#TY.INT,R0
	CMP	R0,#TY.LNG-TY.INT
	BHIS	228$
	MOV	RT(SP),R0
	SUB	#TY.INT,R0
	CMP	R0,#TY.LNG-TY.INT
	BLO	240$

228$:	MOV	ROP(SP),R4	;SET UP FOR RIGHT CONVERT		;u5+
	BEQ	230$		;NO TREE, MUST BE UNARY
	MOV	LOP(SP),R5	;OTHER TREE
	CMP	R3,#OP.ASG	; Is this an asg?			;u6+
	BEQ	2285$		; Yes
	CMP	R3,#OP.ADA	; Assignment type operator?
	BLO	229$		; skip if too small
	CMP	R3,#OP.XRA	; too big?
	BHI	229$		; yes, skip
; We have an assignment or assignment-type operator
2285$:
	BIC	#GOAL,R1	; Clear old type
	BIS	LT(SP),R1	; Force type to that of left
	BIT	#RA,R1		; Need to convert right?
	BEQ	241$		; No, early exit

	CALL	CVR		; Else perform conversion to register	;u6-
	MOV	R2,ROP(SP)	;REPLACE TREE
	BR	241$		;AND EXIT

229$:	BIT	#R,R1		;APPLY CONVERSIONS TO RIGHT
	BEQ	230$		;BR IF N/A
	CALL	CVR		;PERFORM CONVERSION TO REGISTER
	MOV	R2,ROP(SP)	;REPLACE TREE

230$:	MOV	LOP(SP),R4	;SET UP TO CONVERT LEFT
	MOV	ROP(SP),R5	;OTHER TREE
	BIT	#L,R1		;NOT ASSIGNMENT, DO WE CONVERT
	BEQ	240$		;NO
	CALL	CVR		;ADD OP.CVR
236$:	MOV	R2,LOP(SP)	;SAVE NEW LEFT TREE			;u5-

240$:	BIC	#^C<GOAL>,R1	;GET THE GOAL TYPE
	CMP	R3,#OP.EQ	;IF THE OPERATOR IS A RELATIONAL
	BLO	241$		;THEN
	CMP	R3,#OP.GTU	;THE GOAL IS
	BHI	241$		;ALWAYS
	MOV	#TY.INT,R1	;INTEGER

241$:	MOV	#ES.OP,R2	;ALLOCATE A
	CALL	TREES1		;TREE NODE			;01

	MOV	LOP(SP),R4	;GET LEFT AND
	MOV	ROP(SP),R5	;RIGHT SUBTREES

	CMP	R1,#TY.PTR	;IS THE RESULT A POINTER
	BNE	243$		;NO
	MOV	R4,R0		;ASSUME THE LEFT IS THE POINTER
	CMP	LT(SP),#TY.PTR	;CORRECT ASSUMPTION
	BEQ	242$		;YES
	MOV	R5,R0		;NO, GET RIGHT TREE
242$:	MOVB	E.TYPE(R0),R1	;GET TYPE INTO R1
	MOV	E.DIMP(R0),E.DIMP(R2) ;SETUP THE DIMS AND
	MOV	E.DOPE(R0),E.DOPE(R2) ;THE SSTRUCTURE SIZE

243$:	MOV	R3,(R2)		;SET OP
	MOVB	R1,E.TYPE(R2)	;SET RESULT TYPE
	MOV	R4,E.LOP(R2)	;LEFT SUBTREE
	MOV	R5,E.ROP(R2)	;RIGHT SUBTREE

;
; SOME FINAL CHECKS
; PTR+PTR IS ILLEGAL
; THE ROP OF AN '=-' OR '=+' CANNOT BE PTR
; ADD OP.CVR/PTR TO INTEGER FOR PTR-PTR
;

	CMP	LT(SP),#TY.PTR	;TEST IF BOTH
	BNE	244$
	CMP	RT(SP),#TY.PTR	;ARE POINTERS
	BNE	244$

	CMP	R3,#OP.ADD	;CANNOT ADD TWO POINTERS
	BEQ	250$

	CMP	R3,#OP.SUB	;IS THIS PTR-PTR
	BNE	244$		;NO
	MOV	R2,R4		;SAVE TREE
	MOV	LOP(SP),R2	;SEE IF THE POINTERS
	CALL	PLENG
	MOV	ROP(SP),R2	;HAVE THE SAME LENGTH
	MOV	R0,-(SP)	;SAVE LENGTH OF LOP
	CALL	PLENG
	MOV	R4,R2		;THIS GETS THE TREE BACK
	CMP	R0,(SP)+
	BNE	250$		;ERROR OF NOT

	MOV	LOP(SP),R5	;OTHER TREE
	MOV	#TY.INT,R1	;GOAL TYPE
	CALL	CVR		;PERFORM PTOI CONVERSION
	BR	400$

244$:	CMP	R1,#TY.PTR	;IS THE RESULT OF THE NODE POINTER
	BNE	400$		;NO
	CMP	R3,#OP.ADA	;'=+'
	BEQ	246$
	CMP	R3,#OP.SBA	;'=-'
	BNE	400$
246$:	CMP	RT(SP),#TY.PTR	;CANNOT HAVE POINTER ON RIGHT
	BNE	400$

250$:	CALL	CLASH		;TYPE CLASH
	BR	400$

;
; COMMON RETURNS
;

290$:	MOVB	E.TYPE(R4),R0	;GET TYPE OF LEFT BEFORE CALLING THE
300$:	MOV	#ES.OP,R2	;GENERAL NODE BUILDER
	CALL	TREES1						;01
	MOVB	R0,E.TYPE(R2)	;TYPE IN R0
	MOV	R1,E.DIMP(R2)	;DIMP IN R1
	MOV	R3,(R2)		;OP IN R3
	MOV	R4,E.LOP(R2)	;LEFT OP IN R4
	MOV	R5,E.ROP(R2)	;RIGHT OP IN R5
	MOV	E.DOPE(R4),E.DOPE(R2) ;COPY STRUCTURE DOPE FOR '&'	;u4

400$:	CALL	BUMPN		;PUSH R2 ONTO THE OPERAND STACK
	MOV	R2,@NPTR

410$:	MOV	@NPTR,R0	;GET OPERAND				;u4+
	CMPB	E.TYPE(R0),#TY.STR ;STRUCTURE?
	BLO	420$		;NO
	MOV	E.DOPE(R0),R0	;GET DOPE VECTOR
	BEQ	420$		;SKIP IF NONE
	MOV	S.STID(R0),LSTRUC	;SET LAST SEEN STRUCTURE

420$:	ADD	#10,SP		;RETURN					;u4-
	MOV	(SP)+,R0
	MOV	(SP)+,R1
	MOV	(SP)+,R2
	MOV	(SP)+,R3
	MOV	(SP)+,R4
	MOV	(SP)+,R5
	RETURN

;+
; ** CAST -- TRY TO READ A CAST.
;
; TEST TO SEE IF THE NEXT LITTLE BIT OF INPUT IS A CAST. THE LEFT PAREN
; IS SITTING IN LEX0. IF YOU CANNOT GET A CAST JUST HOP BACK WITH THE C
; BIT SET. OTHERWISE READ IN THE ABSTRACT TYPE AND RETURN IT.
;
; INCLUDED HERE ARE THE LOCAL SUBROUTINES "ABDECL" WHICH READS ABSTRACT
; DECLARATORS, "ABTACK" WHICH ADDS A NEW DIM NODE, ALLOCATED FROM  TREE
; SPACE, TO THE END OF THE DIMP, AND "ABRPAR", WHICH CHECKS FOR A RIGHT
; PARENTHESIS AND PRINTS A DIAGNOSTIC.
;
; OUTPUTS:
;	R3=TYPE.
;	R4=DIMP.
;	R5=DOPE.
;-

CAST:	MOV	R0,-(SP)	;SAVE
	MOV	R1,-(SP)	;SOME
	MOV	R2,-(SP)	;REGISTERS

	MOV	CLASS,-(SP)	;AND
	MOV	TYPE,-(SP)	;SOME
	MOV	DIMP,-(SP)	;OF
	MOV	DOPE,-(SP)	;THE
	MOV	SHORTF,-(SP)	;GLOBALS USED
	MOV	LONGF,-(SP)	;BY
	MOV	USIGNF,-(SP)	;THE TYPE GETTER.

	CALL	CANDT		;GET CLASS AND TYPE.

	MOV	CLASS,R0	;IF NO CLASS
	BIS	TYPE,R0		;OR TYPE
	BNE	10$		;THEN
	SEC			;JUST DUCK
	BR	40$		;OUT

10$:	TST	CLASS		;THERE MUST
	BEQ	20$		;NOT
	MOV	#ERR12,R0	;BE A
	CALL	ERROR1		;CLASS				;01

20$:	TST	TYPE		;THERE MUST
	BNE	30$		;BE
	MOV	#ERR13,R0	;A
	CALL	ERROR1		;TYPE				;01

30$:	CALL	ABDECL		;DO THE NITTY GRITTY
	CALL	ABRPAR		;CHECK FOR THE ")"

	MOV	TYPE,R3		;LOAD
	MOV	DIMP,R4		;RETURN
	MOV	DOPE,R5		;VALUES
	CLC			;GOOD RETURN

40$:	MOV	(SP)+,USIGNF	;RESTORE
	MOV	(SP)+,LONGF	;ALL
	MOV	(SP)+,SHORTF	;THE
	MOV	(SP)+,DOPE	;GLOBAL
	MOV	(SP)+,DIMP	;VARIABLES
	MOV	(SP)+,TYPE	;WE
	MOV	(SP)+,CLASS	;SAVED

	MOV	(SP)+,R2	;AND
	MOV	(SP)+,R1	;THE
	MOV	(SP)+,R0	;REGISTERS

	RETURN			;DONE

ABRPAR:	CMP	LEX0,#OP.RPA	;IS IT ")"
	BEQ	10$		;YES
	MOV	#ERR15,R0	;COMPLAIN ABOUT
	CALL	ERROR1		;IT.				;01
10$:	RETURN			;DONE

ABDECL:	CALL	SCAN		;GET TOKEN.
	CMP	R0,#OP.MUL	;"*"
	BNE	10$		;NOPE.
	CALL	ABDECL		;GET A DECLARATOR.
	MOV	#DT.PTR,R0	;TACK ON A POINTER
	CLR	R1		;DIM BLOCK.
	CALLR	ABTACK		;AND RETURN

10$:	CMP	R0,#OP.LPA	;"("
	BNE	40$		;NOPE.
	CMP	LEX1,#OP.RPA	;IF ITS ACTUALLY "()"
	BEQ	30$		;GO DO FUNCTION.
	CALL	ABDECL		;ELSE IT'S A DECLARATOR
	CALL	ABRPAR		;IN PARENTHESES.

20$:	CALL	SCAN		;GET NEXT TOKEN.
	CMP	R0,#OP.LPA	;"("
	BNE	40$		;NOPE.

30$:	CALL	SCAN		;GRAB NEXT TOKEN.
	CALL	ABRPAR		;MUST BE ")"
	MOV	#DT.FUN,R0	;TACK ON A FUNCTION
	CLR	R1		;RETURNING
	CALL	ABTACK		;NODE AND
	BR	20$		;GO FOR MORE DIMS.

40$:	CMP	R0,#OP.LSQ	;"["
	BNE	60$		;NO.
	CLR	R1		;DEFAULT BOUND.
	CALL	SCAN		;GRAB NEXT TOKEN.
	CMP	R0,#OP.RSQ	;IF "[]" THEN
	BEQ	50$		;YOU HAVE THE BOUND.
	MOV	TPTR,-(SP)	;SAVE TREE SPACE POINTER
	MOV	INITFG,-(SP)	;AND "," ":" FLAG.
	INC	INITFG		;MAKE THEM SPECIAL.
	CALL	CONXPR		;AND READ CONSTANT EXPRESSION.
	MOV	R5,R1		;GET IT IN THE RIGHT PLACE.
	MOV	(SP)+,INITFG	;RESTORE FLAG
	MOV	(SP)+,TPTR	;AND RECLAIM TREE SPACE.
	CMP	LEX0,#OP.RSQ	;THE DELIMITER
	BEQ	50$		;MUST BE
	MOV	#ERR14,R0	;A "]"
	CALL	ERROR1		;OR IT'S AN ERROR.		;01

50$:	MOV	#DT.ARY,R0	;MAKE ARRAY DIM
	CALL	ABTACK		;NODE
	BR	20$		;AND GO FOR MORE DIMS.

60$:	RETURN			;DONE.

ABTACK:	MOV	#D.LENG,R2	;GET A DIM BLOCK
	CALL	TREES1		;FROM TREE SPACE.		;01
	MOV	R0,D.TYPE(R2)	;SET DIM TYPE
	MOV	R1,D.BOUN(R2)	;AND BOUND.

	MOV	DIMP,R0		;ANY OLD DIMS?
	BNE	10$		;YES!
	MOV	R2,DIMP		;NO, START NOW.
	BR	30$		;

10$:	TST	(R0)		;OTHERWISE FIND
	BEQ	20$		;THE
	MOV	(R0),R0		;END OF
	BR	10$		;THE DIM LIST.
20$:	MOV	R2,(R0)		;AND ADD THE NEW ONE THERE.

30$:	RETURN			;DONE

;+
; ** CVR - INSERT AN OP.CVR NODE
;
; INPUTS:
;	R1=GOAL TYPE (MASKED BY GOAL)
;	R4=TREE
;	R5=THE OTHER TREE
;
; OUTPUTS:
;	R2=CONVERTED TREE
;
; USES:
;	R0
;-

	.ENABL	LSB

CVRCOT:	MOV	#OP.COT,-(SP)	;Send hard cast to pass 2		;u7
	BR	10$							;u7

CVR:	MOV	#OP.CVR,-(SP)	;SAVE OP

10$:	CLR	R0		;DEFAULT TO NULL POINTER
	MOV	R5,R2		;PICK UP OTHER TREE
	BEQ	20$		;NULL, CONVERTING UNARY OP
	CALL	PLENG		;THE LENGTH OF THE POINTER
	CALL	BCONST
	MOV	R2,R0

20$:
	MOV	#ES.OP,R2	;ALLOCATE A
	CALL	TREES1		;TREE NODE			;01
	MOV	(SP)+,(R2)	;OP
	MOV	R4,E.LOP(R2)	;TREE WE ARE CONVERTING
	MOV	R0,E.ROP(R2)	;OTHER SIZE
	MOV	E.DOPE(R5),E.DOPE(R2) ;STRUCTURE DOPE		;u4
	MOV	R1,R0		;MASK OFF THE
	BIC	#^C<GOAL>,R0	;GOAL TYPE AND
	MOVB	R0,E.TYPE(R2)	;SAVE IT IN THE NODE
	RETURN			;RETURN

	.DSABL	LSB

;+
; ** CONXPR -- GET CONSTANT EXPRESSION.
;
; READ IN A CONSTANT EXPRESSION. THE CALLING SEQUENCE IS THE SAME AS
; THAT OF "EXPR".
;
; OUTPUTS:
;	R5=VALUE.
;-

CONXPR:	CALL	EXPR		;READ THE EXPR.
	TST	R5		;IF SOME SORT OF ERROR
	BEQ	10$		;DUCK.
	CALL	EVAL		;EVALUATE THE TREE.
	BCC	10$		;OK.
	MOV	R0,-(SP)	;SAVE R0
	MOV	#ERR11,R0	;CONSTANT EXPRESSION
	CALL	ERROR1		;REQUIRED			;01
	MOV	(SP)+,R0	;RESTORE R0
	CLR	R5		;RETURN CONSTANT 0
10$:	RETURN			;DONE


;+
; ** EVAL -- CONSTANT EXPRESSION EVALUATOR.
;
; THIS ROUTINE, GIVEN A POINTER TO A TREE, ATTEMPTS TO REDUCE IT TO
; A CONSTANT. ONLY SOME OF THE OPERATIONS ARE, IN FACT, FOLDED. THE
; PURPOSE OF ALL THIS IS TO PERMIT CONSTANT EXPRESSIONS IN  CERTAIN
; PLACES, NOTABLE CASE LABELS AND ARRAY BOUNDS.
;
; INPUTS:
;	R5=TREE.
;
; OUTPUTS:
;	R5=VALUE.
;	C BIT SET IF THE TREE WILL NOT REDUCE.
;-

EVAL:	MOV	R0,-(SP)	;SAVE REGISTERS
	MOV	R1,-(SP)	;
	MOV	R4,-(SP)	;
	MOV	R5,-(SP)	;

	MOV	(R5),R4		;GET OP.
	CMP	R4,#OP.CON	;CONSTANT?
	BNE	10$		;NO.
	MOVB	E.TYPE(R5),R0	;PICK UP ITS TYPE.
	CMP	R0,#TY.INT	;INTEGER?
	BNE	160$		;NO, ERROR.
	MOV	E.VAL(R5),R5	;GRAB THE VALUE AND
	BR	150$		;RETURN.

10$:	CMP	R4,#OP.ADD	;LEAF?
	BLO	160$		;YES, ERROR

	MOV	E.ROP(R5),R5	;GRAB RIGHT SUBTREE.
	BEQ	20$		;NULL.
	CALL	EVAL		;REDUCE IT.
	BCS	170$		;ERROR
20$:	MOV	R5,R0		;VALUE OF ROP TO R0

	MOV	(SP),R5		;GET
	MOV	E.LOP(R5),R5	;ROP
	BEQ	30$		;IS THIS NECESSARY?
	CALL	EVAL		;REDUCE IT
	BCS	170$		;ERROR

30$:	CMP	R4,#OP.ADD	;"+"
	BNE	40$		;NO.
	ADD	R0,R5		;DO IT
	BR	150$		;

40$:	CMP	R4,#OP.SUB	;"-"
	BNE	50$		;NO.
	SUB	R0,R5		;DO IT.
	BR	150$		;

50$:	CMP	R4,#OP.MUL	;"*"
	BNE	60$		;NO.

.IF NE	C$$EIS							;01

	MUL	R0,R5		;DO IT.

.IFF

	MOV	R5,R1		;DO
	MOV	R0,-(SP)	;IT
	CALL	$MULR1		;THE
	TST	(SP)+		;HARD
	MOV	R1,R5		;WAY

.ENDC

	BR	150$		;

60$:	CMP	R4,#OP.DIV	;"/"
	BNE	70$		;NO.

.IF NE	C$$EIS							;01

	TST	R5		;DO
	SXT	R4		;THE
	DIV	R0,R4		;DIVIDE
	MOV	R4,R5		;QUOTIENT TO R5

.IFF

	MOV	R0,-(SP)	;SAVE DIVISOR
	CLR	R0		;NO
	MOV	R5,R1		;SXT
	BPL	65$		;IS
	COM	R0		;BORING
65$:	CALL	$DIVR0		;DO THE DIVIDE
	TST	(SP)+		;CLR STACK
	MOV	R0,R5		;QUOTIENT TO R5

.ENDC

	BR	150$		;

70$:	CMP	R4,#OP.MOD	;"%"
	BNE	80$		;NO

.IF NE	C$$EIS							;01

	TST	R5		;EXTEND
	SXT	R4		;SIGN
	DIV	R0,R5		;REMAINDER

.IFF

	MOV	R0,-(SP)	;SAVE DIVISOR
	CLR	R0		;NO
	MOV	R5,R1		;SXT
	BPL	75$		;IS
	COM	R0		;BORING
75$:	CALL	$DIVR0		;DO DIVIDE
	TST	(SP)+		;CLR STACK
	MOV	R1,R5		;REMAINDER TO R5

	.ENDC

	BR	150$		;

80$:	CMP	R4,#OP.AND	;"&"
	BNE	90$		;NO
	COM	R0		;DO IT
	BIC	R0,R5		;SILLY HARDWARE.
	BR	150$		;

90$:	CMP	R4,#OP.OR	;"OR" (SILLY ASSEMBLER)
	BNE	100$		;NO
	BIS	R0,R5		;DO IT
	BR	150$		;

100$:	CMP	R4,#OP.XOR	;"^"
	BNE	110$		;NO

.IF NE	C$$EIS							;01

	XOR	R0,R5		;DO IT

.IFF

	MOV	R0,R1		;DO
	BIC	R5,R0		;NON
	BIC	R1,R5		;EIS
	BIS	R0,R5		;XOR

.ENDC

	BR	150$		;

110$:	CMP	R4,#OP.ASL	;"<<"
	BNE	120$		;NO

.IF NE	C$$EIS							;01

	ASH	R0,R5

.IFF

	TST	R0		;CHECK SHIFT COUNT.
	BMI	125$		;IS RIGHT.
	BEQ	150$		;DONE.
115$:	ASL	R5		;DO
	DEC	R0		;THE
	BNE	115$		;SHIFT

.ENDC

	BR	150$		;

120$:	CMP	R4,#OP.ASR	;">>"
	BNE	130$		;NO

.IF NE	C$$EIS							;01

	NEG	R0
	ASH	R0,R5

.IFF

	TST	R0		;CHECK SHIFT COUNT
	BMI	115$		;IS LEFT
	BEQ	150$		;DONE
125$:	ASR	R5		;DO
	DEC	R0		;THE
	BNE	125$		;SHIFT

.ENDC

	BR	150$		;

130$:	CMP	R4,#OP.COM	;"TILDE" (SILLY ASSEMBLER)
	BNE	140$		;NO
	COM	R5		;DO IT
	BR	150$		;

140$:	CMP	R4,#OP.NEG	;"-"
	BNE	160$		;
	NEG	R5		;DO IT

150$:	CLC			;GOOD RETURN
	BR	170$		;

160$:	SEC			;BAD RETURN

170$:	MOV	(SP)+,R4	;DISCARD R5, LEAVE C BIT
	MOV	(SP)+,R4	;
	MOV	(SP)+,R1	;
	MOV	(SP)+,R0	;
	RETURN			;


;+
; ** CLASH - REPORT TYPE CLASH
;
; USES:
;	R0
;-

CLASH:	MOV	#ERR10,R0	;TYPE CLASH
	CALLR	ERROR1						;01

;+
; ** MPTR - MAKE A POINTER DIM ENTRY IN TREE SPACE
;
; OUTPUTS:
;	R2=POINTER TO DIM ENTRY
;-

MPTR:	MOV	#D.LENG,R2	;ALLOCATE
	CALL	TREES1		;DIM NODE			;01
	MOV	#DT.PTR,D.TYPE(R2) ;SET TYPE TO POINTER AND
	RETURN			;RETURN

;+
; ** GTYPE - GET THE TYPE OF A TREE
;
; GIVEN A TREE, RETURN A TYPE THAT CAN BE USED TO INDEX INTO THE
; CONVERSION TABLES. ALL POINTERS RETURN A COMMON TYPE OF TY.PTR
; ALL STRUCTURES AND UNIONS LOOK LIKE STRUCTURES.
;
; INPUTS:
;	R2=TREE
;
; OUTPUTS:
;	R0=TYPE
;-

GTYPE:	MOV	#TY.PTR,R0	;IF THERE ARE ANY DIMS CALL
	TST	E.DIMP(R2)	;IT POINTER
	BNE	10$

	MOVB	E.TYPE(R2),R0	;OTHERWISE GET THE TYPE FROM THE
	CMP	R0,#TY.UST	;NODE
	BLO	10$
	MOV	#TY.STR,R0	;ALL STRUCTS

10$:	RETURN

;+
; ** CHFUN - CHECK FOR FUNCTIONS (AND ADD AN AMPERSAND)
; ** CHARY - CHECK FOR ARRAYS    (AND ADD AN AMPERSAND)
;
; INPUTS:
;	R2=TREE
;
; OUTPUTS:
;	R2=TREE
;
; USES:
;	R0
;-

	.ENABL	LSB

CHFUN:	MOV	E.DIMP(R2),R0	;GET DIMS OF THE TREE
	BEQ	20$		;SCALAR
	CMP	D.TYPE(R0),#DT.FUN ;IS IT A FUNCTION
	BNE	20$		;BR IF NOT
	BR	10$		;GO ADD AMPERSAND IF YES

CHARY:	CMPB	E.CLAS(R2),#CL.MOS ;DON'T DO THIS IF THE
	BEQ	20$		;CLASS IS MOS (P->ARRAY)
	MOV	E.DIMP(R2),R0	;GET DIMS OF THE TREE
	BEQ	20$		;SCALAR
	CMP	D.TYPE(R0),#DT.ARY ;IS IT AN ARRAY
	BNE	20$		;NO
	MOV	(R0),E.DIMP(R2)	;YES, REMOVE THE ARRAY DIM

10$:	MOV	R3,-(SP)	;SAVE R3
	CALL	BUMPN		;PUSH THE TREE ONTO
	MOV	R2,@NPTR	;THE OPERAND STACK
	MOV	#OP.ADR,R3	;ADD
	CALL	BUILD		;AMPERSAND
	CALL	SETYPE		;MAKE TYPE AND DIMP RIGHT
	MOV	@NPTR,R2	;GET THE
	SUB	#2,NPTR		;TREE BACK
	MOV	(SP)+,R3	;RESTORE R3

20$:	RETURN

	.DSABL	LSB

;+
; ** SETYPE - SET TYPE AND DIMP
;
; THIS ROUTINE ADJUSTS THE TYPE AND DIMP OF A TREE TO AGREE WITH
; THE VIEWPOINT OF THE TOP OF THE TREE.
;
; INPUTS:
;	THE TREE IS ON THE TOP OF THE OPERAND STACK
;
; USES:
;	NONE
;-

SETYPE:	MOV	R5,-(SP)	;SAVE
	MOV	R4,-(SP)	;REGISTERS
	MOV	R3,-(SP)	;
	MOV	R2,-(SP)	;

	MOV	@NPTR,R5	;GET THE TREE
	MOVB	E.TYPE(R5),R4	;ITS TYPE
	MOV	E.DOPE(R5),R3	;ITS STRUCTURE DOPE			;u4
	MOV	E.DIMP(R5),R2	;ITS DIMS

10$:	CMP	(R5),#OP.IND	;IS THE TOP OF THE TREE A '*'
	BNE	20$		;NO
	MOV	R2,-(SP)	;THE DIMS BELOW IT
	CALL	MPTR		;MUST HAVE BEEN
	MOV	(SP)+,(R2)	;POINTER TO
	BR	40$		;

20$:	CMP	(R5),#OP.ADR	;IS THE TOP OF THE TREE A '&'
	BNE	30$		;NO
	MOV	(R2),R2		;REMOVE THE PTR DIM
	BR	40$		;

30$:	CMP	(R5),#OP.ADD	;IS THE TOP OF THE TREE A '+'
	BNE	50$		;NO, RETURN

40$:	MOV	E.LOP(R5),R5	;FOLLOW DOWN THE LEFT TREE
	MOV	R2,E.DIMP(R5)	;RESET DIMS
	MOV	R3,E.DOPE(R5)	;STRUCTURE DOPE				;u4
	MOVB	R4,E.TYPE(R5)	;AND TYPE
	BR	10$		;CONTINUE

50$:	MOV	(SP)+,R2	;RETURN
	MOV	(SP)+,R3	;
	MOV	(SP)+,R4	;
	MOV	(SP)+,R5	;
	RETURN			;FINIS

;+
; ** ELENG - GET SIZE OF AN EXPRESSION TREE
;
; INPUTS:
;	R2=TREE
;
; OUTPUTS:
;	R0=SIZE
;-

ELENG:	MOV	R2,-(SP)	;SAVE REGISTERS
	MOV	R1,-(SP)

	MOV	#1,R1		;START OFF AS A SCALAR
	MOV	E.DIMP(R2),R0	;GET POINTER TO DIMS
	BEQ	30$		;IT IS A SCALAR
10$:	CMP	D.TYPE(R0),#DT.ARY ;AS LONG AS WE FIND ARRAYS
	BNE	20$		;JUST

.IF NE	C$$EIS							;01

	MOV	R0,-(SP)	;MUL TRASHES R0			;03 untested
	MUL	D.BOUN(R0),R1	;MULTIPLY THE BOUNDS
	MOV	(SP)+,R0	;RESTORE R0			;03 untested

.IFF

	MOV	D.BOUN(R0),-(SP);MULTIPLY THE BOUNDS
	CALL	$MULR1		;
	TST	(SP)+		;

.ENDC
	MOV	(R0),R0		;TOGETHER
	BNE	10$
	BR	30$

20$:								;03+
	CMP	D.TYPE(R0),#DT.FUN ;CHECK IF FUNCTION
	BNE	25$		;BR IF IT ISN'T
	CLR	R0		;FUNCTIONS HAVE ZERO LENGTH
	BR	40$		;ONWARD
25$:								;03-
	MOV	#2,R0		;MUST BE A POINTER
	BR	40$		;WHICH IS 2 BYTES LONG

30$:
	TST	R1		;IF 0 LENGTH ARRAY ([])
	BEQ	45$		;YOU KNOW THE SIZE
	MOVB	E.TYPE(R2),R0	;GET THE BASIC TYPE
	CMP	R0,#TY.STR	;IF STRUCT (OR UNION)
	BLO	35$		;
	MOV	E.DOPE(R2),R2	;GET STRUCTURE SIZE			;u4+
	BEQ	35$
	MOV	S.SSIZE(R2),R2						;u4-
35$:
	CALL	BASIZE		;GET BASIC SIZE OF THE ITEM

40$:
.IF NE	C$$EIS							;01

	MOV	R0,-(SP)	;COMPUTE SIZE IN BYTES		;03 untested
	MUL	(SP)+,R1					;03 untested

.IFF

	MOV	R0,-(SP)	;COMPUTE SIZE IN BYTES
	CALL	$MULR1		;
	TST	(SP)+		;

.ENDC

45$:	MOV	R1,R0		;RETURN SIZE IN R0
	MOV	(SP)+,R1	;RETURN
	MOV	(SP)+,R2	;
	RETURN			;

;+
; ** PLENG - POINTER SIZE
;
; IF THE TREE IS A POINTER RETURN THE SIZE OF THE ITEM TO WHICH
; THE POINTER POINTS. IF IT IS NOT A POINTER RETURN 1.
;
; INPUTS:
;	R2=TREE
;
; OUTPUTS:
;	R0=SIZE
;-

PLENG:	MOV	E.DIMP(R2),R0	;CHECK FOR POINTERS
	BEQ	10$
	CMP	D.TYPE(R0),#DT.PTR
	BNE	10$

	MOV	R0,-(SP)	;SAVE OLD DIM
	MOV	(R0),E.DIMP(R2)	;REMOVE 1 LEVEL OF POINTERS
	CALL	ELENG		;COMPUTE THE SIZE AND
	MOV	(SP)+,E.DIMP(R2);PUT THE DIMS BACK
	BR	20$

10$:	MOV	#1,R0		;NOT A REFERENCE

20$:	RETURN

;+
; ** BCONST - BUILD CONSTANT NODE
;
; INPUTS:
;	R0=VALUE OF THE CONSTANT
;
; OUTPUTS:
;	R2=NODE POINTER
;-

BCONST:	MOV	#ES.CON,R2	;GET TREE SPACE
	CALL	TREES1						;01
	MOV	#OP.CON,(R2)	;SET OP
	MOVB	#TY.INT,E.TYPE(R2) ;SET THE TYPE
	MOV	R0,E.VAL(R2)	;SET THE CONSTANT VALUE
	RETURN

;+
; ** RCVN - RETURN STATEMENT TYPE CONVERSIONS
;
; THIS ROUTINE CONVERTS THE RESULT OF A TREE SO THAT IT MATCHES
; THE TYPE OF THE FUNCTION WE ARE RETURNING FROM. IT DOES  THIS
; BY FAKING AN ASSIGNMENT TO A BUILT ON THE FLY REGISTER,   AND
; THROWING THE ASSIGNMENT AWAY.
;
; INPUTS:
;	R5=TREE
;
; OUTPUTS:
;	R5=TREE
;
; USES:
;	R0, R1, R3
;-

RCVN:	MOV	SP,NEND		;ALLOCATE
	SUB	#2*SSIZE,SP	;AN
	MOV	SP,NPTR		;OPERAND
	SUB	#2,NPTR		;STACK
	MOV	FSYMBL,R0	;GET POINTER TO FUNCTION NAME
	CLR	FV3		;SIZE = 0				;u4
	MOV	S.DIMP(R0),R1	;SET DIMS FROM THE SYMBOL
	MOV	(R1),FV2	;THE FIRST WILL BE 'FUNCTION'
	MOVB	S.TYPE(R0),R1	;SET TYPE FROM
	MOVB	R1,FV1		;THE SYMBOL
	CMP	R1,#TY.STR	;IF THE SYMBOL IS A STRUCTURE (OR UNION)
	BLO	10$		;THEN
	MOV	S.DOPE(R0),R1	;SET THE
	MOV	S.SSIZ(R1),FV3	;STRUCTURE SIZE
10$:	CALL	BUMPN		;PUSH THE LEFT OP
	MOV	#FV,@NPTR	;OF THE FAKE ASSIGNMENT
	CALL	BUMPN		;PUSH THE RIGHT OP
	MOV	R5,@NPTR	;OF THE FAKE ASSIGNMENT
	MOV	#OP.ASG,R3	;BUILD THE
	CALL	BUILD		;ASSIGNMENT THEN
	MOV	@NPTR,R5	;RECOVER THE
;	SUB	#2,NPTR		;RESULT AND			;u2 (useless?)
;	MOV	E.ROP(R5),R5	;DISCARD THE ASSIGNMENT OP	;u2 bug!
	ADD	#2*SSIZE,SP	;FREE THE OPERAND STACK
	RETURN

;+
; ** CLRTRE - CLEAR TREE SPACE					;u3+
; ** PSHTRE - PUSH CURRENT TREES
; ** POPTRE - POP CURRENT TREES ( MUST MATCH PSHTRE )
;-

CLRTRE:	MOV	TRBASE,TPTR	;WIND BACK POINTER
	RETURN

PSHTRE:	MOV	@SP,-(SP)	;MAKE ROOM ON STACK
	MOV	TRBASE,2(SP)	;PUSH CURRENT TREE BASE
	MOV	TPTR,TRBASE	;NEW BASE IS CURRENT DEPTH
	RETURN

POPTRE:	MOV	TRBASE,TPTR	;RESTORE POINTER
	MOV	2(SP),TRBASE	;RESTORE BASE
	MOV	(SP)+,@SP	;POP ARG
	RETURN							;u3-

;+
; ** TREES1 - ALLOCATE TREE SPACE				;01
;
; INPUTS:
;	R2=SIZE REQUIRED (BYTES; TREES1)			;01
;
; OUTPUTS:
;	R2=POINTER TO THE SPACE (TREES1)			;01
;	TREE SPACE ALLOCATED IS ZEROED
;-

TREES1:	MOV	R5,-(SP)	;SAVE REGISTERS			;01
	MOV	R2,R5		;GET WORKING SIZE
	INC	R5
	BIC	#1,R5

	MOV	TPTR,R2		;DOES IT FIT?
	ADD	R5,R2
	CMP	R2,#TREE+<2*TSIZE>
	BHI	30$		;NO

	MOV	TPTR,R2		;GET POINTER TO THE SPACE
	ADD	TPTR,R5		;GET NEW END OF TREE SPACE
	MOV	R5,TPTR		;UPDATE TREE SPACE POINTERS
10$:	CMP	R5,R2		;CLEAR NEW SPACE
	BLOS	20$
	CLR	-(R5)
	BR	10$

20$:	MOV	(SP)+,R5
	RETURN

30$:	MOV	#ERR02,R0	;OUT OF TREE SPACE
	CALL	ERROR1		;PRINT MESSAGE AND		;01
	JMP	CCABR1		;JUST DIE.			;01

;+
; ** OUTREE - PUT OUT TREE
;
; CAVEAT: OUTREE IGNORES THE E.OFFS FIELD OF OP.LID AND OP.ID NODES
; THIS FIELD IS ALWAYS 0 NOW; IF THIS EVER CHANGES REMEMBER TO  FIX
; THIS ROUTINE.
;
; INPUTS:
;	R5=TREE POINTER
;-

OUTREE:	MOV	R2,-(SP)	;SAVE R2
	MOV	R5,-(SP)	;SAVE TREE POINTER

	MOVB	#'Z,R0		;PUT OUT THE RECORD HEADER
	CALL	CODC1						;01
	CALL	70$

	TST	R5		;IF THE TREE IS NULL PUT OUT EOF
	BNE	5$
	MOV	#OP.EOF,R0
	BR	40$

5$:	MOV	(R5),R0		;PUT OUT THE OPERATOR
	CALL	CODNM1						;01
	CALL	70$
	MOV	R5,R2		;TYPE
	CALL	GTYPE
	CALL	CODNM1						;01
	CALL	70$

	MOV	(R5),R0		;OPCODE
	CMP	R0,#OP.CON	;CONSTANT
	BNE	10$		;NO
	MOV	E.VAL(R5),R0	;PUT OUT ALL 4 WORDS
	CALL	CODNM1		;				;01
	CALL	70$		;
	MOV	E.VAL+2(R5),R0	;
	CALL	CODNM1		;				;01
	CALL	70$		;
	MOV	E.VAL+4(R5),R0	;
	CALL	CODNM1		;				;01
	CALL	70$		;
	MOV	E.VAL+6(R5),R0	;
	BR	40$		;

10$:	CMP	R0,#OP.REG	;REGISTER
	BNE	15$
	MOV	E.REG(R5),R0
	BR	40$

15$:	CMP	R0,#OP.INX	;INDEX (FOR AUTOS)
	BNE	20$
	MOV	E.REG(R5),R0
	CALL	CODNM1						;01
	CALL	70$
	MOV	E.OFFS(R5),R0
	BR	40$

20$:	CMP	R0,#OP.ID	;IDENTIFIER
	BNE	25$
	MOV	R5,R0
	ADD	#E.NAME,R0
	CALL	CODST1						;01
	BR	50$

25$:	CMP	R0,#OP.LID	;LOCAL IDENTIFIER
	BNE	30$
	MOV	E.LAB(R5),R0
	BR	40$

30$:	CMP	R0,#OP.FLD	;FIELD?
	BNE	35$		;NO.
	MOVB	E.WIDE(R5),R0	;SEND WIDTH.
	CALL	CODNM1		;				;01
	CALL	70$		;
	MOVB	E.BOFS(R5),R0	;SEND OFFSET
	CALL	CODNM1		;				;01

35$:	CALL	CODNL1		;OPERATOR			;01
	MOV	E.LOP(R5),R5	;LEFT SUBTREE
	CALL	OUTREE
	MOV	(SP),R5		;RIGHT SUBTREE
	MOV	E.ROP(R5),R5
	CALL	OUTREE
	BR	60$

40$:	CALL	CODNM1						;01
50$:	CALL	CODNL1						;01
60$:	MOV	(SP)+,R5
	MOV	(SP)+,R2
	RETURN

70$:	MOVB	#' ,R0
	CALLR	CODC1						;01

;+
; OPERATOR DOPE TABLE
; INDEXED BY OPERATOR NUMBER (*2)
;
; 000077	PRIORITY OF THE OPERATOR
; 000100	BINARY
; 000200	RIGHT ASSOCIATIVE
; 000400	HAS LVALUE
; 001000	NEEDS LVALUE ON LEFT
; 002000	NEEDS WORD OPERAND ON LEFT
; 004000	NEEDS WORD OPERAND ON RIGHT
; 010000	NEEDS NON FLOATING OPERAND ON BOTH SIDES
; 020000	NEEDS NON POINTER OPERAND ON BOTH SIDES
;-

OPDOPE:	.WORD	000000		;OP.EOF

	.WORD	000000		;OP.CON
	.WORD	000400		;OP.ID
	.WORD	000400		;OP.LID
	.WORD	000000		;OP.LCN
	.WORD	000000		;OP.DCN
	.WORD	000400		;OP.REG
	.WORD	000400		;OP.INX
	.WORD	000400		;OP.AUI
	.WORD	000400		;OP.AUD

	.WORD	000130		;OP.ADD
	.WORD	000130		;OP.SUB
	.WORD	020132		;OP.MUL
	.WORD	020132		;OP.DIV
	.WORD	030132		;OP.MOD
	.WORD	030126		;OP.ASL
	.WORD	030126		;OP.ASR
	.WORD	030120		;OP.AND
	.WORD	030117		;OP.OR
	.WORD	030117		;OP.XOR

	.WORD	001312		;OP.ADA
	.WORD	001312		;OP.SBA
	.WORD	021312		;OP.MUA
	.WORD	021312		;OP.DVA
	.WORD	031312		;OP.MOA
	.WORD	031312		;OP.ALA
	.WORD	031312		;OP.ARA
	.WORD	031312		;OP.ANA
	.WORD	031312		;OP.ORA
	.WORD	031312		;OP.XRA

	.WORD	000122		;OP.EQ
	.WORD	000122		;OP.NE
	.WORD	000124		;OP.LT
	.WORD	000124		;OP.LE
	.WORD	000124		;OP.GE
	.WORD	000124		;OP.GT
	.WORD	000124		;OP.LT  UNSIGNED
	.WORD	000124		;OP.LE  UNSIGNED
	.WORD	000124		;OP.GE  UNSIGNED
	.WORD	000124		;OP.GT  UNSIGNED

	.WORD	006116		;OP.ANDAND
	.WORD	006115		;OP.OROR
	.WORD	011334		;OP.INB
	.WORD	011334		;OP.INA
	.WORD	011334		;OP.DEB
	.WORD	011334		;OP.DEA
	.WORD	001312		;OP.ASG

	.WORD	001234		;OP.ADR
	.WORD	000634		;OP.IND
	.WORD	020234		;OP.NEG
	.WORD	030234		;OP.COM
	.WORD	002234		;OP.NOT

	.WORD	002314		;OP.QRY
	.WORD	000314		;OP.CLN
	.WORD	000307		;OP.CMA
	.WORD	000107		;OP.SEQ
	.WORD	000000		;OP.BIC
	.WORD	000000		;OP.BCA
	.WORD	000000		;OP.BIT
	.WORD	000136		;OP.JSR
	.WORD	000000		;OP.CVR
	.WORD	000000		;OP.MLL				;u7
	.WORD	000000		;OP.FLD
	.WORD	000234		;OP.COT
	.WORD	000000		;OP.LOD
	.WORD	000000		;OP.CST
	.WORD	000136		;OP.NAC

	.WORD	000000		;OP.SEM
	.WORD	001136		;OP.DOT
	.WORD	002136		;OP.ARO
	.WORD	000036		;OP.LPA
	.WORD	000002		;OP.RPA
	.WORD	000036		;OP.LSQ
	.WORD	000002		;OP.RSQ
	.WORD	000000		;OP.LBR
	.WORD	000000		;OP.RBR

	.WORD	000000		;OP.114
	.WORD	000000		;OP.115

	.WORD	000000		;OP.INT
	.WORD	000000		;OP.CHR
	.WORD	000000		;OP.FLT
	.WORD	000000		;OP.DBL
	.WORD	000000		;OP.UNS
	.WORD	000000		;OP.LNG
	.WORD	000000		;OP.STR
	.WORD	000000		;OP.AUT
	.WORD	000000		;OP.STA
	.WORD	000000		;OP.EXT
	.WORD	000000		;OP.GOT
	.WORD	000000		;OP.RET
	.WORD	000000		;OP.IF
	.WORD	000000		;OP.WHI
	.WORD	000000		;OP.ELS
	.WORD	000000		;OP.SWI
	.WORD	000000		;OP.CAS
	.WORD	000000		;OP.BRK
	.WORD	000000		;OP.CON
	.WORD	000000		;OP.DO
	.WORD	000000		;OP.DEF
	.WORD	000000		;OP.FOR
	.WORD	000000		;OP.TYP
	.WORD	000234		;OP.SIZ (SIZEOF)
	.WORD	000000		;OP.SHO
	.WORD	000000		;OP.UNI

;+
; ** CONVERSION TABLE
;
; INDEXED BY 7*(LT-TY.CHR) + (RT-TY.CHR)
;-

NASTY	=	0		;ILLEGAL CONVERSION
GOAL	=	000377		;GOAL TYPE
R	=	000400		;CONVERT RIGHT
L	=	001000		;CONVERT LEFT

; RA set means that for assignment or assignment type operators, the	;u6+
; right side requires a CVR to be inserted.  Note that in this case,
; conversion is to the type of the left, rather than to the goal type
; specified in the table.
; Mods include inserting RA in the table below.

RA	=	002000		;CONVERT RIGHT FOR ASSIGNMENT OPERATOR	;u6-

;u5	The LA flag is made obsolete by this edit. All assignments receive
;u5	the type of the left, and right converts are inserted as necessary.

CVTAB:	.WORD	TY.INT+R+L+RA	;C :: C
	.WORD	TY.INT+L	;C :: I
	.WORD	TY.UNS+L	;C :: U
	.WORD	TY.PTR+L	;C :: P
	.WORD	TY.LNG+L+RA	;C :: L
	.WORD	TY.FLT+L+RA	;C :: F
	.WORD	TY.DBL+L+RA	;C :: D

	.WORD	TY.INT+R+RA	;I :: C
	.WORD	TY.INT		;I :: I
	.WORD	TY.UNS		;I :: U
	.WORD	TY.PTR+L	;I :: P
	.WORD	TY.LNG+L+RA	;I :: L
	.WORD	TY.FLT+L+RA	;I :: F
	.WORD	TY.DBL+L+RA	;I :: D

	.WORD	TY.UNS+R+RA	;U :: C
	.WORD	TY.UNS		;U :: I
	.WORD	TY.UNS		;U :: U
	.WORD	TY.PTR+L	;U :: P
	.WORD	TY.LNG+L+RA	;U :: L
	.WORD	TY.FLT+L+RA	;U :: F
	.WORD	TY.DBL+L+RA	;U :: D

	.WORD	TY.PTR+R+RA	;P :: C
	.WORD	TY.PTR+R+RA	;P :: I
	.WORD	TY.PTR+R+RA	;P :: U
	.WORD	TY.PTR		;P :: P
	.WORD	TY.PTR+R+RA	;P :: L
	.WORD	NASTY		;P :: F
	.WORD	NASTY		;P :: D

	.WORD	TY.LNG+R+RA	;L :: C
	.WORD	TY.LNG+R+RA	;L :: I
	.WORD	TY.LNG+R+RA	;L :: U
	.WORD	TY.PTR+L+RA	;L :: P
	.WORD	TY.LNG		;L :: L
	.WORD	TY.FLT+L+RA	;L :: F
	.WORD	TY.DBL+L+RA	;L :: D

	.WORD	TY.FLT+R+RA	;F :: C
	.WORD	TY.FLT+R+RA	;F :: I
	.WORD	TY.FLT+R+RA	;F :: U
	.WORD	NASTY		;F :: P
	.WORD	TY.FLT+R+RA	;F :: L
	.WORD	TY.FLT		;F :: F
	.WORD	TY.DBL+L+RA	;F :: D

	.WORD	TY.DBL+R+RA	;D :: C
	.WORD	TY.DBL+R+RA	;D :: I
	.WORD	TY.DBL+R+RA	;D :: U
	.WORD	NASTY		;D :: P
	.WORD	TY.DBL+R+RA	;D :: L
	.WORD	TY.DBL+R+RA	;D :: F
	.WORD	TY.DBL		;D :: D

	.END