varutil.asm

Dos6.0

ClearPV_Exit:
	jmp	short Clear_Exit

Clear_Not_Array:
	lea	cx,[bx.VAR_value]
	GetOtyp	ax,[bx]			;ax = oTyp for this variable

	cmp	ax,ET_SD
	jnz	Clear_Not_SD		;brif not clearing an SD

	push	ax			;preserve across call
	push	cx			; preserve across call
	push	dx			; preserve across call
	cCall	B$STDL,<cx>		;release the SD
	pop	dx			
	pop	cx			
	pop	ax
Clear_Not_SD:
	push	bx			; save pVar
	mov	bx,[oMrsCur]		;in case we're clearing a prs in some
					;  module other than mrsCur
	call	CbTypOTypOMrs		; returns ax = cb for given type
	pop	bx			; restore pVar
	jnz	Clear_ZeroFill		

	; fixed-length string - - - get count of bytes to fill from var entry
	mov	ax,[bx.VAR_cbFixed]	
Clear_ZeroFill:
	push	dx			; preserve across call
	cCall	ZeroFill,<cx,ax>	
	pop	dx			
Clear_Table_Next:
	call	NextVar_Clear		;ax = oVar or UNDEFINED, bx = pVar
	jmp	Clear_Table_Loop
	
Clear_Table_Exit:
	pop	si
Clear_Exit:
	or	ax,sp			;non-zero exit, per interface
cEnd	ClearPV

;***
;CbTyp(oTyp) - Return the size of a value of given type
;Purpose:
;	This routine returns the number of bytes of data required for
;	the input type. Note that this will work for both predefined and
;	user-defined types.
;Input:
;	oTyp
;Output:
;	ax = cbTyp - i.e., the size of a value of the given type.
;Modifies:
;	none
;***************************************************************************
cProc	CbTyp,<NEAR,PUBLIC,NODATA>
	parmW	oTyp
cBegin	CbTyp
	mov	ax,[oTyp]
	call	CbTypOTyp		;returns with result in AX
cEnd	CbTyp

;***
;CbTypOTyp, CbTypOTypOMrs
;Purpose:
;	This routine returns the number of bytes of data required for
;	the input type. Note that this is called directly from the scanner
;	use CbTyp (above) for a C interface to this routine.
;
;	CbTypOTyp assumes that if the oTyp is a user-defined type, it is
;			an offset into mrsCur.MRS_bdVar.
;	CbTypOTypOMrs uses the MRS_bdVar table in the mrs whose oMrs is
;			given in bx.
;Input:
;	ax = oTyp
;	for CbTypOTypOMrs, bx = oMrs of type table
;Output:
;	ax = cbTyp
;	for input oTyp of ET_FS, ax = zero.
;	PSW flags set based on an OR AX,AX on exit
;Prserves:
;	all (even bx)
;***************************************************************************
;The CbTyp code below was significantly reworked throughout for revision [9]
mpCbTyp label byte
	DB	0		;ET_IMP hole
	.errnz	ET_IMP - 0
	DB	2		;ET_I2
	.errnz	ET_I2  - 1
	DB	4		;ET_I4
	.errnz	ET_I4  - 2
	DB	4		;ET_R4
	.errnz	ET_R4  - 3
	DB	8		;ET_R8
	.errnz	ET_R8  - 4
	DB	SIZE SD 	;ET_SD
	DB	0		;ET_FS - - - can't tell size from ET_ type

	.errnz	ET_SD - 5
	.errnz	ET_FS - 6

	.errnz	ET_MAX - ET_FS	;Ensure this is found if someone adds a type.

	PUBLIC	CbTypOTypOMrs
	PUBLIC	CbTypOTyp
CbTypOTypOMrs	PROC	NEAR
	push	bx
	jmp	short CbTypOTyp_Cont
CbTypOTyp:
	push	bx
	mov	bx,[grs.GRS_oMrsCur]	
	DbChk	oTyp,ax 		;sanity check on input oTyp
CbTypOTyp_Cont:
	cmp	ax,ET_MAX		;Is it a fundamental type?
	ja	NotPredefinedType	;  brif not - user defined

	mov	bx,offset mpCbTyp	;base of lookup table in CS
	xlat	byte ptr cs:[bx]	;al == desired size
	pop	bx
	or	ax,ax			;set PSW flags
	ret

