home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
DP Tool Club 19
/
CD_ASCQ_19_010295.iso
/
vrac
/
bugslay.zip
/
BUGSLAY.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1994-09-29
|
8KB
|
220 lines
{BugSlay (TM) Run time error handler.
Generates stack trace in the event of an error using BugSlay.DLL. If
unable to load BugSlay, a run time error message is shown with instructions
to contact technical support.
See BugSlay.WRI for details.
Rex K. Perkins, 6th September 1992.
Revised 9th February 1994 for exception trapping and symbols.
Revised 13th June 1994 for stack trace.
⌐ Copyright Apsley-Bolton Computers, Inc.}
Unit BugSlay;
Interface
Implementation
Uses WinProcs, WinTypes, ExceptionHandler, ToolHelp, Win31, BugSlayImports,
{$IfDef Ver15}
WObjects; {WObjects in TPW1.5}
{$Else}
OMemory; {OMemory in BP7}
{$EndIf}
{$S-,B-}
{$W-} {BugSlay does not support Windows stack frames, so turn them off}
{$IfDef Ver15} {Local in TPW1.5, default in BPW7}
{$G+} {Enable 286 instructions}
{$EndIf}
Var OldExitProc:Pointer;
ExceptionCallbackAddr:TFarProc;
Type
TLongSplit=Record
Case Byte Of
0:(Lo,Hi:Word);
1:(Byte0,Byte1,Byte2,Byte3:Byte);
2:(Long:Longint);
3:(Ptr:Pointer);
4:(Offset,Segment:Word);
5:(PStr:PChar)
End;
{------------------------External functions---------------------------------}
Function AltInterruptRegister(Task:THandle;lpfn:TFarProc):Bool; Far; External 'TOOLHELP' Index 75;
{Alternative InterruptRegister. Relaxed type checking}
{--------------------------Local functions-------------------------------}
Procedure SetOptions;
{Set the BugSlay options}
Begin
BugSlayImports.SetBugSlayOptions(
{Reserved1, Reserved2} 0,0,
{td_LogFileTrace} td_Normal,
{td_LogFileOverview} td_DoStackTrace OR td_ModuleName,
{td_AuxTrace} td_DoStackTrace OR td_HeapDump OR td_ModuleName,
{MaxFrames} 10000,
{HeapBytesToDump} 13,
{OWLSafetyPoolSize} SafetyPoolSize, {In OMemory(BP7) or WObjects(TPW1.5)}
{MaxDumpSize} 32,
{MaxUnroll} 3,
{DoHeapAllocationCheck} True,
{AuxName} 'NUL',
{ErrorLogFilename} 'c:\error',
{Reserved3} 0)
End;
{-------------------------Replacement exit procedure----------------------}
Procedure NewExitProc; Far;
{Called upon application termination. If ErrorAddr<>Nil then an error
occured, else normal termination. See ExitProc in the BP help for
details}
Var ExitText:Array[0..254] Of Char;
ErrorStackFrame:Word;
ErrorSegment:Word;
ExitStats:Record {Record allows us to use WVSPrintF}
Code:Integer;
Segment:Longint;
Offset:Longint
End;
{$IfDef Ver15}
{GetInstanceModule 'Macro' is missing from the TPW 1.5 WIN31 unit,
so provide it here}
Function GetInstanceModule(Instance:THandle):THandle;
{Return the module handle of a given instance}
Begin
GetInstanceModule:=GetModuleHandle(POINTER(LONGINT(Instance)))
End;
Function SelectorToSegment(Selector:Word):Word; Assembler;
{Convert a selector to a logical segment. Needed only for TPW1.5.
Since this is only called by the exit procedure, we know Selector
is in our code, so we can use the Pascal shortcut to get the segment
number. The compiler puts the logical segment number in the
first word of the code segment. Returns 0 if Selector is invalid}
ASM
xor ax,ax {First, check Selector is valid}
cmp Selector,$FFFF {Is selector $FFFF, ie NPU related error?}
jz @SelectorInvalid {Yes. Pass along as $FFFF}
lsl ax,Selector {Will set ax to the segment's limit (i.e. maximum offset) if it
is valid, else ax remains unchanged}
cmp ax,0 {Check for 0 limit or invalid. LSL did set Z flag, but check for 0 limit here}
je @SelectorInvalid {Invalid selector or limit=0}
mov es,Selector {Get the logical segment at Selector:0}
mov ax,es:[0] {Function result is in ax}
@SelectorInvalid: {If jumped here, ax(=Result) is 0 already}
End;
{$EndIf}
Begin
ExitProc:=OldExitProc; {Restore the old exit procedure}
{If an error occured recover the stack frame (BP) where it occured}
If ErrorAddr<>Nil Then
ASM
mov bx,SS:[BP] {Skip over ONE stack frame}
mov ax,ss
lsl ax,ax {Check BP's previous value is valid}
cmp bx,ax
jae @OutOfRange {Old BP>=SS limit. Invalid}
mov ErrorStackFrame,bx
jmp @End
@OutOfRange:
mov ErrorStackFrame,$FFFE {BP chain is invalid}
@End:
End
Else
ErrorStackFrame:=$FFFE; {Program ended normally}
{$IfDef Ver15}
{TPW returns selector:offset in ErrorAddr. Convert this to logical segment:offset}
ErrorSegment:=SelectorToSegment(TLongSplit(ErrorAddr).Segment);
{$Else}
{BPW returns segment:offset in ErrorAddr}
ErrorSegment:=TLongSplit(ErrorAddr).Segment;
{$EndIf}
If ExceptionCallbackAddr<>Nil Then {Uninstall the exception handler, if installed}
Begin
InterruptUnregister(0);
FreeProcInstance(ExceptionCallbackAddr)
End;
If BugSlayImports.BugSlayLoaded Then
BugSlayImports.AppStatusDump(GetInstanceModule(hInstance),SSeg,ErrorStackFrame,ErrorSegment,
TLongSplit(ErrorAddr).Offset,ExitCode,HeapList,True)
Else
If ErrorAddr<>Nil Then {A run time error occured and we aren't logging it}
Begin {Display a [slightly] friendlier message box}
ExitStats.Code:=ExitCode;
ExitStats.Segment:=ErrorSegment;
ExitStats.Offset:=TLongSplit(ErrorAddr).Offset;
WVSPrintF(ExitText,'A fatal error occured.'#10'Please contact technical support,'#10'specifying error'+
' %4u at %04.4lX:%04.4lX',ExitStats);
MessageBox(0,ExitText,'Fatal error',mb_SystemModal OR mb_OK OR mb_IconStop)
End;
ErrorAddr:=Nil {We handled the error, no need for anyone else to hear about it. Clear the address}
End;
Begin
{Notes for DLLs:
1) Due to the SYSTEM unit's implemtation of DLL run time error exit code
we can't trap these errors. Our exit handler doesn't get called until
the WEP and is then called in a Windows supplied stack (for implicit
links). We can't do anything useful here.
2) Don't install the exception handler for DLLs. Install them only
in applications, one per task. The app's handler can trap DLL errors
anyway.}
If DSeg=SSeg Then {Don't install the handlers in a DLL, ie SS<>DS}
Begin
OldExitProc:=ExitProc; {Add our exit procedure to the exit chain}
ExitProc:=@NewExitProc;
If BugSlayImports.BugSlayLoaded Then
Begin {Install the exception handler and set BugSlay options only if BugSlay is loaded}
SetOptions;
ExceptionCallbackAddr:=MakeProcInstance(@ExceptionHandler.ExceptionCallback,HInstance);
If (ExceptionCallbackAddr<>Nil) Then
AltInterruptRegister(0,ExceptionCallbackAddr) {Install an interrupt call back}
End
Else
ExceptionCallbackAddr:=Nil
End
Else
ExceptionCallbackAddr:=Nil
End.