ssrude.asm

[随书类]Dos6.0源代码

;***
;HandleError
;Purpose:
;	This routine is called when an error occurs in scanning from
;	SS_RUDE to SS_PARSE. It saves away the first unscanned pcode,
;	replacing it with opEot. It saves away the error code for later
;	reporting. It sets SI & DI to zero, sets the TargetState to
;	SS_RUDE for descanning, and returns to the scan/descan loop.
;Input:
;	SI-4 points to the first unscanned pcode.
;	AL contains the qbimsgs error code; AH is likely non-zero.
;	ES is still set up for text table being scanned.
;	DI Assumed != UNDEFINED, EXCEPT for the special case where a
;		statement might be fully scanned to parse and THEN the
;		error is noticed. Example: CONST x = 1/0.
;		In this case, the otx for where the error actually occured
;		is on the stack
;Exit:
;	[SsErrOTx] = text offset to error
;
;*****************************************************************************
DbPub	HandleError
HandleError:
	SsRefreshES			; es = cur pcode seg (heap movement)
	xor	ah,ah			;convert error code to a word
	mov	[SsErr],ax
	cmp	[grs.GRS_oPrsCur],UNDEFINED
	jz	HandleErr_Cont		;brif no prs active

	cmp	[prsCur.PRS_procType],PT_DEFFN
	jnz	HandleErr_Cont		;brif active prs is not a DEF FN

	call	PrsDeActivateFar	; deactivate the DEF FN
HandleErr_Cont:
	sub	si,4			;move back to first unscanned opcode
	mov	[SsErrOTx],si		;save oTx of opcode we're replacing
	mov	ax,si			
	inc	di			;special case?
	jnz	HandleErr_Cont1		;  brif not

	pop	ax
HandleErr_Cont1:
	mov	sp,[spErrorRestore]	;in case stack in an intermediate state
	or	al,[fErrWithinOp]	;tell caller if error was at operand
	mov	[grs.GRS_otxCur],ax	;tell SsRudeScan's caller where error is
	LODSWTX				;get original opcode
	mov	[SsErrOpcode],ax	;  and save it for later restoration
	mov	WORD PTR es:[si-2],opEot
	mov	[TargetState],SS_RUDE	;so we'll descan portion scanned so far
	jmp	SsRudeScanErr		;return to the main loop

;***
;HandleId
;Purpose:
;	Given an oTyp in ax, an oNam at es:[si], and mkVar.flags
;	set up appropriately, call MakeVariable to search for
;	(and create if necessary) the variable, replacing the
;	oNam with an oVar.
;Input:
;	ax = oTyp for var
;	es:si and es:di both point to oNam in pcode
;	mkVar.flags and mkVar.cDimensions (if appropriate)
;		are already set up per varmgr spec.s.
;Output:
;	The oVar is substituted for the oNam
;	si & di point at the following word
;Preserves:
;	ES
;*****************************************************************************
DbPub	HandleId
HandleId	PROC	NEAR
	mov	[mkVar.MKVAR_oTyp],ax
	LODSWTX				;Pick up oNam
	mov	[mkVar.MKVAR_oNam],ax
	call	MakeVariableFar 	
	SsRefreshES			;es = cur pcode seg (heap movement)
	or	ah,ah			;an error return?
	js	Id_Mkvar_Error		;  brif so

	cmp	[otxConstCur],0		;scanning a CONST statement?
	jnz	ConstCheck		;  brif so

HandleId_Exit:
	STOSWTX				;emit the oVar

	xor	ax,ax
	xchg	ax,[varFlags_Reset]	; reset flag, fetch previous
					;   settings of certain flag bits
	or	[mkVar.MKVAR_flags],ax	
					;for special case; see IdLd, below
	ret

Id_Mkvar_Error:
	TESTM	mkVar.MKVAR_exitFlags,FVI_INDEXED	
	jz	HandleError5		;brif not an array pcode

Id_Error:
	dec	si			;so si points 4-bytes past opcode
	dec	si
HandleError5:
	jmp	HandleError

ConstCheck:
	test	[mkVar.MKVAR_flags2],MV_fConstFound
	jnz	HandleId_Exit		;brif things are okay, i.e., we're in
					;  a CONST statement and the variable
					;  we just found is really a constant
	mov	al,MSG_InvConst		;"Invalid Constant"
	jmp	short Id_Mkvar_Error
	
HandleId	ENDP

	page
