varutil.asm

Dos6.0

	push	di
	xor	di,di			;tell SsAdjustCommon to release owners
					;  rather than to adjust them
	mov	bx,si
	add	bx,COM_bdType		; point to bdType for this block
	call	SsAdjustCommon
	pop	di

	xor	ax,ax
	test	[mrsCur.MRS_flags],FM_VARNEW	; called from VarDealloc?
	jz	NoBashTypeTable 		; brif not
	mov	[si.COM_bdType.BD_cbLogical],ax ; type table no longer valid
NoBashTypeTable:				

	cmp	[fResetCommon],al	;want to release COMMON block tables?
	jz	Zero_Common		;  brif not - - just set values to zero

	;reset tables to size zero in case this is blank common
	mov	[si.COM_bdType.BD_cbLogical],ax
	cmp	[si.COM_bdValue.BD_cbPhysical],UNDEFINED
	jz	ClearCommon_Reset_Cont	;brif bdValue table is for a U.L. block
					; - - - leave U.L. block bdValue alone
	mov	[si.COM_bdValue.BD_cbLogical],ax
ClearCommon_Reset_Cont:

	cmp	si,[grs.GRS_bdtComBlk.BD_pb]
	jz	ClearCommon_Loop	;don't ever release blank COMMON tables

	lea	ax,[si.COM_bdType]
	cCall	BdFree,<ax>		;free the table of oTyps for this block
	cmp	[si.COM_bdValue.BD_cbPhysical],UNDEFINED
	jz	ClearCommon_Loop	;brif bdValue is not an owner (but is
					;  instead used to hold info on U.L. 
					;  block)
	lea	ax,[si.COM_bdValue]
	cCall	BdFree,<ax>		;free the value table for this block
	jmp	short ClearCommon_Loop	;done

Zero_Common:
	cmp	[si.COM_bdValue.BD_cbPhysical],UNDEFINED ; QuickLib common?
	jne	NotQlb			; brif not -- clear it now
	mov	fQlbCommon,TRUE 	; call B$IRTCLR later to clear it
	jmp	short ClearCommon_Loop	; go back for more

NotQlb: 				; clear the non-QLB common block
	push	[si.COM_bdValue.BD_pb]
	push	[si.COM_bdValue.BD_cbLogical]
	call	ZeroFill
	jmp	short ClearCommon_Loop

ClearCommon_Exit:
	xor	cx,cx			; prepare to clear & test fQlbCommon
	xchg	cl,[fQlbCommon] 	; COMMON block that wasn't deleted?
	jcxz	NoZeroVars		; brif not - don't set vars to zero
	cmp	[fChaining],FALSE	; are we chaining?
	jnz	NoZeroVars		; brif so -- B$CHNINI will do the
					; work for us
	call	B$IRTCLR		
NoZeroVars:				
	DbAssertRel si,z,di,CP,<ClearCommon: End of table not where expected>
cEnd

;***
;ResetCommon() - Deallocate all common blocks
;Purpose:
;	Calls ClearCommon to release all strings and arrays, throws out value
;	and type tables for each common block as well as the common block entry
;	itself, and shrinks the global common block table. If 'fChaining' is
;	FALSE, this is done to the unnamed common block as well, otherwise,
;	that block is excluded. Note that, even in the case where the unnamed
;	block is to be reset, it is still not deallocated; it's buffers are just
;	trimmed to zero. This (along with initialization code) allows us to 
;	always assume that the unnamed block exists, and it's buffers allocated,
;	although perhaps to size zero.
;
;	Note that the value field in COMMON entries in existing variable tables
;	will now be garbage; this is okay, because we know that the scanner will
;	explicitly put the correct information in when it is next invoked - - -
;	the variable tables do NOT need to be accessed by this routine.
;Entry:
;	global flag fChaining set appropriately
;Exit:
;	none.
;Exceptions:
;	none.
;*******************************************************************************
cProc	ResetCommon,<PUBLIC,NEAR,NODATA>
cBegin
	mov	[fResetCommon],TRUE
	call	ClearCommon
	xor	ax,ax
	mov	[fResetCommon],al
	mov	[oValComMax],ax 		;reset max oVar of blank common
	mov	[oTypComMax],ax 		;reset max oTyp of blank common
	mov	[grs.GRS_bdtComBlk.BD_cbLogical],SIZE COM
						;trim global table back so it
						;  just contains blank COMMON
