ssscan.asm

Microsoft MS-DOS6.0 完整源代码

	TITLE	SSSCAN	-	Main Static Scanner Module
;***
;ssscan - Main static scanner module
;
;	Copyright <C> 1986, Microsoft Corporation
;
;Purpose:
;
;   This is the main static scanner module.  It contains all external
;   interfaces to the module.  These interfaces are:
;   ssscan	      - scans the current text table to executor mode.
;   SsDescan(toState) - descans current text table to the state specified
;			this state may be SS_PARSE or SS_RUDE.
;
;
;****************************************************************************

	.xlist
	include 	version.inc
SSSCAN_ASM	= ON
	IncludeOnce	context
	IncludeOnce	executor
	IncludeOnce	opmin
	IncludeOnce	opstmt
	IncludeOnce	optables
	IncludeOnce	pcode
	IncludeOnce	qbimsgs
	IncludeOnce	rtinterp
	IncludeOnce	ssint
	IncludeOnce	txtmgr
	IncludeOnce	variable
	.list

assumes ds, DATA
assumes es, NOTHING
assumes SS, DATA

extrn	B$IFindEvHandler:far
extrn	exBolLab:far


	    extrn   DimImplicit:far	


sBegin	DATA

EmitErrOtx	dw	0

sEnd	DATA


sBegin	SCAN
assumes cs,SCAN

;*************************************************************************
;UpdateTxdBdl - Update the TXD or BDL for text table
;
; Purpose:
;
;   Update the txdCur (or the direct mode bdl) for this text table.
;
; Entry:
;
;   al = scanState
;   di = cbLogicalNew	    oTx of opEOT + 2
;
;   The structure txdCur identifies the current text table.
;   If grs.fDirect is TRUE, the direct mode text table (grs.bdlDirect)
;      is used instead.
;
; Preserves:
;
;   All
;
;*************************************************************************
UpdateTxdBdl:
	cmp	grs.GRS_fDirect,FALSE
	jne	DirectMode		;branch if in direct mode
	mov	txdCur.TXD_bdlText_cbLogical,di
	mov	txdCur.TXD_scanState,al
	ret

DirectMode:
	mov	[grs.GRS_bdlDirect_cbLogical],di
	ret

;***
; TxLnkInit
; Entry:
;	bx points to table to use for SsLinkCtl
; Exit:
;	ax = 0 (callers assume this)
; preserves: bx,dx (callers assume this)
;
;********************************************************
TxLnkInit PROC NEAR
	push	es
	push	di
	mov	SsLinkCtl,bx		;Save for scan dispatch routines
	push	ds
	pop	es
	mov	di,bx
	mov	cx,(size TXLNK)/2	;Count of bytes in structure
	xor	ax,ax			;Get a zero
	rep	stosw			;Initialize link controls to zero
	pop	di
	pop	es
	ret
TxLnkInit ENDP

;***
;ushort SsScan - Scan pcode from SS_PARSE to SS_EXECUTE
;
;Purpose:
;
;   In the case of an error, the pcode is left entirely
;   in the state in which the pcode was found.	An error
;   code is always returned.
;
;   This procedure causes memory allocations in the
;   interpreter and far heaps.
;
;   Certain scan routines push identified frames on the stack.
;   These frames must be uniquely identifiable, as other scan
;   routines must check to see if they exist.  At scan initialization,
;   an end-of-frame identifier is pushed on the stack, ensuring
;   that the bottom of the stack is not misinterpreted as some
;   particular scan stack entry.
;
;   NOTE: If grs.GRS_fDirect is TRUE on entry, txdCur should be
;	    ignored, and we should assume that the text table (whose
;	    segment is obtained via TxtSegCur) is in SS_RUDE, and
;	    must be scanned to SS_EXECUTE. Note also that the information
;	    in txdCur should be unchanged on return in this case.
;
;Algorithm:
;
;   Determine whether current text table is in SS_EXECUTE already
;      return if so
;   Grow the text table
;      If cbScanned = 0 then guess that cbScanned = 1.3 * cbText
;      Attempt to grow the text table by cbScanned
;	    error if NO growth possible
;      Move text up to end
;	    relink all links
;   Set up for main scan loop
;      install return address
;      set up es, si, di
;      push an end-of-stack frame identifier
;   Loop to completion
;   pop end-of-stack frame identifier
;   Return
;
;Entry:
;
;   grs.GRS_fDirect	 Current context information
;   rs	    mrsCur	 Current context information
;   ushort  oPrsCur	 Offset of current procedure.
;			    UNDEFINED = module
;   prs     prsCur	 Procedure context if
;			    oPrsCur != UNDEFINED
;
;Exit:
;
;   ax	    = 0 if no error occurred
;	      or
;	      error code
;   SsScan		 Standard BASIC error code
;   grs.context 	 Pcode address of the error
;			 or
;			 unmodified
;Exceptions:
;
;   None
;
;********************************************************
cProc	SsScan,<FAR,PUBLIC>,<si,di>

	localV	txLinks,<SIZE TXLNK>