;***
;SsVProc Unsupported
;
;Purpose:
;
;   This routine reports an error when unsupported opcodes are encountered.
;   This will occur from a binary load of a file from another basic product
;   that supports statements not supported by this product.
;
;Input:
;
;   standard rude scan dispatch.
;
;Output:
;
;   standard rude scan dispatch.
;
;**********************************************************************

SsVProc Unsupported			
	mov	al,Msg_Unsupported	
HandleError7:				
	inc	si			; Set SI-4 to point to this opcode
	inc	si			
	jmp	short HandleError5	

;***
;SsVProc Id<Ld|St>
;Purpose:
;	Simple Id SS_RUDE scan/descan dispatch points.
;
;	The only rude mode issue is to move the single operand between
;	oVar and oNam.
;
;	Scanning:
;		For each of these, the oNam in in the pcode stream,
;		the oTyp can be fetched from the rule table (mpOpRule).
;Input:
;	standard rude scan dispatch.
;Output:
;	standard rude scan dispatch.
;*****************************************************************************
SsVProc	IdSt
	jz	DIdRude
	mov	cx,[otxConstCur]
	jcxz	IdSt			;brif not scanning a CONST statement

	inc	si			;advance txt ptr to next pcode
	inc	si
	;cx = oTx of start of CONST expression
	mov	ax,si			
	sub	ax,cx			; ax = count of bytes in CONST expr.
	cCall	ScanAndExec,<cx,ax>	; creates CONST variable, scans &
					;  executes expression, setting
					;  value field in the new CONST variable
	SsRefreshES			;es = text segment
					; (ScanAndExec can cause far heap
					;  movement)
	mov	[spErrorRestore],sp	;refresh (ScanAndExec changes this)
	or	ax,ax
	jz	IdSt_NoErr		;brif no error
	js	HandleError5		;brif pcode not modified by ScanAndExec

	sub	si,4			;so we report error on correct line
	push	si
	mov	di,UNDEFINED		;signal special case, so UI will report
					;  the error on the correct line
	add	si,8			;advance oTx to reflect that the IdSt
					;  pcode did get bound to an oVar by
					;  ScanAndExec
	jmp	short HandleError5	;brif error
IdSt_NoErr:
	mov	[otxConstCur],si	;in case there are more CONSTant
					;  expressions in this statement
	jmp	short RetToScan5	;no error

IdSt:					;start of code shared for array St's
	or	[mkVar.MKVAR_flags],FVI_LVAL	
	;We know the zero flag won't be set after the above 'or', so fall thru
SsVProc	IdLd
	jz	DIdRude

	;The following tests for ReDim scalar which can appear because QB4
	;incorrectly allowed it.  The binary translator mucks with the code
	;but must leave it so it can be listed to and editted by the user.


	cmp	PTRTX[si+2],opStReDimTo+OPCODE_MASK+1	; ReDimScalar
	je	ReDimScalar
IdLd_1: 				
	;The below code is for a case like STATIC X,Y(A),Z
	;  where 'A' will be an IdLd.   We preserve and HandleId restore's the
	;  previous state of the FVI_STATIC flag in case of variables like 'Z'
	mov	cx,[mkVar.MKVAR_flags]	
	KEYWORD_FLAGS	EQU    FVI_SHARED OR FVI_COMMON OR FVI_STATIC OR FVI_DIM
	and	cx,KEYWORD_FLAGS	
	mov	[varFlags_Reset],cx	;0 or some flag bit
	and	[mkVar.MKVAR_flags],NOT KEYWORD_FLAGS	

IdLd:					;start of code shared for array Ld ID's
	call	HandleId
RetToScan5:
	jmp	RudeLoop		;return to the main loop

ReDimScalar:				
	mov	al,Msg_SubCnt		
	jmp	short HandleError7	

DIdRude:				;Common ID rude descan code
	LODSWTX				;Pick up operand
	add	ax,dx			; ax = pVariable
	xchg	bx,ax			
	mov	ax,[bx].VAR_oNam	;ax = oNam for variable
	STOSWTX				;emit the oNam
	jmp	RudeLoop		;And return to the main loop


SsVProc	VtRf
	jz	DIdRude
IdVtRf:					;start of code shared for array VtRf's
	TestM	[mkVar.MKVAR_flags],FVI_ASCLAUSE    
	jz	IdLd			;brif no 'AS' clause found

	cmp	ax,ET_IMP
	jnz	IdLd			;brif explicitly typed VtRf opcode

	mov	ax,[mkVar.MKVAR_oTyp]	;desired oTyp is already in mkVar
	jmp	short IdLd


