ssrude.asm

[随书类]Dos6.0源代码

HandleError2:
	jmp	HandleError		;descan up to this opcode, report error
	

;***
;SsVProc AsType - handle opAsType and opAsTypeExp
;Purpose:
;	Set the mkVar flag to note that an 'AS' clause has been
;	seen, and set mkVar.oTyp to the appropriate type.
;	op[A]IdVtRfImp dispatch points must check to see if
;	the FVI_ASCLAUSE bit is set in mkVar.flags, and leave the
;	oTyp alone if so (rather than loading it from the rule
;	table index).
;Input:
;	standard rude scan dispatch.
;Output:
;	standard rude scan dispatch.
;
;*****************************************************************************
SsVProc	AsType				;Includes AsTypeExp
	jz	D_AsType		;no descanning work here
	
	or	[mkVar.MKVAR_flags],FVI_ASCLAUSE	
	LODSWTX				;ax = 1st operand
	cmp	cx,opAsType		;is this for opAsType?
	jnz	AsTypeExp		;  brif not - opAsTypeExp

	cCall	RefTyp,<ax,di>
	SsRefreshES			; es = cur pcode seg (heap movement)
	or	ah,ah			;an error return?
	jns	AsType_Cont		;  brif not
HandleError6:
	jmp	short HandleError2
AsTypeExp:
	cmp	cx,opAsTypeExp
	jz	AsType_Cont		;ax contains a pre-defined oTyp

	DbAssertRel cx,z,opAsTypeFixed,SCAN,<SsVProc AsType: unexpected opcode>
	xchg	ax,dx
	LODSWTX 			;ax contains cbFS or oNam of const
					;  or oNam of FORM/MENU
	or	dh,dh			;length, or oNam?
	jns	AsTypeFixed_Cont	;  brif ax == length

	or	[mkVar.MKVAR_flags2],MV_fONamInOTyp
	and	dh,07FH 		;mask to make this a normal oTyp
AsTypeFixed_Cont:
	.errnz	MKVAR_fsLength - MKVAR_oNamForm 
	mov	[mkVar.MKVAR_fsLength],ax
	xchg	ax,dx
AsType_Cont:				;have type in ax
	mov	[mkVar.MKVAR_oTyp],ax
	inc	si
	inc	si			;Skip listing column
	jmp	short RetToScan2

D_AsType:
	add	si,4			;skip to next pcode if descanning
	cmp	cx,opAsTypeFixed
	jnz	RetToScan2		;brif only two-bytes to skip

	inc	si
	inc	si			;Skip listing column
	jmp	short RetToScan2

;***
;SsVProc StDefTyp
;Purpose:
;	Grab the 4-byte mask from the pcode; pass this to SetDefBits to
;	reset the default type for specified alphabet letters.
;Input:
;	standard rude scan dispatch.
;Output:
;	standard rude scan dispatch.
;*****************************************************************************
SsVProc	StDefType
	jz	D_DefType		;no descanning work here

	inc	si			;skip link field - - point to
	inc	si			;  I4mask in pcode
	LODSWTX				;Pick up low word
	xchg	ax,dx			;DX = Low word of mask
	LODSWTX 			;AX:DX = I4mask
	push	ax			
	push	dx			
	and	dl,FV_TYP_MASK		; mask out all but type constant
	push	dx			
	call	SetDefBits		;set new type default(s)
	SsRefreshES			; es = cur pcode seg (heap movement)
RetToScan2:
	jmp	RudeLoop		;return to the main loop


D_DefType:
	;fall through to StStatic for return to descan loop

;***
;SsVProc StCommon, StShared, StStatic, Shared
;Purpose:
;	Set flags for later variable references. Each of these
;	opcodes come before the associated Id opcodes, so these
;	flags are simply set up, and left until BOS/BOL.
;
;	To save code, don't bother to detect if we're scanning or
;	descanning; just set the flags regardless.
;
;Input:
;	standard rude scan dispatch.
;Output:
;	standard rude scan dispatch.
;*****************************************************************************
SsVProc	StStatic
	or	[mkVar.MKVAR_flags],FVI_STATIC	
RetToScanOps:
	jmp	Operand_Skip_Ret	;skip operands and return to main loop

SsVProc	StCommon
	or	[mkVar.MKVAR_flags],FVI_COMMON	
	jmp	short	RetToScanOps

SsVProc	StShared
SsVProc	Shared
	or	[mkVar.MKVAR_flags],FVI_SHARED	
	jmp	short	RetToScanOps	

SsVProc StDim
	or	[mkVar.MKVAR_flags],FVI_DIM	
	jmp	short	RetToScanOps	


