.IIF	NDF	RSX	RSX	=	1	;Assume RSX	;01+
	.TITLE	CC201
	.ident	/X01.U5/

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

;
; C COMPILER
; EXPRESSION TREE MODIFIER (NON EIS)
;
; VERSION X01
;
; DAVID G. CONROY	01-APR-78
; LAST UPDATED:		24-MAY-79
;
; Edit history
; 01 04-Mar-80 MM	Added RT11 support
; 02 06-Mar-81 MM	Added fpu support
; u1 11-Sep-81 CCG	Modified to understand FLT constants.
; 03 04-Dec-81 MM	Psect directive
; 04 10-Feb-82 MM	Merged Unimation sources
; u2 15-Apr-82 CCG	Fixed FIXCVR bug for uns <- ptr
;			(looks like FIXCVR may need work for long, float
;			 and double pointers too)
; u3 15-Apr-82 CCG	Fix up MUL, DIV, MOD -> convert to shifts or bics
; 05 05-May-82 JRW(RBD)	Add J.R. Westmoreland's FFOLD which uses FPU at
;			 compile to do a lot more floating constant
;			 folding.  Enabled by equating C$$FPP to non-zero.
; 06 17-Jun-82 MM	Added default definition of C$$FPP
; 07 01-Jul-82 MM	Commentary for new psect
; u4 21-Jul-82 CCG	Added FIXCOT for LONG = INT*INT support (uses OP.MLL)
;			and INT = LONG/INT (used OP.DLL)
;			Removed OP.CVM references
; 08 21-Sep-82 CCG	Cannot optimize signed DIV to ASL
; u5 19-Oct-82 CCG	Fixed bug in edit 08
; end-edit

.iif	ndf	C$$FPP	C$$FPP = 0					;06
	.GLOBL	MODIFY
	.GLOBL	MWCON
	.GLOBL	NODE
	.GLOBL	CONZER

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

;
; LOCAL DATA
;

CHANGE:	.BLKW	1		;SOMETHING CHANGED FLAG
MWPSFG:	.BLKW	1		;PSECT FLAG FOR MWCON
NLIST:	.BLKW	15.		;NODE LIST (RORDER)
LLIST:	.BLKW	15.		;LEAF LIST (RORDER)

;
; STRINGS.
;

ERR01:	.ASCIZ	"Warning: division by zero"

STR03:	.ASCIZ	"	.word	"

	.EVEN
	.PAGE

; MODIFY
;+
; ** MODIFY - MODIFY AN EXPRESSION TREE
;
; THIS ROUTINE IS CALLED TO MODIFY AN EXPRESSION TREE PRIOR TO ACTUAL
; CODE GENERATION. SOME OF THE TRANSFORMATIONS ARE MADE TO  MAKE  THE
; CODE GENERATOR'S LIFE A LITTLE EASIER.
; THE MODIFICATION LOOP IS TABLE DRIVEN. IT REPEATS UNTIL EITHER  THE
; TREE REDUCES TO A LEAF NODE, OR A PASS IS MADE WITH NO CHANGES.
;
; INPUTS:
;	R5=TREE
;
; OUTPUTS:
;	R5=MODIFIED TREE
;-

MODIFY:	MOV	R3,-(SP)	;SAVE
	MOV	R4,-(SP)	;REGISTERS
	MOV	(R5),R3		;OP
	ASL	R3		;
	MOV	OPDOPE(R3),R3	;OPDOPE
	BIT	#LEAF,R3	;LEAF NODES GET
	BNE	50$		;NO MODIFICATION

	MOV	R5,-(SP)	;SAVE TREE
	TST	E.ROP(R5)	;IS THERE A RIGHT SUBTREE
	BEQ	10$		;NO
	MOV	E.ROP(R5),R5	;GRAB RIGHT
	CALL	MODIFY		;MODIFY IT
	MOV	R5,R0		;
	MOV	(SP),R5		;
	MOV	R0,E.ROP(R5)	;

10$:	MOV	E.LOP(R5),R5	;LEFT SUBTREE
	CALL	MODIFY		;MODIFY IT
	MOV	R5,R0		;
	MOV	(SP)+,R5	;
	MOV	R0,E.LOP(R5)	;

20$:	CLR	CHANGE		;NO CHANGES.
	MOV	(R5),R4		;OP
	MOV	R4,R3		;
	ASL	R3		;
	MOV	OPDOPE(R3),R3	;DOPE
	MOV	#60$,R2		;POINT AT TABLE.

30$:	CMP	R2,#70$		;DONE?
	BHIS	40$		;YES.
	CALL	@(R2)+		;CALL FUNCTION
	MOV	(R5),R4		;REFRESH OP
	MOV	R4,R3		;
	ASL	R3		;
	MOV	OPDOPE(R3),R3	;AND DOPE
	BIT	#LEAF,R3	;DO THE NEXT ONE IF
	BEQ	30$		;WE HAVN'T TURNED INTO A LEAF

40$:	TST	CHANGE		;ANY CHANGES THIS PASS?
	BNE	20$		;YES

50$:	MOV	(SP)+,R4	;ALL DONE
	MOV	(SP)+,R3	;
	RETURN			;

60$:	.WORD	RORDER		;REORDER (MUST BE FIRST)
	.WORD	FOLD		;FOLD INTEGERS
	.WORD	FFOLD		;FOLD FLOATING POINT
	.WORD	UNARY		;DELETE NEEDLESS UNARY OPERATIONS
	.WORD	AMPER		;SPECIAL FIXES FOR AMPERSAND
	.WORD	SUBSUM		;SUBSUME CONSTANTS IN &A+CONST
	.WORD	STAR		;SPECIAL FIXES FOR STAR
	.WORD	AUTOS		;EXPLOIT AUTO(INC/DEC) ADDRESSING
	.WORD	FIXCOT		;FIX UP HARD CASTS (Put before FIXCVR)	;u4
	.WORD	FIXCVR		;ADJUST OP.CVR NODES
	.WORD	MULDIV		;FIX UP MUL, DIV OPERATORS		;u3
	.WORD	FIXMOD		;FIX UP MOD OPERATORS			;u3
	.WORD	MKBIC		;AND INTO BIC
	.WORD	DZEROP		;DELETE OPERATIONS WITH ZERO
70$:				;THE END
	.PAGE

