.TITLE	CC200
	.IDENT	/X01/
 
	.NLIST	BEX
	.ENABL	LC
 
;
; C COMPILER
; CODE GENERATOR
;
; VERSION X01
;
; DAVID G. CONROY	21-NOV-77
;
 
	.GLOBL	CC200
	.GLOBL	TREESP
	.GLOBL	ERROR
	.GLOBL	WARN
 
	.MCALL	CALL
	.MCALL	CALLR
	.MCALL	RETURN
	.MCALL	GET$S
	.MCALL	GPRT$S
 
;
; EQUIVALENCES
;
 
MSWIT	=	50.		;MAX NUMBER OF SWITCHES
BLANK	=	40		;ASCII BLANK
 
;
; LOCAL DATA
;
 
SWTAB:	.BLKW	2*MSWIT		;2 WORDS PER SWITCH
PPBUF:	.BLKW	3		;FOR GPRT$S
DEFLAB:	.BLKW	1		;DEFAULT LABEL FOR SWITCH
TTREE:	.BLKW	1		;POINTER TO TOP OF TREE
TMEM:	.BLKW	1		;POINTER TO TOP OF MEMORY
BMEM:	.WORD	0		;POINTER TO BOTTOM OF MEMORY (0=INVALID)
LINENO:	.WORD	1		;LINE NUMBER
LIMITS:	.LIMIT			;LIMITS+2 = BOTTOM OF FREE MEMORY
BUF:	.BLKB	81.		;INPUT BUFFER (+1 FOR THE NUL)
ID:	.BLKB	9.		;ID BUFFER, 8. BYTES + THE NUL
MBUF:	.BLKB	100		;MESSAGE BUFFER
FILE:	.BYTE	0		;FILE NAME
	.BLKB	39.		;BUFFER
 
;
; ERRORS
; MOST OF THESE INDICATE THAT THE FORMAT OF THE INTERMEDIATE
; CODE IS BAD.
;
 
ERR01:	.ASCIZ	'Bad I.L., phase 2'
ERR02:	.ASCIZ	'Out of tree space, phase 2'
ERR03:	.ASCIZ	'Unexpected EOF, phase 2'
ERR04:	.ASCIZ	'Duplicated case constant'
 
;
; CODE STRINGS.
;
 
STR01:	.ASCII	"	.globl	_save"<12>
	.ASCIZ	"	.globl	_ret"<12>
STR02:	.ASCIZ	"	.even"<12>
STR03:	.ASCIZ	"	.blkb	"
STR04:	.ASCIZ	":"<12>
STR05:	.ASCIZ	"	jsr	r0,_save"<12>
STR06:	.ASCIZ	"	tst	-(sp)"<12>
STR07:	.ASCIZ	"	sub	$"
STR08:	.ASCIZ	",sp"<12>
STR09:	.ASCIZ	"	.psect	.strn."<12>
STR10:	.ASCIZ	"	jmp	_ret"<12>
STR11:	.ASCIZ	"	.byte	"
STR12:	.ASCIZ	"	.globl	"
STR13:	.ASCIZ	"	.word	"
STR14:	.ASCIZ	"	mov	r0,"
STR15:	.ASCIZ	<12>"	mov	$"
STR16:	.ASCII	",r1"<12>
	.ASCII	"	cmp	r0,(r1)+"<12>
	.ASCII	"	bne	.-2"<12>
	.ASCIZ	"	jmp	*"
STR17:	.ASCIZ	"(r1)"<12>
STR18:	.ASCIZ	"	.blkw	1"<12>
STR19:	.ASCII	"	jsr	r0,_psave"<12>
	.ASCII	"	.word	0"<12>
	.ASCIZ	"	.word	"
STR20:	.ASCII	"	.globl	_psave"<12>
	.ASCIZ	"	.globl	_ret"<12>
STR21:	.ASCIZ	"	.psect	.prof."<12>
STR22:	.ASCIZ	"	.psect	.prog."<12>
STR23:	.ASCIZ	",r0"<12>
STR24:	.ASCIZ	"	cmp	r0,$"
STR25:	.ASCIZ	<12>"	bhi	"
STR26:	.ASCIZ	<12>"	asl	r0"<12>"	jmp	*"
STR27:	.ASCIZ	"(r0)"<12>
STR28:	.ASCIZ	"	dec	r0"<12>
 
	.EVEN
	.PAGE
 
;+
; ** CC200 - CODER MAINLINE
;
; THIS IS THE MAINLINE OF THE CODE GENERATOR. IT IS CALLED FROM THE
; ROOT WITH THE ASM OUTPUT FILE OPEN ON AFDB, AND THE  INTERMEDIATE
; FILE (FROM PHASE 1)  OPEN ON IFDB.  THIS FILE NEEDS TO BE REWOUND
; BEFORE USE.
;
; ERRORS IN THE FORMAT OF THE INTERMEDIATE FILE ARE FATAL, BUT  THE
; CODER CONTINUES. PERHAPS IT WOULD BE BETTER TO ABORT. 
;-
 
