.TITLE	CC203
	.IDENT	/X01/
 
	.NLIST	BEX
	.ENABL	LC
 
;
; C COMPILER
; CODER, PART II (NON EIS)
;
; VERSION X01
;
; DAVID G. CONROY	01-APR-78
; LAST UPDATED:		23-MAY-79
;
 
	.GLOBL	ADDRES
	.GLOBL	HASADR
	.GLOBL	CLASFY
	.GLOBL	ITREE
 
	.MCALL	CALL
	.MCALL	CALLR
	.MCALL	RETURN
 
;
; NODE CLASSES
; CHANGE AT YOUR PERIL!
;
 
CON0	==	0		;CONST 0
CON1	==	1		;CONST 1
CON2	==	2		;CONST 2
CON3	==	3		;CONST 3
CON4	==	4		;CONST 4
CON5	==	5		;CONST 5
CON6	==	6		;CONST 6
CON7	==	7		;CONST 7
CON8	==	10		;CONST 8
CON9	==	11		;CONST 9
CON10	==	12		;CONST 10
CON12	==	13		;CONST 12
CON16	==	14		;CONST 16
CON32	==	15		;CONST 32
ADDR	==	16		;ADDRESSABLE
EASY	==	17		;REGISTER TEMP. AVAILABLE
ANY	==	20		;ANYTHING ELSE
 
;
; THIS TABLE IS USED TO HELP CLASSIFY CONSTANTS.
;
 
CONTB:	.WORD	0,	CON0	;ONE ENTRY PER SPECIAL CONSTANT
	.WORD	1,	CON1	;
	.WORD	2,	CON2	;
	.WORD	3,	CON3	;
	.WORD	4,	CON4	;
	.WORD	5,	CON5	;
	.WORD	6,	CON6	;
	.WORD	7,	CON7	;
	.WORD	10,	CON8	;
	.WORD	11,	CON9	;
	.WORD	12,	CON10	;
	.WORD	14,	CON12	;
	.WORD	20,	CON16	;
	.WORD	40,	CON32	;
CONTBE:	.BLKW	0		;END OF TABLE
 
 
;
; STRINGS AND ERROR MESSAGES.
;

STR01:	.ASCIZ	"	.word	"
STR02:	.ASCIZ	"	.byte	"

ERR01:	.ASCIZ	"Bad initialisor"
ERR02:	.ASCIZ	"Bad call: addres"
ERR03:	.ASCIZ	"Not yet written: ltod"
ERR04:	.ASCIZ	"Not yet written: dtol"

	.EVEN
	.PAGE
;+
; ** ADDRES - PUT OUT AN ADDRESS
;
; THIS ROUTINE OUTPUTS A TREE AS A STANDARD PDP-11 ADDRESS FIELD. THE
; TREE MUST DESCRIBE AN ADDRESSABLE THING OR THE COMPILER ABORTS.
;
; INPUTS:
;	R5=TREE
; 	R4=A FLAG
;		0	ORDINARY
;		1	NO SIDE EFFECTS
;		-1	SECOND (LOW ORDER) PART OF A LONG
;-
 
ADDRES:	MOV	R5,-(SP)	;SAVE REGISTERS
	MOV	R1,-(SP)	;
	MOV	R0,-(SP)	;
 
	CMP	(R5),#OP.IND	;INDIRECTION REQUIRES AN '*'
	BNE	10$		;
	CMP	@E.LOP(R5),#OP.REG ;REGISTERS PRINT AS (REG)
	BEQ	20$		;
	MOVB	#'*,R0		;OUTPUT THE '*'
	CALL	CODC		;
	MOV	E.LOP(R5),R5	;AND DELETE THE INDIRECTION
	BR	20$		;
 
10$:	CMP	(R5),#OP.ADR	;ADR OF NAME
	BNE	20$		;NO
	MOVB	#'$,R0		;MODE 2 ADDRESS
	CALL	CODC		;
	MOV	E.LOP(R5),R5	;DELETE ADR
 
20$:	MOV	(R5),R0		;PICK UP THE OPERATOR
	CMP	R0,#OP.IND	;INDIRECTION
	BNE	23$		;NO
	MOV	E.LOP(R5),R5	;THIS MAKES **REG INTO @(REG)
	CMP	(R5),#OP.REG	;
	BEQ	2000$		;
	JMP	100$		;DIE
2000$:	TST	R4		;IS THIS THE SECOND PART OF A LONG
	BGE	21$		;NO
	MOVB	#'2,R0		;YES, MAKE INDEXING
	CALL	CODC		;
