rterror.asm

Microsoft MS-DOS6.0 完整源代码

	TITLE	RTERROR - interpreter-specific error handling code
;***
;rterror.asm - interpreter-specific error handling code
;
;	Copyright <C> 1986, 1987 Microsoft Corporation
;
;Purpose:
;	This module contains interpreter-specific code to restore context
;	to a clean state after some runtime error occurs, or to invoke a
;	users error trap if one exists.
;
;
;*******************************************************************************

	.xlist
	include 	version.inc

;set these runtime switches, just so we can include messages.inc (which
;we include just so we can map their internal error constants to ours)
FE_EVENT = TRUE
OM_DOS2  = TRUE
OX_XENIX = FALSE

	RTERROR_ASM = ON
	includeOnce	architec
	includeOnce	context
	includeOnce	executor
	includeOnce	exint
	includeOnce	heap
	include 	messages.inc
	includeOnce	names
	includeOnce	opcontrl
	includeOnce	qbimsgs
	includeOnce	rtinterp
	includeOnce	rtps
	includeOnce	scanner			
	includeOnce	txtmgr
	includeOnce	ui
	includeOnce	util
	.list

assumes DS, DATA
assumes SS, DATA
assumes ES, NOTHING

sBegin	DATA
	externW	b$fInt24Err	; 0 ==> rt gives error on int 24
				; -1 ==> rt saves int24 error code and
				;        ignores it. No errors have occurred
				; NZ ==> an int24 error has occurred
	externB	b$inonerr	;TRUE if currently executing in an error trap
	externW	b$errnum	;standard BASIC error code for error
	externW	b$errlin	;line number of error
	externD	b$erradr	;far address of error if in compiled code
	externD	b$errmod	;far pointer to name of module in which error
				;  occurred
	externW	b$fcomperr	;Set 0 by B$IONERR to tell user interface that
				;  error occured in QB4 code; if non-zero, tells
				;  UI to use b$errmod, b$erradr.
	externW	b$cCSubs	;count of invocations of compiled BASIC code
	externB	b$ErrInfo	;extended error codes (UI <--> Runtime)
	externW RtDispVecHigh	;must be reset on runtime error
	staticW	otxSave,0	
	staticW	oRsSave,0	
	staticW	pGosubSave,0	
	globalB fBreakOnErr,0	
sEnd	DATA

	EXTRN	B$RUNERRINFO:FAR
	EXTRN	B$END:FAR	;call if internal error to force QB4 termination
	EXTRN	B$PUTS:NEAR	;used to output err msg for really fatal errors
	EXTRN	B$ClearRange:FAR ;frees all owners in a given range
	EXTRN	SetSpFar:FAR	;used to restore BOS/BOL SP based on BP
	EXTRN	B$ASSN:FAR	;used to obtain SEG address of runtime entry pts
	EXTRN	B$STDALCALLTMP:NEAR	
				; frees temp strings at or above current levl
	EXTRN	B$RESUMED:far	; RT support code for the RESUME stmt

;	Message numbers used by the UL loader.

	PUBLIC	ER_DMA		;Dos Arena error
	PUBLIC	ER_ULM		;Memory allocation error
	PUBLIC	ER_ULO		;Out of memory error
	PUBLIC	ER_ULI		;Invalid user library format error
	PUBLIC	ER_ULD		;Disk IO error
	PUBLIC	ER_ULF		;Cannot find file error (if redirected IO)
	PUBLIC	ER_ULE		;Error message preamble
	PUBLIC	ER_ULG		;Error message postamble
	PUBLIC	ER_ULP		;Path prompt preamble
	PUBLIC	ER_ULT		;Path prompt postamble

	.errnz	FE_QBINITBASE AND 00FFH
				;assuming that low-byte of FE_QBINITBASE is 0
	QB_RTERR_MASK EQU FE_QBINITBASE SHR 8
				;byte mask to OR into a normal error message
				;  to make it a QB-specific initialization
				;  error code (but print out w/same string)

sBegin	RT
assumes CS, RT