CC200:	MOV	#IFDB,R0	;REWIND INPUT
	CLR	R1		;
	MOV	#1,R2		;
	CLR	R3		;
	CALL	.POINT		;
 
10$:	CALL	GET		;READ INPUT RECORD
	BCS	20$		;EOF
	CALL	PROCES		;PROCESS THE RECORD
	BR	10$		;
 
20$:	MOV	#STR01,R0	;PUT OUT GLOBALS
	TSTB	PFLAG		;PROFILING
	BEQ	30$		;NO
	MOV	#STR20,R0	;GET CORRECT GLOBALS
30$:	CALLR	CODSTR		;PUT OUT AND RETURN
 
;
; PROCESS RECORD.
;
 
PROCES:	MOV	#BUF,R5		;POINT AT RECORD
	MOVB	(R5)+,R0	;GET OPCODE
	CALL	MAPUP		;MAP TO UPPER CASE
 
	MOV	#50$,R1		;GO TO THE SERVICE ROUTINE
20$:	CMP	R0,(R1)+	;
	BNE	30$		;
	CALLR	@(R1)+		;
30$:	TST	(R1)+		;
	CMP	R1,#60$		;
	BLO	20$		;
	CALLR	NASTY		;
 
50$:	.WORD	'A,ADIR		;'A'	ALLIGN EVEN
	.WORD	'B,BDIR		;'B'	BLOCK
	.WORD	'C,CDIR		;'C'	STRING PSECTION
	.WORD	'D,DDIR		;'D'	GLOBAL LABEL
	.WORD	'E,EDIR		;'E'	TREE FOR EFFECT
	.WORD	'F,FDIR		;'F'	JUMP FALSE
	.WORD	'G,GDIR		;'G'	GLOBL
	.WORD	'H,HDIR		;'H'	BYTE INITIALISER
	.WORD	'I,IDIR		;'I'	WORD POINTER INITIALISER
	.WORD	'J,JDIR		;'J'	JUMP
	.WORD	'K,KDIR		;'K'	TREE INITIALISER
	.WORD	'L,LDIR		;'L'	LOCAL LABEL
	.WORD	'M,MDIR		;'M'	LINE NUMBER
	.WORD	'N,NDIR		;'N'	ENTER FUNCTION
	.WORD	'P,PDIR		;'P'	PROGRAMME PSECTION
	.WORD	'Q,QDIR		;'Q'	SYMBOL TABLE ENTRY
	.WORD	'R,RSDIR	;'R'	RETURN VALUE
	.WORD	'S,RSDIR	;'S'	SWITCH VALUE
	.WORD	'T,TDIR		;'T'	JUMP TRUE
	.WORD	'W,WDIR		;'W'	SWITCH
	.WORD	'X,XDIR		;'X'	EXIT FUNCTION
	.WORD	'Y,YDIR		;'Y'	WORD INITIALISER
60$:	.BLKB	0		;	END OF TABLE
 
ADIR:	MOV	#STR02,R0	;.EVEN
	CALLR	CODSTR		;
 
BDIR:	MOV	#STR03,R0	;.BLKB
	CALL	CODSTR		;
	CALL	GETNUM		;OUTPUT SIZE OF BLOCK
	CALL	CODNUM		;
	CALLR	CODNL		;
 
CDIR:	CALL	PFLUSH		;FLUSH BRANCHES
	MOV	#STR09,R0	;.PSECT .STRN.
	CALLR	CODSTR		;
 
DDIR:	CALL	GETID		;GET IDENTIFIER
	MOV	#ID,R0		;PUT IT OUT
	CALL	CODSTR		;
	MOV	#STR04,R0	;THEN : NEWLINE
	CALLR	CODSTR		;
 
EDIR:	CALL	CLRTRE		;PURGE OLD TREE
	CALL	TREEIN		;READ IN THE NEW TREE
	MOV	#ETAB,R3	;TABLE = EFFECT TABLE
	CALLR	RCEXPR		;
 
FDIR:	CALL	GETNUM		;GET LABEL FROM INPUT
	MOV	R0,R3		;
	CALL	CLRTRE		;PURGE THE OLD TREE
	CALL	TREEIN		;READ IN THE NEW TREE
	CALLR	RJFALS		;
 
GDIR:	MOV	#STR12,R0	;.GLOBL
	CALL	CODSTR		;
	CALL	GETID		;GET THE NAME
	MOV	#ID,R0		;PUT IT OUT
	CALL	CODSTR		;
	CALLR	CODNL		;
 
