prsid.asm

Dos6.0

	call	Emit16
	test	[flags],FEM_ElemOk
	je	EvNoElem2		;brif didn't get .element
	push	[opBase]		;pass EeElements opBase
	call	EmitElements		;parse and emit .elem...
	jmp	SHORT EvExit		;return ax as result

EvNoElem2:
	clc				;return success
EvExit:
cEnd

;*********************************************************************
; STATICF(boolean) EmitElements(ax:opBase)
;	Many modifications during revision [15]
; Purpose:
;	Scan .id[.id...] and emit pcode for construct
;
; Entry:
;	parm1 = opBase = opId_Ld or opId_St or opId_Rf
;	pTokScan points to token for '.'
;	mkVar.oTyp contains the type of the variable
;
; Exit:
;	If syntax error
;	   returns Carry Set and al=PR_BadSyntax after emitting error msg
;	else
;	   returns Carry Clear
;	   pTokScan points beyond end of construct
;
;***********************************************************************
DbPub	EmitElements
cProc	EmitElements,<NEAR>,<si,di>	
	parmW	opBase
cBegin	EmitElements			
EeLoop:
	or	[psFlags],PSIF_fNoPeriod
					;so ScanTok stops at "."
					;get's reset by IdTokNoPeriod
	call	ScanTok			;skip past "." token
	call	IdTokNoPeriod		;check for id token with no period in it
	stc				;prepare to return error
DJMP	jl	EeExit			;brif PR_BadSyntax, carry set

	mov	si,[bx.TOK_id_oNam]	;si = oNam
	mov	di,[bx.TOK_id_oTyp]	;save oTyp in di
	call	ScanTok			;skip id token
	test	[psFlags],PSIF_fBindVars
	je	EeSavTyp		;brif parser not binding variables


	;ask typmgr to convert oNam to oElem
	
	push	si			
	push	di			;pass oTyp so RefElem can test the
					; explicit type if any
	cCall	RefElem 		;ax = oElem (high bit set if error)
;Fix bug where a random error message gets generated for an undefined
;element reference or element type mismatch. Fix this only in QBJ to
;be sure it has no affect on frozen QB4.5.
;Note however that this is thought to be a very safe bug fix.
	mov	si,ax			;save si = oElem
	or	si,si			
	jns	EeSavTyp		;brif no error

	;Either the variable manager hasn't seen this oNam in the variable's
	;TYPE definition or the explicit type conflicted with the actual
	;type.  Tell ParseLine() to return ReParse.
	;We call this instead of PErrMsg_AX so we can continue
	;checking for bad syntax.
	
	and	ah,7Fh			;mask off sign bit. ax = error code
	call	ParseErrTokScan