; RORDER
;+
; ** RORDER - REORDER.
;
; THIS ROUTINE EXAMINES THE SUBTREES OF COMMUTATIVE OPERATIONS AND RE
; ORDERS THE NODES IN AN "OPTIMAL" MANNER. THE CONSTANTS  ARE  PULLED
; TOGETHER FOR THE BENEFIT OF THE FOLDER. ALL TREE NODES WITH ADDRESS
; ARE MOVED TO RIGHT BRANCHES OF THE UPPERMOST TREE NODES.  HOPEFULLY
; THIS MOVES THE HARD COMPUTATION TO THE BOTTOMOST LEFT BRANCHES.
;
; THE REORDERING IS A THREE PASS PROCESS. FIRST ALL OF THE TIP  NODES
; ARE LOCATED. THESE ARE PACKED INTO THE "LLIST". THE NODES IN   THIS
; LIST ARE ORDERED "ORDINARY, ADDRESSABLE, CONSTANTS". THE "NLIST" IS
; USED TO SAVE POINTERS TO THE NODES. SECONDLY A RECONSTAUCTION  PASS
; FROM BACK TO FRONT IS DONE TO COLLECT ALL OF THE CONSTANT NODES FOR
; FUTURE FOLDING. A POINTER TO THIS TREE IS SAVED BACK INTO THE LLIST
; FINALLY A FRONT TO BACK REASSEMBLY OF ALL THE TIP NODES IS DONE.
;-

RORDER:	BIT	#COMMUT,R3	;THE OPERATION MUST BE
	BEQ	50$		;COMMUTATIVE
	BIT	#RELOP,R3	;BUT NOT A
	BNE	50$		;RELATIONAL

	MOV	R2,-(SP)	;SAVE R2

	MOV	#NLIST,R2	;GET POINTERS TO NODE LIST
	MOV	#LLIST,R3	;AND LEAF LIST
	CALL	INSERT		;INSERT TREE INFO IN THEM

	MOV	-(R3),R5	;START WITH A LEAF
10$:	CMP	R3,#LLIST	;THEN, AS LONG AS THERE ARE
	BLOS	20$		;MORE LEAVES
	CMP	@-2(R3),#OP.CON	;AND THE LEAF IS A
	BNE	20$		;CONSTANT
	MOV	-(R2),R0	;GET A NODE AND
	MOV	R5,E.LOP(R0)	;LINK IT INTO THE
	MOV	-(R3),E.ROP(R0)	;NEW TREE
	MOV	R0,R5		;MAKE THE NEW NODE THE TREE TOP
	BR	10$		;AND CONTINUE TIL DONE

20$:	MOV	R5,(R3)+	;SAVE THE CONSTANT TREE
	MOV	R3,-(SP)	;SAVE END OF LLIST POINTER
	MOV	#LLIST,R3	;MOVE BACK TO THE FRONT

	MOV	(R3)+,R5	;START WITH A LEAF
30$:	CMP	R3,(SP)		;MORE?
	BHIS	40$		;NO
	MOV	-(R2),R0	;GRAB A NODE
	MOV	R5,E.LOP(R0)	;SET LEFT AND
	MOV	(R3)+,E.ROP(R0)	;RIGHT SUBTREES
	MOV	R0,R5		;RESET NODE POINTER AND
	BR	30$		;REPEAT

40$:	TST	(SP)+		;FIX STACK
	MOV	(SP)+,R2	;RESTORE AND
50$:	RETURN			;RETURN

;
; INSERT ENTRIES INTO LLIST AND NLIST.
; USED BY RORDER.
;

INSERT:	CMP	(R5),R4		;IS THE OPERATOR CORRECT
	BNE	10$		;NO, ITS A LEAF

	MOV	R5,(R2)+	;MAKE ENTRY INTO THE NLIST
	MOV	R5,-(SP)	;SAVE THE TREE
	MOV	E.LOP(R5),R5	;INSERT THE
	CALL	INSERT		;LEFT SUBTREE
	MOV	(SP)+,R5	;RECOVER THE TREE
	MOV	E.ROP(R5),R5	;INSERT THE
	CALL	INSERT		;RIGHT SUBTREE
	BR	60$		;DONE

10$:	CMP	(R5),#OP.CON	;IS IT A CONSTANT
	BNE	20$		;NO
	MOV	R5,(R3)+	;APPEND TO THE LEAF
	BR	60$		;LIST

20$:	MOV	R3,R0		;MUST MOVE THE
	TST	(R3)+		;ENTIRE
	MOV	R3,R1		;LIST FORWARD

	CALL	HASADR		;IS THIS ADDRESSABLE
	BCS	40$		;NO, ON FRONT
30$:	CMP	R0,#LLIST	;MOVE ONLY THE CONSTANTS
	BLOS	50$		;BACK
	CMP	@-2(R0),#OP.CON	;SO THE ADDRESSABLES
	BNE	50$		;END UP IN THE
	MOV	-(R0),-(R1)	;RIGHT
	BR	30$		;PLACE

40$:	CMP	R0,#LLIST	;DONE
	BLOS	50$		;YES
	MOV	-(R0),-(R1)	;NO, MOVE AN ENTRY
	BR	40$		;AND GO FOR MORE

50$:	MOV	R5,(R0)		;MAKE ENTRY ON THE FRONT

60$:	RETURN			;COMMON RETURN

	.PAGE

; FOLD
;+
; ** FOLD - FOLD INTEGER EXPRESSIONS
;
; THIS ROUTINE COLLAPSES EXPRESSIONS WITH CONSTANT  INTEGER  OPERANDS
; YES VIRGINIA, THERE IS A TEST FOR DIVIDE BY ZERO IN  BOTH  DIVISION
; AND REMAINDER NODES.
;-

FOLD:	MOV	R2,-(SP)	;SAVE R2

	CMP	(R5),#OP.ADD	;DO NOTHING IF LEAF
	BHIS	4$		;UGH
	JMP	140$		;

4$:	MOV	R5,-(SP)	;SAVE TREE
	TST	E.ROP(R5)	;IS THERE A RIGHT TREE?
	BEQ	5$		;NOPE.
	MOV	E.ROP(R5),R5	;YES, FOLD IT
	CALL	FOLD		;
	MOV	R5,R0		;REPLACE.
	MOV	(SP),R5		;RIGHT
	MOV	R0,E.ROP(R5)	;TREE

5$:	MOV	E.LOP(R5),R5	;FOLD LEFT
	CALL	FOLD		;
	MOV	R5,R0		;REPLACE
	MOV	(SP)+,R5	;LEFT
	MOV	R0,E.LOP(R5)	;SUBTREE

	MOV	E.ROP(R5),R2	;RIGHT
	BEQ	10$		;ISN'T ONE
	CMP	(R2),#OP.CON	;CHECK FOR WORD CONSTANT
	BNE	140$		;
	CMPB	E.TYPE(R2),#TY.LNG ;
	BHIS	140$		;
	MOV	E.VAL(R2),R2	;GET ITS VALUE

