.TITLE	CC101
	.IDENT	/X01/
 
	.NLIST	BEX
	.ENABL	LC
 
;
; C COMPILER
; LEXICAL ANALYSER
;
; VERSION X01
;
; DAVID G. CONROY	14-NOV-77
; LAST UPDATED:		30-APR-79
;
 
	.GLOBL	SCAN
	.GLOBL	ESCAN
	.GLOBL	ADVANC
	.GLOBL	GLOBS
	.GLOBL	ULABS
	.GLOBL	UNDEF
	.GLOBL	PURGE
	.GLOBL	KWINIT
	.GLOBL	MAPCH
	.GLOBL	FDIMP
	.GLOBL	FDOPE
 
	.GLOBL	LEX0
	.GLOBL	LEX1
	.GLOBL	VAL0
	.GLOBL	VAL1
	.GLOBL	LINENO
	.GLOBL	FILE
	.GLOBL	SYMTAB
	.GLOBL	INMOSF
 
	.MCALL	CALL
	.MCALL	CALLR
	.MCALL	RETURN
 
;
; EQUIVALENCES
;
 
NL	=	12		;ASCII NEWLINE CHARACTER
BLANK	=	40		;ASCII BLANK CHARACTER
TAB	=	11		;ASCII TAB CHARACTER
ORBAR	=	174		;ASCII OR BAR
 
;
; GLOBAL DATA
;
 
INMOSF:	.WORD	0		;IN MOS FLAG
LEX0:	.BLKW	1		;LEXICAL TYPE[0]
VAL0:	.BLKW	4		;LEXICAL VALUE[0]
LEX1:	.BLKW	1		;LEXICAL TYPE[1]
VAL1:	.BLKW	4		;LEXICAL VALUE[1]
LINENO:	.WORD	1		;SOURCE LINE NUMBER
FILE:	.BYTE	0		;FILE NAME (FROM '#' RECORDS)
	.BLKB	39.		;INITIALLY NULL
 
	.EVEN
 
;
; LOCAL DATA
;
 
MOSFLG:	.WORD	0		;MEMBER OF STRUCTURE FLAG
SYMTAB:	.WORD	0		;POINTER TO LINKED SYMBOL TABLE
EXP:	.BLKB	1		;FOR NUMBER READER
DOT:	.BLKB	1		;
SGN:	.BLKB	1		;
OCT:	.BLKB	1		;
HEX:	.BLKB	1		;
NTL:	.BLKB	1		;
NB:	.BLKB	25.		;NAME AND NUMBER BUFFER
NBE:	.BLKB	0		;THE END
 
;
; DATA USED BY ATOD.
; FBEX MUST BE JUST BEFORE FBUF.
; FESGN MUST BE LAST.
;

	.EVEN

FBEX:	.BLKW	1		;BINARY EXP.
FBUF:	.BLKW	4		;MAIN ACC.
FSAV:	.BLKW	4		;AUX. ACC.
FSGN:	.BLKW	1		;SIGN.
FEXP:	.BLKW	1		;DECIMAL EXP.
FDOT:	.BLKW	1		;DOT FLAG.
FESGN:	.BLKW	1		;EXP. SIGN.

; 
; CHARACTER TRANSFER TABLE. THIS TABLE IS INDEXED BY 7 BIT ASCII. ALL
; ILLEGAL CHARACTERS (200-377) ARE SCREENED OUT BEFORE THE JUMP.
;
 
ADVTAB:	.WORD	ADV10,	ADV10,	ADV10,	ADV10
	.WORD	ADV10,	ADV10,	ADV10,	ADV10
	.WORD	ADV10,	ADV05,	ADV15,	ADV05
	.WORD	ADV05,	ADV10,	ADV10,	ADV10
	.WORD	ADV10,	ADV10,	ADV10,	ADV10
	.WORD	ADV10,	ADV10,	ADV10,	ADV10
	.WORD	ADV10,	ADV10,	ADV10,	ADV10
	.WORD	ADV10,	ADV10,	ADV10,	ADV10
 
	.WORD	ADV05,	ADV20,	ADV25,	ADV160
	.WORD	ADV10,	ADV30,	ADV35,	ADV40
	.WORD	ADV45,	ADV50,	ADV55,	ADV60
	.WORD	ADV65,	ADV70,	ADV75,	ADV80
	.WORD	ADV85,	ADV85,	ADV85,	ADV85
	.WORD	ADV85,	ADV85,	ADV85,	ADV85
	.WORD	ADV85,	ADV85,	ADV90,	ADV95
	.WORD	ADV100,	ADV105,	ADV110,	ADV115
 
	.WORD	ADV10,	ADV155,	ADV155,	ADV155
	.WORD	ADV155,	ADV155,	ADV155,	ADV155
	.WORD	ADV155,	ADV155,	ADV155,	ADV155
	.WORD	ADV155,	ADV155,	ADV155,	ADV155
	.WORD	ADV155,	ADV155,	ADV155,	ADV155
	.WORD	ADV155,	ADV155,	ADV155,	ADV155
	.WORD	ADV155,	ADV155,	ADV155,	ADV120
	.WORD	ADV10,	ADV125,	ADV130,	ADV155
 
	.WORD	ADV10,	ADV155,	ADV155,	ADV155
	.WORD	ADV155,	ADV155,	ADV155,	ADV155
	.WORD	ADV155,	ADV155,	ADV155,	ADV155
	.WORD	ADV155,	ADV155,	ADV155,	ADV155
	.WORD	ADV155,	ADV155,	ADV155,	ADV155
	.WORD	ADV155,	ADV155,	ADV155,	ADV155
	.WORD	ADV155,	ADV155,	ADV155,	ADV135
	.WORD	ADV140,	ADV145,	ADV150,	ADV10
 
;
; ERROR MESSAGES
;
 
ERR01:	.ASCIZ	"Illegal character ???"
ERR02:	.ASCIZ	"EOF in comment"
ERR03:	.ASCIZ	"Warning: nested comments"
ERR04:	.ASCIZ	"Character constant too long"
ERR06:	.ASCIZ	"Nonterminated string"
ERR07:	.ASCIZ	"Undefined label "<140>"?????????"
ERR08:	.ASCIZ	"Undefined name "<140>"?????????"
ERR09:	.ASCIZ	"Strange '#' line"
ERR10:	.ASCIZ	"Number too long"
ERR11:	.ASCIZ	"Warning: constant is long"
 
	.EVEN
	.PAGE
;+
; ** SCAN  - LEXICAL ANALYSER
; ** ESCAN - LEXICAL ANALYSER
;
; THIS ROUTINE:
;	1) COPIES THE STUFF IN SLOT 1 OF THE WINDOW INTO
;	   SLOT 0 OF THE WINDOW.
;	2) READS A NEW TOKEN INTO SLOT 1 OF THE WINDOW.
;
; END OF FILES KEEP COMING.
;
; THERE IS SOME (NECESSARY) INTERACTION WITH GETSTR. WHEN THE TOKEN IN
; SLOT 1 OF THE WINDOW IS OP.CST (STRING QUOTE) IT KEEPS COMING.  THIS
; IS SO THE CALLER OF SCAN CAN CALL GETSTR TO READ IN THE BODY OF  THE
; STRING. AFTER GETSTR HAS READ IN THE STRING HE CALLS ADVANC TO  MOVE
; THE WINDOW ALONG. THIS RESTARTS THE SCANNER.
;
; THE ESCAN ENTRY POINT DEFEATS THIS INTERACTION.  IT IS NECESSARY  TO
; PREVENT LOOPING IF THE ERROR FLUSH ENCOUNTERS A STRING.
;
; THERE ARE REALLY TWO SYMBOL TABLES IN ONE;  THE SF.MOS BIT SAYS THAT
; THE SYMBOL IS IN THE MEMBER/TAG TABLE. THE MOSFLG  DETERMINES  WHICH
; TABLE IS USED. IT IS SET WHENEVER A '.', AN '->' OR THE WORD  STRUCT
; IS SCANNED. THE MOSFLG IS OR-ED WITH THE GLOBAL CELL INMOSF; THIS IS
; INITIALLY ZERO, INCREMENTED ON STRUCTURE ENTRY AND DECREMENTED  UPON
; LEAVING THE STRUCTURE. THIS INSURES THAT ALL CONTEXTS WHICH USE  THE
; MOS SYMBOL TABLE ACTUALLY USE IT, WITHOUT GETTING 'STRUCT X X' WRONG
; 'UNION' TRIGGERS THIS NOW AS WELL!!
;
; OUTPUTS:
;	R0=CONTENTS OF LEX0 AFTER THE SCAN
;-
 
	.ENABL	LSB
 
