inc	ax
	jz	OMError
	and	ax,not 1		;Round up to next word
;Make sure it's not too big
	mov	cx,ax
	add	ax,[bp-SsCom].COM_oValCur	;Get oValue
        jc	OMError
	call	ChkComSize
 	jc	OkRet				;Return with CY set if error
	add	bx,[bp-SsCom].COM_bdType.BD_pb	;bx = pTypCur
	xchg	ax,cx
	ret

ExtendType:
;Grow the COMMON type table
;
;Inputs:
;	bx = new length
;	dx = oTyp
;Outputs:
;	CY set if failed (error reported)
;Preserves:
;	bx,cx,dx

	push	dx
	push	cx
	push	bx
	inc	bx
	inc	bx				;Need at least one more word
	cmp	dx,ET_FS			; Record? Fixed?
	.erre	ET_FS EQ ET_MAX 		
	jb	SmallTyp			
	inc	bx				; FS have cbFixed
	inc	bx				;Records have oRS too
SmallTyp:
.errnz	COM_bdType - SsCom
	push	bp				;Owner
	push	bx				;New size
	call	BdRealloc			;Extend COMMON type table
	call	OMEcheck			;See if it worked
	pop	bx				;oTypCur
	pop	cx
	pop	dx
	ret

	page
;***
;Ss_ReDim - Scan opReDim
;
;Purpose:
;
;   Scan opReDim.
;
;   The opReDim opcode comes after a AIdLd opcode.  This scan
;   routine receives a scan stack entry describing the referenced
;   variable as follows:
;
;		oTx	    Always immediately preceeding point
;		oType	    <-- (Top of stack)
;
;   Tasks include:
;
;	1. Bind to executor
;	2. Coerce remaining arguments to integers
;	3. if argument is the first reference to an array
;	   then set whether the array is $STATIC or $DYNAMIC
;	4. Test for REDIMing a $STATIC array error.
;
;Input:
;
;   ax	  = executor
;   bx	  = 2 * opcode
;   es:si = pcode source address
;   es:di = pcode emission address
;
;Output:
;
;   si, di updated
;
;Modifies:
;
;Exceptions:
;
;   Ss_Error
;
;******************************************************************

	page

SsProc	ReDim
	STOSWTX 			;Emit the executor
	dec	si
	dec	si			;Report errors on preceding AIdLd

	pop	ax			;Discard oType of array
	DbAssertTst ax,z,ST_Array?,SCAN,<Ss_ReDim: Non-array>
	pop	bx			;BX = oTx after exAIdLd
	call	MakeArrayRef		;Convert to exAdRf

	    mov     bx,PTRTX[si-2]		;BX = oVar
	    add     bx,[mrsCur.MRS_bdVar.BD_pb] ;BX = pVar

	test	byte ptr [bx].VAR_fStat,FV_STATIC ;Is this a static array?
	jnz	ReDimStatic		;REDIM stmt. $Static arrays not allowed.
ReDimX:
	inc	si
	inc	si
	jmp	[ScanRet]		;Scan next opcode

ReDimStatic:
	mov	ax,MSG_OBA		;Array already dimensioned
	call	SsError
	jmp	ReDimX

	page
;SetArrayType
;
;Purpose:
;
;   Routine to set FV_STATIC and FV_STATICSET in an array var entry.
;
;   This routine sets FV_STATIC to the value in f_StaticCalc iff
;   FV_STATICSET is FALSE.  It then ensures that FV_STATICSET is TRUE.
;
;Input:
;
;   f_StaticCalc = TRUE if type is $STATIC, else FALSE
;   bx		 = pVariable for an array variable
;
;Outputs:
;
;   CY set if first reference
;
;Preserves:
;
;   all


	public	SetArrayType
SetArrayType:
	or	[SsFlags],SSF_HaveDimmed	;Had a DIM: no OPTION BASE now
SetArrayTypeNoDim:
	DbChk	pVar,bx 			;Verify that this is a variable
SetArrayTypePublic:
	TestM	[bx].VAR_flags,FV_STATICSET	
						;Determine if the $STATIC flag
						; is already set for this array.
	jnz	SetArrayTypeX			;Already set - nothing to do.

	;Note:	In EB, all declarations at the module
	;level are shared and all at the the procedure level
	;are not therefore there need not be two checks.

	    ;Don't set flags for shared variables while scanning proc

	    TestM   [bx].VAR_flags,FVSHARED	; Shared variable?
	    jz	    SetStatic			;If not, set bit
	    test    byte ptr [grs.GRS_oRsCur+1],80H ;Scanning module level?
	    jnz     SetArrayTypeX		;If not, don't set bit
