page	49,132
	TITLE	ssdeclare - scan support for declarative statement opcodes
;***
;ssdeclare - scan support for declarative statement opcodes
;
;	Copyright <C> 1986, Microsoft Corporation
;
;Purpose:
;
;   These routines scan DIM, COMMON, VtRf, AVtRf, and provide additional
;   external support for COMMON.
;
;   COMMON utilizes a value table, where the actual values are stored,
;   and a type table, which describes what's in the value table.  (In
;   the case of arrays, the array descriptor is in the value table.)
;
;   Each entry in the value table is rounded up to the next whole word
;   in size if it needs an odd number of bytes.  This can only happen
;   when fixed-length strings are involved, either as simples or in
;   records.
;
;   The basic entry in the type table is the oType of its corresponding
;   element in the value table.  Types and values are linked only by their
;   order in the tables.  For arrays, the oType is preceded by a word
;   with bit 14 set, and the count of dimensions in its low byte.  For
;   records, the oType is followed by the oMRS that defines the type.
;
;   Arrays are always assumed to have 8 dimensions for purposes of
;   allocating space in the value table for the array descriptor.  The
;   actual number of dimensions is kept for type checking, not space
;   allocation.
;
;   When chaining, information about user types is lost.  To still
;   provide some type checking, the type table entry is modified.
;   The oMRS field for the record type is changed to contain the
;   record length.  Bit 13 of the oType is set to indicate this was
;   done.  Type checking consists of verifying the records are of
;   of the same length.  The oType itself is no longer used.
;
;
;****************************************************************************

	.xlist
	include		version.inc
SSDECLARE_ASM = ON
	IncludeOnce	context
	IncludeOnce	executor	
	IncludeOnce	optables
	IncludeOnce	pcode		
	IncludeOnce	qbimsgs
	IncludeOnce	ssint
	IncludeOnce	txtmgr
	IncludeOnce	variable
	.list


extrn	B$ISdUpd:far
extrn	B$IAdUpd:far
extrn	B$STDL:far
extrn	B$IErase:far

assumes	es,nothing
assumes	ds,DATA
assumes	ss,DATA
assumes cs,SCAN


sBegin	DATA

	globalW	pSsCOMcur,0		;normally zero; when we're growing
					;  COMMON bdTyp and bdValue tables, this
					;  contains a pointer to where those
					;  tables can be found on the stack.
					;  This is necessary for bkptr updating
					;  in case the value table moves.
sEnd	DATA

sBegin	SCAN

;These flags are used in the high bits of oTyp in a COMMON block type table
cDimsFlag=	40H	;This word has cDims in low byte, not oTyp
LengthFlag=	20H	;Next word is length of record
StaticFlag=     1       ;$STATIC array in COMMON

;***
;Ss_StCommon - Scan the COMMON statement
;
;Purpose:
;
;   Creates a stack frame with COMMON information.  This frame is removed
;   by SsBos.
;
;   The frame includes the owners of the COMMON block's type and value
;   tables, as well as indexes into those tables.  The change of owners
;   is needed so they don't move as the the tables grow.
;
;***********************************************************************

SsProc	StCommon,rude
	mov	[SsOTxPatchBos],di	; Patch this with next Bos address
	STOSWTX 			;Emit executor
	test	[SsExecFlag],OPA_fExecute ;Already seen executable stmt?
	jz	@F
	mov	ax,MSG_COM		;COMMON must precede executable stmts
	call	SsError
@@:
	MOVSWTX 			;Skip over oTx operand
	LODSWTX				;Get oNam
	STOSWTX 			;Emit it
	push	ax
	call	MakeCommon
	inc	ax			;Out of memory?
	jz	OME
	dec	ax
	or	[SsBosFlags],SSBOSF_StCommon	;Set flag for VtRf

	;Make stack frame with COMMON info

	push	bp
	push	ax			; Place holder for COM_cbFixed
	push	ax			;Save oCommon
	    add     ax,[grs.GRS_bdtComBlk.BD_pb]    ;oCommon --> pCommon
	add	ax,SsCom+SsComSize	;Get to end of structure
	xchg	bx,ax			;pCommon.bdType to bx
	mov	cx,SsComSize/2		;Word size of structure
@@:
	dec	bx			
	dec	bx
	push	[bx]			;Copy word to stack
	loop	@B			;Repeat
	mov	bp,sp			;bp is low byte of COM structure
	    mov     [pSsCOMcur],sp	;see module header for explanation