SCAN:	MOV	VAL1,VAL0	;MOVE WINDOW
	MOV	VAL1+2,VAL0+2	;ALL 4
	MOV	VAL1+4,VAL0+4	;WORDS OF
	MOV	VAL1+6,VAL0+6	;IT
	MOV	LEX1,R0		;MOVE TOKEN
	MOV	R0,LEX0		;TYPE
	CMP	R0,#OP.EOF	;KEEP RETURNING EOF
	BEQ	10$		;AND
	CMP	R0,#OP.CST	;STRING
	BEQ	10$		;QUOTE
	BR	5$		;GO TO COMMON CODE
 
ESCAN:	MOV	VAL1,VAL0	;SLIDE THE WINDOW ALONG
	MOV	VAL1+2,VAL0+2	;
	MOV	VAL1+4,VAL0+4	;
	MOV	VAL1+6,VAL0+6	;
	MOV	LEX1,R0		;
	MOV	R0,LEX0		;
	CMP	R0,#OP.EOF	;KEEP RETURNING EOF
	BEQ	10$		;
 
5$:	CMP	R0,#OP.DOT	;IF THE TOKEN IS '.'
	BEQ	7$		;OR
	CMP	R0,#OP.STR	;'STRUCT'
	BEQ	7$		;OR
	CMP	R0,#OP.UNI	;'UNION'
	BEQ	7$		;OR
	CMP	R0,#OP.ARO	;'->'
	BNE	8$		;THEN
7$:	INC	MOSFLG		;SET THE MOSFLAG
8$:	BIS	INMOSF,MOSFLG	;SET MOSFLAG CORRECTLY AND
	CALL	ADVANC		;GET NEW TOKEN FOR LEX1
	MOV	LEX0,R0		;SET UP THE RETURN VALUE
 
10$:	RETURN			;RETURN
 
	.DSABL	LSB
 
;+
; ** ADVANC - ADVANCE WINDOW
;
; THIS ROUTINE IS CALLED TO READ A NEW TOKEN INTO WINDOW SLOT 1. IT IS
; BASICLY JUST A GIANT SWITCH STATEMENT ON ASCII CHARACTERS.
;-
 
ADVANC:	MOV	R0,-(SP)	;SAVE REGISTERS
	MOV	R1,-(SP)	;
	MOV	R2,-(SP)	;
 
10$:	CALL	GETC		;GET CHARACTER FROM INPUT
	BCC	20$		;BR IF NOT EOF
	MOV	#OP.EOF,R0	;IF EOF, RETURN EOF TOKEN
	BR	30$		;
 
20$:	CMP	R0,#200		;IS IT LEGAL ASCII
	BLO	25$		;BR IF YES
	CALL	ADV10		;CALL ILLEGAL CHARACTER CODE
	BCS	10$		;IF RESCAN
	BR	30$		;
 
25$:	MOV	R0,R1		;GET TABLE
	ASL	R1		;INDEX
	CLC			;DEFAULT C BIT
	CALL	@ADVTAB(R1)	;CALL CHARACTER SPECIFIC ROUTINE
	BCS	10$		;IF CS GET ANOTHER CHARACTER
 
30$:	MOV	R0,LEX1		;SAVE TOKEN
	CLR	MOSFLG		;CLEAR MEMBER OF STRUCTURE FLAG
	MOV	(SP)+,R2	;RETURN
	MOV	(SP)+,R1	;
	MOV	(SP)+,R0	;
	RETURN			;
 
;
; ILLEGAL CHARACTERS.
; WHITE SPACE.
; NEWLINES.
; ALL THREE RETURN WITH C BIT SET, SO SCANNING CONTINUES.
;
 
ADV10:	MOV	R0,R1		;ILLEGAL CHARACTER
	SWAB	R1		;GET IN TOP 9 BITS
	CLC			;
	ROR	R1		;
	MOV	#ERR01+18.,R2	;
10$:	MOV	#6,R0		;
	ASL	R1		;GET A DIGIT
	ROL	R0		;
	ASL	R1		;
	ROL	R0		;
	ASL	R1		;
	ROL	R0		;
	MOVB	R0,(R2)+	;
	CMP	R2,#ERR01+21.	;LOOP FOR 3 DIGITS
	BLO	10$		;
	MOV	#ERR01,R0	;PRINT DIAGNOSTIC
	CALL	ERROR		;
ADV05:	SEC			;IGNORE CHARACTERS
	RETURN			;
 
ADV15:	INC	LINENO		;NEWLINE, FIX LINE NUMBER
	CALL	MREC		;PUT OUT 'M' RECORD
	SEC			;
	RETURN			;
 
;
; !	OP.NOT
; !=	OP.NE
;
 
ADV20:	CALL	GETC		;'!', MUST CHECK FOR '!='
	BCS	20$		;EOF
	CMPB	R0,#'=
	BNE	10$		;MUST BE '!'
	MOV	#OP.NE,R0
	BR	30$
10$:	CALL	UNGETC		;PUT THE CHARACTER BACK
20$:	MOV	#OP.NOT,R0
30$:	CLC
	RETURN
 
;
; "	OP.CST
; THERE IS SOME FUNNYNESS HERE. LOOK IN THE DESCRIPTION OF SCAN 
; AND THE CODE FOR SCAN (CC101) AND GETSTR (CC104)
;
 
ADV25:	MOV	#OP.CST,R0	;STRING QUOTE
	RETURN
 
;
; %	OP.MOD
; %=	OP.MOA
;
 
ADV30:	MOV	#OP.MOD,R0	;'%'
	CALL	ASGOP		;
	CLC			;
	RETURN			;
 
;
; &	OP.AND
; &&	OP.AA
; &=	OP.ANA
;
 
ADV35:	CALL	GETC		;'&', CHECK FOR '&&'
	BCS	30$		;EOF
	CMPB	R0,#'&		;'&&'
	BNE	10$		;NO
	MOV	#OP.AA,R0	;
	BR	40$		;

10$:	CMPB	R0,#'=		;'&='
	BNE	20$		;NO
	MOV	#OP.ANA,R0	;
	BR	40$		;

20$:	CALL	UNGETC		;PUT CHARACTER BACK
30$:	MOV	#OP.AND,R0	;
40$:	CLC			;GOOD RETURN
	RETURN			;
 
;
; '	CHARACTER CONSTANTS 
;
 
ADV40:	CALL	GETCC		;READ IN THE CHARACTER CONSTANT
	MOV	#OP.CON,R0
	CLC
	RETURN
 
;
; (	OP.LPA
;
 
ADV45:	MOV	#OP.LPA,R0	;'('
	RETURN
 
;
; )	OP.RPA
;
 
ADV50:	MOV	#OP.RPA,R0	;')'
	RETURN
 
;
; *	OP.MUL
; *=	OP.MUA
;
 
ADV55:	MOV	#OP.MUL,R0	;'*'
	CALL	ASGOP		;
	CLC			;
	RETURN			;
 
;
; +	OP.ADD
; ++	OP.INB
; +=	OP.ADA
;
 
ADV60:	CALL	GETC		;GET NEXT CHARACTER
	BCS	30$		;EOF
	CMPB	R0,#'+		;'++'
	BNE	10$		;
	MOV	#OP.INB,R0	;
	BR	40$		;

10$:	CMPB	R0,#'=		;'+='
	BNE	20$		;
	MOV	#OP.ADA,R0	;
	BR	40$		;

