prsid.asm

Dos6.0

; Exit:
;	If successfully parsed,
;	   no pcode is emitted, but value is stored beyond end
;	      of pcode buffer,
;	   bx points to value,
;	   al = PR_GoodSyntax
;	else
;	   al = PR_NotFound or PR_BadSyntax
;	Condition codes are set based on value in al
;
;*********************************************************************
NtLitI2NoCode PROC NEAR
	call	NtLitI2			;consume integer, emit 2 byte value
	jle	NoI2			;brif no integer found, or snerr
	sub	[ps.PS_bdpDst.BDP_cbLogical],2 ;eliminate pcode emitted by NtLitI2
	mov	bx,[ps.PS_bdpDst.BDP_pbCur] ;bx points beyond emitted value
	dec	bx			;pbCur -= 2
	dec	bx
	mov	[ps.PS_bdpDst.BDP_pbCur],bx
	or	al,al			;set condition codes for caller
NoI2:
	ret
NtLitI2NoCode ENDP

;*********************************************************************
; PARSE_RESULT NEAR NtIdAry()
;
; Purpose:
;	Try to parse a scalar or array id of the form: id [()] [AS <type>]
;	This can occur in the following statements:
;	   SHARED IdAry {tkComma IdAry}
;
; Exit:
;	Returns PR_NotFound, PR_GoodSyntax or PR_BadSyntax
;
;*********************************************************************
PUBLIC	NtIdAry
NtIdAry	PROC NEAR
	mov	ax,IDM_INDEXED OR IDM_VTREF OR IDM_AS
	jmp	SHORT NtId
NtIdAry	ENDP

;*********************************************************************
; PARSE_RESULT NEAR NtIdAryElem()
;
; Purpose:
;	Try to parse a scalar or array element of the form:
;	   id[<type>] [(exp, ... )] [.id[.id...]]
;	This can occur in the following statements:
;	   FIELD #n, 15 AS IdAryElem, 20 as IdAryElem [QB4]
;	   MID$ (IdAryElem, 5, 3) = exp
;	   LSET IdAryElem = exp
;	   RSET IdAryElem = exp
;	   NtExp() calls this for any id's encountered within expressions
;
; Exit:
;	Returns PR_NotFound, PR_GoodSyntax or PR_BadSyntax
;
;*********************************************************************
PUBLIC	NtIdAryElem
NtIdAryElem PROC NEAR
	mov	ax,IDM_INDEXED OR IDM_EXP OR IDM_ARGS OR IDM_ELEM
	jmp	SHORT NtId
NtIdAryElem ENDP

;*********************************************************************
; PARSE_RESULT NEAR NtIdAryElemRef()
;
; Purpose:
;	Try to parse a scalar or array element of the form:
;	   id[<type>] [(exp, ... )]
;	and emit a Rf Id opcode.
;	This can occur in the following statements:
;	   INPUT IdAryElem
;	   LINE INPUT IdAryElem
;	   READ IdAryElem
;	   y = VARPTR(IdAryElem)
;
; Exit:
;	Returns PR_NotFound, PR_GoodSyntax or PR_BadSyntax
;
;*********************************************************************
PUBLIC	NtIdAryElemRef
NtIdAryElemRef PROC NEAR
	mov	ax,IDM_INDEXED OR IDM_EXP OR IDM_REF OR IDM_ELEM
	jmp	SHORT NtId
NtIdAryElemRef ENDP

;*********************************************************************
; PARSE_RESULT NEAR NtIdAryGetPut()
;
; Purpose:
;	Try to parse a scalar or array element of the form:
;	   id[<type>] [(exp, ... )]
;	This can occur in the following statements:
;	   GET (10,10)-(20,20),IdAryGetPut
;	   PUT (10,10),IdAryGetPut
;	   PALETTE USING IdAryGetPut
;
; Exit:
;	Returns PR_NotFound, PR_GoodSyntax or PR_BadSyntax
;
;*********************************************************************
PUBLIC	NtIdAryGetPut
NtIdAryGetPut PROC NEAR
	mov	ax,IDM_INDEXED OR IDM_EXP OR IDM_ARRAY	
	jmp	SHORT NtId
NtIdAryGetPut ENDP