HDIR:	MOV	#STR11,R0	;.BYTE
	CALL	CODSTR		;
	CALL	GETNUM		;VALUE OF INITIALISER
	BIC	#177400,R0	;
	CALL	CODNUM		;
	CALLR	CODNL		;
 
IDIR:	MOV	#STR13,R0	;.WORD
	CALL	CODSTR		;
	CALL	GETNUM		;LABEL
	CALL	CODLAB		;
	CALLR	CODNL		;
 
JDIR:	CALL	GETNUM		;PUT OUT BRANCH
	CALLR	BRANCH		;
 
KDIR:	CALL	CLRTRE		;TREE INITIALISER
	CALL	TREEIN		;READ IT IN
	CALLR	ITREE		;PUT IT OUT
 
LDIR:	CALL	GETNUM		;LABEL
	CALLR	LABEL		;
 
MDIR:	CALL	GETNUM		;GET LINE NUMBER
	MOV	R0,LINENO	;
 
	CLRB	FILE		;SET NO NAME
	MOV	#FILE,R1	;POINT AT FILE NAME
10$:	MOVB	(R5)+,R0	;SKIP BLANKS
	BEQ	30$		;NO NAME
	CMP	R0,#BLANK	;
	BEQ	10$		;
 
	MOVB	R0,(R1)+	;COPY NAME
20$:	MOVB	(R5)+,(R1)+	;
	BNE	20$		;
 
30$:	RETURN			;DONE
 
NDIR:	CALL	GETNUM		;GET SIZE OF AUTOS
	MOV	R0,-(SP)	;
	CALL	GETNUM		;HIGHEST REGISTER
	MOV	R0,FHGPR	;
 
	TSTB	PFLAG		;ARE WE PROFILING
	BNE	10$		;BR IF YES
	MOV	#STR05,R0	;NO, STANDARD SAVE
	CALL	CODSTR		;
	BR	30$		;
 
10$:	MOV	#STR19,R0	;PROFILE SAVE
	CALL	CODSTR		;
	CALL	GENLAB		;POINTER TO FUNCTION NAME
	MOV	R0,-(SP)	;
	CALL	CODLAB		;
	CALL	CODNL		;
	MOV	#STR21,R0	;SWITCH INTO .PROF. PSECTION
	CALL	CODSTR		;
	MOV	(SP)+,R0	;OUTPUT LABEL FOR THE STRING
	CALL	LABEL		;
 
20$:	MOVB	(R5)+,R0	;PUT OUT THE NAME (ASCIZ)
	CMPB	R0,#BLANK	;
	BEQ	20$		;
	MOV	R0,-(SP)	;
	MOV	#STR11,R0	;.BYTE
	CALL	CODSTR		;
	MOV	(SP),R0		;THE VALUE
	CALL	CODNUM		;
	CALL	CODNL		;
	TST	(SP)+		;CONTINUE UNTIL NUL
	BNE	20$		;
 
	MOV	#STR22,R0	;SWITCH INTO .PROG. PSECTION
	CALL	CODSTR		;
 
30$:	MOV	(SP)+,R0	;RECOVER AUTO SIZE
	BEQ	60$		;ZERO
	CMP	R0,#2		;IS IT THE SPECIAL CASE OF 2
	BNE	40$		;NO
	MOV	#STR06,R0	;YES, TEST -(SP)
	BR	50$		;
 
40$:	MOV	R0,R1		;SAVE SIZE
	MOV	#STR07,R0	;SUB $
	CALL	CODSTR		;
	MOV	R1,R0		;THE SIZE
	CALL	CODNUM		;
	MOV	#STR08,R0	;,SP
 
50$:	CALL	CODSTR		;
60$:	RETURN			;DONE
 
PDIR:	MOV	#STR22,R0	;.PSECT .PROG.
	CALLR	CODSTR		;
 
QDIR:	MOVB	#'/,R0		;JUST PUT OUT THE 'Q'
	CALL	CODC		;
	MOV	#BUF,R0		;AS A COMMENT
	CALL	CODSTR		;
	CALLR	CODNL		;
 
RSDIR:	CALL	CLRTRE		;PURGE OLD TREE
	CALL	TREEIN		;READ IN NEW ONE
	MOV	#RTAB,R3	;TABLE = REGISTER TABLE
	CALL	RCEXPR		;
	TST	R0		;MAKE SURE RESULT IS IN R0
	BEQ	10$		;
	CLR	R1		;
	MOVB	E.TYPE(R5),R2	;
	CALL	MOVREG		;
10$:	RETURN			;DONE
 
TDIR:	CALL	GETNUM		;GET LABEL
	MOV	R0,R3		;
	CALL	CLRTRE		;PURGE OLD TREE
	CALL	TREEIN		;GET NEW ONE
	CALLR	RJTRUE		;
 