20$:	CALL	UNGETC		;PUT CHARACTER BACK
30$:	MOV	#OP.ADD,R0	;
40$:	CLC			;
	RETURN			;
 
;
; ,	OP.CMA
;
 
ADV65:	MOV	#OP.CMA,R0	;','
	RETURN
 
;
; -	OP.SUB
; --	OP.DEB
; -=	OP.SBA
; ->	OP.ARO
;
 
ADV70:	CALL	GETC		;GET NEXT CHARACTER
	BCS	40$		;EOF
	CMPB	R0,#'>		;'->'
	BNE	10$		;
	MOV	#OP.ARO,R0	;
	BR	50$		;

10$:	CMPB	R0,#'-		;'--'
	BNE	20$		;
	MOV	#OP.DEB,R0	;
	BR	50$		;

20$:	CMPB	R0,#'=		;'-='
	BNE	30$		;
	MOV	#OP.SBA,R0	;
	BR	50$		;

30$:	CALL	UNGETC		;PUT IT BACK
40$:	MOV	#OP.SUB,R0	;
50$:	CLC			;
	RETURN			;
 
;
; .	OP.DOT (STRUCTURE REFERENCE)
;	MAY BE A FLOATING POINT NUMBER
;
 
ADV75:	CALL	GETC		;PEEK AHEAD
	BCS	20$		;EOF, TIS A DOT
	CMPB	R0,#'0		;SEE IF A DIGIT
	BLO	10$		;
	CMPB	R0,#'9		;
	BHI	10$		;
	CALL	UNGETC		;PUT THE DIGIT BACK
	MOVB	#'.,R0		;RECOVER THE DOT
	CALL	NUMBER		;READ IN A NUMBER
	BR	30$		;
 
10$:	CALL	UNGETC		;PUT CHARACTER BACK
20$:	MOV	#OP.DOT,R0	;RETURN STRUCTURE DOT
30$:	CLC			;GOOD RETURN
	RETURN			;
 
;
; /	OP.DIV
; /=	OP.DVA
;	CHECK FOR AND FLUSH COMMENTS
;
 
ADV80:	CALL	GETC		;CHECK IF '/*' OF A COMMENT
	BCS	15$		;EOF
	CMPB	R0,#'*		;IS IT '/*'
	BEQ	20$		;START OF COMMENT

	CMPB	R0,#'=		;'/='
	BNE	10$		;NO
	MOV	#OP.DVA,R0	;
	CLC			;
	RETURN			;

10$:	CALL	UNGETC		;PUT IT BACK
15$:	MOV	#OP.DIV,R0	;
	CLC			;
	RETURN			;
 
20$:	MOV	#1,R1		;COMMENT NESTING DEPTH
30$:	TST	R1		;BREAK IF NO LONGER IN COMMENT
	BEQ	80$		;GO BACK FOR ANOTHER CHARACTER
	CMPB	R0,#'*		;POSSIBLE */
	BNE	50$		;NO
	CALL	GETC		;TEST FOR THE /
	BCS	70$		;EOF
	CMPB	R0,#'/		;WAS IT A */
	BNE	30$		;NO
	DEC	R1		;YES, DECREMENT COMMENT DEPTH
	BR	30$		;AND GO FOR MORE
 
50$:	CMPB	R0,#'/		;STARTING ANOTHER COMMENT?
	BNE	60$		;NO
	CALL	GETC		;MAYBE, CHECK FOR THE '*'
	BCS	70$		;EOF
	CMPB	R0,#'*		;
	BNE	30$		;NOT A '*'
	MOV	#ERR03,R0	;NESTED COMMENTS DRAW A WARNING
	CALL	WARN		;
	INC	R1		;FIX NESTING DEPTH
	BR	30$		;
 
60$:	CMPB	R0,#NL		;IF A NEWLINE
	BNE	65$
	INC	LINENO		;FIX THE LINE NUMBER
65$:	CALL	GETC		;GRAB THE NEXT CHARACTER
	BCC	30$
 
70$:	MOV	#ERR02,R0	;END OF FILE IN A COMMENT
	CALL	ERROR
	MOV	#OP.EOF,R0
	CLC
	RETURN
 
80$:	SEC			;AFTER SUCCESSFUL FLUSH, GET
	RETURN			;ANOTHER CHARACTER
 
;
; 0-9	CONSTANTS
;
 
ADV85:	CALL	NUMBER		;GET THE NUMBER
	CLC			;GOOD RETURN
	RETURN			;
 
;
; :	OP.CLN
;
 
ADV90:	MOV	#OP.CLN,R0	;COLON
	RETURN
 
;
; ;	OP.SEM
;
 
ADV95:	MOV	#OP.SEM,R0	;SEMICOLON
	RETURN
 
;
; <	OP.LT
; <=	OP.LE
; <<	OP.ASL
;
 
ADV100:	CALL	GETC		;'<', CHECK FOR '<<'
	BCS	30$		;EOF
	CMPB	R0,#'<		;
	BNE	10$		;NO
	MOV	#OP.ASL,R0	;ITS '<<'
	CALL	ASGOP		;CHECK FOR '<<='
	BR	40$		;

10$:	CMPB	R0,#'=		;NOT '<<', TRY '<="
	BNE	20$		;NO
	MOV	#OP.LE,R0
	BR	40$

20$:	CALL	UNGETC		;JUST ORDINARY '<'
30$:	MOV	#OP.LT,R0
40$:	CLC
	RETURN
 
;
; ==	OP.EQ
; =	OP.ASG
;
 
ADV105:	CALL	GETC		;GET NEXT CHARACTER
	BCS	20$		;EOF
	CMPB	R0,#'=		;'=='
	BNE	10$		;NO
	MOV	#OP.EQ,R0	;
	BR	30$		;

10$:	CALL	UNGETC		;PUT IT BACK
20$:	MOV	#OP.ASG,R0	;
30$:	CLC			;
	RETURN			;
 
;
; >	OP.GT
; >>	OP.ASR
; >>=	OP.ARA
; >=	OP.GE
;
 
ADV110:	CALL	GETC		;'>', CHECK FOR '>>'
	BCS	30$		;EOF
	CMPB	R0,#'>
	BNE	10$
	MOV	#OP.ASR,R0
	CALL	ASGOP
	BR	40$
10$:	CMPB	R0,#'=		;NOT '>>', CHECK FOR '>='
	BNE	20$
	MOV	#OP.GE,R0
	BR	40$
20$:	CALL	UNGETC		;ORDINARY '>'
30$:	MOV	#OP.GT,R0
40$:	CLC
	RETURN
 
;
; ?	OP.QRY
;
 
ADV115:	MOV	#OP.QRY,R0	;QUESTION MARK (AS IN ? :)
	RETURN
 
;
; [	OP.LSQ
;
 
ADV120:	MOV	#OP.LSQ,R0	;'['
	RETURN
 
;
; ]	OP.RSQ
;
 
ADV125:	MOV	#OP.RSQ,R0	;']'
	RETURN
 
;
; ^ 	OP.XOR
; ^=	OP.XRA
;
 
ADV130:	MOV	#OP.XOR,R0	;'^' (EXCLUSIVE OR)
	CALL	ASGOP		;'^='
	CLC
	RETURN
 
;
; 	OP.LBR
;
 
ADV135:	MOV	#OP.LBR,R0	;LEFT (OPENING) BRACE
	RETURN
 
;
; 	OP.OR
;	OP.OO
;
 
ADV140:	CALL	GETC		;GET NEXT CHARACTER
	BCS	30$		;EOF
	CMPB	R0,#ORBAR	;'OROR'
	BNE	10$		;NO
	MOV	#OP.OO,R0
	BR	40$

10$:	CMPB	R0,#'=		;'OR='
	BNE	20$		;
	MOV	#OP.ORA,R0	;
	BR	40$		;

20$:	CALL	UNGETC		;PUT IT BACK
30$:	MOV	#OP.OR,R0	;
40$:	CLC			;
	RETURN			;
 
;
;	OP.RBR
;
 
ADV145:	MOV	#OP.RBR,R0	;RIGHT (CLOSING) BRACE
	RETURN
 