ScanXj: jmp	ScanX

cBegin	SsScan

	DbMessTimer	SCAN,<Enter SsScan - >

;Assume not direct mode
	mov	cx,txdCur.TXD_bdlText_cbLogical ;Bytes of text
	cmp	grs.GRS_fDirect,FALSE		;Direct mode?
	jz	GetTXDInfoX			;Program mode
	xor	cx,cx
GetTXDInfoX:
;Grow the text, ensuring a gap between emit and source
	shr	cx,1
	shr	cx,1
	shr	cx,1			;Gap should equal 1/8 source size.
	GETSEGTXTCUR			;es = the text segment
	xor	ax,ax
	mov	SsCbTxExpand,ax 	;Initialize bytes of text expansion
	mov	[ScannerFlags],ax
	SetStartOtx	si		;oTxSrc
	mov	di,si			;oTxEmit
	DbChkTxdCur			;perform sanity check on txdCur
	call	SsMakeGap		;Ensure enough gap to scan (cx=gap)
	mov	ax,ER_OM		;Indicate out of memory
	jc	ScanXj			;Out of memory - can't scan
	lea	bx,txLinks		;Address of link controls
	call	TxLnkInit		;init txLinks structure to 0
					;ax = 0
					;preserves: bx,ax,dx, uses: cx,es
	mov	dx,txdCur.TXD_otxLabLink;Label link head pointer
	mov	[bx].TXLNK_LabDefNext,dx;offset of next label definition
					;LabDefLast left at zero

	cmp	grs.GRS_fDirect,FALSE	;Direct mode?
	jnz	InitLinks		;If direct mode, don't worry about CONT
	or	[txdCur].TXD_otxLabLink,1 ;Set LSB to indicate unbound

	    mov     bx,dataOFFSET prsCur.PRS_cbFrameTemp    ;Assume PRS
	    test    byte ptr [grs.GRS_oRsCur+1],80H	    ;MRS?
	    jnz     @F					    ;No
	    and     [mrsCur].MRS_flags,not FM_OptionBase1   ;Set option base 0
	    mov     bx,dataOFFSET mrsCur.MRS_cbFrameTemp
	    mov     [mrsCur.MRS_data_otxFirst],UNDEFINED    ;Init head of DATA list
@@:
	    xchg    ax,[bx]		;Zero cbFrameTemp if not direct mode
	push	ax			;Save old cbFrameTemp
	mov	bx,[grs.GRS_otxCONT]	;Get CONT otx
	inc	bx
	jz	InitLinks		;Can't continue, don't swap pcode
	mov	cx,[grs.GRS_oRsCONT]	;Get CONT oRS
	call	GetOtxRS		;Make sure oRS in cx isn't for DefFn
	cmp	cx,[grs.GRS_oRsCur]	;Is it the one we're scanning?
	jnz	InitLinks
	mov	ax,opNoList0
	xchg	ax,PTRTX[bx-1+si-StartOtx] ; Replace CONT pcode with special
	mov	[SsErrOpcode],ax	;Save original pcode

InitLinks:
	xor	ax,ax			;AX = 0

	mov	f_Static,TRUE		;Set $STATIC in effect flag

	;Initialize oTypCur and oValCur fields in COMMON to zero

	    mov     bx,[grs.GRS_bdtComBlk.BD_pb]
	mov	cx,ax
ZeroCom:
	cmp	cx,[grs.GRS_bdtComBlk.BD_cbLogical] ;Within size of block?
	jae	@F
	mov	[bx].COM_oTypCur,ax	;Zero oTypCur
	mov	[bx].COM_oValCur,ax
	add	bx,size COM
	add	cx,size COM
	jmp	ZeroCom

@@:

	mov	ssStackSave,sp		;Preserve the sp from start of scan loop