WDIR:	CALLR	SWITCH		;DO SWITCH STUFF
 
XDIR:	MOV	#STR10,R0	;JMP _RET
	CALLR	CODSTR		;
 
YDIR:	MOV	#STR13,R0	;.WORD
	CALL	CODSTR		;
	CALL	GETNUM		;GET THE INITIALISER
	CALL	CODNUM		;
	CALLR	CODNL		;
 
;+
; ** GET - GET INPUT RECORD
;
; READ A RECORD FROM THE INPUT FILE. PACK IT (IN ASCIZ) INTO BUF. ON
; EOF RETURN WITH THE C BIT SET.
;
; USES:
;	R0 (NATCH)
;-
 
GET:	GET$S	#IFDB,#BUF,#80.	;GET RECORD
	BCS	10$		;BR ON ERROR (ASSUME EOF)
	MOV	F.NRBD(R0),R0	;MAKE THE RECORD ASCIZ
	CLRB	BUF(R0)		;
10$:	RETURN			;
 
;+
; ** SWITCH - SWITCH BLOCK PROCESSING
;-
 
SWITCH:	CALL	PFLUSH		;J.I.C.

	CALL	GETNUM		;DEFAULT LABEL
	MOV	R0,DEFLAB	;
 
;
; READ IN THE SWITCH DATA.
; IT LIVES IN 'W' RECORDS (W VALUE LABEL).
; THE END IS MARKED BY A 'V'.
; EOF WILL ALSO STOP IT.
;
 
	MOV	#SWTAB,R4	;POINT AT START OF SWITCH BUFFER
10$:	CALL	GET		;READ IN SWITCH ITEMS
	BCS	60$		;EOF
	MOV	#BUF,R5		;POINT AT BUFFER
	MOVB	(R5)+,R0	;GET RECORD TYPE
	CALL	MAPUP		;
	CMPB	R0,#'V		;'V'	END OF SWITCH TABLE
	BEQ	60$		;YES
	CMPB	R0,#'W		;'W'	SWITCH ITEM
	BEQ	20$		;YES
	CALL	NASTY		;IT'S A NASTY RECORD
	BR	10$		;SO SKIP IT
 
20$:	CMP	R4,#SWTAB+<4*MSWIT> ;CHECK FOR OVERFLOW
	BLO	30$		;IT WILL FIT
	CALL	NASTY		;ITS NASTY
	BR	10$		;
 
30$:	CALL	GETNUM		;VALUE
	MOV	R0,(R4)+	;TO THE SWITCH DATA BUFFER
	CALL	GETNUM		;LABEL
	MOV	R0,(R4)+	;TO THE SWITCH DATA BUFFER
	BR	10$		;AND GO GET ANOTHER RECORD
 
;
; NO CASES.
; BR TO DEFAULT LABEL.
;
 
60$:	CMP	R4,#SWTAB	;ANY ENTRIES
	BHI	70$		;YES
	MOV	DEFLAB,R0	;BR TO DEFLAB
	CALL	BRANCH		;
	BR	90$		;
 
;
; DECIDE ON SWITCH TYPE.
; IF RANGE>0 AND RANGE<=3*NCASES, USE A
; JUMP TABLE SWITCH.
; OTHERWISE USE A SIMPLE LOOK UP SWITCH.
;

70$:	CALL	SORT		;SORT THE CASES
	BCS	90$		;ERROR

	MOV	-4(R4),R3	;COMPUTE RANGE
	SUB	SWTAB,R3	;
	BLE	80$		;-VE, TABLE SWITCH
	MOV	R4,R0		;GET 3*NCASES
	SUB	#SWTAB,R0	;
	MOV	R0,R1		;
	ASR	R1		;
	ASR	R1		;
	SUB	R1,R0		;
	CMP	R3,R0		;RANGE <= 3*NCASES
	BGT	80$		;NO
	CALL	JTSWIT		;DO JUMP TABLE SWITCH
	BR	90$		;

80$:	CALL	TLSWIT		;DO TABLE LOOK UP SWITCH

90$:	RETURN			;

;+
; ** SORT -- SORT CASES
;
; ALSO CHECKS FOR DUPLICATED ENTRIES.
;
; INPUTS:
;	R4=POINTER JUST PAST LAST SWITCH.
;
; USES:
;	R0, R1, R2, R3
;-

SORT:	MOV	R4,R1		;GET WORKING LAST POINTER

10$:	SUB	#4,R1		;BACK UP
	CMP	#SWTAB,R1	;BREAK IF DONE
	BHIS	60$		;
	CLR	R2		;INTERCHANGE FLAG
	MOV	#SWTAB,R3	;START