;
; 	OP.COM
;
 
ADV150:	MOV	#OP.COM,R0	;TILDE (ONES COMPLEMENT)
	RETURN
 
;
;	OP.ID
;	OP.KEYWORDS
;
 
ADV155:	CALL	GETNAM		;GATHER UP THE NAME
	CALL	LOOKUP		;SYMBOL TABLE
	CMPB	S.CLAS(R0),#CL.KEY ;IS IT A KEYWORD?
	BNE	10$		;NO
	MOV	S.ADDR(R0),R0	;YES, RETURN
	BR	20$		;KEYWORD TOKEN
10$:	MOV	R0,VAL1		;NO, SAVE SYMBOL TABLE PTR.
	MOV	#OP.ID,R0	;AND RETURN ID
20$:	CLC			;
	RETURN			;
 
;
; 	'#' CHARACTER
;	#LINENUMBER [FILENAME] FROM CC000/CC001
;
 
ADV160:	CALL	GETC		;GET CHARACTER AFTER THE '#'
	BCS	80$		;ERROR
	CMPB	R0,#'0		;MUST BE A DIGIT
	BLO	70$		;
	CMPB	R0,#'9		;
	BHI	70$		;
	MOV	R0,R1		;READ IN LINE NUMBER
10$:	SUB	#'0,R1		;ITS DECIMAL
	CALL	GETC		;
	BCS	80$		;
	CMPB	R0,#NL		;STOP ON BLANK OR NEWLINE
	BEQ	20$		;
	CMPB	R0,#BLANK	;
	BEQ	20$		;
	ASL	R1		;N = 10*N + C
	MOV	R1,-(SP)	;
	ASL	R1		;
	ASL	R1		;
	ADD	(SP)+,R1	;
	ADD	R0,R1		;ADD IN NEW DIGIT
	BR	10$		;
20$:	MOV	R1,LINENO	;RESET LINE NUMBER
30$:	CMPB	R0,#BLANK	;SKIP BLANKS
	BNE	40$		;
	CALL	GETC		;
	BCS	80$		;
	BR	30$		;
40$:	MOV	#FILE,R1	;POINT AT THE FILE NAME BUFFER
50$:	CMPB	R0,#NL		;COLLECT UNTIL NEWLINE
	BEQ	60$		;
	MOVB	R0,(R1)+	;
	CALL	GETC		;
	BCS	80$		;
	BR	50$		;
60$:	CLRB	(R1)		;MAKE THE NAME ASCIZ
	CALL	MREC		;PUT OUT M RECORD
	BR	90$		;
 
70$:	CMPB	R0,#NL		;SKIP UNTIL NEWLINE
	BEQ	80$		;
	CALL	GETC		;
	BCC	70$		;
80$:	MOV	#ERR09,R0	;ERROR (FUNNY SHARP)
	CALL	ERROR		;
90$:	SEC			;READ MORE
	RETURN			;
 
;+
; ** MREC - PUT OUT M RECORD
;
; THIS ROUTINE PASSES THE LINE NUMBER AND FILE NAME OVER TO PASS 2
; VIA AN M RECORD.
;
; USES:
;	R0, R1
;-
 
MREC:	MOVB	#'M,R0		;OPCODE
	CALL	CODC		;
	MOVB	#' ,R0		;
	CALL	CODC		;
 
	MOV	LINENO,R0	;LINE NUMBER
	CALL	CODNUM		;
 
	TSTB	FILE		;IS THERE A FILE NAME
	BEQ	10$		;NO
	MOVB	#' ,R0		;YES, PUT IT OUT
	CALL	CODC		;
	MOV	#FILE,R0	;
	CALL	CODSTR		;
 
10$:	CALLR	CODNL		;DONE
 
;+
; ** ASGOP - CHECK FOR ASSIGNMENT OP
;
; INPUTS:
;	R0=BASE OP
;
; OUTPUTS:
;	R0=NEW OP
;
; USES:
;	R1
;-

ASGOP:	MOV	R0,R1		;SAVE BASE OP

	CALL	GETC		;GET NEXT CHARACTER
	BCS	20$		;EOF
	CMPB	R0,#'=		;IS IT ASSIGNMENT
	BNE	10$		;NO
	ADD	#OP.ADA-OP.ADD,R1 ;ADJUST THE OPERATOR
	BR	20$		;

10$:	CALL	UNGETC		;PUT CHARACTER BACK
20$:	MOV	R1,R0		;RETURN OP
	RETURN			;
 
;+
; ** NUMBER - GET A NUMBER
;
; READ A NUMBER INTO VAL1. RETURN ITS KIND. THIS ROUTINE HANDLES MANY
; TYPES OF NUMBERS; LONGS, INTEGERS AND DOUBLES.
;
; INPUTS:
;	R0=FIRST CHARACTER OF THE NUMBER
;
; OUTPUTS:
;	R0=KIND
;-
 
NUMBER:	MOV	R1,-(SP)	;SAVE REGISTERS
	MOV	R2,-(SP)	;
	MOV	R3,-(SP)	;
 
	CLR	R2		;START WITH NUMBER 0
	CLR	R3		;
	CLRB	EXP		;NO E
	CLRB	DOT		;NO DOT
	CLRB	OCT		;DECIMAL
	CLRB	HEX		;
	CLRB	NTL		;
	MOVB	#1,SGN		;SIGN NOT LEGAL
	MOV	#NB,R1		;POINT AT BUFFER
 
	CMPB	R0,#'0		;SET OCT IF REQUIRED
	BNE	10$		;
	INCB	OCT		;
	CALL	GETC		;GRAB NEXT
	BCS	4$		;EOF
	CMPB	R0,#'X		;SELECT HEX AS WELL
	BEQ	2$		;YES
	CMPB	R0,#'x		;
	BNE	3$		;NO
2$:	INCB	HEX		;SET HEX
	BR	4$		;
3$:	CALL	UNGETC		;PUT CHARACTER BACK
4$:	MOV	#'0,R0		;FAKE!!
 
10$:	CMPB	R0,#'.		;DOT
	BNE	30$		;
	TSTB	DOT		;DON'T ALLOW TWO
	BNE	80$		;
	INCB	DOT		;
	BR	50$		;
 
30$:	CMPB	R0,#'+		;SIGNS
	BEQ	32$		;
	CMPB	R0,#'-		;
	BNE	40$		;
32$:	TSTB	SGN		;DON'T ALLOW TWO
	BNE	80$		;
	INCB	SGN		;
	BR	50$		;
 
40$:	TSTB	HEX		;HEX
	BEQ	42$		;NO
	CMPB	R0,#'A		;RANGE CHECK HEX
	BLO	42$		;
	CMPB	R0,#'F		;
	BLOS	50$		;OK
	CMPB	R0,#'a		;OTHER CASE AS WELL
	BLO	42$		;
	CMPB	R0,#'f		;
	BLOS	50$		;OK

42$:	CMPB	R0,#'0		;DIGIT RANGE
	BLO	45$		;
	CMPB	R0,#'9		;
	BLOS	50$		;LEGAL DIGIT.

45$:	CMPB	R0,#'E		;EXPONANTS.
	BEQ	46$		;OK.
	CMPB	R0,#'e		;IN EITHER CASE.
	BNE	80$		;NO.

46$:	TSTB	EXP		;SECOND ONE?
	BNE	80$		;YES.
	INCB	EXP		;SET EXP SEEN.
	CLRB	SGN		;ALLOW A SIGN.

50$:	CMP	R1,#NBE-1	;DOES IT FIT?
	BHIS	51$		;NO.
	MOVB	R0,(R1)+	;SAVE IT.
	BR	52$		;

51$:	INCB	NTL		;SET TOO LONG FLAG

52$:	TSTB	OCT		;BASE 8
	BEQ	60$		;NO, MUST BE BASE 10
	ASL	R3		;MULTIPLY R2/R3 BY 8
	ROL	R2		;
	ASL	R3		;
	ROL	R2		;
	ASL	R3		;
	ROL	R2		;
	TSTB	HEX		;8 OR 16
	BEQ	70$		;8
	ASL	R3		;
	ROL	R2		;
	BR	70$		;
 
