ssrude.asm

[随书类]Dos6.0源代码

	dec	si
	jmp	short HandleError3

StProcError:
	;Found an error while scanning a formal parameter for a SUB, FUNCTION,
	;  or DEF. SI points past this formal parameter (that was itself
	;  unmodified). 
	;For StProcError, [si-4] = oNam. This will cause oNam of the formal
	;  to be temporarily replaced with opEot; wierd, but saves code.
	
	mov	[fErrWithinOp],1	;tell caller error was in operand
HandleError3:
	jmp	HandleError

StProc_Scan:				;scan each formal parameter for the proc
	;es:si points 2-bytes before the oPrs for FUNCTION/DEF statement
	;bl = procType of proc

	cmp	bl,PT_DEFFN		;are we scanning a DEF FN statement?
	jnz	Not_Def_Fn		;  brif not

	push	bx			
	call	MakePrsTVar		;make variable hash table for DEF FN
	pop	bx			
	SsRefreshES			;es = cur pcode seg (heap movement)
	or	ax,ax			;error return?
	mov	al,ER_OM		
	jz	HandleError3		;  brif so

Not_Def_Fn:
	;At this point, we make a RetVal entry for the FUNCTION/DEF FN.
	;This is so there is space in the variable table for this, even
	;if not used, in case we determine at execute scan time that we
	;have a RetVal where we thought we had a reference. Note that this
	;logic depends on the fact that we always end up in SS_RUDE when a
	;FUNCTION or DEF FN is added.
	;Note that we assume that the oTyp and oNam are still valid in mkVar
	;for this FUNCTION or DEF FN
	mov	[mkVar.MKVAR_flags],FVI_LVAL	
	push	bx			
	call	MakeVariableFar 	;search for and create var if not found
	pop	bx			
	;Note that we don't use the return value, i.e., it doesn't go in the
	;pcode - - - the goal is just to create the retval entry.
	SsRefreshES			;es = cur pcode seg (heap movement)
	or	ah,ah			;an error return?
	jns	StProc_Scan1		; brif not

	cmp	bl,PT_DEFFN		
	jz	HandleError3		; si-4 points to opStDefFn

	inc	si			
	inc	si			
	DbAssertRelB bl,z,PT_FUNCTION,SCAN,<ssrude:opStFunction, invalid PT_ type>
	jmp	HandleError3		; si-4 points to opStFunction

StProc_Scan1:				;SUB support joins up w/FUNCTION & 
					;  DEF FN support here
	add	si,6			; point si past oPrs and procAttr 
	.errnz	DCL_oPrs - 2		; operands
	LODSWTX				;get count of parameters
	.errnz	DCL_cParms - 6
	mov	cx,ax			;cx = count of parm sets (3 words/set)
	jcxz	RetToScan3		;brif zero parms
	inc	ax			;test for UNDEFINED
					;special value indicating no parameters?
	jz	RetToScan3		;  brif so

	or	[mkVar.MKVAR_flags],FVI_FORMAL	
	mov	BYTE PTR [mkVar.MKVAR_cDimensions],0
					;set this to default for any array parms
DbPub	FormalParm_Loop
FormalParm_Loop:
	mov	di,si			;reset di to point to oNam of parm
	LODSWTX				;ax = oNam of parm
	mov	[mkVar.MKVAR_oNam],ax
	LODSWTX				;ax = flags for parm
	mov	dx,ax
	and	ax,(FVI_ARRAY OR FVI_ASCLAUSE)	
	or	[mkVar.MKVAR_flags],ax