;***
; B$PUTNUM - Print numbered message to the screen
;
;Purpose:
; Prints a string to the console device (B$PTRFIL = 0), as referenced by the
; passed message number
;
;Entry:
; [AX] = Message number
;
;Exit:
; none.
;
;Uses:
;
;******************************************************************************
cProc	B$PUTNUM,<NEAR,PUBLIC>
cBegin
	or	ah,ah			;internal error?
	jz	Got_QB4_Err		;brif not - error number o.k.

	cmp	ah,QB_RTERR_MASK	;error during init noted in own code?
	jnz	Not_QB_Init_Error	; brif not one of ours

	xor	ah,ah			;mask of high byte; al contains a
					; standard runtime error message
	jmp	short Got_QB4_Err
Not_QB_Init_Error:
	DbAssertRel  ax,nz,FE_NOLINEBASE,RT,<B$PUTNUM Error>
	mov	bx,FE_NOTHINGBASE	;first Runtime message # in fourth set
	mov	cx,ER_D21		;first QB4 message # in fourth set
	cmp	ax,bx
	jnb	Get_QB4_Err		;brif in last of 4 internal msg sets

	mov	bx,FE_BASE		;first Runtime message # in middle set
	mov	cx,ER_SSC		;first QB4 message # in middle set
	cmp	ax,bx
	jnb	Get_QB4_Err		;brif in first of 4 internal msg sets

In_First_Set:
	mov	bx,MS_BASE		;first Runtime message # in first set
	mov	cx,ER_RFS		;first QB4 message # in first set
Get_QB4_Err:
	sub	ax,bx			;ax = offset into appropriate group
	add	ax,cx			;add start of QB4 message group
Got_QB4_Err:
	cCall	ListStdMsgFar,<ax>	;put error msg in bufStdMsg
	mov	dx,ds
	mov	ax,dataOFFSET bufStdMsg	;dx:ax points to error message
	cCall	B$PUTS
cEnd

;***
;B$IErrSaveState
;Purpose:
;	This routine added as part of revision [5].
;
;	Save key QB-specific state variables away so that a later call to
;	B$IErrRestState can restore them.
;Entry:
;	none.
;Exit:
;	none.
;*******************************************************************************
cProc	B$IErrSaveState,<PUBLIC,NEAR,NODATA>
cBegin
	mov	ax,[pGosubLast]
	mov	[pGosubSave],ax
	mov	ax,[grs.GRS_otxCur]
	mov	[otxSave],ax
	mov	ax,[grs.GRS_oRsCur]
	mov	[oRsSave],ax
cEnd

;***
;B$IErrRestState
;Purpose:
;	This routine added as part of revision [5].
;
;	Restore QB-specific state variables saved by B$IErrSaveState
;Entry:
;	none.
;Exit:
;	none.
;*******************************************************************************
cProc	B$IErrRestState,<PUBLIC,NEAR,NODATA>
cBegin
	mov	ax,[pGosubSave]
	mov	[pGosubLast],ax
	mov	ax,[otxSave]
	mov	[grs.GRS_otxCur],ax
	push	[oRsSave]
	call	RsActivate
cEnd

