home *** CD-ROM | disk | FTP | other *** search
/ The Pier Shareware 6 / The_Pier_Shareware_Number_6_(The_Pier_Exchange)_(1995).iso / 013 / bugslay.zip / BUGSLAY.PAS < prev    next >
Pascal/Delphi Source File  |  1994-09-29  |  8KB  |  220 lines
  1.  
  2.  
  3. {BugSlay (TM) Run time error handler.
  4.  
  5. Generates stack trace in the event of an error using BugSlay.DLL. If
  6. unable to load BugSlay, a run time error message is shown with instructions
  7. to contact technical support.
  8.  
  9. See BugSlay.WRI for details.
  10.  
  11. Rex K. Perkins, 6th September 1992.
  12.         Revised 9th February 1994 for exception trapping and symbols.
  13.         Revised 13th June 1994 for stack trace.
  14.  
  15. ⌐ Copyright Apsley-Bolton Computers, Inc.}
  16.  
  17. Unit BugSlay;
  18.  
  19. Interface
  20.  
  21. Implementation
  22.  
  23. Uses WinProcs, WinTypes, ExceptionHandler, ToolHelp, Win31, BugSlayImports,
  24.   {$IfDef Ver15}
  25.      WObjects;    {WObjects in TPW1.5}
  26.   {$Else}
  27.      OMemory;     {OMemory in BP7}
  28.   {$EndIf}
  29.  
  30.  
  31. {$S-,B-}
  32. {$W-}    {BugSlay does not support Windows stack frames, so turn them off}
  33.  
  34. {$IfDef Ver15}  {Local in TPW1.5, default in BPW7}
  35.   {$G+}  {Enable 286 instructions}
  36. {$EndIf}
  37.  
  38.  
  39.  
  40. Var OldExitProc:Pointer;
  41.     ExceptionCallbackAddr:TFarProc;
  42.  
  43. Type
  44.     TLongSplit=Record
  45.       Case Byte Of
  46.         0:(Lo,Hi:Word);
  47.         1:(Byte0,Byte1,Byte2,Byte3:Byte);
  48.         2:(Long:Longint);
  49.         3:(Ptr:Pointer);
  50.         4:(Offset,Segment:Word);
  51.         5:(PStr:PChar)
  52.     End;
  53.  
  54.  
  55.  
  56. {------------------------External functions---------------------------------}
  57.  
  58.   Function AltInterruptRegister(Task:THandle;lpfn:TFarProc):Bool; Far; External 'TOOLHELP' Index 75;
  59.     {Alternative InterruptRegister. Relaxed type checking}
  60.  
  61. {--------------------------Local functions-------------------------------}
  62.  
  63.   Procedure SetOptions;
  64.   {Set the BugSlay options}
  65.  
  66.   Begin
  67.     BugSlayImports.SetBugSlayOptions(
  68.       {Reserved1, Reserved2}  0,0,
  69.       {td_LogFileTrace}       td_Normal,
  70.       {td_LogFileOverview}    td_DoStackTrace OR td_ModuleName,
  71.       {td_AuxTrace}           td_DoStackTrace OR td_HeapDump OR td_ModuleName,
  72.       {MaxFrames}             10000,
  73.       {HeapBytesToDump}       13,
  74.       {OWLSafetyPoolSize}     SafetyPoolSize,  {In OMemory(BP7) or WObjects(TPW1.5)}
  75.       {MaxDumpSize}           32,
  76.       {MaxUnroll}             3,
  77.       {DoHeapAllocationCheck} True,
  78.       {AuxName}               'NUL',
  79.       {ErrorLogFilename}      'c:\error',
  80.       {Reserved3}             0)
  81.   End;
  82.  
  83. {-------------------------Replacement exit procedure----------------------}
  84.  
  85.   Procedure NewExitProc; Far;
  86.  
  87.   {Called upon application termination. If ErrorAddr<>Nil then an error
  88.   occured, else normal termination. See ExitProc in the BP help for
  89.   details}
  90.  
  91.   Var ExitText:Array[0..254] Of Char;
  92.       ErrorStackFrame:Word;
  93.       ErrorSegment:Word;
  94.       ExitStats:Record          {Record allows us to use WVSPrintF}
  95.                   Code:Integer;
  96.                   Segment:Longint;
  97.                   Offset:Longint
  98.                 End;
  99.  
  100.      {$IfDef Ver15}
  101.       {GetInstanceModule 'Macro' is missing from the TPW 1.5 WIN31 unit,
  102.        so provide it here}
  103.  
  104.       Function GetInstanceModule(Instance:THandle):THandle;
  105.  
  106.       {Return the module handle of a given instance}
  107.  
  108.       Begin
  109.         GetInstanceModule:=GetModuleHandle(POINTER(LONGINT(Instance)))
  110.       End;
  111.  
  112.       Function SelectorToSegment(Selector:Word):Word; Assembler;
  113.  
  114.       {Convert a selector to a logical segment. Needed only for TPW1.5.
  115.       Since this is only called by the exit procedure, we know Selector
  116.       is in our code, so we can use the Pascal shortcut to get the segment
  117.       number. The compiler puts the logical segment number in the
  118.       first word of the code segment. Returns 0 if Selector is invalid}
  119.  
  120.       ASM
  121.         xor ax,ax              {First, check Selector is valid}
  122.         cmp Selector,$FFFF     {Is selector $FFFF, ie NPU related error?}
  123.         jz  @SelectorInvalid   {Yes. Pass along as $FFFF}
  124.  
  125.         lsl ax,Selector        {Will set ax to the segment's limit (i.e. maximum offset) if it
  126.                                 is valid, else ax remains unchanged}
  127.         cmp ax,0               {Check for 0 limit or invalid. LSL did set Z flag, but check for 0 limit here}
  128.         je  @SelectorInvalid   {Invalid selector or limit=0}
  129.  
  130.         mov es,Selector        {Get the logical segment at Selector:0}
  131.         mov ax,es:[0]          {Function result is in ax}
  132.  
  133.        @SelectorInvalid:       {If jumped here, ax(=Result) is 0 already}
  134.       End;
  135.      {$EndIf}
  136.  
  137.  
  138.   Begin
  139.     ExitProc:=OldExitProc;   {Restore the old exit procedure}
  140.        {If an error occured recover the stack frame (BP) where it occured}
  141.     If ErrorAddr<>Nil Then
  142.       ASM
  143.         mov bx,SS:[BP]      {Skip over ONE stack frame}
  144.         mov ax,ss
  145.         lsl ax,ax           {Check BP's previous value is valid}
  146.         cmp bx,ax
  147.         jae  @OutOfRange    {Old BP>=SS limit. Invalid}
  148.         mov ErrorStackFrame,bx
  149.         jmp @End
  150.        @OutOfRange:
  151.         mov ErrorStackFrame,$FFFE     {BP chain is invalid}
  152.        @End:
  153.       End
  154.     Else
  155.       ErrorStackFrame:=$FFFE;  {Program ended normally}
  156.  
  157.    {$IfDef Ver15}
  158.            {TPW returns selector:offset in ErrorAddr. Convert this to logical segment:offset}
  159.     ErrorSegment:=SelectorToSegment(TLongSplit(ErrorAddr).Segment);
  160.    {$Else}
  161.            {BPW returns segment:offset in ErrorAddr}
  162.     ErrorSegment:=TLongSplit(ErrorAddr).Segment;
  163.    {$EndIf}
  164.  
  165.  
  166.    If ExceptionCallbackAddr<>Nil Then  {Uninstall the exception handler, if installed}
  167.       Begin
  168.         InterruptUnregister(0);
  169.         FreeProcInstance(ExceptionCallbackAddr)
  170.       End;
  171.  
  172.     If BugSlayImports.BugSlayLoaded Then
  173.       BugSlayImports.AppStatusDump(GetInstanceModule(hInstance),SSeg,ErrorStackFrame,ErrorSegment,
  174.                            TLongSplit(ErrorAddr).Offset,ExitCode,HeapList,True)
  175.     Else
  176.       If ErrorAddr<>Nil Then   {A run time error occured and we aren't logging it}
  177.         Begin                  {Display a [slightly] friendlier message box}
  178.           ExitStats.Code:=ExitCode;
  179.           ExitStats.Segment:=ErrorSegment;
  180.           ExitStats.Offset:=TLongSplit(ErrorAddr).Offset;
  181.           WVSPrintF(ExitText,'A fatal error occured.'#10'Please contact technical support,'#10'specifying error'+
  182.                              ' %4u at %04.4lX:%04.4lX',ExitStats);
  183.           MessageBox(0,ExitText,'Fatal error',mb_SystemModal OR mb_OK OR mb_IconStop)
  184.         End;
  185.     ErrorAddr:=Nil    {We handled the error, no need for anyone else to hear about it. Clear the address}
  186.   End;
  187.  
  188.  
  189. Begin
  190.   {Notes for DLLs:
  191.  
  192.   1) Due to the SYSTEM unit's implemtation of DLL run time error exit code
  193.      we can't trap these errors. Our exit handler doesn't get called until
  194.      the WEP and is then called in a Windows supplied stack (for implicit
  195.      links). We can't do anything useful here.
  196.  
  197.   2) Don't install the exception handler for DLLs. Install them only
  198.      in applications, one per task. The app's handler can trap DLL errors
  199.      anyway.}
  200.  
  201.   If DSeg=SSeg Then    {Don't install the handlers in a DLL, ie SS<>DS}
  202.     Begin
  203.       OldExitProc:=ExitProc;    {Add our exit procedure to the exit chain}
  204.       ExitProc:=@NewExitProc;
  205.       If BugSlayImports.BugSlayLoaded Then
  206.         Begin    {Install the exception handler and set BugSlay options only if BugSlay is loaded}
  207.           SetOptions;
  208.           ExceptionCallbackAddr:=MakeProcInstance(@ExceptionHandler.ExceptionCallback,HInstance);
  209.           If (ExceptionCallbackAddr<>Nil) Then
  210.             AltInterruptRegister(0,ExceptionCallbackAddr)  {Install an interrupt call back}
  211.  
  212.         End
  213.       Else
  214.         ExceptionCallbackAddr:=Nil
  215.     End
  216.   Else
  217.     ExceptionCallbackAddr:=Nil
  218. End.
  219.  
  220.