cEnd

;***
;MakeCommon(oNam) - Create COMMON Block if req'd, rtn offset to block
;Purpose:
;	Given an oNam for a COMMON Block (UNDEFINED for the unnamed block),
;	creates the COMMON Block if it does not already exist, and returns an
;	offset into the global table of COMMON Blocks for the specified block.
;	If the block is created, this routine also calls the heap manager to
;	allocate buffers of minimal size for the value and type tables.
;
;Entry:
;	oNam - offset into the module name table for the Block name
;		Note: it is assumed that oNam is valid, i.e., represents
;			an actual name in mrsCur.bdlNam. In many cases, things
;			will work out o.k. even if it is not, but not always.
;	It is assumed that the global table of COMMON Blocks (grs.bdtComBlk)
;		is already a valid heap item. 
;
;Exit:
;	ax = offset into grs.bdtComBlk to the specified block, or UNDEFINED
;		if out of memory.
;
;	Special case: if the static flag 'fCreateCommon' is FALSE, then we
;		don't want to create a new entry, but just find if a given
;		entry is present or not. In this case, ax = offset to specified
;		block or UNDEFINED if the block is not found.
;	
;Exceptions:
;	None. If Out-of-Memory occurs, the logical size of grs.bdtComBlk will be
;	unchanged, and no new buffers will have been allocated.
;*******************************************************************************
cProc	MakeCommon,<PUBLIC,FAR,NODATA>,<SI,DI>
	parmW	oNam
	localW	ogNam			
	localV	bdName,%(SIZE BD)
	localV	bdType,%(SIZE BD)
	localV	bdValue,%(SIZE BD)
cBegin	MakeCommon
	mov	ax,[oNam]		
	inc	ax			; UNDEFINED?
	jz	@F			; brif so - - - set ogNam == 0

	dec	ax			
	cCall	OgNamOfONam,<ax>	
	jnz	@F			; brif no error
	jmp	MakeCommon_Exit 	; OM error adding name to
					;	global name table
@@:					
	mov	[ogNam],ax		
	;Register Use:	SI points to current COM entry in bdtComBlk
	;		DI points just past last allocated COM entry
	mov	si,[grs.GRS_bdtComBlk.BD_pb]
	mov	di,si
	add	di,[grs.GRS_bdtComBlk.BD_cbLogical]

	;First, search table to see if a matching entry exists
	sub	si,SIZE COM		;special 1st-time-thru-loop value
MakeCommon_Loop:
	add	si,SIZE COM
	cmp	si,di
	jae	MakeCommon_Grow		;no more entries - - - no match

	mov	ax,[si.COM_ogNam]	
	cmp	ax,[ogNam]		
	jnz	MakeCommon_Loop		;brif match not found
	jmp	MakeCommon_SI_Exit	;match found

MakeCommon_Grow:
	DbAssertRel	si,z,di,CP,<MakeCommon: SI ne DI @ end of table search>
	cmp	[fCreateCommon],FALSE	;Want a new entry?
	jz	MakeCommon_Err_1Exit1	;  brif not - indicate search failure

	mov	di,[grs.GRS_bdtComBlk.BD_cbLogical]
					;save offset of new entry in si (because
					;  bdtComBlk might move during BdGrow)
	PUSHI	ax,<dataOFFSET grs.GRS_bdtComBlk>
	PUSHI	ax,<SIZE COM>
	call	BdCheckFree		;grow common block table for new entry
					;NOTE: we don't increase cbLogical until
					;NOTE: the entry is built; this way,
					;NOTE: heap movement of this table
					;NOTE: doesn't try to treat random
					;NOTE: garbage now in this new entry
					;NOTE: as heap owners
	or	ax,ax
	jnz	MakeCommon_Grow_OK	;brif BdGrow successful
MakeCommon_Err_1Exit1:
	jmp	MakeCommon_Err_Exit1	;BdGrow failed
