prsexp.asm

Dos6.0

	TITLE	prsexp.asm - Parser Expression Recognizer

;==========================================================================
; Module:  prsexp.asm - Parser Expression Recognizer
; Subsystem:  Parser
; System:  Quick BASIC Interpreter
;
;  NOTE:
;	See prsnt.asm for general comments
;
;===========================================================================

	include version.inc
	PRSEXP_ASM = ON 
	includeOnce opaftqb4
	includeOnce prstab
	includeOnce opintrsc
	includeOnce qbimsgs
	includeOnce parser
	includeOnce pcode
	includeOnce psint
	includeOnce variable

	assumes DS,DATA
	assumes SS,DATA
	assumes ES,NOTHING

sBegin	DATA

PREC_lPar EQU	1	;operator precedence for '('
PREC_rPar EQU	1	;operator precedence for ')'
PREC_mark EQU	0	;minimum operator precedence


FOP_unary EQU	1	;flag indicating resword can be a unary operator

;NOTE: order of this table assumes values of IOP_mark through IOP_LParen
; as defined in psint.inc
;
.errnz	IOP_mark	- 0
.errnz	IOP_RParen	- 1
.errnz	IOP_Imp		- 2
.errnz	IOP_Eqv		- 3
.errnz	IOP_Xor		- 4
.errnz	IOP_Or		- 5
.errnz	IOP_And		- 6
.errnz	IOP_Not		- 7
.errnz	IOP_EQ		- 8
.errnz	IOP_LT		- 9
.errnz	IOP_GT		- 10
.errnz	IOP_LE		- 11
.errnz	IOP_GE		- 12
.errnz	IOP_NE		- 13
.errnz	IOP_Add		- 14
.errnz	IOP_Minus	- 15
.errnz	IOP_Mod		- 16
.errnz	IOP_Idiv	- 17
.errnz	IOP_Mult	- 18
.errnz	IOP_Div		- 19
.errnz	IOP_Plus	- 20
.errnz	IOP_UMinus	- 21
.errnz	IOP_Pwr		- 22
.errnz	IOP_LParen	- 23

