ssaid.asm

[随书类]Dos6.0源代码

page    49,132
	TITLE	ssaid	- Scan support for array id opcodes
;***
;ssaid.asm - Scan support for array id opcodes
;
;	Copyright <C> 1986, Microsoft Corporation
;
;Purpose:
;
;   This module contains the scanner dispatch routines for array id opcodes.
;   These routines perform all tasks related to moving array id opcodes from
;   SS_PARSER to SS_EXECUTE scan state.
;
;   Scan routines for IdLd opcodes make a stack entry that describes the type
;   and location of the id in the scanned pcode.  The scan stack entry is
;   created by:
;
;	push oTx  - emitted pcode address of byte following id
;		     (address at which coercion would be inserted)
;	push oTyp - type of expression or ET_RC for records
;
;   See scanner.inc for a complete definition of the id stack entry.  The
;   oTyp word contains flags that uniquely distinguish variable references,
;   literals, and intermediate expression values.
;
;   Routines named Ss_<name> are dispatched by a jmp.  These routines
;   all return to the scan loop by an indirect jmp through variable scanret.
;
;
;****************************************************************************

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

assumes ds, DATA
assumes es, NOTHING
assumes ss, DATA


sBegin	SCAN
assumes cs, SCAN

	subttl	Ss_AIdLd
	page
;***
;Ss_AId Scan Ld and St variants of array Id opcodes
;
;Purpose:
;
;   Scan the id variants opAIdLd<type> and opAIdSt<type>.
;
;   Functions are referenced using opAIdLd opcodes.  The scanner must detect
;   that the reference is a function reference from flags in the variable
;   table entry.
;
;   These routines expect only fundamental BASIC data types.  User types are
;   handled by opIdRf variants followed by OpIdOff opcodes.
;
;Parsed state opcode format:
;
;   (Nexp,...) opAId<Ld|St><Imp|I2|I4|R4|R8|CY|SD|TX>(cnt,oVar)
;
;      The expressions preceeding the opcode represent the indices whose
;   count is given by the argument cnt.
;
;Algorithm:
;
;   Calculate exe map table offset for data type from type in vt.
;   Calculate exe map offset for <I|S|F|C> from oPrsCur and vt flags
;   Load and emit executor
;   Copy operand
;   Coerce index arguments to I2.
;   If this is a Ld variant then
;	    Push stack entry
;	       operand address + 2
;	       type (with variable reference bit set)
;   Else
;	    Ensure the right side variable is of the correct type.
;   Set $STATIC flag in the variable table (if this is 1st ref).
;   Return to main loop
;
;Input:
;
;   ax	  = executor map address
;   bx	  = 2 * opcode
;   es:di = pcode emission address
;   es:si = pcode source address
;
;Output:
;
;	si,di updated
;
;Modifies:
;Exceptions:
;	Ss_Error
;******************************************************************
page
StRedirect:
	mov	ax,[bx].VAR_Value	    ;Value field has new oVar
	mov	PTRTX[si+2],ax		    ;Replace old one in pcode
	jmp	short AIdStRetry

SsProc	AIdSt,Rude
	.erre	LOW OPCODE_MASK EQ 0ffh 	    
	test	byte ptr es:[si-1],HIGH (NOT OPCODE_MASK)
	jnz	AIdStRetry			    
	mov	dx,scanOFFSET mpAStImpOpExe	    
AIdStRetry:					    
		mov	bx,[MrsCur.MRS_bdVar.BD_pb] 
	    add     bx,PTRTX[si+2]		    

	DbChk	pVar,bx 			    ;Verify this is a variable

	;Check flags to see if we're really doing a store

	    mov     ax,[bx].VAR_flags	; Fetch flags
	    TestX   ax,FVREDIRECT	;Test for redirected variable
	    jnz     StRedirect		;Go fix the redirected case
	    TestX   ax,FVFUN		;Test for function reference
	jz	@F
	mov	ax,ER_DD		;It is an error to store into a
	call	SsError 		;function with arguments.
