prsexp.asm

Dos6.0

	; don't balance, i.e.  the expression (a)), in which
	; case we return, because the right paren we're looking
	; at may be for an array reference.  If it is an error,
	; it will be caught by a higher level.
	
	call	PopTillLParen
	jne	EndOfExp		;brif we got a right paren, but it
					; was beyond the expression we were
					; called to parse.  Exit without
					; consuming this right paren.
	add	[pExpTos],2		;pop left paren's precedence
	mov	ax,opLParen		;emit opLParen pcode
	call	Emit16_AX
	call	ScanTok			;skip right paren
	jmp	SHORT State2		;state remains ExpBinaryOp

;Check for relational operator
; di = IOP_xxx for operator
;
NotRightParen:
	call	RelOp			;see if its a relational operator
	je	ConsumeOp		;branch if not
	
	;iop = RelOp() + IOP_EQ - 1
	
	add	al,IOP_EQ - 1		;ax = operator index - IOP_EQ - 1
	xchg	di,ax			;di = IOP for relational operator

;This is executed when we have scanned an operator while parsing
; an expression.  All stacked operators with precedence greator or
; equal to the scanned operator are emitted, then the scanned operator
; is stacked.  This is how we convert infix to postfix (or reverse polish).
; di = IOP_xxx for operator
;
ConsumeOp:
	mov	si,[pExpTos]		;si points to top of exp stack
	mov	al,mpIopPrecedence[di]	;al = operator's precedence
	sub	ah,ah			;ax = operator's precedence
	shl	di,1			;di = IOP_xxx * 2
	push	mpIopOpcode[di]		;save current operator's opcode
	mov	di,ax			;di = operator's precedence
	test	al,FOP_unary
	jne	EmitDone		;brif unary operator (must be stacked
					; until we emit the term it applies to)
EmitLoop:
	cmp	[si],di
	jb	EmitDone		;brif stacked operand's precedence
					; is less than precedence of
					; current operator
					; (i.e. leave relatively high precedence
					;  operators on the stack)
	inc	si			;pop stacked operator's precedence
	inc	si
	lodsw				;pop and emit stacked operator's opcode
	call	Emit16_AX		;emit the stacked opcode
	jmp	SHORT EmitLoop	

EmitDone:
	sub	si,4			;make room for new entry
	mov	[si],di			;push current operator's precedence
	pop	[si+2]			;push current operator's opcode
	mov	[pExpTos],si		;save exp stack ptr
	cmp	si,dataOFFSET stkExpMin
	jbe	J_ExpTooComplex		;brif exp stack overflow
	jmp	Scan_State1		;scan token, advance state

J_ExpTooComplex:
	jmp	ExpTooComplex		;Error: Expression too complex

