prsid.asm

Dos6.0

 	TITLE	prsid.asm - Parser ID Related NonTerminal Functions

;==========================================================================
;
;	Module:  prsid.asm - Parser ID Related NonTerminal Functions
;	Subsystem:  Parser
;	System:  Quick BASIC Interpreter
;
;	See Comments at top of prsnt.asm for rules for writing non-terminal
;	functions
;
;
;==========================================================================

	include		version.inc
	PRSID_ASM = ON

	includeOnce	architec
	includeOnce	context
	includeOnce	names
	includeOnce	opcodes
	includeOnce	parser
	includeOnce	pcode
	includeOnce	prstab
	includeOnce	prsirw
	includeOnce	psint
	includeOnce	qbimsgs
	includeOnce	scanner
	includeOnce	txtmgr
	includeOnce	ui
	includeOnce	util
	includeOnce	variable

	MAXARG EQU 60d	;BASCOM shared constant - max args to SUB/FUNC/DEF
	MAXDIM EQU 60d	;BASCOM shared constant - max args to DIM

ET_MAX_NOFIELDS = ET_MaxStr

FV_ARYELEM EQU 0


sBegin	DATA
assumes	ds,DATA
assumes ss,DATA

fLastIdIndexed	DW 1 DUP (?)

PUBLIC		oNamConstPs
oNamConstPs	DW 0	;non-zero if we're parsing a CONST expression

;pdcl is used to pass info from parser terminal recognizers like
;NtIdSubDecl, NtIdFn [QB4], etc. to the code generator CgDeclare():
;
PUBLIC		pdcl
pdcl		DB size PDCL_st DUP(?)


NTEL_ARGS EQU 0010h			;used as input flag to NtExprOrArg

	extrn	fMergeInSub:byte	;non-zero if MERGING into SUB/FUNC
					;only valid when FLoadActive is TRUE
sEnd	DATA

sBegin	CP
assumes	cs,CP

;====================================================================
; ID Syntactic Elements
;
;       Common identifier non-terminals referenced from bnf.prs
;
;	IdNamCom := idNoType
;	      occurs in COMMON /id/ statements	[QB4]
;	IdAry := id [()]
;	      occurs in SHARED statement. [QB4]
;	IdAryI := id [([integer])]
;	      occurs in STATIC, COMMON [QB4], and array in formal arg list for
;	IdAryElem := id [(arg, ... )]
;	      occurs in expressions, which can be array references or function
;	         invocations. [QB4]
;	IdAryElemRef := id [(arg, ... )]
;	      occurs in GET, LINE INPUT, INPUT, MID$, PUT, READ, RSET,
;	      SADD, SWAP, VARPTR, VARPTR$, VARSEG.
;	      Causes a Rf type Id opcode to be emitted.
;	IdArray() := id
;	      occurs in ERASE, LBOUND, UBOUND
;	IdAryGetPut() := id [(exp, ...)]
;	      occurs in GET, PUT, PALETTE USING statements [QB4]
;	IdAryDim := id [(exp [TO exp], ... )]
;	      occurs in DIM statement.
;	IdAryRedim := id (exp [TO exp], ... )
;	      occurs in REDIM statement.
;	IdFor := id
;	      occurs in FOR and NEXT statements
;	IdSubDef := id <no type char>
;	      occurs in SUB statement
;	IdSubDecl := id <no type char>
;	      occurs in DECLARE SUB statement
;	IdFuncDef := id
;	      occurs in FUNCTION statement
;	IdFuncDecl := id
;	      occurs in DECLARE FUNCTION statement
;	IdType := id
;	      occurs in TYPE statement and AS <type> clause
;	IdFn := FNid
;	      occurs in DEF FN statement
;	IdParm := [BYVAL | SEG] variable
;	      occurs in DECLARE, SUB, FUNCTION, DEF FN parm lists
;	NArgsMax3 := [arg [, [arg] [, arg]]]
;	      occurs in CLEAR and COLOR statements
;	NArgsMax4 := [arg [, [arg] [, [arg] [, arg]]]]
;	      occurs in SCREEN statement
;	NArgsMax5 := [arg [, [arg] [, [arg] [, [arg] [, arg]]]]]
;	      occurs in LOCATE statement
;
; ACTIONidCommon [QB4] - sets varmgr COMMON flag for all ids until end-of-stmt
; ACTIONidShared [QB4] - sets varmgr SHARED flag for all ids until end-of-stmt
; ACTIONidAuto [EB] - sets varmgr AUTO flag for all ids until end-of-stmt
; ACTIONidPublic [EB] - sets varmgr PUBLIC flag for all ids until end-of-stmt
; ACTIONidStatic - sets varmgr STATIC flag for all ids until end-of-stmt
;
;	NOTE [QB4] That it is ok for types, elements, labels, subs, and
;	   common block names to begin
;	   with FN.  It is not ok for scalars, FUNCTIONS or arrays to begin
;	   with FN.
;
;=======================================================================