NotPredefinedType:
	test	[conFlags],F_CON_StaticStructs
	jz	Mrs_In_Table		;brif mrsCur not set up

	cmp	bx,[grs.GRS_oMrsCur]
	jz	Want_MrsCur		;brif passed oMrs is for mrsCur

Mrs_In_Table:
	RS_BASE add,bx			; bx points into Rs table
	GETRS_SEG es			
	jmp	short Got_pMrs

Want_MrsCur:				;ax is an offset into type table
	lea	bx,mrsCur		;  found in the current mrs
	SETSEG_EQ_SS es 		
Got_pMrs:
	add	ax,PTRRS[bx.MRS_bdVar.BD_pb] ;[2] ax = pTyp
	xchg	bx,ax			;bx = oTyp, ax = garbage
	mov	ax,[bx].TYP_cbData	;ax = cbData from type table entry
	pop	bx
	or	ax,ax			;set PSW flags
	ret
CbTypOTypOMrs	ENDP


;***
;StdSearch() - search the appropriate hash table with standard algorithm
;Purpose:
;	Search the appropriate table (tPV or tMV) in the typical case.
;Entry:
;	vm_fPVCur - module static flag, TRUE if we're to search tPV, FALSE if 
;			tMV.
;	mrsCur.bdVar assumed set up, and if vm_fPVCur is TRUE, prsCur is 
;		assumed	to be set up, and the oVarHash field is either 
;		UNDEFINED (in which case we just return), or contains an 
;		offset into mrsCur.bdVar to the tPV hash table.
;	mkVar set up as per MakeVariable (below).
;Exit:
;	FALSE = no error
;	otherwise, the same error code is returned as described for MakeVariable
;
;	If no error is returned, then the static vm_fVarFound indicates 
;		success or failure. 
;	If vm_fVarFound == TRUE, vm_oVarCur is set to the offset into 
;		mrsCur.bdVar to the found variable entry, and vm_pVarCur 
;		points to the entry.
;Exceptions:
;	none.
;******************************************************************************
	PUBLIC	StdSearch
StdSearch	PROC	NEAR
	mov	[vm_fVarFound],FALSE		;initialize
	mov	bx,[mkVar.MKVAR_oNam]
	and	bx,HASH_MV_NAMMASK
	.errnz	(HASH_MV_NAMMASK AND HASH_PV_NAMMASK) - HASH_PV_NAMMASK
	cmp	[vm_fPVCur],FALSE
	jz	StdSearch_Cont1			;brif no prs active

	and	bx,HASH_PV_NAMMASK
	add	bx,[prsCur.PRS_oVarHash]
StdSearch_Cont1:
	push	si
	mov	si,[mrsCur.MRS_bdVar.BD_pb]	;ptr to base of var table
	mov	ax,[bx][si]
	or	ax,ax				;empty hash chain?
	jz	StdSearch_Exit_2		;brif so; ax already 0 for retvl

	push	di
	mov	di,ax
	mov	WORD PTR [oTypNew],UNDEFINED	;if something else on exit and
						;  search succeeded, set
						;  mkVar.MKVAR_oTyp to oTypNew
	add	di,si
	mov	cx,[mkVar.MKVAR_oNam]
StdSearch_Loop:
	cmp	si,di				;end of hash chain?
	je	False_Exit			;  brif so

	cmp	[di.VAR_oNam],cx
	je	Got_oNam			;brif oNam's match
Next_Var_Entry1:
	mov	di,[di.VAR_oHashLink]		;offset to next entry in chain
	and	di,0FFFEH			;mask off low bit
	add	di,si				;offset ==> pointer
	jmp	short StdSearch_Loop

StdSearch_Exit_2:
	jmp	StdSearch_Exit_1		;ax already 0 for retval

False_Exit:
	sub	ax,ax
	jmp	StdSearch_Exit

Shared_Or_Const:
	TESTX	cx,<FVSTATIC OR FVFORMAL OR FVCONST>	
	jnz	StdSearch_DD_Err		; Duplicate definition
	jmp	short StdSearch_Cont2