;*********************************************************************
; PARSE_RESULT NEAR NtIdAryI()
;
; Purpose:
;	Try to parse a scalar or array id of the form:
;	   id [([<integer>])] [AS <type>]
;	This can occur in the following statement:
;	   STATIC IdAryI {tkComma IdAryI}
;	   COMMON [SHARED] [/id/] IdAryI {tkComma IdAryI} [QB4]
;
; Exit:
;	Returns PR_NotFound, PR_GoodSyntax or PR_BadSyntax
;
;*********************************************************************
PUBLIC	NtIdAryDim2
NtIdAryDim2	LABEL	NEAR



PUBLIC	NtIdAryI
NtIdAryI PROC NEAR
	mov	ax,IDM_INDEXED OR IDM_CONST OR IDM_VTREF OR IDM_AS
	jmp	SHORT NtId
NtIdAryI ENDP

;*********************************************************************
; PARSE_RESULT NEAR NtIdArray()
;	Parse an identifier of the form:   "id"
;	This can occur in the following statements:
;	   ERASE IdArray {tkComma IdArray}
;	   PALETTE [USING IdArray]...
;
;*********************************************************************
PUBLIC	NtIdArray
NtIdArray PROC NEAR
	mov	ax,IDM_ARRAY		
	jmp	SHORT NtId
NtIdArray ENDP

;*********************************************************************
; PARSE_RESULT NEAR NtIdFor()
;
; Purpose:
;	Try to parse an identifier of the form:  id [<type>]
;	This can occur in the following statements:
;	   FOR IdFor ...
;	   NEXT IdFor ...
;
; Exit:
;	Returns PR_NotFound, PR_GoodSyntax or PR_BadSyntax
;
;*********************************************************************
PUBLIC	NtIdFor
NtIdFor PROC NEAR
	mov	ax,IDM_REF
	jmp	SHORT NtId
NtIdFor ENDP