10$:	MOV	E.LOP(R5),R1	;GET THE LEFT OPERAND
	CMP	(R1),#OP.CON	;CHECK FOR WORD CONSTANT
	BNE	140$		;
	CMPB	E.TYPE(R1),#TY.LNG ;
	BHIS	140$		;
	MOV	E.VAL(R1),R1	;GET ITS VALUE

	MOV	(R5),R4		;OP
	CMP	R4,#OP.ADD	;DO THE FOLD.
	BNE	20$		;
	ADD	R2,R1		;ADDITION
	BR	130$		;

20$:	CMP	R4,#OP.SUB	;SUBTRACTION
	BNE	30$		;
	SUB	R2,R1		;
	BR	130$		;

30$:	CMP	R4,#OP.MUL	;MULTIPLICATION
	BNE	40$		;
	MOV	R2,-(SP)	;
	CALL	$MULR1		;
	TST	(SP)+		;
	BR	130$		;

40$:	CMP	R4,#OP.DIV	;DIVISION
	BNE	50$		;
	TST	R2		;DIVIDE CHECK?
	BNE	41$		;NO
	MOV	#ERR01,R0	;WARN
	CALL	WARN		;USER
	BR	140$		;AND QUIT

41$:	CLR	R0		;
	TST	R1		;
	BPL	42$		;
	COM	R0		;
42$:	MOV	R2,-(SP)	;
	CALL	$DIVR0		;
	TST	(SP)+		;
	MOV	R0,R1		;
	BR	130$		;

50$:	CMP	R4,#OP.MOD	;REMAINDER
	BNE	60$		;
	TST	R2		;DIVIDE CHECK
	BNE	51$		;NO
	MOV	#ERR01,R0	;WARN
	CALL	WARN		;USER
	BR	140$		;AND QUIT

51$:	CLR	R0		;
	TST	R1		;
	BPL	52$		;
	COM	R0		;
52$:	MOV	R2,-(SP)	;
	CALL	$DIVR0		;
	TST	(SP)+		;
	BR	130$		;

60$:	CMP	R4,#OP.ASL	;SHIFT LEFT
	BNE	70$		;
62$:	DEC	R2		;
	BMI	130$		;
	ASL	R1		;
	BR	62$		;

70$:	CMP	R4,#OP.ASR	;SHIFT RIGHT
	BNE	80$		;
72$:	DEC	R2		;
	BMI	130$		;
	ASR	R1		;
	BR	72$		;

80$:	CMP	R4,#OP.AND	;BITWISE AND
	BNE	90$		;
	COM	R2		;
	BIC	R2,R1		;
	BR	130$		;

90$:	CMP	R4,#OP.OR	;BITWISE OR
	BNE	100$		;
	BIS	R2,R1		;
	BR	130$		;

100$:	CMP	R4,#OP.XOR	;BITWISE EXCLUSIVE OR
	BNE	110$		;
	MOV	R2,-(SP)	;XOR = (A BIC B) BIS (B BIC A).
	BIC	R1,R2		;
	BIC	(SP)+,R1	;
	BIS	R2,R1		;
	BR	130$		;

110$:	CMP	R4,#OP.NEG	;UNARY NEGATION
	BNE	120$		;
	NEG	R1		;
	BR	130$		;

120$:	CMP	R4,#OP.COM	;BITWISE COMPLEMENT
	BNE	140$		;
	COM	R1		;

130$:	MOV	E.LOP(R5),R5	;USE LEFT CONST NODE FOR RESULT
	MOV	R1,E.VAL(R5)	;
	INC	CHANGE		;SAY SOMETHING CHANGED

140$:	MOV	(SP)+,R2	;RETURN
	RETURN			;

; FFOLD
.IF EQ C$$FPP								;05
;+
; ** FFOLD - FOLD FLOATING EXPRESSIONS
;
; THIS ROUTINE ONLY FOLDS UNARY NEGATION. THIS IS PRIMARILY  TO ALLOW
; NEGATIVE CONSTANTS IN INITIALISERS.
;-

FFOLD:	CMP	R4,#OP.NEG	;NEGATION
	BNE	10$		;NO
	CMPB	E.TYPE(R5),#TY.FLT ;WITH FLOAT OR DOUBLE RESULT	;u1
	BLO	10$		;NO				;u1

	MOV	E.LOP(R5),R0	;GET LEFT SUBTREE
	CMP	(R0),#OP.CON	;CONSTANT
	BNE	10$		;NO
	ADD	#100000,E.VAL(R0) ;REVERSE THE SIGN BIT
	MOV	R0,R5		;DELETE THE NEGATION
	INC	CHANGE		;MARK A CHANGE

10$:	RETURN			;DONE
.ENDC								;05

.IF NE C$$FPP							;05+
;+
; ** FFOLD - FOLD FLOATING EXPRESSIONS
;
; THIS ROUTINE ONLY FOLDS UNARY NEGATION, ADDITION,
; SUBTRACTION, MULTIPLICATION, AND DIVISION.
;-

FFOLD:	MOV	R2,-(SP)	;SAVE R2

	CMP	(R5),#OP.ADD	;DO NOTHING IF LEAF
	BHIS	4$		;UGH
	JMP	140$		;

4$:	MOV	R5,-(SP)	;SAVE TREE
	TST	E.ROP(R5)	;IS THERE A RIGHT TREE?
	BEQ	5$		;NOPE.
	MOV	E.ROP(R5),R5	;YES, FOLD IT
	CALL	FFOLD		;
	MOV	R5,R0		;REPLACE.
	MOV	(SP),R5		;RIGHT
	MOV	R0,E.ROP(R5)	;TREE

5$:	MOV	E.LOP(R5),R5	;FOLD LEFT
	CALL	FFOLD		;
	MOV	R5,R0		;REPLACE
	MOV	(SP)+,R5	;LEFT
	MOV	R0,E.LOP(R5)	;SUBTREE

	MOV	E.ROP(R5),R2	;RIGHT
	BEQ	10$		;ISN'T ONE
	CMP	(R2),#OP.CON	;CHECK FOR WORD CONSTANT
	BNE	140$		;
	CMPB	E.TYPE(R2),#TY.FLT ;
	BLO	140$		;
	BHI	8$
	SETF
	BR	9$
8$:	CMPB	E.TYPE(R2),#TY.DBL ;
	BHI	140$		;
	SETD			;
9$:	LDf	E.VAL(R2),R2	;GET ITS VALUE

10$:	MOV	E.LOP(R5),R1	;GET THE LEFT OPERAND
	CMP	(R1),#OP.CON	;CHECK FOR WORD CONSTANT
	BNE	140$		;
	CMPB	E.TYPE(R1),#TY.FLT ;
	BLO	140$		;
	BHI	11$
	SETF
	BR	12$