21$:	CALL	PREG		;THE INDEX REGISTER
	BR	90$		;DONE
 
23$:	CMP	R0,#OP.CON	;CONSTANT
	BNE	25$		;NO
	MOVB	#'$,R0		;USE LITERAL MODE
	CALL	CODC		;
	MOV	E.VAL(R5),R0	;THE VALUE
	TST	R4		;GET THE RIGHT
	BPL	24$		;PART OF A
	MOV	E.VAL+2(R5),R0	;LONG
24$:	CALL	CODNUM		;
	BR	90$		;
 
25$:	CMP	R0,#OP.LID	;LOCAL ID
	BNE	30$		;NO
	MOV	E.LAB(R5),R0	;DO THE NAME
	CALL	CODLAB		;
	BR	31$		;THEN GO DO OFFSETS
 
30$:	CMP	R0,#OP.ID	;ID
	BNE	40$		;NO
	MOV	R5,R0		;PUT OUT THE NAME
	ADD	#E.NAME,R0	;
	CALL	CODSTR		;

31$:	MOV	E.OFFS(R5),R1	;GET OFFSET
	TST	R4		;IS IT THE SECOND PART OF A LONG
	BGE	32$		;NO
	ADD	#2,R1		;YES, FIX IT
32$:	MOVB	#'+,R0		;DEFAULT SIGN FOR THE OFFSET
	TST	R1		;TEST FOR NO OFFSET
	BEQ	90$		;
	BPL	34$		;POSITIVE
	MOVB	#'-,R0		;GET SIGN
	NEG	R1		;FIX VALUE
34$:	CALL	CODC		;PUT OUT OFFSET SEPERATOR
	MOV	R1,R0		;THEN THE OFFSET
	CALL	CODNUM		;
	BR	90$		;
 
40$:	CMP	R0,#OP.INX	;INDEX
	BNE	50$		;NO
	MOV	E.OFFS(R5),R1	;GET THE OFFSET
	TST	R4		;FIXUP FOR LONGS
	BGE	42$		;
	ADD	#2,R1		;
42$:	TST	R1		;TEST FOR ZERO OFFSET
	BEQ	46$		;
	BPL	44$		;POSITIVE
	MOVB	#'-,R0		;GET CORRECT SIGN
	CALL	CODC		;
	NEG	R1		;AND VALUE
44$:	MOV	R1,R0		;INDEX CONSTANT
	CALL	CODNUM		;
46$:	CALL	PREG		;INDEX REGISTER
	BR	90$		;
 
50$:	CMP	R0,#OP.REG	;REGISTER
	BNE	60$		;NO
	MOVB	#'r,R0		;THE 'R'
	CALL	CODC		;
	MOV	E.REG(R5),R0	;THE REGISTER NUMBER
	TST	R4		;IF LOW HALF OR LONG
	BGE	52$		;THEN
	INC	R0		;ITS REG+1
52$:	ADD	#'0,R0		;
	CALL	CODC		;
	BR	90$		;
 
60$:	CMP	R0,#OP.AUI	;AUTOINCREMENT
	BNE	70$		;NO
	CALL	PREG		;PUT OUT THE REGISTER PART
	TST	R4		;IF SIDE EFFECTS
	BGT	90$		;
	MOVB	#'+,R0		;PUT OUT THE '+'
	CALL	CODC		;
	BR	90$		;
 
70$:	CMP	R0,#OP.AUD	;AUTODECREMENT
	BNE	100$		;NO
	TST	R4		;IF SIDE EFFECTS
	BGT	72$		;
	MOVB	#'-,R0		;PUT OUT THE '-'
	CALL	CODC		;
72$:	CALL	PREG		;THE REGISTER
 
90$:	MOV	(SP)+,R0	;RETURN
	MOV	(SP)+,R1	;
	MOV	(SP)+,R5	;
	RETURN			;
 
100$:	MOV	#ERR02,R0	;DEATH
	JMP	CCABRT		;
 
;
; OUTPUT A REGISTER IN PARENTHESES.
;

PREG:	MOVB	#'(,R0		;LEFT PARENTHESIS
	CALL	CODC		;
	MOVB	#'r,R0		;'R'
	CALL	CODC		;
	MOV	E.REG(R5),R0	;REGISTER NUMBER
	ADD	#'0,R0		;
	CALL	CODC		;
	MOVB	#'),R0		;RIGHT PARENTHESIS
	CALLR	CODC		;
	.PAGE