;*********************************************************************
; PARSE_RESULT NEAR NtId(ax:mask)
;
; Purpose:
;	Try to parse an id.  The legal format of the ID depends on the bits
;	set in the input parameter 'mask'.
;
; Entry:
;	If the static variable [oNamConstPs] is non-zero, variables which
;	   are not CONSTANT are not allowed
;	ax:mask's bits have the following meanings:
;	   If no bits in mask are set, the only syntax allowed is ID
;	   IDM_INDEXED: ID can be (but need not be) followed by ()
;	      IDM_CONST: (<integer constant>) can (but need not) follow ID
;	      IDM_EXP: exp [,...] must follow ID( if ( is seen
;	      IDM_OEXP: exp [,...] can (but need not) follow ID( if ( is seen
;	         IDM_DIM: each exp can be followed by [TO exp]
;	         IDM_ARGS: each exp can be preceded by BYVAL or SEG
;	            and each exp can be of the form id() or a normal expression
;	   IDM_ARRAY: an array id opcode is emitted even if no
;	      indecies are seen
;	   IDM_AS: id can be followed by [AS id]
;	   IDM_ELEM: id can be followed by [.id[.id...]]
;	   By default, either opIdLd... or opAIdSt... is emitted
;	   IDM_REF : causes opIdRf... or opAIdRf... to be emitted
;	   IDM_VTREF : causes opIdVtRf... or opAIdVtRf... to be emitted
;
;	For example:
;	   SHARED IdAry : IDM_INDEXED | IDM_AS [QB4]
;	   STATIC IdAryI : IDM_INDEXED | IDM_CONST | IDM_AS
;	   ERASE IdArray : IDM_ARRAY
;	   DIM IdAryDim : IDM_INDEXED | IDM_EXP | IDM_DIM | IDM_VTREF | IDM_AS
;	   PUT (10,20),IdAryGetPut : IDM_INDEXED | IDM_EXP | IDM_ARRAY
;	   FOR IdFor : IDM_REF
;	   INPUT IdAryElemRef : IDM_INDEXED | IDM_EXP | IDM_REF | IDM_ELEM
;	   NtExp() calls NtIdAryElem, which calls NtId with :
;	      IDM_INDEXED | IDM_EXP | IDM_ARGS
;
; Exit:
;	If id was indexed, fLastIdIndexed is TRUE, else it is FALSE
;	Returns PR_NotFound, PR_GoodSyntax or PR_BadSyntax in al.
;	Condition codes set based on value in al
;	If result is PR_GoodSyntax, bumps cIdArgs by 1, no matter what
;	   recursion takes place
;	For FV_SQL bx = oVar of emitted variable if variable ref was emitted.
;
;*********************************************************************

;word masks for 'flags'
IDM_INDEXED  EQU 0001H
IDM_CONST    EQU 0002H
IDM_EXP      EQU 0004H
IDM_OEXP     EQU 0008H
IDM_ARGS     EQU 0010H
IDM_DIM      EQU 0020H
IDM_ARRAY    EQU 0040H
IDM_REF      EQU 0080H
IDM_VTREF    EQU 0100H
IDM_ELEM     EQU 0200H
IDM_AS       EQU 0400H
IDM_NOSCALAR EQU 0800H	

;low-byte masks
IDM1_INDEXED  EQU 01H
IDM1_CONST    EQU 02H
IDM1_EXP      EQU 04H
IDM1_OEXP     EQU 08H
IDM1_ARGS     EQU 10H
IDM1_DIM      EQU 20H
IDM1_ARRAY    EQU 40H
IDM1_REF      EQU 80H

;high-byte masks
IDM2_VTREF    EQU 01H
IDM2_ELEM     EQU 02H
IDM2_AS       EQU 04H
IDM2_NOSCALAR EQU 08H	

cProc	NtId,<PUBLIC,NEAR>,<si,di>
	localW	maskW
	maskLO  EQU BYTE PTR (maskW)
	maskHI  EQU BYTE PTR (maskW+1)
	localV	tokId,%(size TOK)
	localW	opBase
	localW	flags
	flagsLO  EQU BYTE PTR (flags)
;Register usage:  di = oDstExp, si = cArgs
cBegin
	push	[cIdArgs]		;save caller's cIdArgs
	mov	[maskW],ax
	sub	al,al			;prepare to return PR_NotFound
	call	IdTok			;bx points to current token
	je	GotId			;brif its an id token
	jmp	NtIdExit		;brif not an id
GotId:
.erre opId_Ld EQ 0
	xor	ax,ax			;ax = opId_Ld
	test	[maskLO],IDM1_REF
	je	NotRefId		;brif not a REFERENCE id
	mov	ax,opId_Rf
	jmp	SHORT SetOpBase
NotRefId:
	test	[maskHI],IDM2_VTREF
	je	SetOpBase		;brif not a VarTab REFERENCE id
	mov	ax,opId_VtRf

;ax = opId_xxx (which class of opId to emit)
SetOpBase:
	mov	[opBase],ax
	;save important information about this token id.
	lea	bx,tokId
	call	CopyTokScanBx		;copy token [pTokScan] to [bx], ScanTok
					; using NtACTIONidDim
	test	[maskLO],IDM1_DIM
	je	NotDim			;brif id is not in DIM stmt
	;var mgr reports duplicate defn for DIM A: DIM A or DIM FNA
	or	[tokId.TOK_id_vmFlags],FVI_DIM
NotDim:
	sub	dx,dx			;default value for flags
	mov	al,[maskHI]
	and	al,IDM2_ELEM		;al = non-zero if .elem can follow id
	je	NoElem
	or	dl,FEM_ElemOk		;tell EmitVar that .elem is ok
NoElem:
	mov	[flags],dx
	test	[maskLO],IDM1_INDEXED
	je	NotIndexed		;brif (...) cannot follow id
	mov	ax,IRW_LParen
	call	TestScan_AX
	jne	TestNoScalar		
DJMP	jmp	SHORT IndexedId		; brif got an indexed id
TestNoScalar:				
	test	[maskHI],IDM2_NOSCALAR	
	jz	NotIndexed		
	mov	ax,IRW_LParen		
	call	PErrExpRw_Ax		
	jmp	SHORT J1_NtIdSnErr	
NotIndexed:
	test	[maskLO],IDM1_ARRAY
	je	NotUnindexedArray

	;got unindexed array reference like ERASE A
	lea	ax,[tokId]
	push	ax			;pass pointer to id's token
	push	[opBase]		;load/store/ref/vtref indicator
	PUSHI	ax,0			;arg count
	or	[flagsLO],FEM_Ary OR FEM_AryNoArgs
	push	[flags]
	call	EmitVar			;emit array id opcode
	jmp	SHORT ChkResult

;got scalar id reference
NotUnindexedArray:
	test	[maskHI],IDM2_AS
	je	NotAsScalar		;brif AS <type> is not allowed here
	sub	ax,ax
	lea	bx,[tokId]
	call	NtAsClause		;parse "AS <type>" clause
	jl	J1_NtIdSnErr		;brif result == PR_BadSyntax
NotAsScalar:
	mov	ax,[tokId.TOK_id_oNam]
	cmp	ax,[oNamConstPs]
	je	BadConst		;brif self-referencial CONST x=x
					; this is needed in case we're in
					; a procedure, and there is a global
					; level CONST x=n stmt.
	lea	ax,[tokId]
	push	ax			;pass ptr to token's id
	push	[opBase]		;load/store/ref indicator
	PUSHI	ax,0			;cArgs = 0
	push	[flags]
	call	EmitVar			;emit a scalar id opcode

;condition codes = result of calling EmitVar
ChkResult:
	jc	J1_NtIdSnErr		;brif bad syntax
	mov	[fLastIdIndexed],FALSE	;tell caller last id was not indexed
	cmp	[oNamConstPs],0
	je	J1_NtIdEnd		;brif not in CONST a=<expression> stmt
	test	[psFlags],PSIF_fBindVars
	je	J1_NtIdEnd		;brif parser not binding variables
					;rude scanner will check for this error
	TESTM	mkVar.MKVAR_flags2,MV_fConstFound	
	jne	J1_NtIdEnd		;brif CONST id = constant
					;else got CONST id = variable
BadConst:
	mov	ax,MSG_InvConst		;Error: Invalid Constant
	call	PErrMsg_AX		; al = PR_BadSyntax
J1_NtIdSnErr:
	jmp	SHORT J2_NtIdSnErr

J1_NtIdEnd:
	jmp	NtIdEnd

;got an indexed id
IndexedId:
	cmp	[oNamConstPs],0
	jne	BadConst		;brif in CONST a=<expression> stmt
					;can't have CONST a=z(i)
	or	[flagsLO],FEM_Ary	;tell EmitVar this is an array/func
	sub	si,si			;cArgs = 0
	call	ScanTok			;skip past left paren

	;Now that we've consumed at least 1 token, we can only return
	;PR_GoodSyntax or PR_BadSyntax
	
	test	[maskLO],IDM1_CONST
	je	NoOptConst		;brif not looking for X(literal) syntax
					; like COMMON x(3) [QB5] or STATIC x(2)
	call	NtLitI2NoCode		;scan optional integer (ignore value)
	jl	J2_NtIdSnErr		;brif result == PR_BadSyntax
NtIdNoArg:
DJMP	jmp	SHORT NtIdGetRParen	

NoOptConst:
	TESTM	maskW,<IDM_EXP OR IDM_OEXP>	
	je	NtIdNoArg
;scan arguments/indicies, can have a number of arguments inside ()
NtIdArgLoop:
	mov	di,[ps.PS_bdpDst.BDP_cbLogical] ;di = oDstExp
.erre NTEL_ARGS EQ IDM_ARGS
	mov	ax,[maskW]		
	call	NtExprOrArg		
	jl	J2_NtIdSnErr		;brif result == PR_BadSyntax
	je	NtIdEndArgs		;brif result == PR_NotFound
BumpCArgs:
	inc	si			;bump cArgs
	test	[maskLO],IDM1_DIM
	je	GetComma

	;each index to DIM represents 2 scanner arguments, but 1
	;arg to MakeVariable.  We communicate this to
	;EmitVar() by passing FEM_AryDim in [flags]
	
	or	[flagsLO],FEM_AryDim
	mov	ax,IRW_TO
	call	TestScan_AX
	jne	NoToClause		;brif didn't get TO
	call	ScanTok			;skip TO
	call	NtConsumeExp		;consume high index
	jge	GetComma		;brif result != PR_BadSyntax
J2_NtIdSnErr:
	jmp	short NtIdSnErr		;brif syntax error

;default lower bound
NoToClause:
	PUSHI	ax,<DATAOFFSET ps.PS_bdpDst>
	push	di			;pass oDstExp
	PUSHI	ax,2