; CLILEX - CLONE LEXICAL ANALISYS
; LAST EDIT:	12-NOV-81
;
.NLIST
.LIST	TTM
.NLIST	BEX
.TITLE	CL1LEX
.LIST
;
TEXT$ ON
;
; THIS MODULE BREAKS THE INPUT STREAM UP INTO ITEMS EACH HAVING ONE OF
; A SMALL SET OF LEXICAL TYPES. NAMES ARE LOOKED UP IN THE APPROPRIATE
; SYMBOL TABLES TO YIELD ASSOCIATED VALUES.
;
; THE PRINCIPAL ENTRY IS GETSYM WHICH RETURNS THE NEXT SYMBOL
; AND PTBACK WHICH MAY BE CALLED TO 'UNREAD' THE LAST SYMBOL READ.
;
; NEXSYM MAY BE CALLED TO YIELD 'RAW' SYMBOLS WITHOUT ANY LOOKUP.
;
TEXT$	OFF
;
.PSECT	CL1LEX
;
;
; FIRST DEFINE THE SYNTACTICAL AND LEXICAL TYPES OF SYMBOLS WHICH MAY OCCURE
; WITHIN A CLONE COMMAND.
LEXERR==-1	;ILLEGAL SYMBOL
LEXNAM==1	;NAME. IE ALPHANUMERIC STARTING ALPHA
LEXSTR==2	;STRING (ENCLOSED IN 'S OR "S)
LEXNUM==3	;A NUMERIC VALUE
LEXOPP==4	;AN OPPERATOR SYMBOL. EG + OR <=
LEXCMD==5	;A SYMBOL IDENTIFIED AS A COMMAND 
LEXVAL==6	;A NAME SYMBOL IDENTIFIED AS A VALUE
LEXSEP==11	;ANY SEPARATOR IE. EOL , : ;
	LEXEOL==0
	LEXCOM==',
	LEXCOL==':
	LEXSEM==';
LEXMAC==13	;MACRO SYMBOL
LEXFUN==17	;INTERNAL FUNCTION NAME ($NAME)
LEXSUB==20	;LOCAL SUBROUTINE NAME
;
;
; VALUE MODE TYPES
M.UDF==0	;UNDEFINED
M.STR==1	;STRING
M.NUM==2	;NUMBER
M.BOO==3	;BOOLEAN
;
;
;
;
;
;+
;
; PRSSYM - RETURNS THE NEXT SYMBOL FROM AN INPUT BUFFER.
;
; INPUT:	R0 -	BUFFER POINTER
;
; OUTPUT:	R0 -	ADDRESS OF ITEM FOUND
;		R1 -	LENGTH OF ITEM
;		R2 -	ITEM LEXICAL TYPE
;		R3 -	QUALIFIER FOR CERTAIN LEXICAL TYPES.
;
; OTHER REGISTERS MODIFIED:	NONE
;
;-
;
EOFCH=-1	;END OF FILE FLAG
EOSCH=0		;END OF LINE/STRING FLAG
SPACH=40	;SPACE
TABCH=11	;TAB
CTRLZ=32	;CONTROL Z
CMNTCH='#	;COMMENT DELIMETER
INDCH='@	;INDIRECT FILE CHARACTER
LOWA=141	;LOWER CASE A
LOWZ=172	;LOWER CASE Z
;
JUMP=32767	;SPECIAL RETURN CODE FOR CHTABL
;
;
PRSSYM::MOV	#CHTABL,R2	;POINT TO START OF CHARACTER TABLE
1$:	TST	(R2)		;TEST FOR END OF TABLE
	BEQ	3$		;SKIP IF SO
	CMPB	(R0),(R2)	;IS CHARACTER IN RANGE
	BEQ	3$		;EQUAL TO FIRST VALUE IS A HIT
	BLO	2$		;BELOW FIRST VALUE IS A MIS
	CMPB	(R0),1(R2)	;COMPARE WITH SECOND VALUE
	BLOS	3$		;AND HIT IF IN RANGE
;
2$:	ADD	#6,R2		;ON TO NEXT TABLE ENTRY
	BR	1$
;
3$:	MOV	4(R2),R3	;RETURN QUALIFIER
	MOV	2(R2),R2	;RETURN TYPE
	CMP	R2,#JUMP	;JUMP SOMEWHERE
	BNE	4$		;SKIP IF NOT
	JMP	(R3)		;ELSE JUMP
;
4$:	MOV	#1,R1		;SYMBOL IS ONE CHAR LONG
	RETURN
;
;
; THE MACRO CHTBDF DEFINES A TABLE HAVING THE FORM:
;	.BYTE	LOW,HIGH
;	.WORD	TYPE,QUALIFIER
;
; A MATCH OCCURES WHEN A CH. MATCHES 'LOW' OR FALLS IN THE RANGE  LOW<=CH<=HIGH
;
.MACRO CHTBDF	LOW,HIGH,TYPE,QUAL
.BYTE	LOW
.IF B HIGH
.BYTE	0
.IFF
.BYTE	HIGH
.ENDC
.WORD	TYPE,QUAL
.ENDM
;
;
CHTABL:	CHTBDF	0,1,		LEXSEP,LEXEOL	;END OF STRING
	CHTBDF	<',>,,		LEXSEP,LEXCOM
	CHTBDF	<';>,,		LEXSEP,LEXSEM
	CHTBDF	<':>,,		LEXSEP,LEXCOL
	CHTBDF	SPACH,,		JUMP,BLANK
	CHTBDF	TABCH,,		JUMP,BLANK
	CHTBDF	'A,'Z,		JUMP,NAME
	CHTBDF	LOWA,LOWZ,	JUMP,NAME
	CHTBDF	'$,,		JUMP,NAME
	CHTBDF	'0,'9,		JUMP,NUM
	CHTBDF	'.,,		JUMP,NUM
	CHTBDF	'',,		JUMP,STRING
	CHTBDF	'",,		JUMP,STRING
	CHTBDF	CMNTCH,,	JUMP,COMM
	CHTBDF	'(,,		LEXCMD,C.BEG
	CHTBDF	'),,		LEXCMD,C.END
	CHTBDF	'[,,		LEXCMD,C.SQB
	CHTBDF	'],,		LEXCMD,C.SQK
	CHTBDF	EOFCH,,		LEXCMD,C.EOF
	CHTBDF	CTRLZ,,		LEXCMD,C.EOF
	CHTBDF	INDCH,,		LEXCMD,C.IND
	CHTBDF	 0,,		JUMP,OPP	;THIS TRAPS ANYTHING ELSE
;
;
; IGNORE 'BLANKS'
BLANK:	INC	R0
	BR	PRSSYM
;
; NAME TYPE SYMBOL
NAME:	MOV	R0,R1		;SAVE START
1$:	INC	R1
	CMPB	(R1),#'A
	BLT	2$
	CMPB	(R1),#'Z
	BLE	1$
	CMPB	(R1),#LOWA
	BLT	2$
	CMPB	(R1),#LOWZ
	BLE	1$
2$:	CMPB	(R1),#'0
	BLT	3$
	CMPB	(R1),#'9
	BLE	1$
3$:	SUB	R0,R1		;GET LENGTH
	CMPB	(R0),#'$	;CHECK FOR '$'
	BNE	4$
	CMP	R1,#1
	BEQ	OPP		;IF SO GO PROCESS AS AN OPERATOR
4$:	MOV	#LEXNAM,R2	;RETURN LEXICAL TYPE
	RETURN
;
; LITERAL STRING. SUPPORTS EITHER DOUBLE OR SINGLE QUOTE
; END OF LINE BEFORE CLOSING QUOTE IS ERROR.
STRING:	MOVB	(R0),R2		;SAVE QUOTE CHAR
	MOV	R0,R1		;INIT POINTER
1$:	INC	R1		;ON TO NEXT CHAR
	TSTB	(R1)		;CHECK FOR END OF LINE
	BNE	2$
	ERROR$	#E.MSQ		;ERROR IF SO
	JMP	SYMERR		;RETURN ERROR TYPE
;
2$:	CMPB	(R1),R2		;MATCHING QUOTE ?
	BNE	1$
	INC	R1		;SKIP PAST END
	SUB	R0,R1
	MOV	#LEXSTR,R2
	RETURN
;
; NUMBER, REAL OR INTEGER '.' IS ILLEGAL
NUM:	CLR	R2		;INTEGER FLAG
	MOV	R0,R1
1$:	CMPB	(R1),#'.	;DECIMAL ?
	BNE	2$
	MOV	#1,R2		;SET REAL FLAG
	BR	5$
2$:	CMPB	(R1),#'0
	BLT	3$
	CMPB	(R1),#'9
	BGT	3$
5$:	INC	R1
	BR	1$
3$:	SUB	R0,R1		;GET LENGTH
	CMP	R1,#1		;SINGLE CHAR ?
	BGT	4$
	TST	R2		;IF SO WAS IT '.'
	BEQ	4$
	ERROR$	#E.IDP
	JMP	SYMERR
4$:	MOV	#LEXNUM,R2
	RETURN
;
;
;
;
; COMMENTS ARE 'CMNTCH' TO END OF LINE
COMM:	TSTB	(R0)+		;EATUP REST OF LINE
	BNE	COMM
	DEC	R0		;LEAVE POINTER ON EOL
	MOV	#1,R1		;WHICH IS OF LENGTH ONE
	MOV	#LEXSEP,R2
	MOV	#LEXEOL,R3
	RETURN
;
;
; ALL OPERATORS ARE DEFINED HERE IN THE TABLE AT 'OPLIST'
; SEARCH ALGORITHM IS FIRST FULL MATCH, THUS LONGER PARTIALY
; MATCHING OPERATORS SHOULD PRECEDE SHORTER ONES IN TABLE
; E.G.  <= BEFORE <
;
; THE MACRO OPDEF DEFINES AN OPERATOR
.MACRO	OPDEF	NAME,STRING
.ASCIZ	STRING
.BYTE	NAME
.ENDM
;
OPLIST:
	OPDEF	O.ADD,"+"
	OPDEF	O.CON,"$+"
	OPDEF	O.IDEN,"$="
	OPDEF	O.SUB,"-"
	OPDEF	O.MUL,"*"
	OPDEF	O.DIV,"/"
	OPDEF	O.EQ,"=="
	OPDEF	O.NEQ,"!="
	OPDEF	O.ASS,"="
	OPDEF	O.AND,"&"
	OPDEF	O.OR,"^"
	OPDEF	O.NOT,"!"
	OPDEF	O.LEQ,"<="
	OPDEF	O.LT,"<"
	OPDEF	O.GEQ,">="
	OPDEF	O.GT,">"
	.BYTE	0
	.EVEN
;
OPP:	MOV	R4,-(SP)
	MOV	#OPLIST,R4	;PICK UP OPERATOR TABLE
	MOV	R0,R1		;INIT POINTER
1$:	CMPB	(R1)+,(R4)+	;COMPARE SYMBOLS
	BNE	2$
	TSTB	(R4)		;END OF TABLE ENTRY ?
	BNE	1$		;IF NOT KEEP GOING
	MOV	#LEXOPP,R2	;ELSE WEVE GOT IT
	MOVB	1(R4),R3	;GET OP-CODE
	SUB	R0,R1		;GET LENGTH
	MOV	(SP)+,R4
	RETURN			;RETURN WITH OPP-CODE IN R3
2$:	MOV	R0,R1		;GET BACK SYMBOL
3$:	TSTB	(R4)+		;SKIP REST OF TABLE ENTRY
	BNE	3$
	INC	R4		;SKIP OP-CODE
	TSTB	(R4)		;END OF TABLE
	BNE	1$		;IF NOT KEEP GOING
	MOV	(SP)+,R4
	ERROR$	#E.ISM		;ILLEGAL SYMBOL
	BR	SYMERR
;
SYMERR:	MOV	#LEXERR,R2
	CLR	R3
	MOV	#1,R1
	RETURN
;
;
;
;+
;
; NEXSYM - READS AND PARSES NEXT SYMBOL FROM CURRENT INPUT STREAM
;	   IN LITERAL MODE ENTIRE LINES ARE TREATED AS LITERAL STRINGS
;	   UNLESS PRECEDED BY A SPECIAL CHARACTER.
;
; INPUT:	STREAM CONTEXT
;
; OUTPUT:	AS FOR PRSSYM
;		CURRENT BUFFER POINTERS ARE UPDATED
;
; REGISTERS DESTROYED:	R4,R5
;
;
;-
.GLOBL	GETPNT,PUTPNT
;
NEXSYM::CALL	GETPNT		;GET LINE POINTER IN R0
	MOV	STREAM,R2	;POINT TO STREAM
	MOV	SL.CLH(R2),R2	;AND NOW TO CONTROL DESCRIPTOR
	BIT	#CF.LIT,CD.FLG(R2) ;ARE WE IN LITERAL MODE
	BEQ	20$		;SKIP IF NOT
	TST	CD.CHP(R2)	;ARE WE AT BEGINNING OF LINE ?
	BNE	20$		;AND SKIP IF NOT
;
; IN LITERAL MODE LINES NOT STARTING WITH A CLONE KEY CHARACTER ARE TREATED
; AS THOUGH THEY WERE WHOLY ENCLOSED IN QUOTES.
; KEY CHARACTERS ARE:	.	PARSE REST OF LINE IN CLONE MODE
;				(PROVIDED NEXT CHAR. IS NOT A DIGIT)
;			@ OR #	PARSE WHOLE LINE IN CLONE MODE
;
1$:	CMPB	(R0),#'.	;CLONE MODE LINE ?
	BNE	3$
	CMPB	1(R0),#'0	;BUT IS IT A DIGIT
	BLT	2$		;SKIP IF NOT
	CMPB	1(R0),#'9
	BLE	10$		;IT IS A LITERAL REPLY
2$:	INC	R0		;SKIP OVER '.'
	BR	20$
;
3$:	CMPB	(R0),#EOFCH	;END-OF-FILE
	BEQ	20$		;GIVE THAT TO THE PARSER
	CMPB	(R0),#CMNTCH	;COMMENT ?
	BEQ	20$		;LET CLONE HAVE THAT TOO
	CMPB	(R0),#INDCH	;INDIRECT FILE ?
	BEQ	20$		;CLONE PROCESSES THEM TOO
;
; NOW RETURN THE WHOLE LINE AS A LITERAL STRING
10$:	MOV	R0,R2		;COPY STRING ADDRESS
	CALL	STRLEN		;GET ITS LENGTH
	DEC	R1		;DO NOT COUNT ZERO BYTE
	MOV	R0,PRVPNT	;SAVE STRING ADDRESS
	CALL	PUTPNT		;UPDATE BUFFER POINTER
	DEC	R0		;PRETEND STRING IS IN QUOTES
	ADD	#2,R1		;SO TWO EXTRA CHARS.
	MOV	#LEXSTR,R2	;RETURN STRING TYPE
	RETURN
;
; PARSE THE LINE AS A CLONE COMMAND
20$:	CALL	PRSSYM		;PARSE A SYMBOL
	MOV	R0,PRVPNT	;SAVE THE ITEM START
	CALL	PUTPNT		;UPDATE BUFFER POINTER
	RETURN
;
;
;+
;
; GETSYM - GET THE NEXT SYMBOL FROM THE INPUT STREAM AND DOES LOOKUPS ETC.
;
; INPUT:	STEAM CONTEXT, STREAM STACK
;
; OUTPUT:	R1	SYMBOL TYPE
;		R0	SYMBOL VALUE
;
;
; TYPES ARE:	LEXOPP	AN OPERATOR SYMBOL
;			VALUE IS OPPCODE
;		LEXCMD  A CLONE COMMAND
;			VALUE IS COMMAND CODE
;		LEXVAL	VARIABLE OR LITERAL
;			VALUE IS ADDRESS OF POINTER TO VALUE ITEM
;		LEXSEP	ANY SEPARATOR 
;			VALUE IDENTIFIES SEPERATOR PRECEISELY
;		LEXMAC	A MACRO NAME
;		LEXFUN	AN INTERNAL FUNCTION NAME
;		LEXSUB	A LOCAL SUBROUTINE NAME
;
;
; REGISTERS MODIFIED:	R0,R1
;
;
;-
;
GETSYM::MOV	R2,-(SP)
	MOV	R3,-(SP)
	MOV	R4,-(SP)
	MOV	R5,-(SP)
	CALL	NEXSYM		;GO GET A SYMBOL
	CMP	R2,#LEXERR	;ILLEGAL SYMBOL ?
	BEQ	10$
	CMP	R2,#LEXOPP	;OPERATOR
	BEQ	10$
	CMP	R2,#LEXSEP	;SEPERATOR
	BEQ	10$
	CMP	R2,#LEXCMD	;COMMAND
	BNE	20$
10$:	MOV	R2,R1		;RETURN TYPE
	MOV	R3,R0		;RETURN QUALIFIER
	BR	GOTSYM
;
20$:	CMP	R2,#LEXNAM	;NAME SYMBOL ?
	BNE	SLIT		;IF NOT IT MUST BE A LITERAL
	CMPB	(R0),#'$	;IS THIS AN INTERNAL FUNCTION NAME ?
	BEQ	SFUN		;IF SO GO LOOK IT UP
	MOV	#PSTAB,R2	;PERMENANT SYMBOL ?
	CALL	LOOKUP
	BCS	SMAC
	MOV	#LEXCMD,R1	;RETURN P.S. TYPE
	MOV	(R2),R0		;AND ITS CODE
	JMP	GOTSYM
; LOOK UP NAME IN FUNCTION TABLE
SFUN:	MOV	#FUNTAB,R2	;POINT TO FUNCTION NAME TABLE
	CALL	LOOKUP		;AND LOOK UP FUNCTION NAME
	BCS	1$		;SKIP IF ITS NOT THERE
	MOV	(R2),R0		;GET FUNCTION CODE
	BR	2$
1$:	ERROR$	#E.FUN		;UNDEFINED INTERNAL FUNCTION NAME
	MOV	#F.NUL,R0	;NULL FUNCTION CODE
2$:	MOV	#LEXFUN,R1
	BR	GOTSYM
;
; SEE IF NAME SYMBOL IS DEFINED AS A MACRO
; FIRST TRY THE LOCAL MACRO TABLE
SMAC:	MOV	STREAM,R2
	TST	SL.LMT(R2)	;ANYTHING THERE
	BEQ	1$
	MOV	SL.LMT+4(R2),R2	;POINT TO SYMBOL TABLE
	CALL	LOOKUP
	BCS	1$		;SKIP IF WE FIND NOTHING
	MOV	#LEXSUB,R1	;RETURN LOCAL SUBROUTINE TYPE
	MOV	R2,R0		;RETURN THE POINTER
	BR	GOTSYM
1$:	MOV	MACSTB,R2	;SYSTEM MACRO TABLE
	CALL	LOOKUP
	BCS	SVAL
	MOV	#LEXMAC,R1	;RETURN MACRO TYPE
	MOV	R2,R0		;RETURN ADDRESS OF POINTER
				;TO MACRO ID
	BR	GOTSYM
; HERE IT MUST BE A VALUE SYMBOL
SVAL:	TST	EXEC		;DO WE EVALUATE ?
	BNE	SDUM		;SKIP IF NOT
	MOV	STREAM,R2	;GET STB POINTER
	MOV	SL.STB+4(R2),R2
	CALL	LOOKUP
	BCS	6$		;SKIP IF NOT FOUND
	MOV	#LEXVAL,R1	;VALUE TYPE
	MOV	(R2),R0		;VALUE POINTER
	CALL	DEREF		;FOLLOW ANY INDIRECTOONS
	BR	GOTSYM
; CREATE A NEW VARIABLE
6$:	CALL	NEWVAL
	MOV	#LEXVAL,R1	;RETURN VALUE TYPE
	BR	GOTSYM
; MUST BE A LITERAL
SLIT:	TST	EXEC
	BNE	SDUM
	CMP	R2,#LEXSTR	;IS IT A QUOTED STRING ?
	BNE	1$		;IF NOT SKIP
	INC	R0		;SKIP FIRST QUOTE
	SUB	#2,R1		;AND REDUCE LENGTH
	MOV	R0,R2		;COPY ADDRESS
	CALL	STRLIT		;CREATE A STRING LITERAL
	CALL	SUBSTR		;DO ANY SUBSTITUTIONS
	TST	EXEC		;WHICH COULD PRODUCE AN ERROR
	BEQ	2$		;SKIP IF NOT
	CALL	VOIDSP		;RELEASE ITEM
	BR	SDUM		;AND RETURN VOID
1$:	MOV	R0,R2		;COPY STRING ADDRESS
	CALL	STRLIT		;FORM A STRING LITERAL
2$:	MOV	#LEXVAL,R1
	BR	GOTSYM
SDUM:	MOV	#LEXVAL,R1	;IF WERE IN DUMMY MODE
	CLR	R0
;
GOTSYM:	MOV	R0,PRVSYM	;SAVE VALUE
	MOV	R1,PRVTYP	;AND TYPE
	MOV	(SP)+,R5
	MOV	(SP)+,R4
	MOV	(SP)+,R3
	MOV	(SP)+,R2
	RETURN
;
; PTBACK PUTS BACK A SYMBOL FOR LATER
;
PTBACK::MOV	R0,-(SP)
	MOV	R1,-(SP)
	CMP	PRVTYP,#LEXVAL	;WAS LAST SYMBOL VALUE ?
	BNE	1$		;SKIP IF NOT
	MOV	PRVSYM,R0	;ELSE GET POINTER
	CALL	VOIDSP		;AND DE-ALLOCATE IT
1$:	MOV	PRVPNT,R0	;NOW RESET LINE POINTER
	MOV	#-1,R1		;PUTBACK FLAG FOR PUTPNT
	CALL	PUTPNT
	MOV	(SP)+,R1
	MOV	(SP)+,R0
	RETURN
;
; THESE THREE WORDS ARE HIGHLY IMPURE, PUTBACK MUST BE
; CALLED IMMEDIATLY AFTER CONSIDERATION OF THE GETSYM RESULT
PRVSYM:	.WORD	0
PRVTYP:	.WORD	0
PRVPNT:	.WORD	0
;
;
; DEREF - FOLLOW AN INDIRECTION CHAIN
;
; INPUT:	R0 -	DIRECT OR INDIRECT VALUE POINTER
;
; OUTPUT:	R0 -	TERMINAL ITEM POINTER
;
DEREF::	TST	R0		;CHECK FOR NULL
	BEQ	1$
	CMP	R0,(R0)		;END OF CHAIN ?
	BEQ	1$
	MOV	(R0),R0		;FOLLOW INDIRECTION
	BR	DEREF
1$:	RETURN
;
	.END