@@:
	DbAssertTst [bx].VAR_flags,nz,FVARRAY+FVFUN,SCAN,<Ss_AIdSt: Non-Array>

	call	cDimsAndIndex		;Check cDims, index into executor map
					;CX = scan stack oTyp of variable
	jcxz	NeedOtyp		;Is it a record?
HavOtyp:				
	call	CoerceIndices		;Also restores DS if SizeD
assumes ds,DATA				
	xchg	ax,cx			;AX = oTyp of target array
	call	EnsureArgType		;Pop stack frame test for coerce
	jmp	[ScanRet]

NeedOtyp:				
	mov	cx,[bx].VAR_oTyp	;Get real oTyp for coercion
	jmp	HavOtyp			

;*****************************************************************************

LdRedirect:
	mov	ax,[bx].VAR_Value	    ;Value field has new oVar
	mov	PTRTX[si+2],ax		    ;Replace old one in pcode
	jmp	short AIdLdRetry

SsProc	AIdLd,Rude
	.erre	LOW OPCODE_MASK EQ 0ffh 	    
	test	byte ptr es:[si-1],HIGH (NOT OPCODE_MASK)
	jnz	AIdLdRetry			    
	mov	dx,scanOFFSET mpALdImpOpExe	    
AIdLdRetry:					    
		mov	bx,[MrsCur.MRS_bdVar.BD_pb] 
	    add     bx,PTRTX[si+2]		    

	DbChk	pVar,bx 			    ;Verify this is a variable

	;Check flags to see if we're really doing a load

	    mov     ax,[bx].VAR_flags	; Fetch flags
	    TestX   ax,FVREDIRECT	;Test for redirected variable
	    jnz     LdRedirect		;Go fix the redirected case
	    TestX   ax,FVFUN		;Test for function reference
	jnz	ExecFunc		;This is a function

	DbAssertTst [bx].VAR_flags,nz,FVARRAY,SCAN,<Ss_AIdLd: Non-Array>

	call	cDimsAndIndex		;Check cDims, index into executor map
	call	CoerceIndices		;Also restores DS if SizeD
assumes ds,DATA				
	or	ch,HIGH ST_ArrVar	;Indicate this is a var reference
	push	di			;oTx for coercion insertion
	push	cx			;oTyp of array element or ET_RC
	jmp	[ScanRet]

ExecFunc:
	mov	cx,PTRTX[si]		;Get count of args
	jmp	SsCallFunc

subttl	Subroutines for <AId|Id><|Off><Ld|St>
page

;cDimsAndIndex
;
;   Used by AId<Ld|St>
;   Check count of indices, then fall into SsIndexType
;
;Inputs:
;
;   dx = base of executor map
;   ds:bx = pVar
;   es:si = pointer to first operand (cDims)
;
;Exceptions:
;
;   Generate MSG_SubCnt if incorrect number of dimensions
;   Undefined Array if first ref as whole array


FirstReference:

	;It's ok to be undefined if this is a ReDim

	cmp	PTRTX[si+4],opStReDimTo 
	je	ArIndexType		


	    ;For QB4 this is the first ref to a previously undefined array.
	    ;Lets treat this as an implicit dim.  However, it is an error if
	    ;this is a whole array ref.

	    jcxz    ArrayNotDefined	; Brif whole array reference

	    test    byte ptr [bx].VAR_fStat,FV_STATIC	; Is this $Static
	    jz	    ArrayNotDefined	


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

	    cmp     [SsErr],0		; Have any errors occured?
	    jne     ArrayCmpCDims	; Brif yes.  Bypass allocation.

	    push    cx			;Save CX = cDims
	    push    dx			;Save DX = Executor map

	    mov     [SsScanExStart],1	;Indicate implicit Dim
	    push    ax			;Dummy parameter
	    push    ax			;Dummy parameter
	    call    ExecuteFromScan	;Allocate array.  AX = RT error code.

	    pop     dx			;Restore DX = Executor map
	    pop     cx			;Restore CX = cDims

		mov	bx,[MrsCur.MRS_bdVar.BD_pb]
	    add     bx,PTRTX[si+2]	;BX = pVar

	    or	    ax,ax		;Was there an error?
	    jnz     ArrayError		;Brif error code <> 0

	    jmp     short ArrayCmpCDims 


