.TITLE	CC101
	.IDENT	/X01/
 
	.NLIST	BEX
	.ENABL	LC
 
;
; C COMPILER
; LEXICAL ANALYSER
;
; VERSION X01
;
; DAVID G. CONROY	14-NOV-77
;
 
	.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		;
NB:	.BLKB	25.		;NAME AND NUMBER BUFFER
NBE:	.BLKB	0		;THE END
 
; 
; CHARACTER TRANSFER TABLE. THIS TABLE IS INDEXED BY 7 BIT ASCII. ALL
; ILLEGAL CHARACTERS (200-377) ARE SCREENED OUT BEFORE THE JUMP.
;
 
	.EVEN
 
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 ????????"
ERR08:	.ASCIZ	"Undefined name ????????"
ERR09:	.ASCIZ	"Strange '#' line"
ERR10:	.ASCIZ	"Number too long"
ERR11:	.ASCIZ	"Warning: constant is long"
ERR12:	.ASCIZ	"Not written: atod"
 
	.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		;
	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	20$		;
	TSTB	DOT		;DON'T ALLOW TWO
	BNE	80$		;
	INCB	DOT		;
	BR	50$		;
 
20$:	CMPB	R0,#'E		;EXPONANTS
	BEQ	22$		;
	CMPB	R0,#'e		;
	BNE	30$		;
22$:	TSTB	EXP		;DON'T ALLOW TWO
	BNE	80$		;
	INCB	EXP		;
	CLRB	SGN		;ALLOW A SIGN
	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	80$		;
	CMPB	R0,#'9		;
	BHI	80$		;
 
50$:	CMP	R1,#NBE		;WILL IT FIT
	BLO	52$		;YES
	MOV	#ERR10,R0	;TOO LONG NUMBER
	CALL	ERROR		;
	CLR	R3		;RETURN CONSTANT 0
	BR	120$		;
 
52$:	MOVB	R0,(R1)+	;SAVE CHARACTER
	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	130$		;
 
	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$		;
 
130$:	CALL	ATOD		;DOUBLE CONSTANT
	MOV	#OP.DCN,R0	;
 
140$:	MOV	(SP)+,R3	;RETURN
	MOV	(SP)+,R2	;
	MOV	(SP)+,R1	;
	RETURN			;
 
;+
; ** ATOD - CONVERT ASCII TO DOUBLE
;
; INPUTS:
;	NB=NULL TERMINATED NUMBER
;
; OUTPUTS:
;	VAL1=NUMBER
;-
 
ATOD:	MOV	#ERR12,R0	;FAKE
	JMP	CCABRT		;
 
;+
; ** 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
;
; MUST BE CAREFUL. IF THE TYPE OF A SYMBOL IS UNDEFINED STRUCTURE
; THE S.DOPE FIELD POINTS TO THE TAG SYMBOL, NOT TO THE DOPE AREA
; GRAVE DISORDER WOULD RESULT IF IT WAS FREED.
; DITTO FOR UNDEFINED UNION.
;
; INPUTS:
;	R4=SYMBOL TABLE NODE
;
; USES:
;	R0
;-
 
FDOPE:	MOVB	S.TYPE(R4),R0	;GET TYPE
	CMP	R0,#TY.UST	;UNDEFINED STRUCTURE
	BEQ	10$		;JUST GO ZERO THE DOPE POINTER
	CMP	R0,#TY.UUN	;UNDEFINED UNION
	BEQ	10$		;DITTO
 
	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+20,R0
20$:	MOVB	(R4)+,(R0)+
	BNE	20$
	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+17,R0
10$:	MOVB	(R4)+,(R0)+
	BNE	10$
	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