;Now we call PopTillLParen to cause all operators stacked by this
; recursive invocation of NtExp to be emitted.  It also detects
; if the parenthesis for this expression don't balance, i.e.
; the expression ((a+5)
;
EndOfExp:
	call	PopTillLParen
	jne	ParensBalance		;brif paranthesis are balanced
	mov	ax,MSG_RightParen	;Error: Expected ')'
	jmp	ExpErrMsg

;Now we pop the minimum precedence operator stack marker which was
;stacked when we entered this recursive invocation of NtExp
;
ParensBalance:
	inc	[cIdArgs]
	mov	al,PR_GoodSyntax	;This is (and must remain) the only
					; exit which returns PR_GoodSyntax
NtExpExit:
	add	[pExpTos],2		;pop off initial stopper
	pop	[mkVar.MKVAR_flags]	;restore caller's mkVar.flags
	or	al,al			;set condition codes for caller
cEnd	NtExp

subttl	Intrinsic Function Nonterminal

;**********************************************************************
; PARSE_RESULT NEAR NtIntrinsic()
;
; Purpose:
;	Parse an intrinsic function.
;
; Entry:
;	If the static variable [oNamConstPs] is non-zero, intrinsic
;	   functions are not allowed
;
; Exit:
;	The value of cIdArgs is preserved
;	If no intrinsic is found, no tokens are consumed, no opcodes
;	   are emitted, and the return value is PR_NotFound.
;	If it is found, a corresponding opcode is emitted and
;	   Parse() is called to check the syntax and generate code
;	   for it.  If the syntax for the intrinsic is good, the
;	   return code is PR_GoodSyntax.  If not the return code
;	   is PR_BadSyntax.
;	Condition codes set based on value in al
;
;******************************************************************
cProc	NtIntrinsic <PUBLIC,NODATA,NEAR>,<si,di>
cBegin	NtIntrinsic
	sub	al,al			;prepare to return PR_NotFound 
	mov	bx,[pTokScan]		;bx points to current token
	cmp	[bx.TOK_class],CL_resWord
	jne	NtIntrExit		;brif not a reserved word
	mov	dx,[bx.TOK_rw_rwf]	;dx = reserved word flags
	test	dx,RWF_FUNC
	je	NtIntrExit		;brif token isn't for intrinsic func
	cmp	[oNamConstPs],0
	je	NotInCONST		;brif not in CONST a=<expression> stmt
	mov	ax,MSG_InvConst		;Error: Invalid Constant
	call	PErrMsg_AX		; al = PR_BadSyntax
	jmp	SHORT NtIntrExit

NotInCONST:
	push	[pCurStkMark]		;preserve caller's pCurStkMarker
	push	[cIdArgs]		;preserve caller's cIdArgs
	mov	[cIdArgs],0		;reset cIdArgs to 0 for this
					; intrinsic function's code generator
	;Fetch info for a particular intrinsic function out of the
	;parser's reserved word table 'tRw'.
	
	mov	si,[bx+TOK_rw_pArgs]	;si -> pRwArgs in tRw
	lods	WORD PTR cs:[si]	;ax=state table offset for func's syntax
	mov	cx,ax			;cx=state table offset
	sub	di,di			;default to no code generator
	test	dx,RWF_FUNC_CG
	je	NoFuncCg		;branch if no code generator for func
	lods	WORD PTR cs:[si]	;ax=adr of code generation func
	mov	di,ax			;di=adr of code generation func
	lods	WORD PTR cs:[si]	;ax=arg to pass to code generation func
	mov	si,ax			;si=code generation arg
NoFuncCg:
	push	cx			;pass oState to Parse
	call	ScanTok			;skip keyword token 
	pop	ax			;ax = oState
	add	ax,OFFSET CP:tState	;ax = pState = &(tState[oState])
	mov	[pStateLastScan],ax
	call	NtParse			;try to parse intrinsic function
	jle	NtIntrNotGood		;branch if result isn't PR_GoodSyntax
	or	di,di
	je	NtIntrGoodSyntax	;branch if no function code generator
	mov	ax,si			;pass arg to code generation routine
					; (usually, this is an opcode)
	call	di			;invoke code generation routine 
NtIntrGoodSyntax:
	mov	al,PR_GoodSyntax	;return PR_GoodSyntax
	jmp	SHORT NtIntrRestore

NtIntrNotGood:
	jl	NtIntrRestore		;branch if result == PR_BadSyntax
	call	PErrState		;Generate error message "Expected
					; <a> or <b> or ..." 
					;al = PR_BadSyntax
NtIntrRestore:
	pop	[cIdArgs]		;restore caller's cIdArgs
	pop	[pCurStkMark]		;restore caller's pCurStkMarker
NtIntrExit:
	or	al,al			;set condition codes for caller
cEnd	NtIntrinsic

subttl	Literal Nonterminals

UNARY_LIT EQU 0
	;	Used when CASE could only be followed by literal instead of Exp.
	;	May easily be useful for some future construct.
	;	Handles up to 1 unary minus.  Could easily be changed
	;	to handle unary +, we would just need to add the opcode.

;**********************************************************************
; PARSE_RESULT NEAR NtLit()
;
; Purpose:
;	Parse any form of literal and, if found, generate a corresponding
;	literal opcode.
;
; Exit:
;	Returns either PR_GoodSyntax, PR_NotFound or PR_BadSyntax
;	Condition codes set based on value in al
;
;******************************************************************
cProc	NtLit <PUBLIC,NODATA,NEAR>,<si,di>
cBegin	NtLit
	mov	di,[pTokScan]		;di points to current token
	cmp	[di.TOK_class],CL_lit
	jne	LitNotFound		;brif already got a unary op
	sub	ax,ax
	or	al,[di.TOK_lit_errCode]	;ax = lexical analyzer's error code
	jne	LitSnErr		;brif lexical analyzer found an error
					; in literal's format
	lea	si,[di.TOK_lit_value_I2];si points to literal's value
	mov	bl,[di.TOK_lit_litType]	;bl = LIT_xxx for literal
	cmp	bl,LIT_STR
	je	GotLitSD
	cmp	bl,LIT_I2
	jne	@F			;branch if not a decimal integer
	mov	ax,[si] 		;ax = value
	cmp	ax,opLitI2Max		; Is value within pcode limit
	ja	@F			;branch if value isn't 0..10
	.erre	OPCODE_MASK EQ 03ffh	; Assure following code is ok
	mov	ah,al			
	mov	al,0			; AX = literal * 0100h
	shl	ax,1			; AX = literal * 0200h
	shl	ax,1			; AX = literal * 0400h
	add	ax,opLitI2		;opcode = opLitI2 w/value in upper bits
	call	Emit16_AX
	jmp	SHORT NtLitGoodSyntax

@@:
	sub	bh,bh			;bx = LIT_xxx for literal
	mov	al,[tLitCwValue + bx]	;al = # words in literal's value
	sub	ah,ah			;ax = # words in literal's value
	mov	di,ax			;di = # words in literal's value
	shl	bx,1			;bx = 2 * LIT_xxx for literal
	mov	ax,[tLitOpcodes + bx]	;ax = opcode
	call	Emit16_AX		;emit the opcode
EmitLitLoop:
	lodsw				;ax = next word of literal's value
	call	Emit16_AX
	dec	di
	jne	EmitLitLoop		;branch if more words to emit
	jmp	SHORT NtLitGoodSyntax

;Got a string constant like "xxxxxxx"
;Emit all source characters between the double quotes.
;If <cbText> is odd, <cbText> is emitted as an odd value,
;and an extra pad byte is appended to keep pcode even-byte alligned.  
;
GotLitSD:
	mov	ax,opLitSD
	call	Emit16_AX
	mov	ax,[di.TOK_oSrc]	;ax = column token started in
	inc	ax			;ax = oSrc + 1 (skip ")
	push	ax			;pass it to EmitSrc
	mov	ax,[si]			;ax = length of string literal in bytes
					;TOK_lit_value_cbStr
	push	ax			;pass size of string to EmitSrc
	call	Emit16_AX		;emit size of the string
	call	EmitSrc			;emit the string itself
NtLitGoodSyntax:
	call	ScanTok			;skip literal token
	mov	al,PR_GoodSyntax
NtLitExit:
	or	al,al			;set condition codes for caller
cEnd	NtLit

LitNotFound:
	sub	ax,ax			;prepare to return PR_NotFound
	jmp	SHORT NtLitExit		;brif we didn't consume unary opcode

;ax = error encountered by lexical analyzer when scanning number
LitSnErr:
	call	PErrMsg_AX		; al = PR_BadSyntax
	jmp	SHORT NtLitExit

sEnd CP
sBegin DATA

;Tables used by NtLit

;Following tables assume following constants:
OrdConstStart 0
OrdConst LIT_I2		; % suffix
OrdConst LIT_O2		; &O prefix
OrdConst LIT_H2		; &H prefix
OrdConst LIT_I4		; & suffix
OrdConst LIT_O4		; &&O prefix
OrdConst LIT_H4		; &&H prefix
OrdConst LIT_R4		; ! suffix
OrdConst LIT_R8		; # suffix
OrdConst LIT_STR	; "xxx"
tLitOpcodes LABEL WORD
	DW	opLitDI2		;LIT_I2	 (% suffix)
	DW	opLitOI2		;LIT_O2	 (&O prefix)
	DW	opLitHI2		;LIT_H2	 (&H prefix)
	DW	opLitDI4		;LIT_I4	 (& suffix)
	DW	opLitOI4		;LIT_O4	 (&&O prefix)
	DW	opLitHI4		;LIT_H4	 (&&H prefix)
	DW	opLitR4			;LIT_R4	 (! suffix)
	DW	opLitR8			;LIT_R8	 (# suffix)

tLitCwValue LABEL BYTE
	DB	1			;LIT_I2	 (% suffix)
	DB	1			;LIT_O2	 (&O prefix)
	DB	1			;LIT_H2	 (&H prefix)
	DB	2			;LIT_I4	 (& suffix)
	DB	2			;LIT_O4	 (&&O prefix)
	DB	2			;LIT_H4	 (&&H prefix)
	DB	2			;LIT_R4	 (! suffix)
	DB	4			;LIT_R8	 (# suffix)

sEnd DATA
sBegin CP

;**********************************************************************
; PARSE_RESULT NEAR NtLitI2() - Parse & emit 16-bit integer
; Purpose:
;	Parse and emit a 16-bit signed integer.  Note this is very
;	different from NtLit() in that it emits no opcode, just
;	a 16 bit value.  It is the responsibility of the caller
;	to emit the opcode before calling this function.
;	If a numeric literal is found, but it is > 32k,
;	an Overflow error message is generated.
; Exit:
;	Returns PR_GoodSyntax, PR_BadSyntax or PR_NotFound
;	Condition codes set based on value in al
;
;******************************************************************
PUBLIC	NtLitI2
NtLitI2	PROC NEAR
	sub	al,al			;prepare to return PR_NotFound
	mov	bx,[pTokScan]		;bx points to current token
	cmp	[bx.TOK_class],CL_lit
	jne	NtLitI2Exit		;branch if token isn't a literal
	cmp	[bx.TOK_lit_type],ET_I2
	jne	NtLitI2Ov		;brif token isn't a signed 16 bit int
	mov	ax,[bx.TOK_lit_value_I2];ax = value
	call	Emit16_AX		;emit it
	call	ScanTok			;consume token
	mov	al,PR_GoodSyntax	;return PR_GoodSyntax
NtLitI2Exit:
	or	al,al			;set condition codes for caller
	ret

NtLitI2Ov:
	mov	ax,ER_OV		;Overflow
	jmp	PErrMsg_AX		;al = PR_BadSyntax
					; return to caller
NtLitI2	ENDP

;**********************************************************************
; PARSE_RESULT NEAR NtLit0() - Parse the literal 0, emit nothing
;******************************************************************
PUBLIC	NtLit0
NtLit0	PROC NEAR
	sub	cx,cx			;expect constant 0
NtLit1Shared:
	sub	al,al			;prepare to return PR_NotFound
	mov	bx,[pTokScan]		;bx points to current token
	cmp	[bx.TOK_class],CL_lit
	jne	NtLit0Exit		;branch if token isn't a literal
	cmp	[bx.TOK_lit_type],ET_I2
	jne	NtLit0Exit		;brif token isn't a signed 16 bit int
	cmp	[bx.TOK_lit_value_I2],cx
	jne	NtLit0Exit		;branch if token isn't 0
	call	ScanTok			;consume token
	mov	al,PR_GoodSyntax	;return PR_GoodSyntax
NtLit0Exit:
	ret
NtLit0	ENDP

;**********************************************************************
; PARSE_RESULT NEAR NtLit1() - Parse the literal 1, emit nothing
;******************************************************************
PUBLIC	NtLit1
NtLit1	PROC NEAR
	mov	cx,1			;expect constant 1
	jmp	SHORT NtLit1Shared
NtLit1	ENDP

;**********************************************************************
; PARSE_RESULT NEAR NtLitString() - Parse a string literal
;******************************************************************
cProc	NtLitString <PUBLIC,NODATA,NEAR>
cBegin	NtLitString
	sub	al,al			;prepare to return PR_NotFound
	mov	bx,[pTokScan]		;bx points to current token
	cmp	[bx.TOK_lit_type],ET_SD
	jne	NtLitStringExit		;branch if token isn't string constant
	call	NtLit			;ax = result of parsing the string
NtLitStringExit:
cEnd	NtLitString

sEnd	CP

end