20$:	CMP	R3,R1		;AT THE END YET
	BHIS	50$		;YES

	CMP	(R3),4(R3)	;TEST IF DUPLICATED CONSTANT
	BNE	30$		;NO
	MOV	#ERR04,R0	;BITCH
	CALL	ERROR		;
	SEC			;RETURN ERROR CODE
	RETURN			;

30$:	BLT	40$		;BR IF NO INTERCHANGE
	INC	R2		;FLAG
	MOV	(R3),R0		;SWAP ENTRIES
	MOV	4(R3),(R3)	;
	MOV	R0,4(R3)	;
	MOV	2(R3),R0	;
	MOV	6(R3),2(R3)	;
	MOV	R0,6(R3)	;

40$:	ADD	#4,R3		;GO ON
	BR	20$		;

50$:	TST	R2		;ANY INTERCHANGES?
	BNE	10$		;YES, AGAIN
60$:	CLC			;GOOD RETURN
	RETURN			;

;+
; ** JTSWIT -- GENERATE JUMP TABLE SWITCH
;
; INPUTS:
;	R3=RANGE
;	R4=POINTER JUST BEYOND SWITCH TABLE
;-

JTSWIT:	TST	SWTAB		;IS LOW VALUE 0
	BEQ	20$		;YES
	MOV	#STR28,R0	;ASSUME ITS 1
	CMP	SWTAB,#1	;WAS IT
	BEQ	10$		;YES
	MOV	#STR07,R0	;SUB $LOW,R0
	CALL	CODSTR		;
	MOV	SWTAB,R0	;
	CALL	CODNUM		;
	MOV	#STR23,R0	;
10$:	CALL	CODSTR		;

20$:	MOV	#STR24,R0	;CMP R0,$RANGE
	CALL	CODSTR		;
	MOV	R3,R0		;
	CALL	CODNUM		;

	MOV	#STR25,R0	;<NL>BHI DEFLAB
	CALL	CODSTR		;
	MOV	DEFLAB,R0	;
	CALL	CODLAB		;

	MOV	#STR26,R0	;<NL>ASL R0<NL>JMP *LAB(R0)
	CALL	CODSTR		;
	CALL	GENLAB		;
	MOV	R0,-(SP)	;
	CALL	CODLAB		;
	MOV	#STR27,R0	;
	CALL	CODSTR		;

;
; THE JUMP TABLE.
;

	MOV	(SP)+,R0	;LABEL
	CALL	LABEL		;

	MOV	#SWTAB,R1	;ENTRY POINTER
	MOV	(R1),R2		;VALUE

30$:	CMP	R1,R4		;DONE YET
	BHIS	50$		;YES
	MOV	#STR13,R0	;.WORD
	CALL	CODSTR		;
	MOV	DEFLAB,R0	;DEFAULT LABEL
	CMP	R2,(R1)		;IS THERE A CASE?
	BNE	40$		;NO
	TST	(R1)+		;YES, GRAB ITS LABEL
	MOV	(R1)+,R0	;

40$:	CALL	CODLAB		;ENTRY
	CALL	CODNL		;
	INC	R2		;ADVANCE CASE VALUE
	BR	30$		;

50$:	RETURN			;DONE

;+
; ** TLSWIT -- TABLE LOOK UP SWITCH
;
; GENERATES:
;	MOV	R0,L3
;	MOV	$L2,R1
; L1:	CMP	R0,(R1)+
;	BNE	L1
;	JMP	*L3-L2(R1)
; L2:	.WORD	VAL
;	.WORD	VAL
; L3:	..
;	.WORD	LAB
;	.WORD	LAB
;	.WORD	DEFAULTLAB
;
; INPUTS:
;	R4=POINTER JUST PAST CASE TABLE
;-
 
TLSWIT:	MOV	#STR14,R0	;MOV R0,
	CALL	CODSTR		;
	CALL	GENLAB		;
	MOV	R0,-(SP)	;
	CALL	CODLAB		;
	MOV	#STR15,R0	;<NL> MOV #
	CALL	CODSTR		;
	CALL	GENLAB		;
	MOV	R0,-(SP)	;
	CALL	CODLAB		;
	MOV	#STR16,R0	;,R1<NL> CMP ... BNE ... JMP *
	CALL	CODSTR		;
	MOV	2(SP),R0	;
	CALL	CODLAB		;
	MOVB	#'-,R0		;
	CALL	CODC		;
	MOV	(SP),R0		;
	CALL	CODLAB		;
	MOV	#STR17,R0	;(R1)<NL>
	CALL	CODSTR		;
	MOV	(SP)+,R0	;
	CALL	LABEL		;
	MOV	#SWTAB,R3	;PUT OUT THE VALUES