.errnz	STYP_StackEnd			;Stack base indicator used to determine
	push	ax			; end of control structures on stack

ScanToExeStart:
	xor	ax,ax
	mov	[SsCbFrameTemp],ax	;Count of temps in next statement
	mov	[SsErr],ax		;Error code
	mov	[SsExec],ax		;No executable code yet
	dec	ax
	mov	[SsErrOTx],ax		;Set error location to FFFF
	mov	[grs.GRS_oTxCur],ax	
	mov	[EmitErrOtx],ax
	mov	[SsDelayCnt],ax
	mov	[SsOTxPatchBos],ax	

	;Top of scan loop when pcode has HeapMove flag set

	public	SetScanRet
SetScanRet:
	mov	[SsOtxHeapMove],di
	mov	ScanRet,SCANOFFSET ScanToExeLoop  ;Set return address for
						;  dispatched opcode scanners

	;Main scan loop for SS_PARSE to SS_EXECUTE

	public	ScanToExeLoop
ScanToExeLoop:
	LODSWTX
	and	ax,OPCODE_MASK


	mov	bx,ax
	mov	al,mpOpAtr[bx]
	or	[SsExecFlag],al
	test	al,OPA_fHeapMove	;Cause heap movement?
	jnz	SetHeapMove
GetExe:
	shl	bx,1
	mov	ax,mpOpExe[bx]		;Get nominal executor
	mov	dx,ax			; Some routines want it in DX
DbPub   DispSS
DispSS:
	jmp	mpOpScanDisp[bx]	;Dispatch to scan routine for opcode

SetHeapMove:
	mov	[ScanRet],SCANOFFSET SetScanRet
	jmp	GetExe

Public	ScanExit
ScanExit:
	pop	ax			;Remove stack base indicator
	call	SsFrameType		;Make sure nothing's on the stack
	mov	sp,[SsStackSave]
	mov	al,SS_EXECUTE		;Scan state of text table
	cCall	UpdateTxdBdl		;Update the TXD or BDL for this table
;See if temp space grew.  If there are frames for this procedure on the stack,
;then temps can't grow.  An exception is if the only frame is the one on the
;top of the stack, where the gosub return addresses can be moved down to make
;more room.  Although direct mode allocates temp space off the current proc,
;it doesn't matter if it grows then because the procedure itself doesn't
;need (or use) the space.
	cmp	grs.GRS_fDirect,FALSE	;Direct mode?
	jnz	CouldCont		;Could always continue if direct mode
;Check for CantCont because temps grew
	pop	ax			;Original cbFrameTemp
	test	[SsFlags],SSF_CantCont	;Already detect CantCont situation?
	jnz	SetCantCont
	test	byte ptr [grs.GRS_oRsCur+1],80H	;MRS?
	    mov     bx,dataOFFSET mrsCur.MRS_cbFrameTemp
	    jz	    TempsGrow		;Brif MRS
	    mov     bx,dataOFFSET prsCur.PRS_cbFrameTemp
TempsGrow:
	    cmp     ax,[bx]		;Did it grow?
	jae	CouldCont		;Didn't grow--still can continue
;Grew FrameTemps
	mov	bx,dataOffset b$CurFrame
	cCall	ActiveORs_Frame,<bx>	; See if frame on stack
	or	ax,ax			
	jz	CouldCont		; Didn't find one
SetCantCont:
	call	CantCont
CouldCont:
;Compute max size of blank COMMON type and value tables
	mov	bx,[grs.GRS_bdtComBlk.BD_pb];pBlankCommon
	mov	ax,[bx].COM_oTypCur	;Size of type table
	cmp	ax,[oTypComMax]		;Grow?
	jbe	MaxComSize
	mov	[oTypComMax],ax		;Set new max
	mov	ax,[bx].COM_oValCur
	mov	[oValComMax],ax		;Set new max for value table
MaxComSize:
	DbChkTxdCur			;perform sanity check on txdCur
	DbMessTimer	SCAN,<Leave SsScan - >
	mov	ax,[SsErr]		;Return error code in ax
	or	ax,ax
	jz	ScanX
	cmp	[grs.GRS_fDirect],FALSE ;don't descan direct mode buffer
	jne	ScanX			;branch if in direct mode
	push	ax			;Descan sets it own error--save ours
	call	far ptr SsDescanErr	;Back to parse state if error
	pop	ax
ScanX:
cEnd	SsScan

;CheckSLoop - exe loop nonRELEASE checking code