;Assign owners
.errnz	SsCom - COM_bdType
	push	bx			;Current owner
	push	bp			;New owner
;If COMMON in user library, Value field is not an owner
	    add     bx,COM_bdValue - COM_bdType
	    cmp     [bx].BD_cbPhysical,UNDEFINED    ;User Library?
	    jz	    CopyTypOwner		    ;yes, skip value field
	push	bx			;Current owner
	lea	bx,[bp-COM_bdType].COM_bdValue
	push	bx			;New owner
	call	BdChgOwner		;Copy BD to stack
CopyTypOwner:
	call	BdChgOwner
	jmp	CommonX

OME:
	mov	ax,ER_OM
	call	SsError
	or	[SsBosFlags],SSBOSF_StStatic	;Set flag for no work in VtRf
	jmp	CommonX


subttl	Ss_AVtRf and Ss_VtRf
page
;***
;Ss_AVtRf - Scan AVtRf variants array Id opcodes
;
;Purpose:
;
;   Scan the id variants opAVtRf<type>.
;
;   The statements STATIC, SHARED, COMMON, and DIM all use AVtRf opcodes.
;
;   Arrays are $STATIC or $DYNAMIC based on the first reference to
;   the array.	Variables in determining the array type are:
;   - Statement.  The first reference may be in any of the following
;     statements: STATIC, SHARED, COMMON, DIM, REDIM, ERASE, PUT, GET
;     or <implicit ref> (indicating any other legal location for an array
;     reference).
;   - $STATIC and $DYNAMIC metacommand.  The default is $STATIC.  This
;     default may be changed by using the $STATIC and $DYNAMIC metacommands.
;
;   The table below shows what kind of array ($STATIC/$DYNAMIC) is created
;   or what error is reported by the BASCOM 2.0 compiler.  The <implicit>
;   case has been added for completeness - it does not use an AVtRf opcode.
;
;   Statement of First Ref  $STATIC		    $DYNAMIC
;   -----------------------------------------------------------
;   STATIC/COMMON/REDIM     $DYNAMIC		    $DYNAMIC
;   DIM (constant indices)  $STATIC		    $DYNAMIC
;   DIM (expression  index) $DYNAMIC		    $DYNAMIC
;   <implicit>		    $STATIC		    $STATIC
;   ERASE/PUT/GET/SHARED    Syntax error	    Syntax error
;
;   In the case of statements where the opcode follows the opAVtRf
;   the AVtRf scanner pushes the oVT and a flag indicating the
;   existence of an expression as an index.  The statement scanners
;   use this information to determine whether the array is $STATIC or
;   $DYNAMIC.  The declarative statement scanners are given the
;   number of AVtRf arguments by methods described in the scan routines
;   for those statements.
;
;   In the case of statements where the statement opcode preceeds the
;   opAVtRf the opAVtRf scanner sees that a flag is set, indicating
;   which executor was seen.  This flag is cleared at BOS.  The AVtRf
;   scanner completes the scan task for the statement indicated by
;   this flag.
;
;   Functions are referenced using the same opcodes as variables.
;   The VtRf variants may reference a function.  However, if they do
;   it is an error.
;
;   Tasks:
;	1. bind to executor.
;	2. complete the scan task for STATIC/COMMON/SHARED.
;	3. calculate whether any index contains an expression (as opposed
;	   to a literal).
;	4. make a scan stack entry for arrays for the case that the statement
;	   executor follows the opAVtRf.
;	5. Coerce all index expressions to integer.  This ensures that the
;	   executor for this statement can clean the stack.
;
;Algorithm:
;
;   Load and emit executor
;   Copy operand(s)
;   Ensure that the variable is not a function.
;   Coerce arguments, calculating whether any argument is not a literal.
;   If COMMON, SHARED, STATIC
;      Perform scan work for these statements.
;   ELSE (must be ERASE, PUT, GET, DIM, REDIM)
;      Push stack entry
;	  oVar
;	  flag TRUE if an index was an expression.
;	  index count
;      Scan routines for these opcodes must verify that the number of
;	  dimensions matches the number of indices.  opStDimTo must have
;	  twice the indices as opStGet, and ERASE takes no indices.
;   Return to scnner main loop
;
;Input:
;
;   ax	  = opcode
;   bx	  = 2 * opcode
;   es:di = pcode emission address
;   es:si = pcode source address
;
;Output:
;
;   si updated
;
;Modifies:
;Exceptions:
;	Ss_Error
;
;******************************************************************