80$:	MOV	#STR13,R0	;.WORD
	CALL	CODSTR		;
	MOV	(R3)+,R0	;
	CALL	CODNUM		;
	CALL	CODNL		;
	TST	(R3)+		;
	CMP	R3,R4		;
	BLO	80$		;
	MOV	(SP)+,R0	;THE WORD THAT GETS STUFFED
	CALL	LABEL		;
	MOV	#STR18,R0	;.BLKW 1
	CALL	CODSTR		;
	MOV	#SWTAB,R3	;THEN THE LABELS
90$:	MOV	#STR13,R0	;.WORD
	CALL	CODSTR		;
	MOV	2(R3),R0	;
	CALL	CODLAB		;
	CALL	CODNL		;
	ADD	#4,R3		;
	CMP	R3,R4		;
	BLO	90$		;
	MOV	#STR13,R0	;THEN THE DEFAULT LABEL
	CALL	CODSTR		;
	MOV	DEFLAB,R0	;
	CALL	CODLAB		;
	CALLR	CODNL		;
 
;+
; ** GETNUM - GET OCTAL NUMBER FROM THE INPUT
;
; THIS ROUTINE SKIPS OVER BLANKS, THEN COLLECTS UP AN OCTAL NUMBER.
; IF THE LINE RUNS OUT BEFORE A NUMBER IS FOUND IT COMPLAINS.
;
; OUTPUTS:
;	R0=THE NUMBER
;-
 
GETNUM:	MOV	R1,-(SP)	;SAVE
 
10$:	MOVB	(R5)+,R1	;SKIP OVER BLANKS
	BEQ	30$		;SHOULDN'T HIT THE END
	CMPB	R1,#BLANK	;
	BEQ	10$		;
 
	CLR	R0		;INITIALIZE THE NUMBER
20$:	SUB	#'0,R1		;CHECK FOR LEGAL OCTAL
	CMP	R1,#7		;
	BHI	40$		;
	ASL	R0		;OLD = OLD<<3 + NEW - '0'
	ASL	R0		;
	ASL	R0		;
	ADD	R1,R0		;ADD IN THE NEW DIGIT
	MOVB	(R5)+,R1	;GET NEXT DIGIT
	BR	20$		;
 
30$:	CALL	NASTY		;NASTY RECORDS
	CLR	R0		;RETURN 0
 
40$:	DEC	R5		;BACK UP ONTO DELIMITER
	MOV	(SP)+,R1	;RETURN
	RETURN			;
 
;+
; ** GETID - READ IN IDENTIFIER
;
; READ A BLANK OR END OF LINE TERMINATED IDENTIFIER INTO THE BUFFER.
; APPEND A NUL TO IT.
;
; USES:
;	R0, R1
;-
 
GETID:	MOV	#ID,R1		;POINT AT ID BUFFER
 
10$:	MOVB	(R5)+,R0	;SKIP BLANKS
	BEQ	40$		;SHOULDN'T HIT THE END
	CMPB	R0,#BLANK	;
	BEQ	10$		;
 
20$:	CMP	R1,#ID+10	;DOES IT FIT
	BHIS	30$		;NO
	MOVB	R0,(R1)+	;SAVE IT
30$:	MOVB	(R5)+,R0	;GET NEXT CHARACTER
	BEQ	50$		;END OF RECORD IS A DELIMITER
	CMPB	R0,#BLANK	;BLANKS ARE DELIMITERS TOO
	BNE	20$		;BR IF NOT END OF ID
	BR	50$		;DONE
 
40$:	CALL	NASTY		;NASTY THINGS
 
50$:	CLRB	(R1)		;MAKE ASCIZ
	DEC	R5		;BACKUP TO DELIMITER
	RETURN			;
 
;+
; ** MAPUP - MAP CHARACTER TO UPPER CASE
;
; INPUTS:
;	R0=CHARACTER
;
; OUTPUTS:
;	R0=MAPPED CHARACTER
;-
 
MAPUP:	CMPB	R0,#141		;LOWER CASE 'A'
	BLO	10$		;
	CMPB	R0,#172		;LOWER CASE 'Z'
	BHI	10$		;
	BICB	#40,R0		;CONVERT TO UPPER CASE
10$:	RETURN			;
 
;+
; ** NASTY - COMPLAIN ABOUT BAD RECORDS
;
; USES:
;	R0
;-
 
NASTY:	MOV	#ERR01,R0	;NASTY MESSAGE
	CALL	CCERR		;
	CALL	CCTTY		;
	MOV	#BUF,R0		;THEN THE BAD RECORD
	CALL	CCERR		;
	CALLR	CCTTY		;
 