Got_oNam:
	;register usage:
	;	BX = oTyp  for current entry
	;	CX = di.VAR_flags 	i.e., flags for current entry
	;	DX = mkVar.MKVAR_flags	i.e., flags from input
	
	mov	dx,[mkVar.MKVAR_flags]
	mov	cx,[di.VAR_flags]
	TESTX	dx,<FVSHARED OR FVCONST>	
	jnz	Shared_Or_Const			;brif input is nmodule shared

StdSearch_Cont2:
	GetOtyp	bx,[di]				;bx = oTyp for this variable
	mov	ax,[mkVar.MKVAR_oTyp]
	cmp	bx,ax				;do types match?
	jnz	StdSearch_Cont2a		; brif not

	cmp	ax,ET_FS			
	jnz	StdSearch_Cont3a		; brif not fixed-length string

	push	ax				
	mov	ax,[di.VAR_cbFixed]		
	cmp	ax,[mkVar.MKVAR_fsLength]	
	pop	ax
	jz	StdSearch_Cont3a		; branch if lengths match

StdSearch_Cont2a:
	TESTX	dx,FVASCLAUSE			
	jnz	StdSearch_DD_Err		; brif input AS bit set

	TESTX	cx,<FVDECLDVAR OR FVCONST>	
	jnz	Has_Name_Space			;brif CONST or declared in an
						;  AS clause or FUNCTION name
	TESTX	dx,FVCONST			
	jnz	RP_DD_Err
	jmp	short Next_Var_Entry		;types don't match


StdSearch_DD_Err:
	mov	ax,PRS_ER_RE OR ER_DD
StdSearch_Err_Exit:
	jmp	StdSearch_Exit

StdSearch_Cont3a:
	TESTX	dx,FVASCLAUSE			
	jz	StdSearch_Cont3 		; brif not AS clause

	TESTX	cx,<FVFUN OR FVCONST>		; brif entry flags have a bit
	jne	StdSearch_DD_Err		;  inconsistent w/AS clause

	mov	ax,PRS_ER_RE OR MSG_ASRqd1st	;assume AS clause NOT in 1st ref
	TESTX	cx,FVDECLDVAR			
	jz	StdSearch_Err_Exit		;brif error
	jmp	short OTyp_Matches

Has_Name_Space:
	TESTX	dx,FVIMPLICIT			
	jnz	Has_Name_Space_1		;brif input implicity typed

	cmp	ax,ET_SD			;is input oTyp ET_SD?
	jnz	RP_DD_Err			;brif not - error

	cmp	bx,ET_FS			;is entry oTyp a Fixed Length
	jnz	RP_DD_Err			;  string? brif not - error
Has_Name_Space_1:
	inc	ax
	.errnz	UNDEFINED - 0FFFFH
	jnz	Has_Name_Space_3		;brif input oTyp != UNDEFINED

	cmp	bx,ET_MAX
	ja	Has_Name_Space_2		;brif entry type not predefined

	TESTX	cx,FVCONST			
	jz	RP_DD_Err			;brif entry not a CONST - error
Has_Name_Space_2:
	cmp	bx,ET_FS			
	jnz	Has_Name_Space_3		; brif entry oTyp not F.L. String
RP_DD_Err:
	mov	ax,PRS_ER_RP OR ER_DD
	jmp	StdSearch_Exit

Owns_Name_Space:
	TESTX	dx,<FVCOMMON OR FVSHARED OR FVDIM OR FVSTATIC>	
	jz	OTyp_Matches

	test	cl,FVFUN
	jnz	StdSearch_DD_Err

	test	dl,FVSTATIC
	jnz	StdSearch_DD_Err

	test	dl,FVCOMMON
	jz	AS_Rqd_Error

	TESTX	cx,FVARRAY			
	jz	StdSearch_DD_Err
AS_Rqd_Error:
	mov	ax,PRS_ER_RE OR MSG_ASRqd
	jmp	StdSearch_Exit
Has_Name_Space_3:
	mov	[oTypNew],bx			;give actual type back to user

StdSearch_Cont3:
	TESTX	cx,FVDECLDVAR			
	jnz	Owns_Name_Space			;brif entry owns name space