SetStatic:

	.errnz	FALSE
	cmp	[f_StaticCalc],FALSE
	je	@F				;$DYNAMIC, leave FV_STATIC clear

	; Array is dynamic if it lives on the procedure frame

	    TestM   [bx].VAR_flags,FRAME	; In the stack?
	    jz	    @F				; Brif array is on frame
	or	byte ptr [bx].VAR_fStat,FV_STATIC	;Set $STATIC
@@:
	or	WORD PTR [bx].VAR_Flags,FV_STATICSET	; Indicate FV_STATIC is set.
	stc
SetArrayTypeX:
	ret



sEnd	SCAN


sBegin	CP

assumes cs, CP

;***
;ChainCommon - prepare blank common for chaining
;
;Purpose:
;
;   Module type tables will be destroyed by chaining, so the
;   COMMON type table must stop referring to it.  Instead, user
;   type entries are replaced with a flag and the size of the type.
;   Type checking against the chained-to program will only compare
;   record sizes.
;
;Preserves:
;
;   dx
;
;Modifies:
;
;   si
;
;***********************************************************************
;
cProc	ChainCommon,<PUBLIC,FAR,NODATA>,<SI>
cBegin
	mov	si,[grs.GRS_bdtComBlk.BD_pb]	;pBlankCommon
	DbAssertRel [si].COM_ogNam,z,NULL,CP,<ChainCommon: 1st block in bdtComBlk is not for blank COMMON> 
	mov	cx,[si].COM_bdType.BD_cbLogical	;Size of type table
	mov	si,[si].COM_bdType.BD_pb	;pTypeTable
	add	cx,si			;Ending address
LookForRecord:
	cmp	cx,si			;Reach end?
	jbe	CommonReady
	lodsw
	cmp	ah,cDimsFlag+StaticFlag	;Static array?
	jz	SkipStatic
	cmp	ah,cDimsFlag		;Array count?
	jnz	Element
GetElement:
	lodsw				;Skip count, do element
Element:
	cmp	ah,LengthFlag		;Already converted?
	jz	SkipOver
.errnz	ET_MAX - ET_FS			; ensure FS is max type
	cmp	ax,ET_MAX		;Record type or fixed length string?
	jb	LookForRecord		; If not, look at next
;Have a record or fixed length string
	xchg	bx,ax			;Save oTyp in bx
	lodsw				;Get oRS
	je	LookForRecord		; brif fixed length string
	xchg	bx,ax			;oTyp to ax, oRS to bx
	call	CbTypOTypOMrs		;Get its size
	mov	byte ptr [si-3],LengthFlag	;Flag as size-only entry
	mov	[si-2],ax
	jmp	LookForRecord

SkipStatic:
	cbw				;ah=0
	shl	ax,1
	shl	ax,1			;Size of dimensions
	add	ax,(size AD-1)		;Skip AD
	add	si,ax			;Point to element
	jmp	GetElement

SkipOver:
	lodsw				;Skip over length
	jmp	LookForRecord

CommonReady:
cEnd

;***
;SsTrimCommon
;
;Purpose:
;
;   After chaining, blank COMMON could be larger than actually used.
;   This routine trims it back, releasing any owners.  The value table
;   is not actually shortened (it could be in a UL), but the type table
;   is, and that's what counts.
;
;   THIS ROUTINE MUST NOT BE CALLED IF SCAN ERROR OCCURED
;
;Inputs:
;
;   [oTypComMax] = max size of type table
;   [oValComMax] = max size of value table
;
;***********************************************************************
	public	SsTrimCommon

SsTrimCommon:
	push	si
	push	di
	mov	si,[grs.GRS_bdtComBlk.BD_pb]	;pBlankCommon
	cmp	[si].COM_bdValue.BD_cbPhysical,UNDEFINED ; QuickLib common?
	jz	SharedQLB			; brif so -- don't delete
						; or zero-fill common
	mov	cx,[si].COM_bdType.BD_cbLogical
	mov	bx,[si].COM_bdValue.BD_pb	
	add	bx,[oValComMax]
	mov	si,[si].COM_bdType.BD_pb	;Pointer to type table
	add	cx,si				;Point last+1 of type table
	add	si,[oTypComMax]
	call	DelCommon
	mov	si,[grs.GRS_bdtComBlk.BD_pb]	;pBlankCommon
;Zero fill trimmed part of value table
	mov	di,[oValComMax]
	push	ds
	pop	es				;Make sure es=ds
	mov	cx,[si].COM_bdValue.BD_cbLogical
	sub	cx,di				;Amount to zero fill


	add	di,[si].COM_bdValue.BD_pb
	shr	cx,1
	xor	ax,ax
rep	stosw

SharedQLB:					
	mov	ax,[oTypComMax] 		
	mov	[si].COM_bdType.BD_cbLogical,ax ; Trim the type table

	pop	di
	pop	si
	ret