MakeCommon_Grow_OK:
	mov	[bdName.BD_pb],NULL
					;in case this is for blank COMMON
	mov	ax,[oNam]
	inc	ax
	.errnz	UNDEFINED - 0FFFFH
	jz	MakeCommon_Got_Name	;brif it is blank COMMON - bdName is set

	dec	ax
	lea	bx,[bdName]
	cCall	CopyONamBd,<ax,bx>	;returns ax = 0 if OM error
	or	ax,ax
	jnz	MakeCommon_Got_Name	;brif no error
	jmp	MakeCommon_Err_Exit2
MakeCommon_Got_Name:
	lea	ax,[bdType]
	push	ax
	PUSHI	ax,0
	PUSHI	ax,IT_NO_OWNERS
	call	BdAlloc			;allocate type table
	or	ax,ax
	jz	MakeCommon_OM_Free1	;if OM error, free all bd's

	mov	si,di			;si = di = offset to new COM entry
	;now call runtime to determine if we should create our own value
	;  table for this block, or if we should use an existing U.L. block
	call	RtPushHandler
	mov	ax,CPOFFSET MakeCommon_RT_Return
	call	RtSetTrap
	lea	ax,[bdName]
	cCall	B$ULGetCommon,<ax>	;always returns ax = 0, plus
					;  bx = 0 if no match, or 
					;  bx = pbBlock, dx = cbBlock
MakeCommon_RT_Return:	
	call	RtPopHandler		;note this preserves ax, bx, & dx
	or	ax,ax			
	jnz	MakeCommon_OM_Free1	;brif runtime error

	or	bx,bx
	jz	Alloc_Value_Table	;brif no match - - allocate our own

	add	si,[grs.GRS_bdtComBlk.BD_pb]
	mov	[si.COM_bdValue.BD_pb],bx
	mov	[si.COM_bdValue.BD_cbPhysical],UNDEFINED
					;cbPhysical == UNDEFINED is what
					; indicates this is a U.L. block
	mov	[si.COM_bdValue.BD_cbLogical],dx
	jmp	short Move_Name_n_bdType
Alloc_Value_Table:
	lea	ax,[bdValue]
	push	ax
	PUSHI	ax,0
	PUSHI	ax,IT_COMMON_VALUE
	call	BdAllocVar		;allocate COMMON Value table in var heap
	or	ax,ax
	jnz	MakeCommon_Cont		;brif no OM error
MakeCommon_OM_Free1:
	jmp	short MakeCommon_OM_Free

MakeCommon_Cont:
	;Success. Now just move the owners, and exit
	add	si,[grs.GRS_bdtComBlk.BD_pb]
	lea	ax,[bdValue]
	lea	bx,[si.COM_bdValue]
	cCall	BdChgOwner,<ax,bx>	;move bdValue into bdtComBlk
Move_Name_n_bdType:
	add	[grs.GRS_bdtComBlk.BD_cbLogical],SIZE COM
					;MakeCommon succeeded - reflect new
					;  table size based on addition of
					;  this new entry
					;NOTE: do this BEFORE these next two
					;NOTE: BdChgOwner calls so non-RELEASE
					;NOTE: code won't complain about finding
					;NOTE: owners past cbLogical in the
					;NOTE: grs.GRS_bdtComBlk table
	mov	ax,[ogNam]		
	mov	[si.COM_ogNam],ax	
	lea	ax,[bdName]		
	cCall	BdFree,<ax>		
	lea	ax,[bdType]
	lea	bx,[si.COM_bdType]
	cCall	BdChgOwner,<ax,bx>	;move bdType into bdtComBlk
	xor	ax,ax
	mov	[si.COM_oTypCur],ax	;initialize
	mov	[si.COM_oValCur],ax
MakeCommon_SI_Exit:
	xchg	ax,si			;ax points to COM struct
	sub	ax,[grs.GRS_bdtComBlk.BD_pb] ;retval is offset into bdtComBlk
MakeCommon_Exit:
cEnd	MakeCommon

MakeCommon_OM_Free:
	lea	ax,[bdName]
	cCall	BdFree,<ax>
	lea	ax,[bdType]
	cCall	BdFree,<ax>
MakeCommon_Err_Exit2:
	sub	[grs.GRS_bdtComBlk.BD_cbLogical],SIZE COM
MakeCommon_Err_Exit1:
	mov	ax,UNDEFINED
	jmp	short MakeCommon_Exit