.errnz	FALSE		;This algorithm depends on F_Static and F_StaticCalc
	page

AVtRfToFun:
	jmp	VtRfToFun

AVtRfRedirect:
	mov	ax,[bx].VAR_value	;Get new oVar
	mov	PTRTX[di-2],ax		;Patch into pcode
	jmp	short AVtRfRetry

StaticArray:
	;If NOT first ref, it's an error

	TestX	dx,FV_STATICSET 	;First reference?
	mov	ax,ER_DD		;Duplicate definition if not
	jnz	AVtRfError
	call	SetArrayTypeNoDim	;Set fStatic for this array
AVtRfX:
	jmp	[ScanRet]

SharedArray:
	;Make sure it's referenced at the module level

	TestX	dx,FV_STATICSET 	;First reference?
	jnz	AVtRfX			;Better not be
	mov	ax,ER_UA		;Array not defined
AVtRfError:
	call	SsError
	jmp	short AVtRfX

FRAME=	FVCOMMON+FVSTATIC+FVSHARED+FVFORMAL+FVVALUESTORED+FVREDIRECT

ComDimCnt	=	8		;No. of dims allowed in COMMON
ComArraySize	=	(size AD - 1) + ComDimCnt * (size DM)

CommonArrayJ:				
	jmp	CommonArray		


SsProc	AVtRf,Rude
	xchg	ax,bx			; BX = executor map address
	mov	al,byte ptr es:[si-1]	; High byte of opcode
	.erre	OPCODE_MASK EQ 03ffh	
	and	ax,HIGH (NOT OPCODE_MASK)
	shr	ax,1			; Convert to word offset
	add	bx,ax			; Index into map
	mov	ax,cs:[bx]		; Load executor
	STOSWTX 			;Emit the executor
	LODSWTX 			;Load argument count
	STOSWTX 			;And emit the arg count
	xchg	cx,ax			;Preserve for processing indices
	LODSWTX 			;Load oVar
	STOSWTX 			;Emit oVar
AVtRfRetry:
	    add     ax,[MrsCur.MRS_bdVar.BD_pb] ;oVar --> pVar
	xchg	ax,bx
	DbChk	pVar,bx 		;Verify that this is a variable
	mov	ax,[bx].VAR_Flags	;[5]

	;Check for AVtRf to a function error.

	TestX	ax,FVFUN		;Is this a ref to a function?
	jnz	AVtRfToFun		;Error - AVtRf to a function.

	    ;Check for AVtRf to redirected variable.

	    TestX   ax,FVREDIRECT	;Is the variable redirected?
	    jnz     AVtRfRedirect	;Redirected variable.

	DbAssertTst ax,nz,FVARRAY,SCAN,<Ss_AVtRf: Non-array>

	;Allocate oFrame.

	    TestX   ax,FRAME		;Is it a frame var?
	    jnz     @F

	call	SsAllocOFrame		;Allocate an oFrame for this var
@@:

	    xchg    dx,ax		;Keep var flags in dx
	    mov     [f_StaticCalc],FALSE;If first ref, assume dynamic array
	    mov     al,[SsBosFlags]
	    test    al,SSBOSF_StCommon	;Is it a COMMON statement?
	    jnz     CommonArrayJ
	    test    al,SSBOSF_StStatic
	    jnz     StaticArray
	    test    al,SSBOSF_StShared
	    jnz     SharedArray

	;DIM case handling - the statement opcode hasn't been seen.

	;Initialize Index Seen flag for $STATIC array calculation.
	;Flag is initialized to current default array type.
	;Needed only for DIM

	    mov     al,[f_Static]	;TRUE if $STATIC in effect
	    mov     [f_StaticCalc],al	;Move to temporary for calc

	mov	ax,ET_I2		;Target type
	call	SsCoerceN		;Coerce cx indices to type ax
					;f_StaticCalc set FALSE if any nonlits

	cmp	[f_StaticCalc],FALSE	; Were any expressions found?
	jne	@F			; Brif no expression found

	    or	    [SsExecFlag],OPA_fExecute	; This is executable