;***
;SsVProc AId<Ld|St>
;Purpose:
;	Array Id SS_RUDE scan/descan dispatch points.
;
;	The only rude mode issue is to move the single operand between
;	oVar and oNam.
;Input:
;	standard rude scan dispatch.
;Output:
;	standard rude scan dispatch.
;*****************************************************************************
SsVProc	AIdSt
	call	AIdPreamble		;common code to all Array ID's
	jmp	short IdSt		;shared code for all St ID's

SsVProc	AIdLd
	call	AIdPreamble		;common code to all Array ID's
	cmp	PTRTX[si+2],opStReDimTo ; Is this a ReDim statement?
	je	ArrayDeclare		; Yes, need to set FVI_ARRAY
	jmp	short IdLd_1		; shared code for all Ld ID's

SsVProc	AVtRf
	call	AIdPreamble		;common code to all Array ID's
ArrayDeclare:
	shr	[mkVar.MKVAR_cDimensions],1
					;divide cDimensions by two in case this
					;  is an array ref., since the 'cnt' for
					;  that pcode counts lower & upper
					;  bounds for each dimension
	or	[mkVar.MKVAR_flags],FVI_ARRAY	
	jmp	short IdVtRf		;shared code for all VtRf ID's

;***
;AIdPreamble
;Purpose:
;	Perform actions common to all array ID opcodes. This
;	includes checking to see if we're scanning or descanning,
;	(and handling the descan case entirely), setting up 
;	mkVar.cDimensions, and setting the FVI_INDEXED bit in mkVar.flags.
;
;Input:
;	standard rude scan dispatch.
;Output:
;	ax = type of ID
;	mkVar.MKVAR_cDimensions field set up (though it could be 2  cDim's)
;	di = si
;	mkVar.flags has FVI_INDEXED set
;*****************************************************************************
DbPub	AIdPreamble
AIdPreamble	PROC	NEAR
	jz	DAIdRude
	
	xchg	ax,bx			;save array type in bx
	LODSWTX				;Pick up (assumed) cDimensions
					;  (note that this might be 2 * cDim's)
	or	ah,ah			;special value in lieu of 0?
	jns	Save_cDims		;  brif not

	xor	al,al			;set cDims to zero
Save_cDims:
	mov	[mkVar.MKVAR_cDimensions],al
	xchg	ax,bx			;common code expects type in ax
	inc	di			;set di = si
	inc	di
	or	[mkVar.MKVAR_flags],FVI_INDEXED	
	ret
AIdPreamble	ENDP

DAIdRude:
	pop	ax			;throw away return addr from AIdPreamble
	inc	si			;skip index count
	inc	si
	mov	di,si			;Move to oVar operand
	jmp	DIdRude 		; and dereference just like an Id


;***
;SsVProc Off<Ld|St>
;Purpose:
;	Record offset Id SS_RUDE scan/descan dispatch points.
;
;	Scan work:	Convert oNam to oElem 
;	Descan work:	Convert oElem to oNam
;Input:
;	standard rude scan dispatch.
;	Count on the oTyp of parent being in mkVar.oTyp.
;Output:
;	standard rude scan dispatch.
;	Leave the oTyp of found element in mkVar.oTyp.
;*****************************************************************************
SsVProc	OffLd
SsVProc OffSt
	xchg	ax,bx			; bx == explicit type constant
	LODSWTX				;fetch oNam/oElem from pcode
	jz	D_Off			;brif descanning

	cmp	[mkVar.MKVAR_oTyp],ET_MAX
	jbe	Not_User_Defined	;[26] brif not user defined type

	cCall	RefElem,<ax,bx> 	;[36]
	SsRefreshES			;es = cur pcode seg (heap movement)
	or	ax,ax			
	js	HandleError2		;brif error return

Off_Exit:
	STOSWTX				;emit the oElem/oNam (common exit point)
RetToScan7:				
	jmp	RudeLoop		;return to the main loop

D_Off:
	mov	bx,dx			    ; get start of type table (bdVar)
	add	bx,ax			    ;bx = pElem
	mov	ax,[bx.ELEM_oNam]	    ;fetch oNam of the element
	jmp	short Off_Exit		; emit the oNam/iCE and return
					; to main loop

Not_User_Defined:			
OffError_oTyp:
	mov	al,MSG_BadElemRef	;in case this isn't of 
					;     user defined type