;***
;B$GetNMALLOC
;Purpose:
;	Called by the runtime to find a QB-specific COMMON block named
;	NMALLOC. If found, we return a pointer to the start of the value
;	table and its size.
;Input:
;	none
;Output:
;	AX = 0 if block not found, or is CB (size of block in bytes)
;	DX = PB (DGROUP-relative pointer to start of block) if AX <> 0
;***************************************************************************
cProc	B$GetNMALLOC,<PUBLIC,FAR,NODATA>
cBegin	B$GetNMALLOC	
	call	EnStaticStructs 	
	push	ax			;remember whether we should disable
					;  Static Structs on exit or not
	mov	ax,dataOFFSET NMALLOC	;points to string 'NMALLOC'
	mov	cx,CB_NMALLOC		;length of string
	call	ONamOfPbCb		;ax = oNam for 'NMALLOC' or 0
	jz	GetNMALLOC_Exit		;if ONamOfPbCb returns out of memory
					;  error code, we know there's no
					;  existing nammgr entry by this name,
					;  because nammgr only needs to grow
					;  name table to add a new entry.
	mov	[fCreateCommon],FALSE	;Tell MakeCommon to just search, not
					;  create
	cCall	MakeCommon,<ax>		;returns ax = offset to found common 
					;  block, or UNDEFINED if not found
	mov	[fCreateCommon],TRUE	;Reset static flag to default
	inc	ax			;was given block found?
	.errnz UNDEFINED - 0FFFFH	
	jz	GetNMALLOC_Exit		;  brif not - - - report failure

	dec	ax	
	add	ax,[grs.GRS_bdtComBlk.BD_pb]
	xchg	ax,bx			;bx now points to COM entry
	mov	dx,[bx.COM_bdValue.BD_pb]
	mov	ax,[bx.COM_bdValue.BD_cbLogical]
GetNMALLOC_Exit:
	pop	cx
	jcxz	GetNMALLOC_Exit1	;brif static structs were already
					;  active on entry
	push	ax			;save return values...
	push	dx			;...across DisStaticStructs
	call	DisStaticStructs
	pop	dx
	pop	ax
GetNMALLOC_Exit1:
cEnd	B$GetNMALLOC	

;***
;AdjustCommon
;Purpose:
;	This routine is called when a common value table is about to be moved.
;	Due to the overhead that would be required for the runtime to update
;	backpointers to AD's and SD's in static variable tables, we do this
;	work here.
;Input:
;	SI = ptr to the COM_bdValue.BD_pb field for an entry in 
;		grs.GRS_bdtComBlk
;	DI = adjustment factor
;Output:
;	none
;Modifies:
;	SI
;***************************************************************************
cProc	AdjustCommon,<PUBLIC,FAR,NODATA>
cBegin	AdjustCommon

	mov	ax,[pSsCOMcur]
	mov	bx,ax
	add	ax,8			;ax = ptr to BdValue.BD_bp on stack
	cmp	ax,si
	jz	AdjustIt		;brif this is the block that's moving

	;nope - - - owner of table MUST therefore be in bdtComBlk
Not_Scanning_Common:
	mov	bx,[grs.GRS_bdtComBlk.BD_pb]

	;First, search table to see if a matching entry exists
	sub	bx,SIZE COM		;special 1st-time-thru-loop value
AdjustCommon_Loop:
	add	bx,SIZE COM
	DbAssertRel bx,b,dx,CP,<AdjustCommon: given value table not found>

	lea	ax,[bx.COM_bdValue.BD_pb]
	cmp	si,ax
	jnz	AdjustCommon_Loop	;brif this isn't the right COMMON block

	add	bx,COM_bdType		; point to bdType for this block
AdjustIt:
	call	SsAdjustCommon		;actually adjust the back pointers
					;  to any SD's and AD's in table
cEnd	AdjustCommon



;###############################################################################
;#                                                                             #
;#                            non-RELEASE Code                                 #
;#                                                                             #
;###############################################################################

;***
;CbTypFar
;Purpose:
;	Far interface to CbTyp
;	Added as part of revision [5].
;Entry:
;	parmW = oTyp
;Exit:
;	size of type
;******************************************************************************/
cProc	CbTypFar,<PUBLIC,FAR>
	parmW	oTyp
cBegin
	cCall	CbTyp,<oTyp>
cEnd

sEnd	CP


	end