opId_Ld		EQU opIdLd - opIdLd	;value to add to opIdLd
					; to get opIdLd
opId_Rf		EQU opIdLd - opIdLd	;value to add to opIdLd to get 
					; ref type opcode (same as Ld type)
opId_St		EQU opIdSt - opIdLd	;value to add to opIdLd
					; to get opIdSt
opId_VtRf	EQU opVtRf - opIdLd	;value to add to opIdLd
					; to get opIdVtRf
opId_Scalar	EQU opIdLd - opIdLd	;value to add to opIdxx opcode
					; to get scalar type opcode
opId_Array	EQU opAIdLd - opIdLd	;value to add to opIdxx opcode 
					; to get array type opcode

;*********************************************************************
; STATICF(boolean) FElements()
; Purpose:
;	Look ahead and see if we're looking at record seperator
; Entry:
;	pTokScan points to current token
; Exit
;	Returns zero condition codes iff record separator is seen
;	Alters bx, preserves all other registers (callers assume this)
;
;*********************************************************************
PUBLIC	FElements			
FElements PROC NEAR
	mov	bx,[pTokScan]
	cmp	[bx.TOK_class],CL_UNKNOWNCHAR
	jne	FeExit			;brif not "."
	cmp	[bx.TOK_unknownChar_unknownChar],"."
FeExit:
	ret
FElements ENDP

;*********************************************************************
; ushort NEAR BindVar(ax:pTok)
; Purpose:
;	If we're parsing to SS_PARSE, bind the variable identified by
;	the token 'pTok'.
; Entry:
;	ax = pTok.  points to a token descriptor for the id
;	mkVar is setup for a call to MakeVariable
; Exit:
;	ax = oVar
;
;*********************************************************************
PUBLIC	BindVar
BindVar	PROC NEAR
	push	ax			;save pointer to id's token
	xchg	bx,ax			;bx points to token

	or	[ps.PS_flags],PSF_fRef	;so text mgr knows to scan program
					; if in direct mode 
	TESTM	mkVar.MKVAR_flags,FVI_FNNAME	
	jne	GotFn			;brif id begins with FN
GotFnRet:
	mov	ax,[mkVar.MKVAR_oNam]	;potential return value
	test	[psFlags],PSIF_fBindVars
	je	BindExit		;brif parser not binding variables
					;return oNam (in ax) instead of oVar

	;let varmgr bind variable.
	;If parsing direct mode stmt, scan-state is same current text
	;table's, since if module is SS_RUDE, everything in module is
	
	mov	al,[bx.TOK_id_lexFlags]
	and	al,FLX_asSymConst	;0 if not 'x AS STRING * <sym const>
	or	al,al
	jz	BindVar_Cont

	or	[mkVar.MKVAR_flags2],MV_fONamInOTyp
BindVar_Cont:
	call	MakeVariable
	or	ax,ax			;high bit is set for errors
	js	BindErr			;brif error
BindExit:				;return oVar/oNam in ax
	pop	dx			;discard pTok parm
BindExit1:
	ret

;Make sure its not COMMON FNx or SHARED FNx etc.
GotFn:
	TESTM	mkVar.MKVAR_flags,<FVI_COMMON or FVI_STATIC or FVI_SHARED or FVI_ARRAY or FVI_DIM or FVI_ASCLAUSE or FVI_FORMAL>	
	je	GotFnRet		;brif not a declarative reference
	mov	ax,MSG_FNStart		
	;fall into BindErr

;MakeVariable detected some error, pass it to ParseLine
;in ps.errCode so it can return RudeEdit or ReParse.
;low byte has QBI Std Error Code 
;
BindErr:
	pop	bx			;bx points to token of interest (or 0)
	call	PErrVarMgr		;handle variable mgr error
	jmp	SHORT BindExit1