;***
;HandleProcName
;Purpose:
;	Shared code for handling the procedure name in a
;	DECLARE, FUNCTION, or DEF FN statement. Calls MakeVariable.
;
;	NOTE: See qbipcode.txt for a description of the procAtr word in
;		the pcode in order to better understand this routine.
;Input:
;	es:[si+2] = oNam or oPrs for procedure
;	If this is for a DEF FN, bits cl = PT_DEFFN, else cx = 0
;Exit:
;	Should not be called for a SUB definition. If called for DECLARE SUB, 
;		does nothing, only return value is bl = PT_SUB.
;	Otherwise,
;		no Prs is active (i.e. module level text tbl is active)
;		mkVar.MKVAR_oTyp contains oTyp returned by MakeVariable
;		bl contains the procType of the prs
;		cx = oPrs of FUNCTION/DEF FN
;Preserves:
;	SI,DI,ES
;Exceptions:
;	This routine handles MakeVariable error return
;*****************************************************************************
DbPub	HandleProcName
HandleProcName PROC NEAR
	mov	ax,es:[si.DCL_atr]	;ax = procAtr operand
	and	ah,DCLA_procType / 100h	;ah = procType (PT_SUB etc.)
	mov	bl,PT_SUB		;put procType in bl in case of a SUB
	cmp	ah,bl			;is this a SUB?
	DJMP	jz HandleProc_Exit	;  brif so - do nothing, exit

HandleProcName_Cont:
	push	[grs.GRS_oRsCur]	;save caller's oRs
	test	al,DCLA_Explicit	;explicitly typed DEF or FUNCTION?
	jnz	HandleProc_Type		;  brif so

	mov	al,ET_IMP		;proc was implicitly typed
HandleProc_Type:
	and	ax,DCLA_oTyp		;ax = oTyp returned by function
	mov	[mkVar.MKVAR_oTyp],ax
	mov	bx,es:[si.DCL_oPrs]	;fetch oPrs (or oNam) from pcode stream
	jcxz	NotDefFn

	mov	[oNamOfPrsCur],bx	;speed optimization - used by varmgr
					;  This is safe because varmgr only uses
					;  this when grs.oPrsCur != UNDEFINED
	push	bx			;oNam of DEF FN
	push	cx			;procType
	cmp	al,ET_IMP		;implicitly typed DEF FN?
	jnz	Not_Implicit		;  brif not

	cCall	oTypOfONamDefault,<bx>	; returns ax = default oTyp
					;	for this oNam
Not_Implicit:
	push	ax			;oTyp of DEF FN (could be ET_IMP)
	xor	dx,dx
	push	dx			;fNotDefine
	call	PrsDefine
	SsRefreshES			;es = cur pcode seg (new txt tbl)
	or	ax,ax
	jnz	ProcNameError		;error in defining prs for DEF FN

	or	[prsCur.PRS_flags],FP_DEFINED
	mov	ax,si
	sub	ax,4			;ax == otx of opStDefFn
	mov	[prsCur.PRS_otxDef],ax
        mov     ax,[grs.GRS_oMrsCur]
        mov     [prsCur.PRS_oRsDef],ax  ;oRsDef is the module's oRS

	mov	bx,[grs.GRS_oPrsCur]	;oPrs for DEF FN
	mov	es:[si.DCL_oPrs],bx	;replace oNam in pcode with oPrs
NotDefFn:
	push	bx			; save oPrs across calls
	push	bx			;pass oPrs to FieldsOfPrs below
	call	PrsDeActivateFar	; make main level variable for
					;  DEF FN or FUNCTION
	cCall	FieldsOfPrsFar		; get oNam in ax, procType in dl
					; parm was already pushed above
	mov	[mkVar.MKVAR_oNam],ax
	push	dx			;save procType for retval
	cmp	dl,PT_FUNCTION		;is this prs for a FUNCTION?
	jnz	ProcFlagsSet		;  brif not - - must be for a DEF FN

	or	[mkVar.MKVAR_flags],FVI_FUNCTION	
ProcFlagsSet:
	call	MakeVariableFar 	;search for and create var if not found
	pop	bx			;restore procType for retval
	pop	cx			; restore oPrs
	or	ah,ah			;an error return?
	js	HandleProc_Error	;  brif so

	DbAssertRel [mkVar.MKVAR_oTyp],nz,ET_IMP,SCAN,<HandleProcName:ET_IMP oTyp>
	pop	dx			;discard caller's grs.oRsCur
HandleProc_Exit:
	ret

HandleProc_Error:
	TESTM	mkVar.MKVAR_exitFlags,FVI_FNNAME	
					;Note: could use DX instead if
					;	MakeVariable in native code
	jnz	ProcNameError		;brif an opStDefFn pcode
	inc	si			;so si points 4-bytes past opcode
	inc	si			; as expected by HandleError
ProcNameError:
	pop	dx			;dx = caller's grs.oRsCur
	push	ax			;save error code
	cCall	RsActivate,<dx> 	; re-activate caller's oRs
	pop	ax			;restore ax = error code
HandleError1:
	jmp	HandleError
HandleProcName	ENDP