11$:	CMPB	E.TYPE(R1),#TY.DBL ;
	BHI	140$		;
	SETD			;
12$:	LDF	E.VAL(R1),R1	;GET ITS VALUE

	MOV	(R5),R4		;OP
	CMP	R4,#OP.ADD	;DO THE FOLD.
	BNE	20$		;
	ADDF	R2,R1		;ADDITION
	BR	130$		;

20$:	CMP	R4,#OP.SUB	;SUBTRACTION
	BNE	30$		;
	SUBF	R2,R1		;
	BR	130$		;

30$:	CMP	R4,#OP.MUL	;MULTIPLICATION
	BNE	40$		;
	MULF	R2,R1	;MULTIPLICATION
	BR	130$		;

40$:	CMP	R4,#OP.DIV	;DIVISION
	BNE	110$		;
	TSTF	R2		;DIVIDE CHECK?
	CFCC			;
	BNE	41$		;NO
	MOV	#ERR01,R0	;WARN
	CALL	WARN		;USER
	BR	140$		;AND QUIT
41$:	DIVF	R2,R1	;DIVISION
	BR	130$		;

110$:	CMP	R4,#OP.NEG	;UNARY NEGATION
	BNE	140$		;
	NEGF	R1		;

130$:	MOV	E.LOP(R5),R5	;USE LEFT CONST NODE FOR RESULT
	STF	R1,E.VAL(R5)	;
	INC	CHANGE		;SAY SOMETHING CHANGED

140$:	MOV	(SP)+,R2	;RETURN
	RETURN			;
.ENDC								;05-
	.PAGE
;+
; ** UNARY - DELETE USELESS UNARY OPERATORS
;
; THIS ROUTINE SEARCHES FOR NEG OR NEG, COM OF COM AND NOT OF NOT AND
; THROWS THEM BOTH AWAY. THE MOST IMPRORTANT OF THESE IS PROBABLY COM
; OF COM, WHICH GETS GENERATED OFTEN IN THE RIGHT SUBTREE OF BIT TEST
; NODES.
;-

UNARY:	CMP	R4,#OP.COM	;LOOK FOR OP.COM
	BEQ	10$		;
	CMP	R4,#OP.NEG	;OP.NEG
	BEQ	10$		;
	CMP	R4,#OP.NOT	;AND OP.NOT
	BNE	20$		;NOT ANY OF THEM

10$:	MOV	E.LOP(R5),R0	;GET SUBTREE
	CMP	R4,(R0)		;DO WE DELETE
	BNE	20$		;NO
	MOV	E.LOP(R0),R5	;YES, DELETE BOTH
	INC	CHANGE		;SAY SOMETHING CHANGED

20$:	RETURN			;DONE
	.PAGE
;+
; ** AMPER - SPECIAL CHECKS FOR AMPERSAND
;
; THIS ROUTINE PERFORMS TWO OPTIMISATIONS FOR THE ADDRESS OPERATOR. IT
; FIRST LOOKS FOR ADDRESS OF AN INDIRECTION, AND DELETES THEM (THIS IS
; GENERATED IN ARRAY ACCESSING). IT THEN LOOKS FOR THE ADDRESS  OF  AN
; INDEX NODE (ADDRESS OF AN AUTO) AND TRANSFORMS IT INTO AN ADDITION.
;-

AMPER:	CMP	R4,#OP.ADR	;IS THE OP AN AMPER
	BNE	30$		;NO

	MOV	E.LOP(R5),R1	;CHECK IF THE SUBTREE
	CMP	(R1),#OP.IND	;STARTS OFF WITH INDIRECTION
	BNE	10$		;NO
	MOV	E.LOP(R1),R5	;IF YES, DELETE BOTH
	BR	20$		;AND GO TO COMMON EXIT

10$:	CMP	(R1),#OP.INX	;AMPER OF INDEX
	BNE	30$		;NO
	MOV	#ES.CON,R4	;CONVERT TO ADDITION
	CALL	TREESP		;FIRST GET A CONSTANT NODE
	MOV	#OP.CON,(R4)	;
	MOVB	#TY.INT,E.TYPE(R4) ;
	MOV	E.OFFS(R1),E.VAL(R4) ;
	MOV	R4,R0		;
	MOV	#OP.REG,(R1)	;MAKE THE INDEX INTO A
	MOVB	#TY.PTR,E.TYPE(R1) ;POINTER IN A REG
	MOV	#ES.OP,R4	;THEN BUILD THE ADD NODE
	CALL	TREESP		;
	MOV	#OP.ADD,(R4)	;
	MOVB	#TY.PTR,E.TYPE(R4) ;
	MOV	R1,E.LOP(R4)	;
	MOV	R0,E.ROP(R4)	;
	MOV	R4,R5		;
20$:	INC	CHANGE		;MARK A CHANGE
30$:	RETURN			;RETURN

; SUBSUM
;+
; ** SUBSUM - SUBSUME CONSTANTS IN &A+CONST
;
; SEARCH FOR NODES OF THE GENERAL FORM &A+B, WHERE A IS EITHER  AN  ID
; OR A LOCAL ID, AND B IS A CONSTANT. ADD THE CONSTANT INTO THE OFFSET
; OF THE ID, THEN DELETE THE CONSTANT. HELPS WHEN REFERENCING CONSTANT
; SUBSCRIPTS INTO EXTERNALS AND STATICS.
;-

SUBSUM:	CMP	R4,#OP.ADD	;IF THE TOP OF THE TREE ISN'T '+'
	BNE	50$		;FORGET THIS

	MOV	E.LOP(R5),R0	;GET LEFT AND
	MOV	E.ROP(R5),R1	;RIGHT SUBTREES
	CMP	(R0),#OP.CON	;IS THE LEFT A CONSTANT
	BNE	20$		;NO
	CMP	(R1),#OP.ADR	;YES, IS THE RIGHT AN ADDRESS
	BNE	20$		;NO
	MOV	E.LOP(R1),R1	;YES, SEE IF THE ADDRESS IS OF
	CMP	(R1),#OP.ID	;EITHER AN
	BEQ	10$		;ID
	CMP	(R1),#OP.LID	;OR A LOCAL ID
	BNE	20$		;NO
10$:	ADD	E.VAL(R0),E.OFFS(R1) ;ADJUST OFFSET
	MOV	E.ROP(R5),R5	;DELETE THE ADDITION
	BR	40$		;AND GO TO COMMON EXIT

20$:	MOV	E.ROP(R5),R1	;RECOVER RIGHT SUBTREE
	CMP	(R1),#OP.CON	;IS THE RIGHT A CONSTANT
	BNE	50$		;NO
	CMP	(R0),#OP.ADR	;IS THE LEFT AN ADDRESS
	BNE	50$		;NO
	MOV	E.LOP(R0),R0	;YES, SEE IF THE ADDRESS IS OF
	CMP	(R0),#OP.ID	;AN ID
	BEQ	30$		;OR
	CMP	(R0),#OP.LID	;A
	BNE	50$		;LOCAL ID