BindVar	ENDP

;*********************************************************************
; STATICF(boolean) EmitVar(pTok, opBase, cArgs, flags)
;
; Emit one of the following opcodes:
;	opAId<Ld|St|Rf>(<cArgs>,<oNam|oVar>)
;	opAVtRf(<cArgs>,<oNam|oVar>)
; The high bits of the opcode are set to give the explicit type if any. [25]
;
; Entry:
;	   pTok->dsc.id.oNam is the name table offset for the var being defined
;	   pTok->dsc.id.oTyp is the explicit type for the variable being defined
;	      (ET_IMP if id has no explicit type)
;	      (RefTyp(oNam) if it was in an AS clause)
;	   pTok->dsc.id.flags has one or more of the following bits set:
;	      FVI_LVAL      if on left side, or in INPUT, READ stmt
;	      FVI_INDEXED   if var followed by "(" - could be an array or Function
;	      FVI_ASCLAUSE  if var type declared via an AS clause
;	      FVI_DIM       if scalar was seen in a DIM stmt, so var mgr can
;		     detect a scalar being DIMed twice (BASCOM compatibility)
;	   opBase = opId_Ld or opId_St or opId_Rf or opId_VtRf
;	   flags.FEM_Ary means we saw an array, not a scalar
;	     cArgs = number of arguments seen within array's parenthesis
;	     cArgs must be set to 0 if called for a scalar
;	     flags.FEM_AryNoArgs means we saw an array with no (),
;	         like ERASE A.  cArgs = 0 in this case.
;	     flags.FEM_AryDim means we saw something like
;	         DIM(x to y,...)
;	         such that the number of args we pass to the scanner as
;	         an opcode argument is 2 * cArgs.  The number we pass
;	         to MakeVariable is cArgs.)
;	   flags.FEM_ElemOk is TRUE if .elem[.elem...] can be scanned
;	   pTokScan points to '.id' if any elements are to be parsed
;	   mkVar.flags has one or more of the following bits set:
;	      FVI_COMMON    if input is from a COMMON statement [QB4]
;	      FVI_STATIC    if input is from a STATIC statement
;	      FVI_SHARED    if SHARED keyword associated with var [QB4]
;	      The setting of any other flags in mkVar.flags are unimportant.
;	         (and any other bits for that matter)
;
;	      FVI_ARRAY will be set by if its a reference array id
;	      as opposed to load/store.  This tells MakeVariable that
;	      it is definately not a function.
;
; Exit:
;	If syntax error
;	   returns Carry Set and al=PR_BadSyntax after emitting error msg
;	else returns Carry Clear
;	If FV_SQL then if there is no error bx = oVar of variable emitted [34]
;
;*********************************************************************
FEM_Ary		EQU 1
FEM_AryNoArgs	EQU 2
FEM_AryDim	EQU 4
FEM_ElemOk	EQU 8
MKVAR_STATIC_FLAGS EQU FVI_COMMON + FVI_STATIC + FVI_SHARED
DbPub	EmitVar

cProc EmitVar,<NEAR>,<si,di>
	parmW pTok			
	parmW opBase
	parmB cArgs
	parmB flags
cBegin
	mov	si,[pTok]
	mov	ax,[si.TOK_id_oNam]
	mov	[mkVar.MKVAR_oNam],ax
	mov	ax,[mkVar.MKVAR_flags]	;ax = default flags
	and	ax,MKVAR_STATIC_FLAGS	;preserve these flags in mkVar.flags
	or	ax,[si.TOK_id_vmFlags]	;set token specific flags
					; this may set one or more of FVI_LVAL,
					; FVI_ASCLAUSE
					;ax = default flags for scalars
	test	[flags],FEM_Ary
	je	NotAry1			;brif we're emitting a scalar

	;FVI_INDEXED can be set for array or function references.
	;If this is a VTREF (declarative/GET/PUT/ERASE) opcode,
	;or an lvalue (assign,INPUT,READ) opcode,
	;tell MakeVariable this is an array and not a function by
	;setting FVI_ARRAY
	
if	FVI_INDEXED AND 0FFH		
	or	al,FVI_INDEXED		;[34] set FVI_INDEXED for arrays
else					
	or	ah,FVI_INDEXED / 100H	;set FVI_INDEXED for arrays
