home *** CD-ROM | disk | FTP | other *** search
/ The Pier Shareware 6 / The_Pier_Shareware_Number_6_(The_Pier_Exchange)_(1995).iso / 013 / bugslay.zip / BUGSLAYI.PAS < prev    next >
Pascal/Delphi Source File  |  1994-09-29  |  7KB  |  192 lines
  1.  
  2.  
  3. {BugSlayImports. Import unit for BugSlay.
  4.  
  5. Uses an unorthodox approach of explicitly linking to BugSlay.DLL. This
  6. allows the application to continue even if the DLL is not found.
  7.  
  8. Rex K. Perkins, 5th July 1994
  9.  
  10. ⌐ Copyright Apsley-Bolton Computers, Inc.
  11. }
  12.  
  13. Unit BugSlayImports;
  14.  
  15.  
  16. Interface
  17.  
  18. Uses WinTypes;
  19.  
  20. {$W-}    {BugSlay does not support Windows stack frames, so turn them off}
  21.  
  22.  
  23. Const
  24.  
  25.     {td_xxxx flags. Combine these to give the level of detail in the stack trace.
  26.     Used in SetBugSlayOptions}
  27.   td_DoStackTrace=$0001;    {Must be set, otherwise a stack trace will not take place}
  28.   td_Vars=$0002;            {Include local vars and parameters in stack dump}
  29.   td_LineNos=$0004;         {Include line numbers and file names for each stack frame}
  30.   td_HeapDump=$0008;        {Dump allocations on the heap}
  31.   td_ModuleName=$0010;      {Include 'Module.' prefix for each stack frame}
  32.       {For LogFileTrace only:}
  33.   td_DumpGlobalSegs=$0020;  {Dump global segments}
  34.   td_DumpGlobalVars=$0040;  {Dump global variables (Typed constants)}
  35.   td_DumpGlobalConsts=$0080;{Dump global Constants (Typed and Untyped constants). Use with td_DumpGlobalVars}
  36.   td_DumpGlobalsInAllModules=$0100;  {Dump globals in all modules if set, in main module only if clear}
  37.  
  38.   td_AllDetails=$FFFF;
  39.   td_Normal=td_AllDetails AND NOT(td_DumpGlobalConsts);
  40.  
  41.  
  42. Type
  43.  
  44.   {Don't use CONST in function/procedure declarations to allow
  45.    compatibility with TPW 15.}
  46.  
  47.   TAppStatusDump=Procedure (Module:THandle;
  48.                             SS,BP,CS,IP,ErrorCode,AppHeapList:Word;
  49.                             CSIsLogicalSegment:Boolean);
  50.   {Do a status dump. Can be called in an error situation to trace an error, or
  51.   a non error situation to do a heap dump. Parameters:
  52.  
  53.   Error condition:
  54.      Module              Specifies handle of the module the error occured in
  55.      SS,BP               SS:BP specifies the stack frame of the error
  56.      CS,IP               CS:IP specifies the error CS:IP. CS can be a selector or segment
  57.      ErrorCode           Specifies the run time error code
  58.      AppHeapList         System.HeapList variable from application
  59.      CSIsLogicalSegment  True is CS is a logical segment, false if selector
  60.  
  61.   Non-error condition:
  62.      Module              Undefined
  63.      SS,BP               Undefined
  64.      CS                  0
  65.      IP                  Undefined
  66.      ErrorCode           Undefined
  67.      AppHeapList         System.HeapList variable from application
  68.      CSIsLogicalSegment  Undefined}
  69.  
  70.  
  71.  
  72.   THandleException=Procedure (ErrorNumber,FaultCS,FaultIP,
  73.                                   FaultBP,FaultSS,FaultSP,AppHeapList:Word);
  74.  
  75.   {ExecptionCallback (in the app) calls this routine for further processing
  76.   if the exception is of interest. Parameters are:
  77.  
  78.   ErrorNumber                Exception code, as defined by ToolHelp/InterruptRegister
  79.   FaultCS:FaultIP            CS:IP of faulting instruction. Note CS is a selector
  80.   FaultBP                    BP when fault occured
  81.   FaultSS:FaultSP            SS:SP of stack when fault occured, or current if fault not stack related
  82.   AppHeapList         System.HeapList variable from application}
  83.  
  84.  
  85.   TSetBugSlayOptions=Procedure (Reserved1,Reserved2:Longint;
  86.                                 td_LogFileTrace,td_LogFileOverview,td_AuxTrace,
  87.                                 MaxFrames,HeapBytesToDump,OWLSafetyPoolSize,
  88.                                 MaxDumpSize:Word;
  89.                                 MaxUnroll:Byte;
  90.                                 DoHeapAllocationCheck:Boolean;
  91.                                 AuxName:PChar;
  92.                                 ErrorLogFilename:PChar;
  93.                                 Reserved3:Longint);
  94.  
  95.    {Set BugSlay options:
  96.  
  97.     NAME                  DEFAULT DESCRIPTION
  98.     ~~~~                  ~~~~~~~ ~~~~~~~~~~~
  99.     Reserved1,Reserved2         0 Reserved: Internal flags.
  100.     td_LogFileTrace         $FF7F Options for main stack trace in log file. Combination of td_xxxx flags.
  101.     td_LogFileOverview      $0011 Options for overview stack trace in log file. Combination of td_xxxx flags.
  102.     td_AuxTrace             $0019 Options for stack trace on debugging terminal. Combination of td_xxxx flags.
  103.     MaxFrames               10000 Maximum number of stack frames to dump.
  104.     HeapBytesToDump            13 Number of bytes per heap block to dump if heap allocations exist on exit.
  105.     OWLSafetyPoolSize        8192 Size of OWL Safety pool. Used to identify in Global dumps.
  106.     MaxDumpSize                32 Number of bytes dumped in a stack frame for an unsupported variable type.
  107.  
  108.     MaxUnroll                   3 Maximum number of levels to unroll a record or pointer
  109.  
  110.     DoHeapAllocationCheck True    If true, check for small heap allocations on app termination
  111.     AuxName               Nul     Name of debugging screen, or Nul if none.
  112.     ErrorLogFilename      'c:\error' Base filename of log file. Will have
  113.                                      either .log or .alt appended to it.
  114.                                      Can be Nil for default.
  115.     Reserved3                   0 Reserved: Internal flags}
  116.  
  117.  
  118. Var
  119.     AppStatusDump:TAppStatusDump;
  120.     HandleException:THandleException;
  121.     SetBugSlayOptions:TSetBugSlayOptions;
  122.     BugSlayLoaded:Boolean;    {True if BugSlay was found}
  123.  
  124. Implementation
  125.  
  126. Uses WinProcs, Win31;
  127.  
  128. Const
  129.  
  130.   DLLName='BugSlay.DLL';
  131.  
  132.  
  133. Var
  134.     hLibrary:THandle;
  135.     OldExitProc:Pointer;
  136.  
  137.  
  138.   Procedure TryToLoadLibrary;
  139.  
  140.   {Attempt to load the DLL}
  141.  
  142.   Var OldErrorMode:Word;
  143.  
  144.   Begin
  145.     OldErrorMode:=SetErrorMode(sem_NoOpenFileErrorBox);  {Don't display an warning if not found}
  146.     hLibrary:=LoadLibrary(DLLName);    {Try to load the library}
  147.     SetErrorMode(OldErrorMode)  {Restore original value}
  148.   End;
  149.  
  150.  
  151.  
  152.   Procedure GetProcedures;
  153.  
  154.   {Get the procedure addresses}
  155.  
  156.   Var TempProc:TFarProc;
  157.  
  158.   Begin
  159.     TempProc:=GetProcAddress(hLibrary,'AppStatusDump');
  160.     AppStatusDump:=TAppStatusDump(TempProc);
  161.     TempProc:=GetProcAddress(hLibrary,'HandleException');
  162.     HandleException:=THandleException(TempProc);
  163.     TempProc:=GetProcAddress(hLibrary,'SetBugSlayOptions');
  164.     SetBugSlayOptions:=TSetBugSlayOptions(TempProc)
  165.   End;
  166.  
  167.  
  168.   Procedure FreeLib; Far;
  169.  
  170.   {Free the BugSlay DLL}
  171.  
  172.   Begin
  173.     ExitProc:=OldExitProc;
  174.     FreeLibrary(hLibrary)
  175.   End;
  176.  
  177.  
  178.  
  179. Begin
  180.   TryToLoadLibrary;
  181.   If hLibrary>HInstance_Error Then   {Got it. Get the procedure addresses}
  182.     Begin
  183.       OldExitProc:=ExitProc;  {Add our exit procedure to the exit chain}
  184.       ExitProc:=@FreeLib;
  185.       GetProcedures;          {Get the addresses of the imported procedures}
  186.       BugSlayLoaded:=True
  187.     End
  188.   Else
  189.     BugSlayLoaded:=False
  190. End.
  191.  
  192.