EeSavTyp:
.errnz	ET_IMP
	or	di,di			;compare di with ET_IMP
	jne	EeNoElem		;brif id is explicitly typed (i.e. id#)
	call	FElements		;check for more record elements
	jne	EeNoElem		;brif didn't get record separator
	mov	ax,opOffLd		
EeEmit:
	call	Emit16_AX		;emit opcode opOffLd
	push	si			;emit oNam/oElem
	call	Emit16
	test	[psFlags],PSIF_fBindVars
	je	EeLoop			;brif parser not binding variables
	mov	ax,[mkvar.MKVAR_oTyp]	;ax = oTyp of last element
					;     (returned by RefElem)
	cmp	ax,ET_MAX_NOFIELDS	;compare it to largest non-fielded
					; 	type
	jbe	EeIdNoPeriod		;brif if not a user defined type
	or	ax,ax			;test the top bit of the oTyp
	jns	EeLoop1 		;if not set we have a user type
EeIdNoPeriod:
	mov	ax,MSG_BadElemRef	;pass error code to ParseErrTokScan
	call	ParseErrTokScan		;As we do for bad element names
					;  we generate a ReParse and 
					;  continue parsing
EeLoop1:				
	jmp	EeLoop	
	
;done with .a.b.c loop
;if mkVar.oTyp is a USER DEFINED TYPE, we need
;to emit a opOffLd, opOffLd or opIdSt with no explicit type.
;EmitOpcode( (oTyp <= ET_MAX) ? opOffLd + opBase + oTyp :
;            (opBase == opId_St) ? opOffSt : opOffLd)
;
;di = ET_IMP or token's explicit type
EeNoElem:
	mov	ax,[opBase]
DbAssertRel	ax,ne,opId_VtRf,CP,<EmitElements: opbase = opId_VtRf>   
DbAssertRel	di,be,ET_MAX,CP,<EmitElements: oTyp is user type>
	add	ax,opOffLd		;ax = opBase + opOffLd
.errnz OPCODE_MASK - 3FFh		
	xchg	ax,di			;di = oTyp, ax = opcode to Emit
	xchg	ah,al			;ah = oTyp
	shl	ax,1			
	shl	ax,1			
	or	ax,di			;ax = opcode with oTyp in high bits
EeEmit2:
	call	Emit16_AX		;emit opOff<Ld|St><Typ>
	xchg	ax,si			;ax = oNam/oElem
	call	Emit16_AX
	clc				;return success
EeExit:
cEnd	EmitElements			

;Tables used to map from opBase to opcodes
twOpBase LABEL WORD			;opBase search table
	dw	opId_St
	dw	opId_Ld
twOpBaseEnd LABEL WORD
CB_OPBASE = twOpBaseEnd - twOpBase

twOpIdMap LABEL WORD
	dw	opIdSt			;opId_St maps to this for scalars
	dw	opVtRf			;opId_Ld maps to this for scalars
	dw	opIdLd			;opId_Rf and opId_VtRf maps to this

twOpAIdMap LABEL WORD
	dw	opAIdSt			;opId_St maps to this for arrays
	dw	opAVtRf			;opId_Ld maps to this for arrays
	dw	opAIdLd			;opId_Rf and opId_VtRf maps to this

;*********************************************************************
; MapBaseOp
; Purpose:
;	Map an opBase (opId_St etc.) to an opcode.
; Entry:
;	ax = value to search for (opId_St etc.)
;	bx = ptr to table of opcodes which cooresponds to twOpBase
; Exit:
;	ax = opcode
;
; Alters ES
;
;*********************************************************************
MapBaseOp PROC NEAR
	mov	dx,CPOFFSET twOpBase
	mov	cx,CB_OPBASE
	jmp	MapCpW			;ax = bx[find[ax,dx,cx]]
MapBaseOp ENDP

	
;*********************************************************************
; ushort NEAR SubRef(oNam)
; Purpose:
;	Map the oNam for a SUB to its oPrs.
; Entry:
;	ax = oNam of subprogram
; Exit:
;	if successful, ax = oPrs, carry clear on exit
;	else ps.errCode is set with error code, carry set on exit
;
;*********************************************************************
cProc	SubRef,<PUBLIC,NEAR>
cBegin
	push	ax			;pass oNam of sub
	PUSHI	ax,PT_SUB
	sub	ax,ax
	push	ax
	call	PrsRef			;ax = error or oPrs
	or	ax,ax
	jns	SubRefGood		;brif no error

	;Don't set PSERR_fAlert flag, wait until ScanTime to report the error
	; since user may have just deleted =B from A=B, which would make
	; A now look like both a variable and an implied call.
	mov	ah,PSERR_fRude / 100h	;set rude edit flag in result
	call	ParseErr0		;report it to ParseLine's caller
	stc				;return error result
	jmp	SHORT SubRefExit

SubRefGood:
	call	UndoLogPrs		;remember to free prs entry if
					; we turn this line into a reparse
					; ax is preserved as oPrs
	clc				;return success
SubRefExit:
cEnd

;*********************************************************************
; STATICF(PARSE_RESULT) NtConsumeExp()
;
; Purpose:
;	Parse an expression.
;	If successfully parsed, return PR_GoodSyntax.
;	If one is not found, report error and return PR_BadSyntax.
;	If expression had bad syntax, return PR_BadSyntax.
;	In other words, identical to NtExp(), but it won't take
;	   PR_NotFound for an answer.
; Exit:
;	al = PR_GoodSyntax or PR_BadSyntax, condition codes set accordingly
;
;*********************************************************************
PUBLIC	NtConsumeExp
NtConsumeExp PROC NEAR
	call	NtExp
	je	PErrExpExpr		;brif result == PR_NotFound
					; error "Expected expression"
					; al = PR_BadSyntax
	ret
NtConsumeExp ENDP

;*********************************************************************
; PARSE_RESULT NEAR PErrExpExpr()
;
; Purpose:
;	generate error "Expected expression" and return PR_BadSyntax
; Exit:
;	al = PR_BadSyntax
;
;*********************************************************************
PUBLIC	PErrExpExpr
PErrExpExpr PROC NEAR
	mov	ax,MSG_ExpExp
	jmp	PErrExpMsg_AX		;Error "Expected expression"
					; al = PR_BadSyntax
PErrExpExpr ENDP

;*********************************************************************
; NtExprOrArg()
; 
; Purpose:
;	Parse an expression or an arg based on the value in ax
; Entry:
;	ax is tested for the flag
;	    NTEL_ARGS: if set allow SEG, BYVAL and A() args
;			        otherwise only allow a normal expression
; Exit:
;	same as NtArg
;	
;*********************************************************************
NtExprOrArg PROC
	test	ax,NTEL_ARGS
	jnz	NtArg
	call	NtExp
	mov	dx,0
	ret
NtExprOrArg ENDP

;*********************************************************************
; ExpRParenLastToken
; Purpose:
;	generate the error "expected ')'" referring to the last token
;	consumed
; Exit:
;	al = PR_BadSyntax
;*********************************************************************
ExpRParenLastToken PROC NEAR
	mov	ax,[pTokLastConsumed]	
	mov	[pTokScan],ax		;reset pTokScan to point to ","
					; so it will be highlighted
	mov	ax,IRW_RPAREN		
	jmp	PErrExpRw_Ax		;generated "expected ')'"
ExpRParenLastToken ENDP

;*********************************************************************
; PARSE_RESULT NEAR NtIdCallArg()
;
; Purpose:
;	Try to parse an identifier of the form:
;	   "[BYVAL | SEG] id[([exp[,exp...]])]"
;	This can occur in the following statements:
;	   tkCALL IdSub [tkLParen IdCallArg {tkComma IdCallArg} tkRParen]
;	Tests to ensure that we haven't yet reached the maximum number
;	of args before branching into 
;
;*********************************************************************
PUBLIC	NtIdCallArg
NtIdCallArg PROC NEAR
	cmp	[cIdArgs],MAXARG
	jae	ExpRParenLastToken	;BASCOM can't handle more than 60
					; args, so we shouldn't either
; fall into NtArg
NtIdCallArg ENDP

;*********************************************************************
; STATICF(PARSE_RESULT) NtArg()
;
; Purpose:
;	Parse and generate code for:
;	   [BYVAL | SEG] expression or
;	   array reference of the form x()
;	Emit the following pcode:
;	   [opByval | opSeg] <expression's pcode>
;	   opAIdRfxx(oVar,0)
;	NOTE: BYVAL x() is illegal because it makes no sense
;	      SEG x() is illegal because we don't want to document
;	              the format of array descriptors to outside world.
; Exit:
;	Returns al = PR_NotFound, PR_GoodSyntax or PR_BadSyntax
;	If result is PR_GoodSyntax, bumps cIdArgs by 1, no matter what
;	   recursion takes place and returns
;	   dx = NTEL_ARGS if SEG, BYVAL, or array ref of form x() seen
;		0 otherwise
;
;*********************************************************************
cProc	NtArg,<NEAR,PUBLIC>,<di>
cBegin
	push	[cIdArgs]
	mov	ax,IRW_Byval
	call	TestScan_AX		;see if current token is BYVAL
					;bx points to current token
	.erre	opByval
	mov	di,opByval
	je	GotByvalSeg		;brif got BYVAL keyword
	sub	di,di			;assume no SEG
	mov	ax,IRW_Seg
	call	TestScan_AX		;see if current token is SEG
					;bx points to current token
	jne	NoByvalSeg		;brif didn't get SEG keyword
	mov	di,opSeg
	.erre	opSeg

GotByvalSeg:
	call	ScanTok			;skip BYVAL or SEG token
					;bx points to current token

;di = 0 for no SEG or BYVAL, opByval for BYVAL, opSeg for SEG
;bx points to current token
NoByvalSeg:
	or	di,di
	jne	NotAryArg		;can't have arg of form 'BYVAL A()'
					; or 'SEG A()'
	cmp	[bx.TOK_class],CL_ID
	jne	NotAryArg		;brif token isn't an id
	call	Peek1Tok		;see if its an array ref of the form x()
	mov	ax,IRW_LParen
	call	TestPeek_AX
	jne	NotAryArg		;brif not '('
	call	PeekNextTok
	mov	ax,IRW_RParen
	call	TestPeek_AX
	jne	NotAryArg		;brif not ')'

	;we did get an array reference of the form x()
	;if (!EmitVar(pTokScan, opId_VtRf, 0, FALSE)) return PR_BadSyntax
	
	push	[pTokScan]		;pass pointer to id's token
	PUSHI	ax,opId_Ld		;make opcode a Ld variant
	PUSHI	ax,0			;pass cArgs == 0
	PUSHI	ax,FEM_Ary		;let EmitVar know its an array ref
	call	EmitVar
	jc	NtArgExit		;brif unsuccessful (al = PR_BadSyntax)
	call	ScanTok			;skip id
	call	ScanTok			;skip '('
	call	ScanTok			;skip ')'
	jmp	SHORT ItsAnArg		

NotAryArg:
	or	di,di
	je	MaybeExp		;brif no tokens consumed yet
	call	NtConsumeExp		;error if can't consume an expression
	jle	NtArgExit		;brif result != PR_GoodSyntax
EmitByvalSeg:
	or	di,di
	je	NtArgGood		;brif no BYVAL or SEG parm
	push	di
	call	Emit16			;emit opByval or opSeg
ItsAnArg:
NtArgGood:
	mov	al,PR_GoodSyntax	;return PR_GoodSyntax
	jmp	SHORT NtArgExit

MaybeExp:
	call	NtExp			;consume expression, al = result
NtArgExit:
	pop	dx			;dx = caller's cIdArgs
	inc	dx
	or	al,al			;set condition codes for caller
	jle	NtArgExit1		;brif result != PR_GoodSyntax
	mov	[cIdArgs],dx		;bump cIdArgs
NtArgExit1:
cEnd

;*********************************************************************
; NtExprList
;	Completely rewritten during revision [15]
; Purpose:
;	Parse and generate code for 
;		(expr1, expr2, ..., exprN)
;	Each of these expressions can be:
;	-  An expression
;	-  A scalar or array element
;
;	Called by NtImpliedLetOrCall and EmitElements.
;
;
; Exit:
;	Returns ax = PR_NotFound, PR_GoodSyntax or PR_BadSyntax
;	condition codes set based on value in [al]
;	cx = number of args scanned. 0 if no "(" found.
;if NOT FV_QB4LANG
;	NtELFlags contains output flags
;		NTEL_ARGS is set if an arg of the form x(), or