;At this point, we know that the oNam and oTyp matches - - - now check flags
OTyp_Matches:
	TESTX	dx,FVFORCEARRAY			
	jnz	Inp_Definite_Array		;brif input is a definite array

StdSearch_Cont4:
	TESTX	dx,FVINDEXED			
	jz	Not_Indexed			;brif input var not indexed

	TESTX	cx,<FVARRAY OR FVFUN>		
	jnz	StdSearch_Cont5

Next_Var_Entry:
	mov	cx,[mkVar.MKVAR_oNam]		;ditto
	jmp	Next_Var_Entry1

Inp_Definite_Array:
	or	dx,FVINDEXED
	mov	[mkVar.MKVAR_flags],dx		;ensure FVINDEXED flag is set

	TESTX	cx,FVFUN			; is entry a FUNCTION?
	jnz	StdSearch_DD_Err1		;brif so - error

	TESTX	cx,FVARRAY			; is entry an array?
	jz	Next_Var_Entry
;[J1]	Check if current entry is VALUESTORED
;[J1]		if NOT VALUE STRORED then it is either a $DYNAMIC or an Auto
;[J1]			array in which case adding a DIM is okay.
;[J1]		if VALUESTORED that means that space for the var has already
;[J1]			been allocated and another check must be made to see
;[J1]			if it is a STATIC or DYNAMIC.
;[J1]	NOTE:  We must perform the this test first before we make the
;[J1]	       next check that tests if current entry is a static array
;[J1]	       because it is not valid if not FVVALUESTORED.
	TESTX	cx,FVVALUESTORED		;[J1] Is there an array desc.?
	jz	StdSearch_Cont5			;[J1] brif no array desc.

;[J1]	There is an array descriptor present so now we have to see if it is
;[J1]	static or dynamic.  If it static then we have to make sure that this
;[J1]	is not a DIM because then this would be a double definition.  If
;[J1]	dynamic then multiple DIMs are okay.
	test	BYTE PTR [di.VAR_value.ASTAT_ad.AD_fFeatures],FADF_STATIC
	jnz	Check_For_Dim_Err		;[J1] Check if this is a DIM
	jmp	short StdSearch_Cont5		;[J1] accept it.

StdSearch_DD_Err1:
	jmp	StdSearch_DD_Err

RP_DD_Err1:
	jmp	RP_DD_Err

Not_Indexed:
	TESTX	dx,FVFORCEARRAY			; is input a definite array?
	jnz	Check_For_Dim_Err		;  brif so

	TESTX	cx,FVARRAY			; is entry an array?
	jnz	Next_Var_Entry			;  brif so - no match

Check_For_Dim_Err:
	TESTX	dx,FVDIM			; input found in a DIM 
						;   statement?
	jnz	StdSearch_DD_Err1		;  brif so - DD error

StdSearch_Cont5:
	TESTX	cx,FVCONST			; is entry a CONST?
	jnz	Entry_Is_Const			;  brif so

	;now ensure that a proc ref. doesn't match a retval:
	cmp	[vm_fPVCur],FALSE
	jz	StdSearch_Cont6			;brif no prs active

	TESTX	cx,FVFUN			; is entry a FUNCTION or 
						;  DEF FN?
	jz	StdSearch_Cont6			;brif not

	TESTX	dx,FVLVAL			; input seen on left side 
						;  of eq.?
	jnz	StdSearch_Cont6			;brif so - - this is a retval
	jmp	Next_Var_Entry			;don't allow a ref. to match
						;  a retval
StdSearch_Cont6:
	TESTX	cx,FVARRAY			; is entry an array?
	jnz	StdSearch_Array_Checks		;brif so
	jmp	StdSearch_Cont7

Entry_Is_Const:
	FVTEMP EQU FVCOMMON OR FVSTATIC OR FVSHARED OR FVFORMAL OR FVFNNAME
						;shorthand, so all will fit on
						;  on line!
	TESTX	dx,<FVTEMP OR FVFUNCTION OR FVLVAL OR FVDIM OR FVASCLAUSE> 
	jnz	RP_DD_Err1			;brif any of the above flags set