ArrayNotDefined:
	mov	ax,ER_UA		; Array not defined

ArrayError:
	call	SsError 		
	jmp	short ArIndexType	

cDimsAndIndex:
	mov	cx,PTRTX[si]		; Get actual cDims
	and	ch,7fh			; Clear MSB which indicates no ()


	    mov     [f_StaticCalc],TRUE ;$Static array if this is first ref

	;There is a problem with ReDim where the FV_STATIC bit is being set
	;when the first array reference is a ReDim with constant indices.
	;This causes the SetArrayType call in Ss_ReDim to complain about
	;ReDim of a $Static array.  The resetting of f_StaticCalc is a
	;solution.  For EB, this is done above as a default.  For QB4, implicit
	;arrays are $Static and only if this is a ReDim is $Dynamic selected.

	cmp	PTRTX[si+4],opStReDimTo 
	jne	@F			
	shr	cx,1			; AIdLd in ReDim has cDims * 2

	    mov     [f_StaticCalc],FALSE;Dynamic array if this is first ref
@@:					

	call	SetArrayType		;CY set if first ref
	jc	FirstReference		; Brif this is first reference
	jcxz	ArIndexType		; Whole array ref. Bypass cDim chk.


ArrayCmpCDims:
	DbAssertRelB	ch,e,0,SCAN,<cDimsAndIndex: cDims GT 255>
	mov	ax,MSG_SubCnt
	cmp	cl,[bx].VAR_value.ASTAT_cDims	;Cmp cDims from variable table
	jne	ArrayError		;Correct no. of indices?

ArIndexType:

	;Look for special case of integer array with 1 dimension

	dec	cx			    ; One dimension?
	jnz	SsIndexType		    ;brif no
	mov	ax,[bx].VAR_flags	    ; Fetch flags
	    TestX   ax,FVCOMMON+FVFORMAL    ;Don't optimize these
	    jnz     SsIndexType
	and	ax,FV_TYP_MASK		    ;Mask flags down to oTyp
	.erre	ET_I2 EQ 1		    
	dec	ax			    ; I2?
	jnz	SsIndexType		    ;Brif no, only optimize I2s
	add	dx,A1SOffset		    ;Point to optimized executors

	;Note:	The constant A1SOffset represents the distance between the
	;executor map for static arrays and the map for one dimension
	;static arrays.  If this is a frame array we are optimizing, the
	;map address must be adjusted again to account for the different
	;seperation.

	    TestM   [bx].VAR_flags,FVVALUESTORED    
	    jnz     SsIndexType 	;Pointing to correct executor map
	add	dx,FrameOffset+A1FrameOffset	;Correct for later ISFC calc.
; fall into SsIndexType

;SsIndexType
;
;	Used by all <AId|Id|Off><Ld|St>
;	Compute index into executor map based on type
;	Executor map is organized as follows:
;		Record
;		I2
;		I4
;		R4	    Only if R4s enabled (FV_R4)
;		R8
;		CY	    Only if currency enabled (FV_CURRENCY)
;		SD
;		TX	    Only if text enabled (FV_TEXT)
;		FS
;		FT	    Only if text enabled (FV_TEXT)
;Inputs:
;	ds:bx = pVar
;	cs:dx = base of executor map
;Outputs:
;	cx = Scan stack type
;	cs:dx = modified executor map address
;Preserves:
;	ax,bx

	public	SsIndexType,SsIndexTypeCx
SsIndexType:
	mov	cl,[bx].VAR_flags
	and	cx,FV_TYP_MASK		;CX = oTyp
SsIndexTypeCx:
	cmp	cx,ET_MAX		;Record type?
	jbe	StdType
.errnz	ET_RC
	xor	cx,cx			;Replace oType with ET_RC
StdType:
	    jb	    IndexType		
	    mov     [SsOtxHeapMove],di	;FS/FT can cause heap movement
IndexType:
;Calculate offset due to type (cx)
	add	dx,cx
	add	dx,cx			;One word per type in table
	ret