;+
; ** HASADR - TEST IF A NODE HAS AN ADDRESS
;
; THIS ROUTINE DETERMINES IF A TREE IS AN 'ADDRESSABLE' TREE; THAT IS,
; IF A PDP-11 ADDRESS FIELD CAN DESCRIBE IT.
; ALL LEAF NODES ARE ADDRESSABLE.
; INDIRECTION ON TOP OF A LEAF NODE IS ADDRESSABLE IF THE RESULT TYPE
; IS NOT LONG.
; ADDRESS OF ON TOP OF EITHER TYPE OF ID (GLOBAL OR LOCAL) IS ADDRESS
; ABLE ALSO.
;
; INPUTS:
;	R5=TREE
;
; OUTPUTS:
;	C=0 IF ADDRESSABLE
;-
 
HASADR:	MOV	R5,-(SP)	;SAVE POINTER TO TREE

	CMP	(R5),#OP.IND	;IF INDIRECTION
	BNE	10$		;AND
	CMPB	E.TYPE(R5),#TY.LNG ;NOT LONG
	BEQ	20$		;THEN
	MOV	E.LOP(R5),R5	;DELETE THE INDIRECTION
	BR	20$		;
 
10$:	CMP	(R5),#OP.ADR	;ADDRESS OF NAME
	BNE	20$		;
	MOV	E.LOP(R5),R5	;GET SUBTREE
	CMP	(R5),#OP.ID	;CHECK FOR BOTH TYPES OF ID
	BEQ	30$		;
	CMP	(R5),#OP.LID	;
	BEQ	30$		;
	BR	40$		;NOT ADDRESSABLE
 
20$:	MOV	(R5),R5		;LOOK FOR LEAF NODE
	ASL	R5		;
	BIT	#LEAF,OPDOPE(R5);
	BEQ	40$		;NOT ADDRESSABLE

30$:	CLC			;SUCCESSFUL RETURN
	BR	50$		;
40$:	SEC			;NON SUCCESSFUL RETURN
50$:	MOV	(SP)+,R5	;RETURN
	RETURN			;
	.PAGE
;+
; ** CLASFY - CLASSIFY BINARY NODES
;
; GIVEN A TREE, AND AN 'OTHER' TREE (USUALLY THE OTHER BINARY OPERATOR
; SUBTREE) RETURN A TREE CLASS AS USED BY THE MATCHER. THIS ROUTINE IS
; SOMETIMES USED TO DETERMINE THE ADDRESSABILITY OF THE SINGLE OPERAND
; OF A UNARY OP; IN THIS CASE THE OTHER TREE IS POINTED AT A LEAF.
;
; INPUTS:
;	R0=THE OTHER TREE
;	R5=THE TREE
;
; OUTPUTS:
;	R0=CLASS
;-
 
CLASFY:	MOV	R4,-(SP)	;SAVE REGISTERS
	MOV	R3,-(SP)	;

;
; CONSTANTS.
;
 
	CMP	(R5),#OP.CON	;IS THIS A CONSTANT
	BNE	30$		;NO
	MOVB	E.TYPE(R5),R3	;IS THE TYPE INTEGER
	CMP	R3,#TY.INT	;
	BNE	30$		;NO
 
	MOV	E.VAL(R5),R3	;GET CONSTANT VALUE
	MOV	#CONTB,R4	;POINT AT TABLE OF MAGIC VALUES
 
10$:	CMP	R3,(R4)+	;MAGIC
	BEQ	20$		;YES
	TST	(R4)+		;NO, MOVE TO THE NEXT
	CMP	R4,#CONTBE	;DONE
	BLO	10$		;NO, TRY MORE
	BR	30$		;NOT A SPECIAL CONSTANT
 
20$:	MOV	(R4),R0		;GET CLASSIFICATION
	BR	100$		;
 
;
; TEST IF ADDRESSABLE.
;

30$:	CALL	HASADR		;WELL
	BCS	40$		;NO
	MOV	#ADDR,R0	;RETURN VALUE
	BR	100$		;
 
;
; TEST IF REGISTER TEMP. AVAILABLE.
; FLOATING POINT IS ALWAYS HARD (FOR NON EIS).
;

40$:	CLR	R4		;1 REG
	CMP	(R5),#OP.IND	;TOP LEVEL '*'
	BEQ	70$		;YES, 1 REG NEEDED
 
	CMP	R3,#OP.LNG	;IS IT FLOATING POINT
	BHI	80$		;YES, FORCE ANY
 
	CALL	NPAIR		;TEST IF PAIR REQUIRED
	BCS	70$		;NO
	INC	R4		;FIX REQUIREMENTS
 