;***
;B$IONERR - branch to user's error trap if there is one
;Purpose:
;	This routine greatly reworked as part of revision [5]
;
;	When a runtime error occurs, the runtime first calls B$IErrSaveState
;	so we can preserve grs.oRsCur, grs.otxCur, and pGosubLast. It also
;	preserves such variables as b$curlevel, b$curframe, and b$cNonQBIFrames.
;	Then the stack is walked, using the most recent BASIC frame (via
;	b$curframe); the BASIC-specific chain is used to find each BASIC
;	frame, and b$cCSubs is used to indicate whether the frame is for
;	compiled or interpreted BASIC code (and thus whether B$CONERR or
;	B$IONERR should be called). 
;	
;	When this routine is called, b$curframe, oRsCur, etc. are all set up
;	for the QB-specific frame of current interest. If this frame is for
;	a context for which there is an active error handler (and barring any
;	special cases), all frames below (more recent to) this one get their
;	owners released (i.e., that part of the stack is "blasted"), and
;	the error handler is invoked; ERL is set as if the error occured in
;	this context, and RESUME [NEXT | line#] act the same way.
;
;	If there is no error handler, we return to the runtime; we return
;	a flag that indicates whether the runtime code should keep walking
;	the stack or not. Currently, we say "quit looking" if the current
;	frame is an event frame.
;
;	Eventually, either a frame is found (QB or BC) that has an active
;	error handler and this is invoked, OR, we find an event frame or
;	the end (top) of the stack. In this latter case, the runtime restores
;	the context at which the error occured (with help from the QB callback
;	routine B$IErrRestState) and calls B$FERROR.
;
;	In the event that we find an error trap to invoke, we clean the stack.
;	In order to clean the stack, we set BP to b$curframe, depending on
;	this always being the current frame pointer. Based on the current 
;	context	(and with the help of the procmgr), we restore SP to what 
;	it was at the beginning of the statement in which the error occured 
;	by calculating what it should be based on BP. We also release any
;	owners left on the stack below what should be there for the current
;	frame.
;
;	In order to save the otx for RESUME, we know that, on input to this
;	routine, grs.GRS_otxCur is the value of SI on entry to the runtime 
;	entry point from which the runtime error code was called.
;	Note that the RESUME state cannot get the otx directly; we must
;	call a routine to move that otx back to the last opBOS, and save
;	THAT otx in the RESUME state.
;
;	Note that, to invoke an error trap, this routine will have to
;	deactivate the current prs, if any, load DI and ES for mrsCur,
;	set SI to the otx for the trap, clean the stack (restoring SP
;	and BP from b$curframe), as well as set up the RESUME state.
;
;
;	An exception to the above is the case where some runtime entry point
;	was called from a place in the interpreter that expects to get the
;	error code back, rather than have a runtime error occur. In this
;	case, the global errCodeRet.SPsave will be non-zero. SI, DI, SP, and
;	BP will be restored from the errCodeRet structure, and the interpreter
;	routine at CP:[errCodeRet.retAddr] will be JMP'd to, with the error
;	code in AX.
;
;Entry:
;	Error code is in b$errnum
;	b$curframe assumed valid
;	grs.GRS_otxCur contains the otx prior to runtime call.
;	pFrameErr is the frame pointer 1 level below error time
;Exit:
;	b$errlin	= line number of error
;	AX = 0 if the error must be treated as a fatal error, perhaps because
;		b$errnum > 255, or the current frame is an event frame and
;		has no handler, or ...
;	AX <> 0 means it's okay for the runtime to continue walking the frame
;		chain looking for an invokeable error handler.
;Uses:
;	SI and DI.
;Exceptions:
;	If the user has no error trap, this routine returns, but if
;	there is an error trap or in certain other instances, we'll clean the 
;	stack and never return.
;
;*******************************************************************************
cProc	B$IONERR,<PUBLIC,NEAR,NODATA>
parmW	pFrameErr			;frame pointer 1 level below error time
cBegin
	DbAssertRel  [b$cCSubs],z,0,RT,<B$IONERR: b$cCSubs not 0>
	mov	[executorFlags],0	;reset to BOS state
	mov	[RtDispVecHigh],SEG B$ASSN ;restore default in case of math err
	mov	ax,[b$errnum]
	or	ah,ah			;error number > 255?
	jz	BIONERR_Cont		;  brif not - not an internal error

	DbAssertRel  ax,ae,FE_BASE,RT,<B$IONERR Got bad internal error from RT>
	DbAssertRel  ax,nz,FE_NOLINES,RT,<B$IONERR: FE_NOLINES found> 
	cmp	ax,FE_GODIRECT
	jnz	J1_BIONERR_NoCont_Exit	;internal error, exit QBI
BIONERR_Cont:
	mov	cx,[errCodeRet.ERRRET_saveSP]
	jcxz	No_Err_Ret		;brif not trying to fake an error return

	cmp	ax,FE_GODIRECT
	jnz	RtTrapRet_Jump

	mov	ax,MSG_GoDirect
RtTrapRet_Jump:
	mov	[b$errnum],ax
	jmp	far ptr RtTrapRet	;return to caller from CP segment

No_Err_Ret:
	mov	[b$errnum],ax		;in case of a modified message number
	;we should only find internal errors here when fInitialized is false:
	DbAssertRelB  [fInitialized],nz,0,RT,<B$IONERR: fInitialized is True>

	xor	cx,cx
	mov	[DimAtScanType],cl	; In case of error during Dim
	mov	[grs.GRS_flagsDir],cl	;reset flags which get reset every
					; time we begin executing pcode,
					; or when a runtime error occurs.

	cmp	ax,FE_GODIRECT
	jnz	NotGoDirect

; Some special untrappable error has occurred which gets us back to
;  the user interface.	This currently happens with:
;	   MSG_GoDirect - User presses CANCEL button in response
;	   to some dialog boxes. (NOTE: this is a case where B$IONERR
;	   can be called from the U.I.)

	mov	[b$errnum],MSG_GoDirect
	jmp	short J2_BIONERR_NoCont_Exit

NotGoDirect:
	cmp	[grs.GRS_fDirect],FALSE	;in direct mode?
	jz	BIONERR_Cont1		;  brif not
					;don't trap errors in direct mode 
					;  statements
J2_BIONERR_NoCont_Exit:
 	mov	[otxSave],0		; reset otxCur to zero, since we're
 					; in direct mode
J1_BIONERR_NoCont_Exit:
	sub	ax,ax			;tell runtime to quit looking for 
					;  an error handler to invoke
	jmp	BIONERR_Exit		;brif special error which gets us
					; back to user interface.
BIONERR_Cont1:
	test	[grs.GRS_flags],FG_WatchActive
	jz	@F			; brif WATCH pcode not executing

	call	far ptr B$FERROR	; don't return to runtime, because
					; that would cause b$inonerr to
					; be reset (and user code might
					; be in an error handler)
@@:					
					
	cmp	[grs.GRS_otxCur],UNDEFINED
	jz	J2_BIONERR_NoCont_Exit	; error must not be trapped,
					; report error at start of text tbl
					; (error occurred after end of text
					; or an END or SYSTEM statement)
	cmp	[b$inonerr],FALSE
	jnz	J1_BIONERR_NoCont_Exit	;brif we're already in an error trap

	cmp	[b$errnum],ER_OM	;Out of memory error?
	jnz	BIONERR_Cont3		;  brif not

	cmp	[b$errinfo],OMErr_STK	;was it really a stack overflow error?
	jz	J1_BIONERR_NoCont_Exit	;  brif so - - - untrappable
BIONERR_Cont3:

	mov	di,[grs.GRS_oMrsCur]	; di points to active mrs in table
	RS_BASE add,di			
	GETRS_SEG es			
	cmp	PTRRS[di.MRS_otxHandler],UNDEFINED	
	jnz	BIONERR_Cont3a		;brif there is a trap to invoke

	;Now, use pGosubLast chain to determine if the current frame is
	;  an event frame. If so, set ax = 0 and exit, else set ax <> 0,
	;  and update otxCur, oRsCur, and pGosubLast for previous qb
	;  frame and exit.  Exception: If b$mainframe == b$curframe,
	;  then don't bother - - - leave ax set as it is and just exit
	;  (because there IS no previous qb frame, and runtime will
	;  immediately see that and quit looping).
	mov	si,[b$curframe]
	cmp	si,[b$mainframe]
	jz	BIONERR_Exit1		;brif this is the first frame on stack
					;  (don't care what ax is here ...)
	mov	bx,[pGosubLast]
Examine_Gosubs:
	or	bx,bx
	jz	NotEventFrame		;brif no gosubs (left)

	cmp	bx,si
	ja	NotEventFrame		; brif no gosubs for current frame

	cmp	word ptr [bx+2],1	;is this an event frame?
	jz	J1_BIONERR_NoCont_Exit	;  brif so - runtime should quit looking

	mov	bx,[bx]			;loop for each gosub in current frame
	jmp	Examine_Gosubs

NotEventFrame:
	;At this point, we know that 
	;	(1) the current frame has no error handler,
	;	(2) the current frame is not an event frame
	;	(3) there is at least one QB frame on the stack previous (above)