30$:	ADD	E.VAL(R1),E.OFFS(R0) ;ADJUST OFFSET
	MOV	E.LOP(R5),R5	;DELETE THE '+'

40$:	INC	CHANGE		;SOMETHING CHANGED

50$:	RETURN			;DONE
	.PAGE

; STAR
;+
; ** STAR - SPECIAL CHECKS FOR STAR
;
; THIS ROUTINE PERFORMS TWO SPECIFIC OPTIMISATIONS FOR INDIRECTION. IT
; FIRST CHECKS FOR INDIRECTION THROUGH AN ADDRESS. THIS  HAPPENS  WHEN
; A REFERENCE IS MADE TO A[0] (THE +0 GETS DELETED). BOTH OF THE NODES
; ARE DELETED.
;
; IT THEN LOOKS FOR NODES OF THE FORM *(A+B) WHERE ONE SIDE OF THE '+'
; IS A REGISTER AND THE OTHER SIDE IS A CONSTANT, AND MAKES THIS  INTO
; AN INDEX NODE.
;-

STAR:	MOV	R2,-(SP)	;NEED A LOT OF REGISTERS

	CMP	R4,#OP.IND	;CHECK FOR INDIRECTION
	BNE	50$		;NO

	MOV	E.LOP(R5),R1	;LOOK FOR STAR
	CMP	(R1),#OP.ADR	;ON TOP OF AN AMPER
	BNE	10$		;NO
	MOV	E.LOP(R1),R5	;DELETE BOTH
	BR	40$		;GO TO COMMON EXIT

10$:	CMP	(R1),#OP.ADD	;IS OP "+"
	BEQ	11$		;YES
	CMP	(R1),#OP.SUB	;IS OP "-"
	BNE	50$		;NO

11$:	MOV	E.ROP(R1),R0	;TEST IF ROP IS A WORD CONSTANT
	CMP	(R0),#OP.CON	;
	BNE	20$		;
	CMPB	E.TYPE(R0),#TY.LNG ;
	BHIS	20$		;
	MOV	E.LOP(R1),R2	;TEST IF LOP IS A REGISTER
	CMP	(R2),#OP.REG	;
	BNE	20$		;
	CMPB	E.TYPE(R2),#TY.LNG ;
	BHIS	20$		;
	MOV	E.VAL(R0),E.OFFS(R2) ;
	CMP	(R1),#OP.SUB	;IF THE OP IS "-"
	BNE	12$		;THEN
	NEG	E.OFFS(R2)	;NEGATE INDEX CONSTANT
12$:	MOVB	E.TYPE(R5),E.TYPE(R2) ;
	MOV	R2,R5		;
	BR	30$		;

20$:	CMP	(R1),#OP.SUB	;IS OP "-"
	BEQ	50$		;YES, DO NOT DO "1-X"
	MOV	E.ROP(R1),R0	;CHECK IF ROP IS A REGISTER
	CMP	(R0),#OP.REG	;
	BNE	50$		;
	CMPB	E.TYPE(R0),#TY.LNG ;
	BHIS	50$		;
	MOV	E.LOP(R1),R2	;CHECK IF LOP IS A WORD CONSTANT
	CMP	(R2),#OP.CON	;
	BNE	50$		;
	CMPB	E.TYPE(R2),#TY.LNG ;
	BHIS	50$		;
	MOV	E.VAL(R2),E.OFFS(R0) ;
	MOVB	E.TYPE(R5),E.TYPE(R0) ;
	MOV	R0,R5		;

30$:	MOV	#OP.INX,(R5)	;OP.REG TO OP.INX
40$:	INC	CHANGE		;MARK A CHANGE
50$:	MOV	(SP)+,R2	;RETURN
	RETURN			;
	.PAGE

; AUTOS
;+
; ** AUTOS - EXPLOIT MODE 2 AND MODE 4 ADDRESSES.
;
; THIS ROUTINE EXAMINES THE ARGUMENT TREE TO SEE IF IT MAY BE TRANSFORMED
; INTO AN OP.AUI (AUTOINCREMENT) OR OP.AUD (AUTODECREMENT) NODE. THE  TOP
; OF THE TREE MUST BE A "*", FOLLOWED BY A "++" POSTFIX OR A "--"  PREFIX
; OF A REGISTER. THE SIZE OF THE INCREMENT OR DECREMENT MUST BE 1 (FOR  A
; CHAR) OR 2 (FOR ANY WORD). THIS LAST CHECK WASN'T ALWAYS THERE; HOWEVER
; IT IS NECESSARY TO PREVENT GRAVE DISASTER IF THE "++" OR "--" ALTERS  A
; STRUCTURE POINTER AND THE MEMBER BEING SELECTED ((P++)->A) IS AT OFFSET
; 0 IN THE STRUCTURE. A TIP OF THE HAT TO PAUL WHO FIRST DISCOVERED  THIS
; ONE.
;
; INPUTS:
;	R5=TREE.
;	R4=OP AT TOP OF TREE.
;
; OUTPUTS:
;	R5=TREE, PERHAPS MODIFIED.
;
; USES:
;	R0, R1
;-

AUTOS:	CMP	R4,#OP.IND	;IS THE TOP A "*"?
	BNE	40$		;NOPE, DONE
	MOVB	E.TYPE(R5),R0	;GRAB TYPE
	CMP	R0,#TY.LNG	;IS IT A WORD OR BYTE?
	BHIS	40$		;NO

	MOV	#1,R1		;GET DEFAULT INCR.
	CMP	R0,#TY.CHR	;CORRECT?
	BEQ	10$		;YES.
	INC	R1		;GET WORD INCR.

10$:	MOV	E.LOP(R5),R0	;SUBTREE
	CMP	(R0),#OP.INA	;LOOK FOR "++" POSTFIX.
	BEQ	20$		;YES.
	CMP	(R0),#OP.DEB	;LOOK FOR "--" PREFIX.
	BNE	40$		;NO.

20$:	MOV	E.ROP(R0),R0	;GET OP.CON PTR.
	CMP	E.VAL(R0),R1	;IS IT THE CORRECT SIZE?
	BNE	40$		;NOPE.

	MOV	E.LOP(R5),R0	;GET THE LVALUE
	MOV	E.LOP(R0),R1	;
	CMP	(R1),#OP.REG	;REGISTER?
	BNE	40$		;NO.
	MOV	#OP.AUI,(R1)	;ASSUME (R)+.
	CMP	(R0),#OP.INA	;CORRECT?
	BEQ	30$		;YES.
	MOV	#OP.AUD,(R1)	;MAKE IT -(R).