;***
;SsVProc StDefFn, StFunction, StSub
;Purpose:
;	Handle the pcodes for SUB, FUNCTION, and DEF.
;
;	For SUB, the proc name is ignored, and we share
;	code with the others for handling each formal
;	parameter (all given as operands to the opcode).
;
;	For DEF, we must bypass the link field; otherwise,
;	it is treated the same as FUNCTION (common code
;	will set the FVI_FUNCTION flag as appropriate).
;
;Inputs:
;	standard rude scan dispatch.
;Outputs:
;	standard rude scan dispatch.
;*****************************************************************************
SsVProc	StDefFn
	pushf
	inc	si			;move to 2-bytes prior to oPrs
	inc	si			;  DECLARE & FUNCTION have no 'link'
	cmp	[grs.GRS_oPrsCur],UNDEFINED
	jne	DefInDefErr		;brif found in another prs
	mov	cl,PT_DEFFN		;tell HanldeProcName this is a DefFn
	popf
	jmp	short Func_Or_Def

DefInDefErr:
	mov	ax,MSG_InvProc		;"Invalid within procedure"
	jmp	SHORT HandleError1

SsVProc	StFunction
	mov	cx,0			;'mov' doesn't affect flags
Func_Or_Def:
	jz	StProc_DeScan		;skip the following if descanning

	call	HandleProcName		;calls MakeVariable for FUNCTION/DEF
	push	bx			;save bl=procType
	cCall	PrsActivate,<cx>	; make FUNCTION/DEF FN active
	pop	bx			;restore bl=procType
	SsRefreshES			;es = cur pcode seg (new txt tbl)
	mov	ax,es:[si.DCL_atr]	;ax = procAtr operand
	and	ax,NOT DCLA_oTyp	;mask out existing oTyp
	mov	dx,[mkVar.MKVAR_oTyp]	;get actual oTyp of DEF FN or FUNCTION
	DbAssertRel  dx,be,ET_FS,SCAN,<SsV_StFunction: oTyp is invalid>
	or	ax,dx			;set correct oTyp in pcode, for later
	mov	es:[si.DCL_atr],ax	;  checking by execute scanner
	and	[prsCur.PRS_oType],NOT M_PT_OTYPE   ; turn off existing oTyp bits
	or	[prsCur.PRS_oType],dl	; ensure oType field set correctly in prs
	DJMP	jmp SHORT StProc_Scan

SsVProc	StSub
	;at this point, es:[si+2] is the proc oPrs; PSW.Z set if descanning
	mov	bl,PT_SUB
	jz	Not_A_DefFn		;brif descanning to SS_RUDE

	jmp	StProc_Scan1		;brif scanning to SS_PARSE

StProc_DeScan:
	;descanning: walk through parms, converting each oVar to an oNam

	;first, reset prs.oVarHash and replace oPrs with oNam in pcode if this
	; is a DEF FN
	jcxz	Not_A_DefFn
	mov	ax,es:[si.DCL_oPrs]	;get oPrs
	push	dx			;save pVarTable
	cCall	FieldsOfPrsFar,<ax>	;ax = oNam, dl = proctype
	DbAssertRelB dl,z,PT_DEFFN,SCAN,<rude descan: dl should == PT_DEFFN here>
	mov	es:[si.DCL_oPrs],ax	;replace oPrs for DEF FN with oNam
	pop	dx			;restore pVarTable
Not_A_DefFn:
	xor	bx,bx			;bx = zero indicates we have oVar's that
					;  must be converted to oNam's
	add	si,DCL_cParms		;mov to parm count
D_FormalParm_Descan:
	LODSWTX				
	mov	cx,ax			;cx = count of parm sets (3 words/set)
	inc	ax			;no parms? (test for UNDEFINED)
	jz	D_Formal_Exit		;  exit if so - si points to next opcode
	jcxz	D_Formal_Exit		;exit if parm count of zero
D_FormalParm_Loop:
	mov	di,si			;point to the oVar in pcode
	cmp	[SsErrOTx],si
	jz	RetToScan3		;special case: if a scan error occured
					;  in this formal parm, the 'oNam' field
					;  will now contain opEot; just dispatch
					;  to it now if we've descanned to error
	LODSWTX				;fetch oVar (or oNam if DECLARE)
	or	bx,bx			;are we descanning a DECLARE statment?
	jnz	D_ONam_Okay		;  brif so - - oNam field fine as is

	add	ax,dx			; ax = pVariable
	xchg	bx,ax			
	mov	ax,[bx].VAR_oNam	;ax = oNam for variable
	STOSWTX				;emit the oNam
	xor	bx,bx			;bx == 0 ===> not descanning a DECLARE
D_ONam_Okay:
	inc	si			;move source pointer to
	inc	si			;  the oTyp field
	LODSWTX
	cmp	ax,ET_MAX		;user-defined oTyp?
	jbe	D_Formal_Cont		;  brif not - - leave it alone

	push	bx
	cCall	ONamOTyp,<ax>		; ax = oNam for name of this type
	pop	bx
	mov	es:[si-2],ax		;replace oTyp with oNam of type in pcode
D_Formal_Cont:
	loop	D_FormalParm_Loop	;loop for each parm set
D_Formal_Exit:
	or	bx,bx			;descanning a DECLARE?
	jz	RetToScan3		;  brif not
	
	mov	si,bx			;skip past alias text in pcode
RetToScan3:
	jmp	RudeLoop		;return to the main loop

OM_ProcError:
	mov	al,ER_OM		;insufficient memory for var hash table
	dec	si			;[si-4] = opStDefFn