60$:	MOV	R2,-(SP)	;MULTIPLY BY 10
	MOV	R3,-(SP)	;
	ASL	R3		;
	ROL	R2		;
	ASL	R3		;
	ROL	R2		;
	ADD	(SP)+,R3	;
	ADC	R2		;
	ADD	(SP)+,R2	;
	ASL	R3		;
	ROL	R2		;
 
70$:	CMPB	R0,#'a		;ADD IN NEW DIGIT
	BLO	72$		;
	SUB	#'a-10.,R0	;
	BR	76$		;

72$:	CMPB	R0,#'A		;
	BLO	74$		;
	SUB	#'A-10.,R0	;
	BR	76$		;

74$:	SUB	#'0,R0		;
76$:	ADD	R0,R3		;
	ADC	R2		;
	CALL	GETC		;GET NEXT CHARACTER
	BCC	10$		;GOT ONE
 
	CLRB	(R1)		;EOF, WRAP UP
	MOVB	DOT,R1		;TEST FOR FP
	BISB	EXP,R1		;
	BNE	130$		;
	BR	90$		;NOT FP
 
80$:	CLRB	(R1)		;WRAP UP
	MOVB	DOT,R1		;TEST FOR FP
	BISB	EXP,R1		;
	BNE	129$		;
 
	CMPB	R0,#'L		;TEST FOR LONG CONSTANT
	BEQ	110$		;
	CMPB	R0,#'l		;
	BEQ	110$		;
	CALL	UNGETC		;PUSH BACK DELIMITER
 
90$:	TST	R2		;TEST FOR LONG CONSTANT
	BEQ	120$		;IS SHORT
	MOV	#ERR11,R0	;WARNING, CONSTANT IS LONG
	CALL	WARN		;
 
110$:	MOV	R2,VAL1		;STORE LONG CONSTANT
	MOV	R3,VAL1+2	;
	CLR	VAL1+4		;
	CLR	VAL1+6		;
	MOV	#OP.LCN,R0	;
	BR	140$		;
 
120$:	MOV	R3,VAL1		;SHORT CONSTANT
	CLR	VAL1+2		;
	CLR	VAL1+4		;
	CLR	VAL1+6		;
	MOV	#OP.CON,R0	;
	BR	140$		;
 
129$:	CALL	UNGETC		;RETURN CHARACTER.
130$:	TSTB	NTL		;DOUBLE, WAS IT TOO LONG?
	BEQ	135$		;NO.
	MOV	#ERR10,R0	;BITCH
	CALL	ERROR		;ABOUT IT.
	CLR	VAL1		;THEN GIVE A ZERO.
	CLR	VAL1+2		;
	CLR	VAL1+4		;
	CLR	VAL1+6		;
	BR	137$		;

135$:	CALL	ATOD		;CONVERT IT

137$:	MOV	#OP.DCN,R0	;
 
140$:	MOV	(SP)+,R3	;RETURN
	MOV	(SP)+,R2	;
	MOV	(SP)+,R1	;
	RETURN			;
 
;+
; ** ATOD -- ASCII TO DOUBLE.
;
; THIS ROUTINE CONVERTS A STRING OF ASCII CHARACTERS TO DOUBLE LENGTH
; FLOATING POINT BINARY. THE NUMBER IS ROUNDED TO DOUBLE LENGTH.  THE
; SCAN STOPS ON THE FIRST CHARACTER THAT IS NOT LEGAL; THE CALLER HAS
; ALREADY CHECKED THAT THE STRING IS LEGAL.
;
; THIS ROUTINE IS BASED ON THE ROUTINE IN MACRO-11 THAT PROCESSES THE
; ".FLT2" AND ".FLT4" PSEUDO OPERATIONS. THE CODE THAT MULTIPLIES THE
; NUMBER BY 4/5 IS ESPECIALLY CLEVER, AND WAS LIFTED ALMOST AS IS.
;
; INPUTS:
;	NB=ASCII NUMBER, NULL TERMINATED.
;
; OUTPUTS:
;     VAL1=FOUR WORD RESULT.
;-

ATOD:	MOV	R0,-(SP)	;SAVE ALL REGISTERS.
	MOV	R1,-(SP)	;
	MOV	R2,-(SP)	;
	MOV	R3,-(SP)	;
	MOV	R4,-(SP)	;
	MOV	R5,-(SP)	;

	MOV	#FBUF,R0	;CLEAR WORK AREAS.
10$:	CLR	(R0)+		;
	CMP	R0,#FESGN+2	;
	BLO	10$		;
	MOV	#65.,FBEX	;SET BINARY EXP.

	MOV	#NB,R5		;POINT AT ASCII NUMBER.

	MOVB	(R5)+,R0	;GRAB A CHARACTER.
	CMP	R0,#'+		;IS IT A "+"
	BEQ	20$		;YES, IGNORE
	CMP	R0,#'-		;IS IT A "-"
	BNE	30$		;NO
	MOV	#100000,FSGN	;YES, SET SIGN FLAG

20$:	MOVB	(R5)+,R0	;GET NEXT CHARACTER

30$:	CMP	R0,#'0		;IS IT A DIGIT
	BLO	60$		;NO
	CMP	R0,#'9		;WELL
	BHI	60$		;NO
	BIT	#174000,FBUF	;CAN WE HANDLE ANOTHER DIGIT.
	BEQ	40$		;YES
	INC	FEXP		;NO, ADJUST SCALE.
	BR	50$		;

40$:	CALL	FM5		;MULTIPLY BY 10
	CALL	FLS		;
	MOV	#FBUF+10,R1	;ADD IN THE DIGIT
	SUB	#'0,R0		;
	ADD	R0,-(R1)	;
	ADC	-(R1)		;
	ADC	-(R1)		;
	ADC	-(R1)		;

50$:	ADD	FDOT,FEXP	;FDOT IS -1 AFTER THE "."
	BR	20$		;

60$:	CMP	R0,#'.		;DECIMAL POINT
	BNE	70$		;NO
	COM	FDOT		;FLIP DOT FLAG
	BMI	20$		;GO FOR MORE
	BR	110$		;SECOND ".", QUIT

70$:	CMP	R0,#'E		;EXPONANT
	BEQ	80$		;YES
	CMP	R0,#'e		;IN EITHER CASE
	BNE	110$		;NO, END

80$:	CLR	R1		;GET EXPONANT
	MOVB	(R5)+,R0	;GET FIRST CHARACTER
	CMP	R0,#'+		;IS IT A "+"
	BEQ	90$		;YES, IGNORE
	CMP	R0,#'-		;IS IT A "-"
	BNE	100$		;NO
	INC	FESGN		;SET FLAG

90$:	MOVB	(R5)+,R0	;GRAB NEXT CHARACTER

100$:	CMP	R0,#'0		;IS IT A DIGIT
	BLO	105$		;NO
	CMP	R0,#'9		;
	BHI	105$		;NO
	ASL	R1		;ADD IN THE DIGIT
	MOV	R1,R2		;
	ASL	R1		;
	ASL	R1		;
	ADD	R2,R1		;
	SUB	#'0,R0		;
	ADD	R0,R1		;
	BR	90$		;

105$:	TST	FESGN		;IS IT NEGATIVE
	BEQ	106$		;NO
	NEG	R1		;FIX

106$:	ADD	R1,FEXP		;FIX EXPONANT

;
; DONE COLLECTING THE NUMBER.
; IF "FEXP" IS NON ZERO (DECIMAL SCALE) APPLY
; THE SCALING TO THE BINARY NUMBER.
;

110$:	MOV	#FBUF,R0	;QUICK CHECK FOR "0".
	MOV	(R0)+,R1	;
	BIS	(R0)+,R1	;
	BIS	(R0)+,R1	;
	BIS	(R0),R1		;
	BEQ	200$		;BR IF 0.

	TST	FEXP		;ANY SCALING?
	BEQ	180$		;NO
	BLT	150$		;YES, DIVIDE