30$:	MOVB	E.TYPE(R5),E.TYPE(R1) ;FIDDLE THE TYPE
	MOV	R1,R5		;GET NEW TREE
	INC	CHANGE		;FLAG A CHANGE AND

40$:	RETURN			;DONE

	.PAGE

; FIXCVR
;-
; ** FIXCVR - ADJUST OP.CVR NODES
;
; THIS ROUTINE SEARCHES OUT CONVERSION NODES THAT ARE  ACTUALLY  DONE
; WITH MULTIPLIES AND/OR DIVIDES (POINTER TO INT AND INT TO  POINTER)
; AND MAKES THE CHANGE. HOPEFULLY THE FOLDER WILL DO SOME ACTION.
;-

FIXCVR:	CMP	R4,#OP.CVR	;QUIT IF THE
	BNE	40$		;OPERATOR IS WRONG

	MOVB	E.TYPE(R5),R0	;GET RESULT TYPE
	MOV	E.LOP(R5),R1	;GET LEFT SUBTREE
	CMP	R0,#TY.PTR	;IS THE RESULT A POINTER
	BNE	20$		;NO
	CMPB	E.TYPE(R1),#TY.INT ;IS THE LEFT A WORD
	BEQ	10$		;YES
	CMPB	E.TYPE(R1),#TY.UNS ;OR AN UNSIGNED
	BEQ	10$		;YES
	MOV	#OP.CVR,R4	;NO, CONVERT IT TO ONE
	CALL	NODE		;
	MOVB	#TY.INT,E.TYPE(R1) ;
	MOV	R1,E.LOP(R5)	;
10$:	MOV	#OP.MUL,(R5)	;CHANGE THE OPERATOR TO A MULTIPLY
	BR	30$		;

20$:	CMP	R0,#TY.INT	;LOOK FOR POINTER TO INT
	BEQ	25$		; Found one			;u2
	CMP	R0,#TY.UNS	; Unsigned is OK too		;u2
	BNE	40$		;NO
25$:	CMPB	E.TYPE(R1),#TY.PTR ;MAYBE			;u2
	BNE	40$		;NO
	MOV	#OP.DIV,(R5)	;CHANGE INTO DIVIDE
30$:	INC	CHANGE		;SOMETHING CHANGED
40$:	RETURN
	.PAGE

; FIXCOT							;u4+
;-
; ** FIXCOT - FIX UP HARD CAST OF TYPES
;
; This routine looks for COT LNG above MUL INT.  If found,
; replaces it with MLL LNG.  Uses special OP.MLL op code
; Only happens if EIS flag (EFLAG) is set.
;
; Also switches COT LNG above ASL INT to
; ASL LNG above CVR LNG<-INT
;
; Otherwise changes OP.COT to OP.CVR.
;
;-

FIXCOT:
	CMP	R4,#OP.COT	;QUIT IF THE
	BNE	100$		;OPERATOR IS WRONG

	MOV	#OP.CVR,(R5)	; SWITCH TO OP.CVR

	TSTB	EFLAG		; EIS?
	BEQ	99$		; Exit if not
	MOV	E.LOP(R5),R1	;GET LEFT SUBTREE

; Check for CVR to LNG

	CMPB	E.TYPE(R5),#TY.LNG	;Is result LONG?
	BNE	50$		; NO, TRY FOR INT
	CMPB	E.TYPE(R1),#TY.INT ;IS THE LEFT AN INTEGER?
	BNE	99$		; NO, EXIT

; Process LONG = INT*INT

	CMP	(R1),#OP.MUL	; IS OPERATOR MUL?
	BNE	10$		; NO, TRY ASL
	MOV	R1,R5		;DELETE CVR NODE
	MOV	#OP.MLL,(R5)	;CHANGE OP TO OP.MLL
	BR	20$		; SET TYPE AND MARK CHANGE

10$:	CMP	(R1),#OP.ASL	; IS OPERATOR ASL?
	BNE	99$		; EXIT IF NOT
	MOV	E.LOP(R1),E.LOP(R5)	;PUT CVR BETWEEN ASL AND ITS LEFT TREE
	MOV	R5,E.LOP(R1)
	MOV	R1,R5		; ASL NODE IS NOW ON TOP

20$:	MOVB	#TY.LNG,E.TYPE(R5) 	; RESULT TYPE IS LONG
	BR	99$		; MARK CHANGE

; Check for CVR to INT

50$:	CMPB	E.TYPE(R5),#TY.INT	;Is result INT?
	BNE	99$		; NO, EXIT
	CMPB	E.TYPE(R1),#TY.LNG ;IS THE LEFT LONG?
	BNE	99$		; NO, EXIT

; Process INT = LONG/INT

	CMP	(R1),#OP.DIV	; IS OPERATOR DIV?
	BNE	99$		; NO, GIVE UP
	MOV	E.ROP(R1),R0	; GET RIGHT SIDE OF DIV
	CMP	(R0),#OP.CVR	; IS RIGHT SIDE CVR?
	BNE	99$		; NO, GIVE UP
	CMPB	E.TYPE(R0),#TY.LNG	; CVR TO LNG?
	BNE	99$		; NO, GIVE UP
	MOV	E.LOP(R0),R0	; GET LEFT SIDE OF CVR
	CMPB	E.TYPE(R0),#TY.INT	; IS LEFT AN INT?
	BNE	99$		; NO, GIVE UP

	MOV	R1,R5		;DELETE TOP CVR NODE
	MOV	R0,E.ROP(R5)	;DELETE RIGHT CVR NODE
	MOV	#OP.DLL,(R5)	;CHANGE OP TO OP.DLL
	MOVB	#TY.INT,E.TYPE(R5) 	; RESULT TYPE IS INT

99$:	INC	CHANGE		;SOMETHING CHANGED

100$:	RETURN
	.PAGE							;u4-

; MULDIV								;u3+
;+
; ** MULDIV
;
; Changes MUL and DIV by positive powers of 2 into shifts
; Deletes MUL and DIV by 1.
;
;-

MULDIV:
	CMP	R4,#OP.MUL	;MUL?
	BNE	10$		;NO
	MOV	#OP.ASL,R1	;SET TO ASL
	BR	30$

10$:	CMP	R4,#OP.MUA	;MUL ASSIGNED?
	BNE	12$		;NO
	MOV	#OP.ALA,R1	;SET TO ALA
	BR	30$

12$:	CMP	R4,#OP.DIV	;DIV?
	BNE	14$		;NO
	MOV	#-OP.ASR,R1	;SET TO -ASR				;u5
	BR	30$