mpIopOpcode LABEL	WORD
	DW	0			;stack marker
	DW	0			;)			
	DW	opImp			;IMP		
	DW	opEqv			;EQV		
	DW	opXor			;XOR		
	DW	opOr			;OR			
	DW	opAnd			;AND		
	DW	opNot			;NOT		
	DW	opEQ			;=			
	DW	opLT			;<			
	DW	opGT			;>			
	DW	opLE			;<=			
	DW	opGE			;>=			
	DW	opNE			;<>			
	DW	opAdd			;binary+	
	DW	opSub			;binary-	
	DW	opMod			;MOD		
	DW	opIDv			; \			
	DW	opMul			;*			
	DW	opDiv			;/			
	DW	0			;unary+	 (never emitted)
	DW	opUMi			;unary-	
	DW	opPwr			;^			
	DW	opLParen		;(

mpIopPrecedence	LABEL	BYTE
	DB	2*PREC_mark		;stack marker
	DB	2*PREC_rPar		;)			
	DB	2*2			;IMP		
	DB	2*3			;EQV		
	DB	2*4			;XOR		
	DB	2*5			;OR			
	DB	2*6			;AND		
	DB	2*7 + FOP_unary		;NOT		
	DB	2*8			;=			
	DB	2*8			;<			
	DB	2*8			;>			
	DB	2*8			;<=			
	DB	2*8			;>=			
	DB	2*8			;<>			
	DB	2*9			;binary+	
	DB	2*9			;binary-	
	DB	2*10			;MOD		
	DB	2*11			; \			
	DB	2*12			;*			
	DB	2*12			;/			
	DB	2*13 + FOP_unary	;unary+	
	DB	2*13 + FOP_unary	;unary-	
	DB	2*14			;^			
	DB	2*PREC_lPar + FOP_unary;(

	PUBLIC	pExpTos, stkExpInit
;Expression stack constants (see prsexp.asm)
CB_EXP_STK	EQU 64			;number of bytes in expression stack
					; 4 bytes per entry, 16 entries
stkExp		DB CB_EXP_STK DUP (?)	;parse-time expression stack
stkExpMin	EQU stkExp+4		;minimum legal offset for pExpTos
stkExpInit	LABEL BYTE		;value of pExpTos when initialized
pExpTos		DW 0			;points to cur top of expression stack

sEnd	DATA


sBegin	CP
assumes CS,CP

;*********************************************************************/
; ushort NEAR RelOp()
;
; Purpose:
;	Called by NtExp() and NtCaseArg() to parse a relational operator.
;	If a 2-token relational operator is parsed, ScanTok() is called
;	once to consume 1st token.  Caller must always call once ScanTok()
;	to skip past token(s).  It is done this way so NtExp() can be faster
;	& smaller.
;
; Entry:
;	pTokScan points to potential relational operator token
;
; Exit:
;	returns:
;		0 if token is not a relational operator
;		1 for = 
;		2 for < 
;		3 for > 
;		4 for <= 
;		5 for >= 
;		6 for <> 
; 	Condition codes set based on value in ax
;
;*********************************************************************/
;Register usage:
;	di = iOperator
;	si = points to current token
;
cProc	RelOp	<PUBLIC,NEAR,NODATA>,<di>
cBegin	RelOp
	sub	di,di			;default return value to 0
	mov	bx,[pTokScan]		;bx points to current token
RelOpLoop:
	cmp	[bx.TOK_class],CL_resword
	jne	RelOpExit		;brif token isn't a reserved word
	mov	ax,[bx.TOK_rw_iOperator];ax = operator's index (IOP_xxx)
	inc	ax			;test for UNDEFINED
	je	RelOpExit		;brif token isn't an operator

	;Got an operator, see if its a relational operator
	;IOP_xxx is always way less than 255, we can deal with low byte of ax
	sub	al,9			;map =,<,> to 0,1,2
	cmp	al,2
	ja	RelOpExit		;brif token isn't a relational operator
	inc	ax			;map =,<,> to 1,2,3
	or	di,di
	jne	Got2ndChar		;brif we're dealing with 2nd char
					; or relational operator
	xchg	di,ax			;save partial return value in di

	;got a relational operator, see if it is a 2-token
	;relational operator like <>, <=, or >=
	
	call	Peek1Tok		;examine beyond current token
					; bx points to that token
	jmp	SHORT RelOpLoop		;examine 2nd char

;di = 1..3 for 1st char in {=,<,>}
;ax = 1..3 for 2nd char in {=,<,>}
Got2ndChar:
	cmp	ax,di
	je	RelOpExit		;brif same char as 1st (<<, >> or ==)
	inc	ax			;map 2nd char {=,<,>} to 2,3,4
	add	di,ax			;map <=, >=, <> to 4,5,6
	call	ScanTok			;skip 1st relational operator
RelOpExit:
	xchg	ax,di			;ax = return value
	or	ax,ax			;set condition codes for caller
cEnd	RelOp

;*********************************************************************
; STATICF(boolean) PopTillLParen()
;
; Purpose:
;	This is called when we have encountered a right paren while
;	parsing an expression.  It causes all operators which have been
;	stacked to be emitted, up to the matching stacked left paren.
;	If no matching left paren is found on the stack, it means we
;	parsed a sub-expression like x+y), so NtExp() should exit
;	and let its caller parse the right paren.  Maybe it marks the
;	end of a function, sub, or array arg list.
;
; Exit:
;	If 1 left paren was popped of the stack, returns psw.EQ,
;  else if no left parens were found on stack, returns psw.NE
;
;*********************************************************************/
cProc	PopTillLParen	<NEAR,NODATA>,<si,di>
cBegin	PopTillLParen
	mov	si,[pExpTos]		;si points to top of expression stack