;***
;SsAdjustCommon
;
;Purpose:
;
;   Called whenever a QBI-specific COMMON value table is moved (by heap
;   management code).  Updates the backpointers to all SD's and string
;   array descriptors found in the value table for the given COMMON block.
;
;Inputs:
;
;   bx = pointer to COM_bdType field
;   di = adjustment factor to be passed on runtime
;	    if di=0, delete all SD's and arrays
;
;***********************************************************************

DelCommon:
;si = starting point in type table
;bx = starting point in value table
;cx = ending point in type table
	xor	di,di
	push	si
	jmp	short TestEndCommon

	public	SsAdjustCommon
SsAdjustCommon:
	push	si
	mov	cx,[bx].BD_cbLogical
	mov	si,[bx].BD_pb		;Pointer to type table
	mov	bx,[bx-COM_bdType].COM_bdValue.BD_pb
	add	cx,si			;Point last+1 of type table
TestEndCommon:
	cmp	si,cx			;End of type table?
	jae	AdjustX
	lodsw				;Get type table entry
	cmp	ah,cDimsFlag+StaticFlag	;Static array?
	jz	AdjustStatic
	cmp	ah,cDimsFlag		;Array?
	jz	AdjustArray
	cmp	ax,ET_MAX		; Record ?
	ja	AdjustRecord		; Brif yes
	.erre	ET_MAX LE 0100h 	; Assure we can use AL
	cmp	al,ET_SD		; String type?
	jb	NotRecord		; Brif not
	    .erre   ET_FS EQ ET_SD+1	; Assure JA is sufficient
	    .erre   ET_FS EQ ET_MAX	; Assure no new types added
	    ja	    RecWithLen		; Brif fixed string

	call	AdjustOneSD
	jmp	TestEndCommon

AdjustRecord:				
	test	ah,LengthFlag		;Has record been crunched to length?
	jnz	RecWithLen
	push	bx
	mov	bx,[si]			;Get oMRS
	inc	si
	inc	si
	call	CbTypOTypOMrs
	pop	bx
	jmp	short AddCbTyp

AdjustX:
	pop	si
	ret

NotRecord:
	call	CbTypOTyp		;Get length of item
AddCbTyp:
	inc	ax			
	and	al,not 1		;Round even
	add	bx,ax
	jmp	TestEndCommon

RecWithLen:
	lodsw				;Get length of record or string
	jmp	AddCbTyp

AdjustStatic:
	cmp	[si].AD_fhd.FHD_hData,0	;Any space in array?
	jz	AdjustX			;In the middle of building an entry


	add	[si].AD_fhd.FHD_oData,di;Adjust pointer to array data
	cbw				;ah=0
	shl	ax,1
	shl	ax,1			;Size of dimensions
	add	ax,(size AD-1)		;Skip header
	xchg	dx,ax			;Save in dx
	mov	ax,[si].AD_fhd.FHD_cPara;Get size of array
	add	si,dx			;Point to element
	cmp	word ptr [si],ET_SD	;String array?
	jz	AdjSdStatic
	add	bx,ax
EatOTyp:
	lodsw				;Get oTyp
	cmp	ax,ET_FS		
	    .erre   ET_FS EQ ET_MAX	
	jb	TestEndCommon		
	lodsw				;Skip over oMRS/length
	jmp	TestEndCommon

AdjustArray:
	push	cx
	push	bx
	or	di,di			;Delete the array?
	jz	DelArray
	lodsw				;Get oTyp of array
	cmp	ax,ET_SD		;Array of strings?
	jne	NoAdjArray
UpdStrings:				
	push	bx			;First arg for runtime
	push	di			;2nd arg for runtime
	call	B$IAdUpd		;Have runtime do update
AddCbArray:
	pop	bx
	pop	cx
	add	bx,ComArraySize
	jmp	TestEndCommon

DelArray:
	push	bx			;First arg for runtime
	call	B$IErase		;ERASE array (no heap movement varient)
	lodsw				;Get oTyp
NoAdjArray:				
	cmp	ax,ET_FS		
	    .erre   ET_FS EQ ET_MAX	
	jb	AddCbArray		
	lodsw				;Skip over oMRS/length
	jmp	AddCbArray

AdjSdStatic:
;ax has size of array
	shr	ax,1
	shr	ax,1			;ax = no. of 4-byte SD's
	push	cx
	xchg	cx,ax			;No. of elements to cx
AdjustEachSD:
	call	AdjustOneSD
	loop	AdjustEachSD
	pop	cx
	jmp	EatOTyp

AdjustOneSD:
	push	cx
	push	bx
	push	bx			;First arg for runtime
	or	di,di
	jz	DelSD
	push	di			;2nd arg for runtime
	call	B$ISdUpd
AddCbSD:
	pop	bx
	pop	cx
	add	bx,4			;Size of SD in value table
	ret

DelSD:
	call	B$STDL			;Delete the SD
	jmp	AddCbSD

sEnd	CP

end