endif					
	TESTM	si.TOK_id_vmFlags,FVI_FNNAME	
	jne	NotAry1			;brif reference to DEF FN
	cmp	[opBase],opId_VtRf
	je	ItsAnArray		;brif we sure its an array
	cmp	[cArgs],0
	je	ItsAnArray		;ref like X() can't be function
	TESTM	mkVar.MKVAR_flags,FVI_LVAL	
	je	NotAry1			;brif it may be a function ref
ItsAnArray:
.errnz	FVI_ARRAY AND 0FFH
	or	ah,FVI_ARRAY / 100H
NotAry1:
	mov	[mkVar.MKVAR_flags],ax	;pass flags to MakeVariable
	mov	al,[cArgs]
	mov	[mkVar.MKVAR_cDimensions],al

	mov	ax,[si.TOK_id_oTyp]
	test	[flags],FEM_ElemOk
	je	EvNoElem		;brif ref cannot have elements
.errnz	ET_IMP
	or	ax,ax			;test for ET_IMP
	jne	EvNoElem		;brif ref is explicitly typed
	call	FElements		;try to parse .elem.elem...
					;ax is preserved as ET_IMP
	jne	EvNoElem		;brif variable not followed by "."
	mov	[mkVar.MKVAR_oTyp],UNDEFINED
					;tell MakeVariable to look for
					; record variable
	jmp	SHORT EvBind

;ax = si.TOK_id_oTyp
EvNoElem:
	mov	[mkVar.MKVAR_oTyp],ax
	and	[flags],NOT FEM_ElemOk	;remember id has no .elem after it
EvBind:
	mov	ax,si			;pass pTok in ax
	call	BindVar
	xchg	di,ax			;di = oVar
	test	[flags],FEM_ElemOk
	je	EvNoElem1		;brif didn't get .element
	mov	ax,opIdLd		
	test	[flags],FEM_Ary
	je	EvEmit			;brif scalar
	mov	ax,opAIdLd		
	jmp	SHORT EvEmit

EvNoElem1:
	TESTM	si.TOK_id_vmFlags,FVI_ASCLAUSE	
	je	EvNoAs
	mov	[si.TOK_id_oTyp],ET_IMP	;so DIM A(5) AS INTEGER won't list
					; like DIM A(5)% AS INTEGER

;if mkVar.oTyp is a USER DEFINED TYPE, we need
;to emit a opAIdLd or opAIdSt with no explicit type.
;EmitOpcode( (pTok->dsc.id.oTyp <= ET_MAX) ?
;               opIdLd + opBase + opId_Array | pTok->dsc.id.oTyp << 10 :
;            (opBase == opId_St) ? opAIdSt :
;            (opBase == opId_VtRf) ? opAVtRf : opAIdLd)
;
EvNoAs:
	mov	bx,CPOFFSET twOpIdMap
	mov	cx,opIdLd		
	test	[flags],FEM_Ary
	je	NotAry3			;brif we're emitting a scalar
	mov	bx,CPOFFSET twOpAIdMap
	mov	cx,opId_Array + opIdLd	
NotAry3:
	mov	ax,[opBase]
	mov	dx,[si.TOK_id_oTyp]
	cmp	dx,ET_MAX
	ja	EvUserTyp		;brif user defined type
	add	ax,cx			;ax = opcode to emit 
.errnz OPCODE_MASK - 3FFh		
	shl	dx,1			
	shl	dx,1			
	or	ah,dl			;ax = opcode with high bits set
					;     to the explicit type if any
	jmp	SHORT EvEmit

EvUserTyp:
	call	MapBaseOp		;ax = opcode for opBase in ax
EvEmit:
	call	Emit16_AX		;Emit16(opcode)
	test	[flags],FEM_Ary
	je	NotAry2			;brif we're emitting a scalar
	mov	ax,8000H		;cArgs for ERASE A and friends
					;high-bit tells lister not to list ()
	test	[flags],FEM_AryNoArgs
	jne	EvNotDim		;brif no args, like ERASE A
	mov	al,[cArgs]
	sub	ah,ah			;ax = al = cArgs



	test	[flags],FEM_AryDim
	je	EvNotDim		;brif not DIM array
	;for DIM x(1 TO 2, 2 TO 3), tell scanner that cArgs = 4
	shl	ax,1			;ax = cArgs * 2



EvNotDim:				;brif not DIM array
	call	Emit16_AX		;emit cArgs
NotAry2:
	push	di			;Emit16(oVar)