;+
; ** TREEIN - READ IN TREE
;
; READ IN A TREE (IN 'Z' RECORDS). RETURN A POINTER TO THE  TREE  THAT
; WAS READ IN.
; ALL CONSTANTS GET 4 WORD TREE NODES. FOR INTEGERS THE LAST 3 ARE NOT
; USED; FOR LONGS THE LAST 2 ARE NOT USED.
;
; OUTPUTS:
;	R5=POINTER TO TREE
;-
 
TREEIN:	MOV	R0,-(SP)	;SAVE REGISTERS
	MOV	R1,-(SP)	;
	MOV	R2,-(SP)	;
	MOV	R3,-(SP)	;
	MOV	R4,-(SP)	;
 
	CALL	GET		;READ AN INPUT RECORD
	BCC	10$		;GOT ONE
	MOV	#ERR03,R0	;UNEXPECTED
	CALL	CCERR		;EOF
	CALL	CCTTY		;
	BR	20$		;RETURN NULL POINTER
 
10$:	MOV	#BUF,R5		;SET UP SCAN POINTER
	MOVB	(R5)+,R0	;GET THE OPCODE
	CALL	MAPUP		;ACCEPT 'Z' IN BOTH CASES
	CMPB	R0,#'Z		;TREE RECORDS HAVE OPCODE 'Z'
	BEQ	30$		;BR ON TREE RECORD
	CALL	NASTY		;NASTY RECORD IN THE TREE
20$:	BR	100$		;RETURN NULL POINTER
 
30$:	CALL	GETNUM		;OP
	CMP	R0,#OP.EOF	;ENCODING OF NULL POINTER?
	BEQ	100$		;BR IF YES
	MOV	R0,R1		;SAVE OP
	CALL	GETNUM		;GET TYPE
	MOV	R0,R2		;SAVE TYPE
 
	CMP	R1,#OP.CON	;CONSTANT?
	BNE	40$		;NO
	MOV	#ES.CON,R4	;YES, GET TREE NODE
	CALL	TREESP		;
	CALL	GETNUM		;PUT VALUE IN IT
	MOV	R0,E.VAL(R4)	;
	CALL	GETNUM		;
	MOV	R0,E.VAL+2(R4)	;
	CALL	GETNUM		;
	MOV	R0,E.VAL+4(R4)	;
	CALL	GETNUM		;
	MOV	R0,E.VAL+6(R4)	;
	BR	90$		;
 
40$:	CMP	R1,#OP.REG	;OP.REG TYPE REG
	BNE	50$		;
	MOV	#ES.REG,R4	;GET TREE NODE
	CALL	TREESP		;
	CALL	GETNUM		;GET REGISTER NUMBER
	MOV	R0,E.REG(R4)	;
	CLR	E.OFFS(R4)	;0 OFFSET
	BR	90$		;
 
50$:	CMP	R1,#OP.INX	;OP.INX TYPE REG OFFSET
	BNE	60$		;
	MOV	#ES.REG,R4	;GET TREE NODE
	CALL	TREESP		;
	CALL	GETNUM		;GET REGISTER NUMBER
	MOV	R0,E.REG(R4)	;
	CALL	GETNUM		;GET OFFSET
	MOV	R0,E.OFFS(R4)	;
	BR	90$		;
 
60$:	CMP	R1,#OP.ID	;OP.ID TYPE NAME
	BNE	75$		;
	MOV	#ES.ID,R4	;GET TREE NODE
	CALL	TREESP		;
	MOV	R1,-(SP)	;SAVE OP AND TYPE
	MOV	R2,-(SP)	;
	CALL	GETID		;GET THE IDENTIFIER AND
	MOV	R4,R3		;PACK IT INTO THE TREE NODE
	ADD	#E.NAME,R3	;
	MOV	#ID,R2		;
70$:	MOVB	(R2)+,(R3)+	;MLR
	BNE	70$		;
	MOV	(SP)+,R2	;RECOVER OP AND TYPE
	MOV	(SP)+,R1	;
	CLR	E.OFFS(R4)	;0 OFFSET
	BR	90$		;
 
75$:	CMP	R1,#OP.LID	;LOCAL ID
	BNE	80$		;
	MOV	#ES.LID,R4	;GET TREE NODE
	CALL	TREESP		;
	CALL	GETNUM		;
	MOV	R0,E.LAB(R4)	;LOCAL LABEL
	CLR	E.OFFS(R4)	;
	BR	90$		;
 
80$:	MOV	#ES.OP,R4	;MUST BE OPERATOR NODE
	CALL	TREESP		;
	CALL	TREEIN		;
	MOV	R5,E.LOP(R4)	;LEFT SUBTREE
	CALL	TREEIN		;
	MOV	R5,E.ROP(R4)	;
 
90$:	MOV	R4,R5		;MOVE RETURN POINTER
	MOV	R1,E.OP(R5)	;
	MOVB	R2,E.TYPE(R5)	;
	CLR	E.HGPR(R5)	;
	CLR	E.HFPR(R5)	;
	BR	110$		;
 