120$:	CMP	FBUF,#31426	;CAN IT HANDLE A * 5?
	BHI	130$		;NO
	CALL	FM5		;YES, MULTIPLY BY 5
	INC	FBEX		;AND BY 2
	BR	140$		;

130$:	CALL	FM54		;MULTIPLY BY 5/4
	ADD	#3,FBEX		;AND BY 8

140$:	DEC	FEXP		;LOOP UNTIL ALL DONE
	BNE	120$		;
	BR	180$		;

150$:	TST	FBUF		;LEFT JUSTIFY
	BMI	155$		;
	DEC	FBEX		;
	CALL	FLS		;
	BR	150$		;

155$:	MOV	#40,R1		;SET STEP COUNT
	CALL	FRS		;SHIFT RIGHT ONCE AND
	CALL	FSV		;COPY TO SAVE BUFFER

160$:	BIT	#1,R1		;ODD ITERATION?
	BNE	170$		;YES.
	CALL	FRS		;NO, 2 EXTRA
	CALL	FRS		;SHIFTS.

170$:	CALL	FRS		;SHIFT RIGHT.
	CALL	FAD		;ADD IN SAVE BUFFER.
	DEC	R1		;
	BNE	160$		;

	SUB	#3,FBEX		;DIVIDE BY 8.
	INC	FEXP		;DO ALL THE SCALING.
	BNE	150$		;

;
; NORMALISE.
; ROUND.
; PUT THE NUMBER TOGETHER.
;

180$:	DEC	FBEX		;NORMALISE AND
	CALL	FLS		;GOBBLE UP THE
	BCC	180$		;HIDDEN BIT.

	MOV	#FBUF+10,R0	;BEGIN D.P. ROUND.
	ADD	#400,-(R0)	;JUST BELOW LAST BIT WE KEEP.
	ADC	-(R0)		;RIPPLE
	ADC	-(R0)		;IN
	ADC	-(R0)		;CARRIES.
	BCC	185$		;IF NC, HIDDEN BIT STILL "1".
	INC	FBEX		;CARRY COMPLEMENTS THE
	CALL	FRS		;HIDDEN BIT.

185$:	ADD	#200,FBEX	;EXCESS 128.
;	BLE	GAK		;UNDERFLOW.
;	TSTB	FBEX+1		;AND
;	BNE	GAK		;OVERFLOW.

	MOV	#FBUF+10,R0	;SLIDE DOWN BY 8 BITS.
	MOV	#FBUF+6,R1	;
190$:	CMP	-(R0),-(R1)	;BACK UP 1 WORD.
	MOVB	(R1),(R0)	;SLIDE A BYTE.
	SWAB	(R0)		;WATCH BYTE ORDER.
	CMP	R0,#FBUF	;DO IT ALL
	BHI	190$		;INCLUDING FBEX.

	CALL	FRS		;THEN MAKE ROOM FOR SIGN
	ADD	FSGN,FBUF	;AND ADD IT IN.

200$:	MOV	#FBUF,R0	;MOVE
	MOV	#VAL1,R1	;RETURN
	MOV	(R0)+,(R1)+	;VALUE
	MOV	(R0)+,(R1)+	;TO
	MOV	(R0)+,(R1)+	;RIGHT
	MOV	(R0)+,(R1)+	;PLACE

	MOV	(SP)+,R5	;RETURN
	MOV	(SP)+,R4	;
	MOV	(SP)+,R3	;
	MOV	(SP)+,R2	;
	MOV	(SP)+,R1	;
	MOV	(SP)+,R0	;
	RETURN			;

;
; LOCAL ROUTINES.
;

FSV:	MOV	#FBUF,R2	;MOVE FBUF TO FSAV
	MOV	#FSAV,R3	;

10$:	MOV	(R2)+,(R3)+	;
	CMP	R2,#FBUF+10	;
	BLO	10$		;
	RETURN			;

FRS:	MOV	#FBUF,R2	;RIGHT SHIFT
	CLC			;
	ROR	(R2)+		;
	ROR	(R2)+		;
	ROR	(R2)+		;
	ROR	(R2)		;
	RETURN			;

FLS:	MOV	#FBUF+10,R2	;LEFT SHIFT
	ASL	-(R2)		;
	ROL	-(R2)		;
	ROL	-(R2)		;
	ROL	-(R2)		;
	RETURN			;

FM54:	CMP	FBUF,#146314	;MULTIPLY BY 5/4
	BLO	10$		;ROOM.
	CALL	FRS		;ADJUST.
	INC	FBEX		;

10$:	CALL	FSV		;SAVE IN FSAV
	CALL	FRS		;SCALE
	CALL	FRS		;RIGHT.
	BR	FAD		;ADD AND RETURN.

FM5:	CALL	FSV		;MULTIPLY BY 5.
	CALL	FLS		;
	CALL	FLS		;

FAD:	MOV	#FBUF+10,R2	;ADD FSAV TO FBUF
	MOV	#FSAV+10,R3	;

10$:	ADD	-(R3),-(R2)	;DO AN ADD
	BCC	30$		;NO CARRIES.
	MOV	R2,R4		;RIPPLE UP THE CARRIES.
20$:	ADC	-(R4)		;
	BCS	20$		;

30$:	CMP	R2,#FBUF	;LOOP TIL DONE
	BHI	10$		;
	RETURN			;
 
;+
; ** GETCC - READ IN A CHARACTER CONSTANT
;
; READ A CHARACTER CONSTANT INTO VAL1. THIS ROUTINE IS SENSITIVE  TO
; THE ORDER OF CHARACTERS IN A WORD (IN THE PDP-11, UNLIKE  THE VAST
; MAJORITY OF MACHINES, THIS IS RIGHT TO LEFT).
;
; A DIAGNOSTIC IS GENERATED IF THE CHARACTER CONSTANT ENDS SUDDENLY,
; OR CONTAINS TOO MANY (>2) CHARACTERS.
;
; USES:
;	R0, R1, R2
;-
 
GETCC:	MOV	#VAL1,R2	;POINT AT RETURN AREA
	CLR	(R2)		;INITIALIZE TO ZERO
	MOV	#'',R1		;SET UP DELIMITER FOR MAPCH
 
10$:	CALL	MAPCH		;GET CHARACTER FROM INPUT
	BCS	30$		;BR IF END OF CONSTANT
	CMP	R2,#VAL1+2	;TEST IF TOO MANY CHARACTERS
	BHIS	20$		;BR IF YES
	MOVB	R0,(R2)		;OTHERWISE SAVE THE CHARACTER
20$:	INC	R2		;IN ANY CASE, ADVANCE THE POINTER
	BR	10$		;AND CONTINUE
 
30$:	CMP	R2,#VAL1+2	;WERE THERE TOO MANY CHARACTERS?
	BLOS	40$		;BR IF NOT
	MOV	#ERR04,R0	;IF TOO MANY CHARACTERS
	CALL	ERROR		;COMPLAIN
 
40$:	RETURN			;
 
;+
; ** GETNAM - READ AN IDENTIFIER INTO NB
;
; THIS ROUTINE READS THE FIRST NCPS CHARACTERS INTO NB. IF
; THE IDENTIFIER IS TOO LONG THE EXTRA CHARACTERS ARE DIS-
; CARDED; IF IT IS TOO SHORT IT IS PADDED WITH ZEROS.
;
; CHARACTERS ARE CLASSIFIED BY LOOKING IN THE JUMP TABLE
; FOR ADDRESSES ADV85 (NUMERICS) AND ADV155 (ALPHABETICS).
; THIS IS FAIRLY DIRTY, BUT WILL PROBABLY REMAIN.
;
; USES:
;	R0, R1, R2
;-
 
GETNAM:	MOV	#NB,R1		;POINT AT THE NAME BUFFER
 
10$:	MOV	R0,R2		;CLASSIFY THE CHARACTER
	ASL	R2
	MOV	ADVTAB(R2),R2
	CMP	R2,#ADV85	;NUMERIC (0 TO 9)
	BEQ	20$		;YES
	CMP	R2,#ADV155	;ALPHABETIC (A TO Z, A TO Z, _)
	BNE	40$		;NO, END OF IDENTIFIER
 