@@:					
	mov	dx,[bx].VAR_Flags	

	;Test for second DIM of array error.
	;In QB multiple Dims of $Dynamic arrays are allowed.
	;In EB multiple Dims are prevented by the variable manager.


	    TestX   dx,FV_STATICSET	;Test if array type has been set
	    jnz     @F			; Brif second Dim.
	    TestX   dx,FVCOMMON 	; Is this common array
	    jz	    NotSecondDimErr	; Brif not common.	Set type

	    ;This is first reference to a Common array.  The array must be
	    ;$Static since the Common statement would have set FV_STATICSET.

	    mov     ax,[SsOTxStart]	;Load oTx for this Dim clause.
	    mov     [bx].VAR_value.ACOM_oValue,ax   ;Save oTx of Dim statement
@@:
	    test    byte ptr [bx].VAR_fStat,FV_STATIC ;Is the array $STATIC?
	    jnz     SecondDimError	;Brif second dim of $Static array
NotSecondDimErr:

	call	SetArrayType		;Set BX=pVtArray to type in f_StaticCalc
	mov	cx,PTRTX[di-4]		;AX = cArgs
	shr	cx,1			;Two indices per dimension in DIM TO
					; Parser ensures pairs of indices.
	cmp	cl,[bx].VAR_value.ASTAT_cDims	;Is index count = dims
	jne	WrongCDimError		;Brif cDims is incorrect
@@:

	mov	ax,[SsOTxStart] 	;Load oTx for this Dim clause.
	mov	[SsScanExStart],ax	;Save in case needed below


AllocateArray:
	test	byte ptr [bx].VAR_fStat,FV_STATIC ;Is the array $Static?
	jz	DimExit 		; Brif $Dynamic array

	    TestX   dx,FVCOMMON 	; Is this common array
	    jnz     DimExit		; Brif common. Don't allocate now.

	cmp	[bx].ASTAT_ad.FHD_hData,0   ;Allocated already?
	jne	DimExit 		;Brif yes.  Bypass allocation.


	cmp	[SsErr],0		;Any errors?
	jne	DimExit2		;Brif yes.  Bypass allocation.

	mov	[DimAtScanType],SSDIM_STATIC
	push	ax			;Dummy parameter
	push	ax			;Dummy parameter
	call	ExecuteFromScan 	;Allocate array.  AX = RT error code.
	jnz	DimError		;Brif error code <> 0

DimExit:				

DimExit2:
	mov	[SsOTxStart],di 	;Update pointer for next Dim clause
	jmp	[ScanRet]		;Scan next opcode



SecondDimError: 			
	mov	ax,MSG_OBA		;Array already dimensioned
	jmp	short DimError		



WrongCDimError: 			
	mov	ax,MSG_SubCnt		;Wrong number of subscripts
DimError:
	call	SsError
	jmp	short DimExit		



NewArTypeJ:
	jmp	NewArType

StaticCommonJ:				
	jmp	StaticCommon		

CommonArray:
	call	SetArrayTypeNoDim	;Set fStatic for this array
					; to type in f_StaticCalc
					;Input:
					; bx = pVtArray

	;Set oCommon and oValue in variable table

        cmp     [SsErr],0                       ;Any errors so far?
        jnz     CommonX                         ;Don't risk it if so
	mov	ax,[bx].VAR_cbFixed		; Get length of FS
	mov	[bp-SsCom].COM_cbFixed,ax	; Save
	mov	ax,[bp-SsCom].COM_oCom		;Get oCommon
	mov	[bx].VAR_value.ACOM_oCommon,ax
	mov	cl,[bx].VAR_value.ACOM_cDims	;Get cDims
	GetOtyp dx,[bx] 			;Get oTyp of element
	test	byte ptr [bx].VAR_fStat,FV_STATIC ;$STATIC array in COMMON?
	jnz	StaticCommonJ
	mov	ch,cDimsFlag

	mov	ax,[bp-SsCom].COM_oValCur	;Get oValue
	mov	[bx].VAR_value.ACOM_oValue,ax

	;See if this stuff fits

	add	ax,ComArraySize			;Size of AD in COMMON
	call	ChkComSize			;bx = oTypCur
	jc	CommonX 			;Quit if no room

	;See if there's a type in table

	cmp	bx,[bp-SsCom].COM_bdType.BD_cbLogical	;Have entry in table?
	jae	NewArTypeJ

	;Compare with existing type