100$:	CLR	R5		;RETURN NULL POINTER
 
110$:	MOV	(SP)+,R4	;RETURN
	MOV	(SP)+,R3	;
	MOV	(SP)+,R2	;
	MOV	(SP)+,R1	;
	MOV	(SP)+,R0	;
	RETURN			;
 
;+
; ** CLRTRE - CLEAR TREE SPACE
;
; CLEAR THE TREE SPACE. THIS IS EASY BECAUSE THE TREE SPACE IS JUST A
; LINEAR BLOCK.
; ON THE FIRST CALL, ASK RSX HOW BIG THE TREE SPACE IS.
;
; USES:
;	R0
;-
 
CLRTRE:	MOV	BMEM,TTREE	;WIND BACK TOP OF TREE POINTER
	BNE	10$		;AOK
 
	MOV	LIMITS+2,BMEM	;SET UP BASE OF MEMORY
	MOV	BMEM,TTREE	;SET UP TOP OF THE TREE
	GPRT$S	,#PPBUF		;HOW LARGE?
	MOV	PPBUF+G.PRPS,R0	;SIZE IN CLICKS
	ASL	R0		;CONVERT TO BYTES THE HARD WAY
	ASL	R0		;
	ASL	R0		;
	ASL	R0		;
	ASL	R0		;
	ASL	R0		;
	ADD	$DSW,R0		;R0=HIGHEST ADDRESS+1
	MOV	R0,TMEM		;SAVE TOP OF MEMORY ADDRESS
 
10$:	RETURN			;
 
;+
; ** TREESP - ALLOCATE SPACE FROM THE TREE BUFFER
;
; ALLOCATE SOME SPACE FROM THE TREE AREA. IF THERE IS NO ROOM, TRY TO
; GROW CORE BY 32 WORDS. IF THAT FAILS, BLOW UP.
;
; INPUTS:
;	R4=SIZE OF DESIRED BLOCK (BYTES)
;
; OUTPUTS:
;	R4=POINTER TO BLOCK
;-
 
TREESP:	MOV	R5,-(SP)	;SAVE REGISTERS
 
	MOV	R4,R5		;GET A COPY OF THE SIZE
	INC	R5		;ROUND UP JUST IN CASE
	BIC	#1,R5		;YOU WERE PASSED AN ODD SIZE
 
10$:	MOV	TTREE,R4	;SEE IF WE FIT
	ADD	R5,R4		;
	CMP	R4,TMEM		;
	BLOS	20$		;OK
 
	MOV	#ERR02,R0	;WHAT ELSE CAN ONE DO?
	JMP	CCABRT		;
 
20$:	MOV	TTREE,R4	;POINTER TO NEW SPACE
	ADD	R5,TTREE	;UPDATE TOP OF TREE POINTER
	MOV	(SP)+,R5	;RESTORE REGISTERS AND
	RETURN			;RETURN
 
;+
; ** ERROR - ISSUE FATAL DIAGNOSTIC
; ** WARN  - ISSUE NON FATAL DIAGNOSTIC
;
; THESE ROUTINE ARE USED TO ISSUE DIAGNOSTICS.  THE FORMAT THE MESSAGE
; (ADDING THE LINE NUMBER AND PERHAPS  THE FILE NAME)  AND PUT IT ONTO
; THER ERROR STREAM VIA CCERR.
;
; INPUTS:
;	R0=POINTER TO ASCIZ MESSAGE
;-
 
ERROR:	INC	NERRS		;FIX ERROR COUNT
 
WARN:	MOV	R1,-(SP)	;SAVE REGISTERS
	MOV	R0,-(SP)	;
	MOV	#MBUF,R1	;POINT AT MESSAGE BUFFER
	MOV	LINENO,R0	;LINE NUMBER
	CALL	$ITOC		;
	MOVB	#':,(R1)+	;LOOKS
	MOVB	#' ,(R1)+	;
 
	MOV	#FILE,R0	;POINT AT FILE NAME
	TSTB	(R0)		;IS THERE ONE
	BEQ	20$		;NO
10$:	MOVB	(R0)+,(R1)+	;COPY FILE NAME
	BNE	10$		;
	DEC	R1		;LOOKS
	MOVB	#':,(R1)+	;
	MOVB	#' ,(R1)+	;
 
20$:	MOV	(SP),R0		;MESSAGE
30$:	MOVB	(R0)+,(R1)+	;COPY INTO BUFFER
	BNE	30$		;
	MOV	#MBUF,R0	;OUTPUT MESSAGE
	CALL	CCERR		;
 
	MOV	(SP)+,R0	;RETURN
	MOV	(SP)+,R1	;
	RETURN			;
 
	.END