20$:	CMP	R1,#NB+8.	;IF THE CHARACTER FITS
	BHIS	30$
	MOVB	R0,(R1)+	;SAVE IT IN THE BUFFER
 
30$:	CALL	GETC		;GRAB THE NEXT CHARACTER, AND
	BCC	10$		;CONTINUE
	BR	50$		;END OF FILE DELIMITED IDENTIFIER
 
40$:	CALL	UNGETC		;PUT LAST (BAD) CHARACTER BACK
50$:	CMP	R1,#NB+8.	;PAD IF NECESSARY
	BHIS	60$
	CLRB	(R1)+
	BR	50$
 
60$:	RETURN
 
;+
; ** GLOBS - PUT OUT REQUIRED 'G' DIRECTIVE
;
; USES:
;	R0, R4, R5
;-
 
GLOBS:	MOV	#SYMTAB,R5	;POINT AT THE SYMBOL TABLE
10$:	MOV	(R5),R5		;CHECK FOR END OF S.T.
	BEQ	30$
 
	CMPB	S.CLAS(R5),#CL.GBD ;LOOK FOR GLOBALS
	BEQ	20$
	CMPB	S.CLAS(R5),#CL.GBR
	BNE	10$
 
20$:	MOVB	#'G,R0		;PUT OUT 'G' DIRECTIVE FOR IT
	CALL	CODC
	MOVB	#' ,R0
	CALL	CODC
	MOV	R5,R0
	ADD	#S.NAME,R0
	CALL	CODSTR
	CALL	CODNL
	BR	10$
 
30$:	RETURN
 
;+
; ** FDIMP - FREE DIMENSION LIST
;
; INPUTS:
;	R4=SYMBOL TABLE NODE
;
; USES:
;	R0, R1
;-
 
FDIMP:	MOV	S.DIMP(R4),R0	;IS THERE A DIM LIST
	BEQ	20$		;NO
 
10$:	MOV	(R0),R1		;SAVE POINTER TO NEXT NODE
	CALL	$FREE		;FREE THIS NODE
	MOV	R1,R0		;FOLLOW LIST AND
	BNE	10$		;STOP IF NO MORE
	CLR	S.DIMP(R4)	;MARK DIM LIST NULL
 
20$:	RETURN
 
;+
; ** FDOPE - FREE DOPE BLOCK
;
; CAVEAT:  THE S.DOPE FIELD POINTS TO A DOPE BLOCK ONLY FOR STRUCTS
; UNIONS AND TAGS.  THE FIELD MAY BE NULL. IF THE  STRUCT OR  UNION
; IS UNDEFINED DON'T FREE IT; THE POINTER POINTS TO THE SYMBOL NODE
; OF THE TAG. FOR FIELDS HAS BEEN OVERLAID BY "S.FLD".
;
; INPUTS:
;	R4=SYMBOL TABLE NODE
;
; USES:
;	R0
;-
 
FDOPE:	MOVB	S.TYPE(R4),R0	;GET TYPE
	CMP	R0,#TY.STR	;STRUCTURE?
	BEQ	5$		;YES.
	CMP	R0,#TY.UNI	;UNION?
	BEQ	5$		;YES.
	MOVB	S.CLAS(R5),R0	;GRAB CLASS.
	CMP	R0,#CL.TAG	;TAG?
	BNE	10$		;NO.
 
5$:	MOV	S.DOPE(R4),R0	;GET POINTER TO DOPE
	BEQ	10$		;NO DOPE
	DEC	S.REFC(R0)	;DECREMENT REFERENCE COUNT
	BNE	10$		;STILL REFERENCED
	CALL	$FREE		;RELEASE THE BLOCK

10$:	CLR	S.DOPE(R4)	;NO DOPE FOR THIS SYMBOL
 
20$:	RETURN
 
;+
; ** ULABS - SEARCH SYMBOL TABLE FOR UNDEFINED LABELS
;
; WALK DOWN THE SYMBOL TABLE, LOOKING FOR FORWARD REFERENCED
; LABELS, WHICH WERE MENTIONED IN A GOTO BUT NEVER DEFINED.
; WRITE OUT DIAGNOSTICS FOR THEM.
;
; USES:
;	R5, R0
;-
 
ULABS:	MOV	#SYMTAB,R5	;POINT AT THE SYMBOL TABLE
10$:	MOV	(R5),R5		;GET NEXT STYMBOL
	BEQ	30$		;BR IF END OF TABLE
 
	CMPB	S.CLAS(R5),#CL.FOR ;IS THIS AN UNDEFINED LABEL
	BNE	10$		;NO
 
	MOV	R5,R4		;YES, COPY NAME INTO MESSAGE
	ADD	#S.NAME,R4
	MOV	#ERR07+21,R0
20$:	MOVB	(R4)+,(R0)+
	BNE	20$
	DEC	R0
	MOVB	#'',(R0)+
	CLRB	(R0)
	MOV	#ERR07,R0	;AND WRITE IT OUT
	CALL	ERROR
	BR	10$
 
30$:	RETURN
 
;+
; ** UNDEF - WRITE OUT UNDEFINED SYMBOL DIAGNOSTICS
;
; THIS ROUTINE IS CALLED BY EXPR TO COMPLAIN ABOUT UNDEFINED
; SYMBOLS.
;
; INPUTS:
;	R5=SYMBOL TABLE NODE
;
; USES:
;	R0, R4
;-
 
UNDEF:	MOV	R5,R4		;COPY NAME INTO THE MESSAGE
	ADD	#S.NAME,R4
	MOV	#ERR08+20,R0
10$:	MOVB	(R4)+,(R0)+
	BNE	10$
	DEC	R0
	MOVB	#'',(R0)+
	CLRB	(R0)
	MOV	#ERR08,R0	;WRITE OUT THE MESSAGE
	CALL	ERROR
	RETURN
 
;+
; ** PURGE - PURGE NON PERM. SYMBOLS
;
; THIS ROUTINE PURGES ALL NON PERMINANT SYMBOLS FROM THE SYMBOL TABLE
; ANY SYMBOL WHICH DOES NOT HAVE SF.PRM SET IS A  CANDIDATE  FOR  THE
; PURGE. THERE IS ONE EXCEPTION TO THIS. NO COMPLETELY UNDEFINED NAME
; IS PURGED. THIS IS BECAUSE THE SCANNER RUNS ONE TOKEN AHEAD OF  THE
; PARSER, AND YOU MIGHT PURGE A LOOK AHEAD NAME.
;
; USES:
;	R0, R4, R5
;-
 
PURGE:	MOV	#SYMTAB,R5	;POINT AT THE SYMBOL TABLE
10$:	MOV	(R5),R4		;GET NEXT SYMBOL
	BEQ	40$		;NO MORE
 
	TSTB	S.CLAS(R4)	;IS IT UNDEFINED
	BEQ	15$		;IF SO IT STAYS
	BIT	#SF.PRM,S.FLAG(R4) ;IS IT A PERM. SYMBOL
	BEQ	20$		;NO, DELETE IT
15$:	MOV	R4,R5		;YES, CONTINUE
	BR	10$
 
20$:	CALL	FDIMP		;FREE DIMP
	CALL	FDOPE		;FREE STRUCTURE DOPE
	MOV	(R4),(R5)	;UNLINK FROM THE SYMBOL TABLE
	MOV	R4,R0		;FREE THE NODE
	CALL	$FREE		;RELEASE THE SYMBOL NODE
	BR	10$
 
40$:	RETURN
 
;+
; ** LOOKUP - SYMBOL TABLE LOOKUP
;
; INPUTS:
;	NB=THE SYMBOL, NULL PADDED
;
; OUTPUTS:
;	R0=POINTER TO SYMBOL NODE
;
; USES:
;	R1, R2
;-
 
LOOKUP:	MOV	#SYMTAB,R0	;POINT AT THE SYMBOL TABLE
10$:	MOV	(R0),R0		;GET NEXT ENTRY
	BEQ	30$		;NOT FOUND
 
	MOV	#NB,R1		;SEE IF THE NAME MATCHES
	MOV	R0,R2
	ADD	#S.NAME,R2