70$:	ADD	E.HGPR(R0),R4	;SEE IF ENOUGH REGISTERS
	CMP	R4,HGPRA	;
	BLOS	90$		;YES, EASY (** CAVEAT **)
 
80$:	MOV	#ANY,R0		;RETURN VALUE
	BR	100$		;

90$:	MOV	#EASY,R0	;RETURN VALUE
100$:	MOV	(SP)+,R3	;DONE
	MOV	(SP)+,R4	;
	RETURN			;
 
;+
; ** ITREE - INITIALISOR TREE
;
; THIS ROUTINE TAKES A TREE, AND OUTPUTS THE VALUE OF IT AS AN INITIAL
; ISOR. THE TYPE OF THE INITIALISOR IS TAKEN FROM THE TYPE OF THE TREE
; WHICH USUALLY HAS A CONVERSION ON THE TOP.
;
; LONGS AND DOUBLES ARE DONE HERE. WORD INITIALISORS ARE SOMEWHAT MORE
; INVOLVED, AND HAVE THEIR OWN ROUTINE.
;
; THE TOP NODE ON THE TREE IS ALWAYS AN OP.CVR CONTAINING THE TYPE  OF
; THE VARIABLE WE ARE INITIALIISING. IT IS ALWAYS REMOVED HERE.   THIS
; MUST BE DONE BEFORE TREE MODIFICATION BECAUSE SOME OP.CVR NODES  GET
; CHANGED INTO MULTIPLICATIONS.
;
; INPUTS:
;	R5=TREE
;-
 
ITREE:	MOV	#STR01,R0	;.WORD
	MOVB	E.TYPE(R5),R1	;GET TREE TYPE
	CMP	R1,#TY.CHR	;IS IT CHAR
	BNE	10$		;NO
	MOV	#STR02,R0	;.BYTE
10$:	CALL	CODSTR		;PUT IT OUT

	MOV	R1,-(SP)	;SAVE TYPE
	MOV	E.LOP(R5),R5	;DELETE THE DUMMY CVR NODE
	CALL	MODIFY		;THEN MODIFY THE TREE
	MOV	(SP)+,R1	;RECOVER TYPE

;
; WORDS AND BYTES.
;

30$:	CMP	R1,#TY.LNG	;TEST FOR WORDS OR BYTES
	BHIS	40$		;NO
	CALL	IWTREE		;
	BR	130$		;

;
; LONGS.
;

40$:	CMP	(R5),#OP.CON	;MAKE SURE ITS A CONSTANT
	BNE	120$		;ERROR IF NOT

	CMP	R1,#TY.FLT	;FLOATING POINT
	BHIS	80$		;YES

	MOVB	E.TYPE(R5),R1	;PICK UP THE CONSTANT TYPE
	CMP	R1,#TY.INT	;INTEGER
	BNE	50$		;NO
	CLR	R0		;MAKE LONG INTEGER
	MOV	E.VAL(R5),R1	;
	BPL	70$		;
	COM	R0		;
	BR	70$		;

50$:	CMP	R1,#TY.LNG	;LONG CONSTANT
	BNE	60$		;NO
	MOV	E.VAL(R5),R0	;GET LONG CONSTANT VALUE
	MOV	E.VAL+2(R5),R1	;
	BR	70$		;

60$:	CALL	DTOL		;MUST BE A DOUBLE

70$:	CALL	CODNUM		;UPPER HALF
	CALL	140$		;COMMA
	MOV	R1,R0		;LOWER HALF
	CALL	CODNUM		;
	BR	130$		;

;
; DOUBLES.
;

80$:	MOV	R1,R4		;SAVE TYPE (FLT OR DBL)
	MOVB	E.TYPE(R5),R1	;PICK UP CONSTANT TYPE
	CMP	R1,#TY.INT	;INTEGER
	BNE	90$		;NO
	CLR	R0		;MAKE LONG INTEGER
	MOV	E.VAL(R5),R1	;
	BPL	85$		;
	COM	R0		;
85$:	CALL	LTOD		;FLOAT IT
	BR	110$		;GO OUTPUT IT

90$:	CMP	R1,#TY.LNG	;LONG
	BNE	100$		;NO
	MOV	E.VAL(R5),R0	;GET LONG CONSTANT VALUE
	MOV	E.VAL+2(R5),R1	;
	CALL	LTOD		;FLOAT IT
	BR	110$		;OUTPUT IT