.erre	FVI_ARRAY AND PATR_array	
.erre	FVI_ASCLAUSE AND PATR_asClause	
	mov	ax,ET_IMP
	TESTX	dx,<PATR_asClause OR PATR_explicit>
	jz	Set_Typ			;brif must set oTyp to default based on
					;  oNam
	mov	ax,es:[si]		;oTyp or oNam
	DbAssertRel ax,nz,0,SCAN,<ssrude formal parm found with AS ANY oTyp>
	;(AS ANY clause only valid for DECLARE statement)
	cmp	ax,ET_MAX		;is this a predefined type?
	jbe	Set_Typ			; brif so (CAN'T be fixed-length string)
					;ax is the oNam of a user type
	push	cx			;save count of formals across call
	cCall	RefTyp,<ax,si>		;returns oTyp or error code	
	pop	cx
	or	ah,ah			;an error return?
	jns	Set_Typ			;  brif no error
StProcError1:
	jmp	StProcError
Set_Typ:
	mov	[mkVar.MKVAR_oTyp],ax
	push	cx			;preserve count of formals
	call	MakeVariableFar 	; create the parm entry
	pop	cx
	SsRefreshES			;es = cur pcode seg (heap movement)
	or	ah,ah			;was an error code returned?
	js	StProcError1		;  brif so
	
	STOSWTX				;replace oNam with oVar
	mov	ax,[mkVar.MKVAR_oTyp]
	mov	es:[si],ax		;put oTyp of found/created var in pcode
@@:
	inc	si			;skip past oTyp field
	inc	si
	DJMP loop FormalParm_Loop  	;continue for each parameter

	and	[mkVar.MKVAR_flags],NOT FVI_FORMAL	
					;turn off this flag for subsequent
					;  scanning
RetToScan1:
	jmp	RudeLoop		;return to the main loop

;***
;SsVProc StDeclare
;Purpose:
;	Call varmgr with FUNCTION name only - - we don't create variables
;	for SUB's, and the parser guarantees that we'll never see a DECLARE
;	for a DEF FN (invalid syntax).  
;	Note that the oVar returned by MakeVariable is discarded
;	we need to call this to create var entry if it doesn't
;	already exist.
;
;	For each formal parameter, if oTyp not correctly set (based on flags
;	in pcode), set it based on current def type.
;
;Input:
;	standard rude scan dispatch.
;Output:
;	standard rude scan dispatch.
;*****************************************************************************
SsVProc	StDeclare
	pushf
	LODSWTX				;ax = cntEos operand
	add	ax,si			;ax points to next opcode
	popf
	jnz	Scan_StDeclare		;brif scanning, not descanning

	;descanning - - must convert each user-defined oTyp in formal parm
	;  list to an oNam, since the type table is gone when in SS_RUDE.
	;share code with StSub/StDefFn/StFunction for this
	add	si,DCL_cParms-2		;point to count of formal parms	
	xchg	ax,bx			;tell shared code we there are no
					;  oVar's to convert to oNam's
	jmp	D_FormalParm_Descan
Scan_StDeclare:
	push	ax			;save, so we can skip alias text @ end
	dec	si
	dec	si			;si points to cntEos operand
	xor	cx,cx			;can't be a DEFFN
	call	HandleProcName		;make the var if it's DECLARE FUNCTION
	SsRefreshES			;es = cur pcode seg (heap movement)
	cmp	bl,PT_FUNCTION
	jnz	StDeclare_Cont		;only change pCode for DECLARE FUNCTION

	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 FUNCTION
	DbAssertRel  dx,be,ET_FS,SCAN,<SsV_StDeclare: oTyp is invalid>
	or	ax,dx			; set correct oTyp in pcode for later
	mov	es:[si.DCL_atr],ax	;	checking by execute scanner
	xchg	ax,cx			; ax = oPrs (from HanldeProcName)
	call	PPrsOPrsSCAN		; bx = pPrs
	and	PTRRS[bx.PRS_oType],NOT M_PT_OTYPE ; turn off existing oTyp bits
	or	BPTRRS[bx.PRS_oType],dl ; ensure oTyp field set correctly in prs
StDeclare_Cont:
	add	si,DCL_cParms		;point to count of formal parms	
	LODSWTX				;ax = cParms operand
	mov	cx,ax			;cx = count of parms in pcode
	inc	ax			;no parms? (test for UNDEFINED)
	jz	StDeclare_Exit		;  exit if so - si points to next opcode
	jcxz	StDeclare_Exit		;brif no formals to scan
Declare_Formal_Loop:
	;loop for each formal parm in DECLARE pcode, setting the oTyp to
	;  the appropriate default if required
	LODSWTX				;ax = oNam of parameter
	xchg	ax,dx
	LODSWTX				;ax = flags, si points to oTyp field
	push	cx			;preserve count of formals
	TESTX	ax,<PATR_asClause OR PATR_explicit>
	jz	Formal_Type_Def_Set	;brif must set oTyp to default based on
					;  oNam
	mov	ax,es:[si]		;oTyp or oNam
	cmp	ax,ET_MAX		;is this a predefined type?
	jbe	Formal_Type_Set		; brif so (CAN'T be fixed-length string)
					;ax is the oNam of a user type
	cCall	RefTyp,<ax,si>		;returns oTyp or error code	
	SsRefreshES			; es = cur pcode seg (heap movement)
	or	ah,ah			;an error return?
	jns	Set_Formal_Typ		;  brif not
	mov	[fErrWithinOp],1	;tell caller error was in operand
HandleError4:
	jmp	HandleError

Formal_Type_Def_Set:
	cCall	oTypOfONamDefault,<dx>	; default oTyp for given oNam
	SsRefreshES			; es = cur pcode seg (heap movement)
Set_Formal_Typ:
	mov	es:[si],ax		;put default oTyp in pcode
Formal_Type_Set:
	pop	cx			;restore count of formals
	inc	si			;skip past this formal
	inc	si
	loop	Declare_Formal_Loop	;brif another formal to scan	
StDeclare_Exit:
	pop	si			;pointer to next pcode
RetToScan4:
	jmp	RetToScan1

;***
;SsVProc StEndDef
;Purpose:
;	This dispatch point is required for END DEF
;	to deactivate the current prs. Keeping prsCur correct during
;	rude scanning is important so that variable search & creation
;	is performed correctly.
;
;Input:
;	standard rude scan dispatch.
;Output:
;	standard rude scan dispatch.
;*****************************************************************************
SsVProc	EndSingleDef
SsVProc	StEndDef
	jz	Operand_Skip_Ret	;do nothing in descan case

	mov	[oNamOfPrsCur],UNDEFINED ; reset to default - just in case
	push	cx			;save opcode for operand skipping
	cCall	PrsDeActivateFar	
	pop	cx
	jmp	short Operand_Skip_Ret


;***
;SsVProc StType
;Purpose:
;	Rude scan an entire TYPE/END TYPE block
;Exit:
;	si points to 1st opcode after opStEndType
;
;*****************************************************************************
SsVProc	StType
	jz	Operand_Skip_Ret	;brif descanning to SS_RUDE

	push	si			;in case of error return
	call	ScanTypeBlock
	pop	cx			;previous (pushed) oTx
	SsRefreshES			;es = cur pcode seg (heap movement)
	or	ax,ax			
	je	RetToScan4		;brif no error

	inc	cx			
	inc	cx			;cx points 4-bytes past opStType
	xchg	cx,si			;si for descanning up to opStType
	push	cx			;oTx of where error really occured
	mov	di,UNDEFINED		;signal special case to HandleError
	jmp	SHORT HandleError4	;descan up to this opcode, report error

;***
;SsVProc StEndType
;Purpose:
;	Report "END TYPE without TYPE error, since all balanced opStEndType
;	opcodes are consumed by ScanTypeBlock.
;
;*****************************************************************************
SsVProc	StEndType
	jz	Operand_Skip_Ret	;brif descanning to SS_RUDE
	inc	si			;bump si by 2 for HandleError
	inc	si
	mov	al,MSG_NoType		;give "END TYPE without TYPE error"
	jmp	SHORT HandleError4

;***
;SsVProc StConst
;Purpose:
;
;Input:
;	standard rude scan dispatch.
;Output:
;	standard rude scan dispatch.
;*****************************************************************************
SsVProc	StConst
	mov	[otxConstCur],si	;remember we're scanning a CONSTant stmt
					;  and save current text pointer
	jmp	short RetToScan4
	
;***
;SsVProc For, Next, NextId
;Purpose:
;
;Input:
;	standard rude scan dispatch.
;Output:
;	standard rude scan dispatch.
;*****************************************************************************
SsVProc	For
SsVProc	Next
SsVProc	NextId
	mov	word ptr es:[si],UNDEFINED
					;replace oBP with UNDEFINED,
					;  so it will be so reset by the time
					;  the scanner sees it again (i.e.,
					;  in case we are descanning or have
					;  descanned from SS_PARSE to SS_RUDE)
	jmp	short Operand_Skip_Ret
	
;***
;SsVProc Bos,Bol,BolLabDef
;Purpose:
;	At the start of each statement, reset mkVar.flags to
;	all zeroes (default bit-flag values). This is necessary,
;	since some flags (such as STATIC, COMMON) must stay in
;	effect for the duration of a statement.
;
;Input:
;	standard rude scan dispatch.
;Output:
;	standard rude scan dispatch.
;*****************************************************************************
SsVProc	Bol
SsVProc	BolEmit
SsVProc	BolLabDef
	mov	ax,[SsLineCount]
	inc	ax
	mov	[SsLineCount],ax
	test	al,LineUpdate-1		;Time to update line count on screen?
	jz	UpdateLine		;brif so
SsVProc	Bos
Bos:
	sub	ax,ax
	mov	[mkVar.MKVAR_flags],ax
	mov	[otxConstCur],ax	;in case we were scanning a CONST stmt
Operand_Skip_Ret:
	mov	bx,cx			;put opcode into bx
	mov	cl,mpOpAtr.[bx]		;load attribute byte
	jmp	Ssv_NOps		;skip past operands, return to loop

UpdateLine:
	cmp	[TargetState],SS_RUDE	;Are we descanning?
	jz	Bos			;  brif so - no line count

	push	cx
	PUSH_ES 			
	push	dx
	cCall	UpdStatusLn,<ax>
	pop	dx
	POP_ES				
	pop	cx
	jmp	short Bos

sEnd	SCAN
end