;CoerceIndices
;
;   Used by AId<Ld|St>
;   Calls SsIndexISFC, copies oVar, then coerces array indices
;
;Inputs:
;
;   dx = current executor map address
;
;Preserves:
;
;   cx

CoerceIndices:
	call	SsIndexISFC		;Locate executor, emit and copy cDims
	MOVSWTX 			;Copy oVar

	;Coerce  array indices

	pop	[SsCbParmCur]		;Get return address out of the way
	mov	bx,cx			;Preserve cx in bx
	mov	cx,PTRTX[di-4]		;count of indices
	and	ch,7fh			;clear MSB when no parens listed
	mov	ax,ET_I2		;Target type for indices
        call    SsCoerceN               ;Coerce indices to I2
	mov	cx,bx			
	jmp	[SsCbParmCur]		;Return to caller

;SsIndexISFC
;
;	Used by <AId|Id><Ld|St>
;	Call SsGetISFC to index into executor map, then fetches and emits
;	executor and one operand
;Inputs:
;	bx = pVar
;	dx = current executor map address
;Preserves
;	cx

	public	SsIndexISFC		;Restores DS if necessary


SsIndexISFC:
	push	cx
	call	SsGetISFC		;Calculate <I|S|F|C> offset from
					;   bx (MSV flags) and oPrsCur
					;Offset returned as modified dx
	pop	cx

;SsEmitExecutor
;
;   Called by Off<Ld|St>, fallen into by all others
;   Fetches executor from map, emits and copies one operand
;
;Inputs:
;
;   dx = current executor map address
;
;Preserves:
;
;   cx

	public	SsEmitExecutor
SsEmitExecutor:
	mov	bx,dx
	mov	ax,WORD PTR cs:[bx]	;Load executor
	STOSWTX 			;Emit the executor
	MOVSWTX 			;Copy the operand
	ret

subttl	Executor map for AIdLd variants
page
;Table mpALdImpOpExe is a list of AIdLdImp executors.  The list is ordered
;as follows:
;	exAId<I|E><I|S|F|C>Ld<type>
;After the Ld executors is Rf excutors for numeric types only.
;
;This table is then followed by AIdLdExp executors.
;Type "0" is used by record executors (implicits only).


	;Optimized 1-dimension load

mpA1IdISLd	equ	$ - 2			
	DWEXT	exA1IdISLdI2

	;Additional types may be added here

mpA1IdIFLd	equ	$ - 2			
	DWEXT	exA1IdIFLdI2

A1FrameOffset	=   mpA1IdIFLd - mpA1IdISLd

	;Note:	The following word fills space used by MakeRef
	;before the explicit map to find the implicit map.

	DW	0				

	public	mpALdImpOpExe
mpALdImpOpExe	label	word			


A1SOffset   =	mpA1IdISLd - $			

mpAIdISLd	label	word			
	DWEXT	exAIdISRf
	DWEXT	exAIdISLd2
	DWEXT	exAIdISLd4
	DWEXT	exAIdISLdR4
	DWEXT	exAIdISLdR8			
	DWEXT	exAIdISRfSD
	DWEXT	exAIdISLdFS

cbContext   =	$ - mpAIdISLd

mpAIdICLd	label	word			
	DWEXT	exAIdICRf
	DWEXT	exAIdICLd2
	DWEXT	exAIdICLd4
	DWEXT	exAIdICLdR4
	DWEXT	exAIdICLdR8			
	DWEXT	exAIdICRfSD
	DWEXT	exAIdICLdFS
	.erre	cbContext EQ ($-mpAIdICLd)	

mpAIdIILd	label	word			
	DWEXT	exAIdIIRf
	DWEXT	exAIdIILd2
	DWEXT	exAIdIILd4
	DWEXT	exAIdIILdR4
	DWEXT	exAIdIILdR8			
	DWEXT	exAIdIIRfSD
	DWEXT	exAIdIILdFS
	.erre	cbContext EQ ($-mpAIdIILd)	

FrameOffset =	mpAIdISLd - $