20$:	CMPB	(R1)+,(R2)+
	BNE	10$		;NO, GO ON
	CMP	R1,#NB+8.
	BLO	20$
 
	CMPB	S.CLAS(R0),#CL.KEY ;IS THE NAME A KEYWORD
	BEQ	50$		;YES, IT ALWAYS MATCHES
 
	TST	MOSFLG		;OTHERWISE MUST MATCH THE MOSFLAG
	BNE	25$		;BR IF MOS
	BIT	#SF.MOS,S.FLAG(R0) ;IS IT MOS
	BNE	10$		;YES, DON'T WANT IT
	BR	50$		;MATCH
 
25$:	BIT	#SF.MOS,S.FLAG(R0) ;IS IT MOS
	BEQ	10$		;NO, DON'T WANT IT
	BR	50$		;MATCH
 
;
; IF NOT FOUND, GET SOME SPACE (VIA $ALLOC) AND BUILD A NEW
; NODE. SET IT TO EVERYTHING UNDEFINED AND/OR NULL. THE MOS
; BIT (SF.MOS) IS SET CORRECTLY, BASED ON THE CURRENT STATE
; OF THE MOSFLG
;
 
30$:	MOV	#S.LENG,R0	;GET A NEW NODE
	CALL	$ALLOC
	MOV	SYMTAB,(R0)	;LINK INTO TABLE
	MOV	R0,SYMTAB
 
	CLRB	S.CLAS(R0)	;NO CLASS
	CLRB	S.TYPE(R0)	;NO TYPE
	CLR	S.DIMP(R0)	;NULL DIMENSIONS
	CLR	S.DOPE(R0)	;NULL DOPE POINTER
	CLR	S.ADDR(R0)	;ADDRESS = 0
	CLR	S.FLAG(R0)	;SET MOS FLAG IF REQUIRED
	TST	MOSFLG
	BEQ	35$
	BIS	#SF.MOS,S.FLAG(R0)
 
35$:	MOV	#NB,R1		;COPY IN THE NAME
	MOV	R0,R2
	ADD	#S.NAME,R2
40$:	MOVB	(R1)+,(R2)+
	CMP	R1,#NB+8.
	BLO	40$
	CLRB	(R2)		;INSURE ITS ASCIZ
 
50$:	RETURN
 
;+
; ** MAPCH - GET CHARACTERS USING STRING MAPPINGS
;
; INPUTS:
;	R1=DELIMITER
;
; OUTPUTS:
;	R0=CHARACTER (C BIT CLEAR)
;	C BIT SET IF THE DELIMITER WAS FOUND
;-
 
MAPCH:	MOV	R2,-(SP)	;SAVE REGISTERS
	MOV	R3,-(SP)
 
5$:	CALL	GETC		;GET CHARACTER FROM THE INPUT
	BCS	75$		;EOF
	CMPB	R0,R1		;IS IT THE DELIMITER
	BEQ	80$		;YES
 
	CMPB	R0,#NL		;IS IT A NEWLINE
	BEQ	75$		;YES, UNTERMINATED STRING
 
	CMPB	R0,#'\		;ESCAPE SEQUENCE
	BNE	72$		;NO
 
	CALL	GETC		;GET FIRST CHARACTER OF THE SEQUENCE
	BCS	75$		;EOF
	CMPB	R0,#'t		;\T
	BNE	10$
	MOVB	#11,R0		;IS A TAB
	BR	72$
 
10$:	CMPB	R0,#'n		;\N
	BNE	20$
	MOVB	#12,R0		;IS A NEWLINE
	BR	72$
 
20$:	CMPB	R0,#'b		;\B
	BNE	25$
	MOVB	#10,R0		;IS A BACKSPACE
	BR	72$
 
25$:	CMPB	R0,#'r		;\R
	BNE	26$
	MOVB	#15,R0		;IS A CARRIAGE RETURN
	BR	72$
 
26$:	CMPB	R0,#'f		;\F
	BNE	30$
	MOVB	#14,R0
	BR	72$

30$:	CMPB	R0,#NL		;\NEWLINE
	BNE	40$
	INC	LINENO
	BR	5$		;IS IGNORED
 
40$:	CMPB	R0,#'0		;\NNN
	BLO	72$
	CMPB	R0,#'7
	BHI	72$
	MOV	#3,R2		;DIGIT COUNTER
	MOV	R0,R3
50$:	SUB	#'0,R3
	DEC	R2
	BLE	70$		;NO MORE THAN 3 BYTES
	CALL	GETC
	CMPB	R0,#'0		;STOP ON NON OCTAL
	BLO	60$
	CMPB	R0,#'7
	BHI	60$
	ASL	R3
	ASL	R3
	ASL	R3
	ADD	R0,R3
	BR	50$
60$:	CALL	UNGETC
70$:	MOV	R3,R0
 
72$:	CLC			;GOOD RETURN
	BR	90$
 
75$:	MOV	#ERR06,R0	;NONTERMINATED STRING
	CALL	ERROR
80$:	SEC			;ERROR RETURN
 
90$:	MOV	(SP)+,R3
	MOV	(SP)+,R2
	RETURN
 
;+
; ** KWINIT - PUT KEYWORDS IN THE SYMBOL TABLE
;
; USES:
;	R0, R1, R2, R5
;-
 
KWINIT:	MOV	#KWS,R5		;POINT OFF AT THE KEYWORDS
 
10$:	MOV	(R5)+,R2	;COPY INTO NB
	MOV	#NB,R1
20$:	MOVB	(R2)+,R0
	BEQ	30$
	BIS	#' ,R0		;FORCE LOWER CASE
	CMP	R1,#NB+8.
	BHIS	20$
	MOVB	R0,(R1)+
	BR	20$
 
30$:	CMP	R1,#NB+8.	;PAD
	BHIS	40$
	CLRB	(R1)+
	BR	30$
 
40$:	CALL	LOOKUP		;LOOKUP THE SYMBOL
	MOVB	#CL.KEY,S.CLAS(R0)
	BIS	#SF.PRM,S.FLAG(R0) ;MARK NON DELETEABLE
	MOV	(R5)+,S.ADDR(R0) ;SET IT UP
 
	CMP	R5,#KWSE
	BLO	10$
	RETURN
 
;
; KEYWORD TABLE
; USED ONLY ONCE (AT INITIALISATION TIME) BY KWINIT.
;
 
	.MACRO	KWORD	NAME,ADDR
	KWORD1	<NAME>,\...LAB
...LAB	=	...LAB+1
	.WORD	ADDR
	.ENDM
 
	.MACRO	KWORD1	NAME,LAB
	.WORD	KW'LAB
	.PSECT	.KWTX.
KW'LAB:	.ASCIZ	"NAME"
	.PSECT
	.ENDM
 
...LAB	=	1
 
KWS:	KWORD	<auto>,OP.AUT
	KWORD	<static>,OP.STA
	KWORD	<extern>,OP.EXT
	KWORD	<int>,OP.INT
	KWORD	<char>,OP.CHR
	KWORD	<float>,OP.FLT
	KWORD	<double>,OP.DBL
	KWORD	<unsigned>,OP.UNS
	KWORD	<long>,OP.LNG
	KWORD	<struct>,OP.STR
	KWORD	<goto>,OP.GOT
	KWORD	<return>,OP.RET
	KWORD	<if>,OP.IF
	KWORD	<while>,OP.WHI
	KWORD	<else>,OP.ELS
	KWORD	<switch>,OP.SWI
	KWORD	<case>,OP.CAS
	KWORD	<break>,OP.BRK
	KWORD	<continue>,OP.CTN
	KWORD	<do>,OP.DO
	KWORD	<default>,OP.DEF
	KWORD	<for>,OP.FOR
	KWORD	<register>,OP.REG
	KWORD	<sizeof>,OP.SIZ
	KWORD	<short>,OP.SHO
	KWORD	<union>,OP.UNI
	KWORD	<typedef>,OP.TYP
KWSE:
 
	.END