subttl	SsDescan
page
;***
;SsDescan
;
;Purpose:
;
;   Descan is dispatched as:
;	    [[mpOpScanDisp+(([executor-2])*2)]-2]
;
;   That is, the descan address is in memory as the word before
;   each scan routine.	This is memory conservative, as there are
;   relatively few scan routines compared to opcodes or executors.
;
;   Individual descan routines must determine descan requirements
;   based on ssTarget and the current pcode state.  This is efficient
;   in that there are few descan routines that are state sensitive.
;
;   When descanning from executor state all pcodes that can be inserted
;   by SsScan only are removed.  In other words scan routines do not have
;   to check to see if coercion tokens (for example) have already been
;   inserted.  This is efficient in that it is usually as hard to check
;   to see if the work is required as it is to simply do the work.
;
;   Descan routines are dispatched with:
;   ax = opcode
;   si = descan source
;   di = descan destination
;
;*******************************************************************************
public	SsDescan
cProc	SsDescanErr,<FAR>,<es,si,di>
	localW	oTxtLast		;Offset of last pcode word
	localV	txLinks,<SIZE TXLNK>	;Link list control
SsDescan:
	mov	[SsErrOTx],-1		;Set error location to FFFF
cBegin	SsDescanErr
	DbMessTimer	SCAN,<Enter SsDeScan - >
	DbChkTxdCur			;perform sanity check on txdCur
	DbAssertRelB grs.GRS_fDirect,e,0,SCAN,<descan called for direct mode buffer>
	DbAssertRelB txdCur.TXD_scanState,e,SS_EXECUTE,SCAN,<descan called when not in EXECUTE state>


;Load text segment to es:
	GETSEGTXTCUR			;es = seg adr of cur text table
	SetStartOtx	di		;Start at the beginning of text
					; and debind labels to oTxt
	call	SsLabelRefDebind	;First descan label references
	mov	ax,UNDEFINED
	mov	txdCur.TXD_otxLabLink,ax;Update txd head pointer
	lea	bx,txLinks		;Address of link control struc
	call	TxLnkInit		;init txLinks structure to 0
					;ax = 0
					;preserves: bx,ax,dx, uses: cx,es
	mov	[SsErr],ax
	mov	ax,txdCur.TXD_bdlText_cbLogical
	dec	ax
	dec	ax
	mov	oTxtLast,ax		;Save offset of last pcode word
	SetStartOtx	si		;Descan from the start
	mov	di,si			;Destination = source
	mov	[SsCbTxExpand],si
	mov	[ScanRet],SCANOFFSET ContDescanLoop ;Descan routines
						;return through ScanRet
SortOTx:
	mov	dx,[EmitErrOtx]		;Start sort with error location
	mov	[SsReturnBp],dataOFFSET EmitErrOtx
	call	FCanCont		; ZF set if user can't continue
	jz	SetNextOtxJ		;Don't search others if can't cont.
	push	si
	push	di
	mov	si,[pGosubLast] 	;Head of gosub list
	mov	di,[b$CurFrame]	;Start of bp return addr chain
	mov	cx,[grs.GRS_oRsCONT]	;cx = current pc's oRs
	mov	bx,dataOFFSET grs.GRS_oTxCONT
FixORs:
	call	GetOtxRS		;Make sure oRS in cx isn't for DefFn
CompOTx:
	test	byte ptr [bx],1 	;Special one we should ignore?
	jnz	NextOTx 		;Brif return to direct mode
	call	CheckUpdate
NextOTx:
	;Scan GOSUB return address list for returns in oPRS = cx

	or	si,si
	jz	CheckFrame		;No more gosub returns
	cmp	si,di			;Still within current module/procedure
	ja	CheckFrame
	lea	bx,[si].FR_otxRet
	mov	si,[si]
	jmp	CompOTx

CheckFrame:
	cmp	di,[b$MainFrame]	;End of list?
	jz	SetNext
	lea	bx,[di].FR_otxRet
	mov	cx,[di].FR_oRsRet	;oRS of return address
	mov	di,[di].FR_basBpLink	
	jmp	FixORs

SetNextOtxJ:
	jmp	short SetNextOtx

SetOtxCont:
	mov	ax,di
	inc	ax			;Set LSB of otx to remember it's set
	mov	[grs.GRS_otxCont],ax	;Set new CONT otx
	jmp	SortOtx

SetErrorLoc:
	mov	ax,di
	dec	ax