14$:	CMP	R4,#OP.DVA	;DIV ASSIGNED?
	BNE	100$		;NO, NOTHING FOR US TO DO
	MOV	#-OP.ARA,R1	;SET TO -ARA				;u5

30$:	MOV	R2,-(SP)	;SAVE A REG

	CMPB	E.TYPE(R5),#TY.LNG	;WITH A 1 WORD
	BHIS	99$		;NO

	MOV	E.ROP(R5),R2	;GET RIGHT SUBTREES

	CMP	(R2),#OP.CON	;TEST FOR CONST
	BNE	99$		;NO
	MOV	E.VAL(R2),R0	;GET CONSTANT VALUE
	CMP	R0,#1		;CHECK FOR 1
	BLT	99$		;EXIT IF ZERO OR NEGATIVE
	BGT	40$		;SKIP IF > 1
	MOV	E.LOP(R5),R5	;CONSTANT 1, DELETE IT
	BR	90$		;MARK CHANGE AND EXIT

; Make sure signed divides are not converted.				;u5+

40$:	TST	R1		;MUL OR DIV?
	BPL	45$		;MUL, SKIP
	NEG	R1		;RECOVER CORRECT OPERATOR
	CMPB	E.TYPE(R5),#TY.UNS ;SIGNED DIVIDE CAN'T BE OPTIMIZED
	BNE	99$		;NO

; SEE IF POWER OF 2 (THANKS TO M. MINOW)

45$:	MOV	R0,-(SP)						;u5-
	NEG	R0
	BIC	R0,(SP)+
	BNE	99$		;EXIT IF NOT AN EXACT POWER OF 2

; WE HAVE A POWER OF 2

	MOV	R1,(R5)		;STUFF THE NEW OPR
	MOV	E.VAL(R2),R0	;GET CONSTANT VALUE

	CLR	R1		;COMPUTE SHIFT COUNT
	BR	55$

50$:	INC	R1		;WE KNOW SHIFT IS >= 1
55$:	ASR	R0		;SHIFT AND COUNT
	BCC	50$		;UNTIL THE BIT COMES OUT

	MOV	R1,E.VAL(R2)	;SET THE NEW VALUE

90$:	INC	CHANGE		;AND INDICATE A CHANGE

99$:	MOV	(SP)+,R2	;RESTORE REG
100$:	RETURN			;DONE					;u3-
	.PAGE

; FIXMOD								;u3+
;+
; ** FIXMOD	Fix up unsigned modulo functions
;
; Converts unsigned modulo by positive powers of 2 to bit clears
;
;-

FIXMOD:
	CMP	R4,#OP.MOD	; MOD?
	BNE	10$		; NO
	MOV	#OP.BIC,R1	; SET OPR TO BIC
	BR	20$
10$:	CMP	R4,#OP.MOA	; ASSIGNED MOD?
	BNE	100$		; NO, EXIT
	MOV	#OP.BCA,R1	; SET OPR TO BCA

20$:	MOV	R1,-(SP)	; SAVE OPR

	CMPB	E.TYPE(R5),#TY.UNS ;UNSIGNED?
	BNE	99$		;NO

	MOV	E.ROP(R5),R1	;GET RIGHT SUBTREE

	CMP	(R1),#OP.CON	;TEST FOR CONST
	BNE	99$		;NO
	MOV	E.VAL(R1),R0	;GET CONSTANT VALUE
	BLE	99$		;EXIT IF ZERO OR NEGATIVE

; SEE IF POWER OF 2 (THANKS TO M. MINOW)

	MOV	R0,-(SP)
	NEG	R0
	BIC	R0,(SP)+
	BNE	99$		;EXIT IF NOT AN EXACT POWER OF 2

; WE HAVE A POWER OF 2

	NEG	E.VAL(R1)	;CREATE MASK FOR THE BIC
	MOV	(SP),(R5)	;STUFF THE NEW OPR

	INC	CHANGE		;AND INDICATE A CHANGE

99$:	TST	(SP)+		;POP STACK
100$:	RETURN

; MKBIC
;+
; ** MKBIC - CHANGE AND TO BIC
;
; THE PDP-11 LACKS AN AND INSTRUCTION. SEARCH FOR AN AND OR ASSIGNED
; AND NODES AND TRANSFORM THEM INTO BIC OR ASSIGNED BIC. IF POSSIBLE
; COMMUTE ANY CONSTANT TO THE LEFT (TO ASSIST FOLDING).
;-

MKBIC:	CMP	R4,#OP.ANA	;ASSIGNED AND
	BEQ	10$		;YES
	CMP	R4,#OP.AND	;AND
	BNE	40$		;NO

	MOV	E.LOP(R5),R0	;IF THE LEFT IS A
	CMP	(R0),#OP.CON	;CONSTANT
	BNE	10$		;THEN
	MOV	E.ROP(R5),E.LOP(R5) ;SWAP THE SUBTREES
	MOV	R0,E.ROP(R5)	;SO THE COM CAN FOLD INTO IT

10$:	MOV	E.ROP(R5),R1	;ADD A COM NODE
	MOV	#OP.COM,R4	;
	CALL	NODE		;
	MOV	R1,E.ROP(R5)	;

	CMP	(R5),#OP.AND	;WAS THE OLD OP OP.AND
	BNE	20$		;NO
	MOV	#OP.BIC,(R5)	;YES, MAKE IT BIC
	BR	30$		;
20$:	MOV	#OP.BCA,(R5)	;OP.ANA BECOMES ASSIGNED BIC
30$:	INC	CHANGE		;
40$:	RETURN			;
	.PAGE

; DZEROP
;+
; ** DZEROP - DELETE ZERO OPERANDS
;
; THIS FUNCTION DELETES OPERATIONS WITH CONSTANT ZERO OPERANDS.  DOPE
; TABLE ENTRIES INDICATE WHICH OPERATORS GET THIS TRANSFORMATION.
; IF THE OPERATOR IS ONE OF THE ASSIGNMENT OPS THEN THE CVM THAT  MAY
; BE AT THE TOP OF THE TREE IS ALSO DELETED.
;-

DZEROP:	BIT	#DZOL,R3	;DELETE ZERO ON LEFT
	BEQ	10$		;NO
	MOV	E.LOP(R5),R1	;CHECK FOR ZERO OPERAND
	CALL	CONZER		;
	BCS	10$		;NO
	MOV	E.ROP(R5),R5	;NEW TREE
	BR	20$		;

10$:	BIT	#DZOR,R3	;DELETE ZERO ON RIGHT
	BEQ	30$		;
	MOV	E.ROP(R5),R1	;CHECK FOR ZERO OPERAND
	CALL	CONZER		;
	BCS	30$		;
	MOV	E.LOP(R5),R5	;NEW TREE