PopLoop:				;while (PREC_lPar < *pExpTosReg) {
	cmp	WORD PTR [si],PREC_lPar
	jbe	PopDone
	inc	si			;pop stacked operator's precedence
	inc	si
	lodsw				;pop and emit stacked operator's opcode
	call	Emit16_AX
	jmp	SHORT PopLoop

PopDone:
	mov	[pExpTos],si		;save pointer to top-of-stack

	;if top-of-stack is left paren, return psw.EQ
	cmp	WORD PTR [si],PREC_lPar
cEnd	PopTillLParen

;*********************************************************************
; PARSE_RESULT NEAR NtExp()
;
; Purpose:
;	Parse an expression and emit code for it.
;	Guarenteed to give Expression To Complex error before
;	more than 16 (CB_EXP_STK/4) entries get pushed onto the expression
;	stack.  This controls unrestricted stack (SS) usage.
;
; Entry:
;	pTokScan points to 1st token of expression to be parsed
;	If the static variable [oNamConstPs] is non-zero, intrinsic
;	   functions are not allowed
;
; Exit:
;	pTokScan points to 1st token after expression
;	cIdArgs is bumped by 1 (no matter how much recursion takes place).
;	The return value is PR_GoodSyntax, PR_NotFound or PR_BadSyntax.
;	If the result is not PR_BadSyntax, mkVar.flags is preserved across
;	the call
;	Condition codes set based on value in al
;
;*******************************************************************
cProc	NtExp	<PUBLIC,NEAR,NODATA>,<si,di>
	localB	fConsumed
cBegin	NtExp
	push	[mkVar.MKVAR_flags]	;preserve this for caller

	;Push a low-precedence stopper onto the stack which prevents any
	;operators already on the stack from being emitted as a result of
	;this recursive invocation of NtExp.
	
	sub	[pExpTos],2		;make room for marker on exp stack
	mov	bx,[pExpTos]
	mov	WORD PTR [bx],PREC_mark	;push minimum precedence
	mov	[fConsumed],0		;we haven't consumed anything yet


;-------------------------------------------------------------------
;State which expects a term (function, constant, or variable).
; If we don't get one, we either return PR_BadSyntax if we've consumed
; 1 or more tokens, or PR_NotFound if we've consumed no tokens
;
State1:
	mov	bx,[pTokScan]		;bx points to current token
	mov	ax,[bx.TOK_class]	;ax = token's class
	cmp	al,CL_id
	je	GotId			;brif token is an id
	cmp	al,CL_resword
	je	GotResWord		;brif token is a reserved word
	cmp	al,CL_lit
	jne	NotTerm			;brif token is not a constant
	call	NtLit			;try to parse a constant
					; It is guarenteed that NtLit cannot
					; return PR_NotFound if the token's
					; class is CL_lit
	jmp	SHORT CheckResult

GotId:	call	NtIdAryElem		;Try to parse an id (may recurse)
					; It is guarenteed that NtIdAryElem
					; cannot return PR_NotFound
					; if the token's class is CL_id
	dec	[cIdArgs]		;NtIdAryElem() bumped cIdArgs,
					; NtExp() bumps it on exit, and we are
					; only supposed to bump it once per
					; invocation of NtExp().
CheckResult:
	or	al,al			;test return code
	jg	State2			;brif PR_GoodSyntax
	jmp	NtExpExit		;return PR_BadSyntax result

;bx points to current token's descriptor
GotResWord:
	mov	ax,[bx.TOK_rw_iOperator]
	inc	ax			;test for UNDEFINED
	je	NotOperator		;brif didn't get an operator
	dec	ax			;ax = IOP_xxx for operator
	cmp	al,IOP_Add
	je	Scan_State1		;brif unary plus
					; no need to emit a unary +
	cmp	al,IOP_Minus
	jne	NotMinus		;brif not if unary minus
	mov	al,IOP_UMinus		;convert to unary form of -

;ax = operator index (IOP_xxx) for current token
NotMinus:
	mov	di,ax			;di = operator index
	test	mpIopPrecedence[di],FOP_unary
	je	NotTerm			;brif not a unary operator
	cmp	al,IOP_LParen
	jne	ConsumeOp		;brif token is not '('
					; -- consume & stack/emit operator

	sub	[pExpTos],2
	mov	bx,[pExpTos]
	mov	WORD PTR [bx],PREC_lPar	;push precedence for '('
					; this precedence can only be popped
					; by right paren
	cmp	bx,dataOFFSET stkExpMin
	jb	ExpTooComplex		;brif stack overflow
Scan_State1:
	call	ScanTok			;skip current token
	mov	[fConsumed],1		;Now we can't return PR_NotFound
	jmp	State1			; because we've consumed something

NotOperator:
	call	NtIntrinsic		;try to parse intrinsic function
	jg	SHORT State2		;brif PR_GoodSyntax (change state)
	jl	J1_NtExpExit		;brif PR_BadSyntax
NotTerm:
	cmp	[fConsumed],1
	je	ExpectedExp		;error if we needed to see a term
					; i.e. we've consumed anything
	;else we never even consumed 1 token, return NotFound
	sub	al,al			;return(PR_NotFound)
	jmp	SHORT J1_NtExpExit

;-------------------------------------------------------------------
;Error handler's (placed here so they can be reached by SHORT jumps)
;
ExpTooComplex:
	mov	ax,MSG_ExpTooComplex	;Error: expression too complex
	call	PErrMsg_AX		;produce parser error msg
					; al = PR_BadSyntax
	jmp	SHORT J1_NtExpExit

;we've encountered something like <term><operator><garbage>
;
ExpectedExp:
	mov	ax,MSG_ExpExp		;Error: Expected expression
ExpErrMsg:
	call	PErrExpMsg_AX		;Error: Expected <ax>
					; al = PR_BadSyntax
J1_NtExpExit:
	jmp	NtExpExit

;-------------------------------------------------------------------
;This code is for the state where we are expecting a binary operator
; or end-of-expression
;
State2:
	mov	bx,[pTokScan]		;bx points to current token
	cmp	[bx.TOK_class],CL_resword
	jne	EndOfExp		;brif not reserved word
	mov	ax,[bx.TOK_rw_iOperator];ax = IOP_xxx for token
	inc	ax			;test for UNDEFINED
	je	EndOfExp		;brif its not an operator
	dec	ax			;ax = operator's IOP_xxx
	mov	di,ax			;di = operator's IOP_xxx
	test	mpIopPrecedence[di],FOP_unary
	jne	EndOfExp		;brif not binary operator (exit)
	cmp	al,IOP_RParen		;check for right paren
	jne	NotRightParen		;brif not

	;Now we call PopTillLParen to cause all operators stacked
	; since the last scanned left paren to be emitted.
	; It also detects if the parenthesis for this expression