100$:	MOV	E.VAL(R5),R0	;GET DOUBLE VALUE
	MOV	E.VAL+2(R5),R1	;
	MOV	E.VAL+4(R5),R2	;
	MOV	E.VAL+6(R5),R3	;

110$:	CALL	CODNUM		;PUT OUT FIRST 2 WORDS
	CALL	140$		;
	MOV	R1,R0		;
	CALL	CODNUM		;

	CMP	R4,#TY.FLT	;DUCK OUT IF FLOAT
	BEQ	130$		;
	CALL	140$		;2 MORE WORDS
	MOV	R2,R0		;
	CALL	CODNUM		;
	CALL	140$		;
	MOV	R3,R0		;
	CALL	CODNUM		;
	BR	130$		;

120$:	MOV	#ERR01,R0	;ILLEGAL INITIALISOR
	CALL	ERROR		;

130$:	CALLR	CODNL		;DONE

;
; LOCAL SUBROUTINE TO PUT OUT A ','.
;

140$:	MOVB	#',,R0		;PUT OUT COMMA
	CALLR	CODC		;

;+
; ** IWTREE - TREE WORD INITIALISOR
;
; THIS IS A SPECIAL ROUTINE THAT COMPILES THE INITIALISORS  FOR  WORDS
; AND BYTES. IT EXPANDS OUT THE '+' AND '-' SIGNS, PRINTS THE NAMES IN
; ADDRESS OF NAME, AND OUTPUTS THE CONSTANTS.
;
; INPUTS:
;	R5=TREE
;
; USES:
;	R0
;-

IWTREE:	MOV	R5,-(SP)	;SAVE TREE POINTER
 
	MOV	(R5),R0		;OP
	CMP	R0,#OP.ADD	;TEST FOR '+' OR '-'
	BEQ	10$		;
	CMP	R0,#OP.SUB	;
	BNE	30$		;
10$:	MOV	E.LOP(R5),R5	;DO LEFT SUBTREE
	CALL	IWTREE		;
	MOV	(SP),R5		;RECOVER TREE
	MOVB	#'+,R0		;OPERATOR
	CMP	(R5),#OP.ADD	;
	BEQ	20$		;
	MOVB	#'-,R0		;
20$:	CALL	CODC		;
	MOV	E.ROP(R5),R5	;DO RIGHT SUBTREE
	CALL	IWTREE		;
	BR	60$		;DONE

30$:	CMP	R0,#OP.ADR	;ADDRESS OF NAME
	BNE	40$		;
	MOV	E.LOP(R5),R5	;
	CMP	(R5),#OP.ID	;
	BNE	50$		;ILLEGAL INITIALISOR
	MOV	R5,R0		;PUT OUT NAME
	ADD	#E.NAME,R0	;
	CALL	CODSTR		;
	MOVB	#'+,R0		;DEFAULT SIGN
	TST	E.OFFS(R5)	;IS THERE AN OFFSET
	BEQ	60$		;NO
	BPL	35$		;POSITIVE
	MOVB	#'-,R0		;FIX SIGN
	NEG	E.OFFS(R5)	;AND OFFSET
35$:	CALL	CODC		;OUTPUT SIGN
	MOV	E.OFFS(R5),R0	;AND
	CALL	CODNUM		;OFFSET
	BR	60$		;

40$:	CMP	R0,#OP.CON	;INTEGER CONSTANT
	BNE	50$		;ILLEGAL INITIALISOR
	CMPB	E.TYPE(R5),#TY.INT ;
	BNE	50$		;ILLEGAL INITIALISOR
	MOV	E.VAL(R5),R0	;PUT OUT THE CONSTANT
	CALL	CODNUM		;
	BR	60$		;DONE

50$:	MOV	#ERR01,R0	;ERROR
	CALL	ERROR		;

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

;+
; ** LTOD - LONG TO DOUBLE
;
; INPUTS:
;	R0-R1=THE LONG
;
; OUTPUTS:
;	R0-R4=THE DOUBLE
;-

LTOD:	MOV	#ERR03,R0	;FAKE
	JMP	CCABRT		;

;+
; ** DTOL - DOUBLE TO LONG
;
; INPUTS:
;	R5=POINTER TO DOUBLE CONSTANT NODE
;
; OUTPUTS:
;	R0-R1=THE LONG
;-

DTOL:	MOV	#ERR04,R0	;FAKE
	JMP	CCABRT		;

	.END