20$:	INC	CHANGE		;MARK A CHANGE.

30$:	RETURN			;DONE
	.PAGE

; CONZER
;+
; ** CONZER - CHECK IF A NODE IS A CONSTANT 0
;
; THIS ROUTINE IS USED ALL OVER THE COMPILER TO TEST IF A NODE IS A
; CONSTANT WITH VALUE 0. CONVERSIONS ARE IGNORED.
;
; INPUTS:
;	R1=POINTER TO THE NODE
;
; OUTPUTS:
;	C BIT CLEAR IF CONSTANT 0
;-

CONZER:	MOV	R0,-(SP)	;SAVE REGISTERS
	MOV	R1,-(SP)	;

10$:	CMP	(R1),#OP.CVR	;IGNORE CONVERSIONS
	BNE	20$		;
	MOV	E.LOP(R1),R1	;
	BR	10$		;

20$:	CMP	(R1),#OP.CON	;DO WE HAVE A CONSTANT
	BNE	30$		;NO
	ADD	#E.VAL,R1	;YES, POINT AT THE VALUE
	MOV	(R1)+,R0	;TEST FOR ZERO
	BIS	(R1)+,R0	;
	BIS	(R1)+,R0	;
	BIS	(R1),R0		;
	BNE	30$		;BR IF NOT ZERO
	CLC			;CLEAR C BIT IF ZERO
	BR	40$		;

30$:	SEC			;SET C BIT IF NON ZERO

40$:	MOV	(SP)+,R1	;RETURN
	MOV	(SP)+,R0	;
	RETURN			;
	.PAGE
;+
; ** NODE - MAKE A UNARY OPERATOR NODE
;
; INPUTS:
;	R1=OLD TREE (BECOMES LOP)
;	R4=OPERATOR
;
; OUTPUTS:
;	R1=NEW TREE
;-

NODE:	MOV	R4,-(SP)	;SAVE THE OPERATOR WHILE WE
	MOV	#ES.OP,R4	;GET TREE NODE
	CALL	TREESP		;
	MOV	(SP)+,(R4)	;OP
	MOVB	E.TYPE(R1),E.TYPE(R4) ;
	MOV	E.HFPR(R1),E.HFPR(R4) ;
	MOV	E.HGPR(R1),E.HGPR(R4) ;
	MOV	R1,E.LOP(R4)	;
	CLR	E.ROP(R4)	;
	MOV	R4,R1		;
	RETURN			;

; MWCON
;+
; ** MWCON - FIX MULTI WORD CONSTANTS
;
; CERTAIN CONSTANTS (LONGS, SOME DOUBLES) WILL NOT FIT INTO A SINGLE
; PDP-11 MACHINE WORD AND CANNOT, THEREFORE, BE EXPRESSED IN A  MODE
; 2 ADDRESS FIELD. THIS ROUTINE SEARCHES FOR SUCH CONSTANTS. IT THEN
; BUILDS A CONSTANT POOL IN PSECTION $MWCN
; THERE IS NO CHECKING FOR DUPLICATION IN THE POOL. (This follows
; the C language specification!)
; THE NODES ARE ALTERED INTO STATIC VARIABLES POINTING TO THE LABELS
; IN THE POOL.
;
; INPUTS:
;	R5=POINTER TO THE TREE
;-

MWCON:	CLR	MWPSFG		;SET NEED PSECT DIRECTIVE
	CALL	MWCON1		;DO THE NASTY STUFF
	TST	MWPSFG		;NEED TO SWITCH BACK
	BEQ	10$		;NO
	MOV	#PSPROG,R0	;PSECT $CODE				;03/06
	CALL	CODPS		;					;03
10$:	RETURN			;

MWCON1:	MOV	R5,-(SP)	;SAVE ARGUMENT

	MOV	(R5),R0		;GET OPERATOR
	CMP	R0,#OP.CON	;CONSTANT
	BNE	40$		;NO
	MOVB	E.TYPE(R5),R0	;GET TYPE OF CONSTANT
	CMP	R0,#TY.LNG	;LONG
	BLO	50$		;EXIT IF 1 WORD			;u1+
	BEQ	10$		;LONG, ITS MULTIWORD
	CMP	R0,#TY.DBL	;DOUBLE OR FLOAT?
	BHI	50$		;NO
	MOV	E.VAL+2(R5),R1	;SEE IF LAST WORDS ARE ZERO
	BCS	5$		; SKIP IF FLOAT (BCS == BLO)
	BIS	E.VAL+4(R5),R1	; CHECK ONLY IF DOUBLE
	BIS	E.VAL+6(R5),R1	;
5$:	BEQ	50$		;SHORT				;u1-

10$:	TST	MWPSFG		;NEED PSECT SWITCH
	BNE	20$		;NO
	INC	MWPSFG		;YES
	CALL	PFLUSH		;FLUSH PENDING BRANCHES
	MOV	#PSMWCN,R0	;				;03
	CALL	CODPS		;

20$:	CALL	GENLAB		;GENERATE A LABEL
	MOV	R0,-(SP)	;SAVE IT
	CALL	LABEL		;OUTPUT IT IN THE PSECT
	MOV	#STR03,R0	;.WORD
	CALL	CODSTR		;
	MOV	E.VAL(R5),R0	;FIRST WORD
	CALL	CODNUM		;
	CALL	60$		;','
	MOV	E.VAL+2(R5),R0	;SECOND WORD
	CALL	CODNUM		;

	CMPB	E.TYPE(R5),#TY.DBL ;DO 2 MORE WORDS IF		;u1
	BNE	30$		;DOUBLE				;u1
	CALL	60$		;','
	MOV	E.VAL+4(R5),R0	;
	CALL	CODNUM		;
	CALL	60$		;
	MOV	E.VAL+6(R5),R0	;
	CALL	CODNUM		;

30$:	CALL	CODNL		;WRAP IT UP
	MOV	#OP.LID,(R5)	;MAKE LOCAL ID NODE
	CLR	E.OFFS(R5)	;
	MOV	(SP)+,E.LAB(R5)	;
	BR	50$		;

40$:	ASL	R0		;NOT CONSTANT, TEST FOR LEAF
	BIT	#LEAF,OPDOPE(R0);
	BNE	50$		;IS LEAF
	MOV	E.LOP(R5),R5	;DO LEFT
	CALL	MWCON1		;
	MOV	(SP),R5		;DO RIGHT
	MOV	E.ROP(R5),R5	;
	BEQ	50$		;
	CALL	MWCON1		;

50$:	MOV	(SP)+,R5	;RETURN
	RETURN			;

60$:	MOVB	#',,R0		;OUTPUT COMMA
	CALLR	CODC		;

	.END