TDM#9: Exceptional Stack Tracing (HVEST)

One of the key questions you should ask yourself as a serious Delphi developer is; what kind of exception handling and logging am I using. If you're not using any custom or third party solution for tracking down exceptional incidents that occur in your production systems or at your customer sites, you're missing out big time!

A proper exception handling and logging system should at least log the calling context (the calls that lead up to the exception) in the form of a stack trace. This makes it so much easier to track down, identify and fix the cause of the problem.

In 1999 I wrote such a tool and published it in The Delphi Magazine article Exceptional Stack Tracing in October 1999. As I have mentioned before, parts of this tool is based on my earlier work on 16-bit stack tracer, YAST. It also uses the excellent RTLI (run-time line information) tool by Vitaly Miryanov. At the time I was inspired by Per Larsen's ExHook32 and Stefan Hoffmeister's Debug Mapper. So I upgraded and improved the stack tracer for Win32, integrated the RTLI code and researched and developed a general implicit DLL import hooking system and a specific exception notification mechanism.

Putting all the pieces together we were able to get meaningful symbolic stack traces from any exceptional error incident - wether it happened during development, testing or at the customer's site. This made it an order of magnitude easier and faster to identify and fix bugs that caused the exception (or to handle it more gracefully).

I always spent a fair amount of time on my articles, but this one was by far the most time-consuming. Here are some key excerpts from the article.

"Often, during beta testing of an application (and, horrors, sometimes in a release version), users will encounter bugs in the form of exceptions (both logical such as EConvertError and hardware such as EAccessViolation). The tricky part is that only address of where the exception occurred is reported by the default Delphi exception handler. This is more often than not, less than helpful. Typically, that address will map to a line deep inside the VCL or RTL. What we’re really interested in is how we ended up there in the first place with invalid parameters (i.e. a blank string or a nil pointer). To get that we would need a complete stack trace of the calls that ended up in the exception being raised.

This article is about developing such an exception stack tracer. Not only will it show a complete stack trace leading up to an exception, but in the presence of so-called Run-Time Location Information (RTLI), it will also give a complete symbolic stack trace. "

"I remember reading an excellent article about PE files by Matt Pietrek^[i]. In it he describes how implicit linking to external DLLs work. About the import address table, he says:

"Since the import address table is in a writeable section, it's relatively easy to intercept calls that an EXE or DLL makes to another DLL.. Simply patch the appropriate import address table entry to point at the desired interception function. There's no need to modify any code in either the caller or callee images. What could be easier?"

Yeah, what could be easier <g>? Such a statement just screams: “Implement me!”. We will implement a completely general way of hooking any routine in any implicitly loaded DLL. We can then use this technique to hook the Kernel32.RaiseException routine that is called from System._RaiseExcept. "

The key routine for hooking DLL imports is listed below:

function IsWin95CallThunk(Thunk: PWin95CallThunk): boolean;
begin
  Result := (Thunk^.PUSH = $68) and (Thunk^.JMP = $E9);
end;
 
function ReplaceImport(Base: Pointer; ModuleName: PChar; FromProc, ToProc: pointer): boolean;
var
  NtHeader          : PImageNtHeaders;
  ImportDescriptor  : PImageImportDescriptor;
  ImportEntry       : PImageThunkData;
  CurrModuleName    : PChar;
  IsThunked         : Boolean;
  FromProcThunk     : PWin95CallThunk;
  ImportThunk       : PWin95CallThunk;
  FoundProc         : boolean;
begin
  Result := false;
  FromProcThunk := PWin95CallThunk(FromProc);
  IsThunked := (Win32Platform = VER_PLATFORM_WIN32_WINDOWS) and
               IsWin95CallThunk(FromProcThunk);
  NtHeader := GetImageNtHeader(Base);
  ImportDescriptor := PImageImportDescriptor(DWORD(Base)+
    NtHeader.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_IMPORT].VirtualAddress);
  while ImportDescriptor^.NameOffset <> 0 do
  begin
    CurrModuleName := PChar(Base) + ImportDescriptor^.NameOffset;
    if StrIComp(CurrModuleName, ModuleName) = 0 then
    begin
      ImportEntry := PImageThunkData(DWORD(Base) + ImportDescriptor^.IATOffset);
      while ImportEntry^.FunctionPtr <> nil do
      begin
        if IsThunked then
        begin
          ImportThunk := PWin95CallThunk(ImportEntry^.FunctionPtr);
          FoundProc := IsWin95CallThunk(ImportThunk) and
                       (ImportThunk^.Addr = FromProcThunk^.Addr);
        end
        else
          FoundProc := (ImportEntry^.FunctionPtr = FromProc);
        if FoundProc then
        begin
          ImportEntry^.FunctionPtr := ToProc;
          Result := true;
        end;
        Inc(ImportEntry);
      end;
    end;
    Inc(ImportDescriptor);
  end;
end;

"Hooking RaiseException

Now that we have the HVHookDLL, it is very easy to hook the RaiseException routine in Kernel32.DLL – take a look at [the code below]"

unit HVExceptNotify;
// Unit that provides a notification service when exceptions are being raised
//
// Written by Hallvard Vassbotn, hallvard@balder.no, September 1999
interface
 
type
  TExceptNotify = procedure (ExceptObj: TObject; ExceptAddr: pointer; OSException: boolean);
var
  ExceptNotify: TExceptNotify;
 
implementation
 
uses
  Windows,
  SysUtils,
  HVHookDLL;
 
var
  Kernel32_RaiseException : procedure (dwExceptionCode, dwExceptionFlags, nNumberOfArguments: DWORD;
  lpArguments: PDWORD); stdcall;
 
type
  PExceptionArguments = ^TExceptionArguments;
  TExceptionArguments = record
    ExceptAddr: pointer;
    ExceptObj : TObject;
  end;
 
procedure HookedRaiseException(ExceptionCode, ExceptionFlags, NumberOfArguments: DWORD;
  Arguments: PExceptionArguments); stdcall;
// All calls to Kernel32.RaiseException ends up here
const
  // D2 has a different signature for Delphi exceptions
  cDelphiException    = {$IFDEF VER90}$0EEDFACE{$ELSE}$0EEDFADE{$ENDIF};
  cNonContinuable     = 1;
begin
  // We're only interested in Delphi exceptions raised from System's
  // internal _RaiseExcept routine
  if (ExceptionFlags    = cNonContinuable)       and
     (ExceptionCode     = cDelphiException)      and
     (NumberOfArguments = 7)                     and
     (DWORD(Arguments)  = DWORD(@Arguments) + 4) then
  begin
    // Run the event if it has been assigned
    if Assigned(ExceptNotify) then
      ExceptNotify(Arguments.ExceptObj, Arguments.ExceptAddr, false);
  end;
  // Call the original routine in Kernel32.DLL
  Kernel32_RaiseException(ExceptionCode, ExceptionFlags, NumberOfArguments, PDWORD(Arguments));
end;
 
var
  SysUtils_ExceptObjProc: function (P: PExceptionRecord): Exception;
 
function HookedExceptObjProc(P: PExceptionRecord): Exception;
begin
  // Non-Delphi exceptions such as AVs, OS and hardware exceptions
  // end up here. This routine is normally responsible for creating
  // a Delphi Exception object corresponding to the OS-level exception
  // described in the TExceptionRecord structure.
  //
  // We leave the mapping to the standard SysUtils routine,
  // but hook this to know about the exception and call our
  // event.

  // First call the original mapping function in SysUtils
  Result := SysUtils_ExceptObjProc(P);

  // Run the event if it has been assigned
  if Assigned(ExceptNotify) then
    ExceptNotify(Result, P^.ExceptionAddress, true);
end;
 
function GetRaiseExceptAddr: pointer;
asm
  LEA EAX, System.@RaiseExcept;
end;
 
initialization
  SysUtils_ExceptObjProc := System.ExceptObjProc;
  System.ExceptObjProc := @HookedExceptObjProc;
  HookImport(Pointer(FindHInstance(GetRaiseExceptAddr)), 'Kernel32.dll', 'RaiseException', @HookedRaiseException, @Kernel32_RaiseException)
 
finalization
  UnHookImport(Pointer(FindHInstance(GetRaiseExceptAddr)), 'Kernel32.dll', 'RaiseException', @HookedRaiseException, @Kernel32_RaiseException);
  System.ExceptObjProc := @SysUtils_ExceptObjProc;
  SysUtils_ExceptObjProc := nil;
 
end.

"The definition of what might be useful context information can vary according to what kind of application you are developing. The name of the currently focused form, the name of active database tables, the name of the logged in user and other global information might be useful. You can easily add any such value-added information yourself.

However, in all cases, a complete overview of the function calls that preceded the raised exception will be most useful. To get that, we have to implement something called a stack tracer. A stack tracer will analyze the current contents of the stack and try to figure out the return addresses stored there by the CPU as part of the CALL instruction operation.

YAST Nostalgia

[...] I have now converted [the 16-bit YAST stack tracer] to a 32-bit version and added some bells and whistles along the way – see the [code below]"

unit HVYAST32;
// Yet-Another-Stack-Tracer, 32-bit version
//
// Loosely based on my 16-bit YAST code published in
// The Delphi Magazine, issue 7.
//
// Description: A general call-back based stack-trace utility.
// Both stack frames based and raw stack tracing is supported.
//
// Written by Hallvard Vassbotn, hallvard@balder.no, July 1999
//
interface
 
uses
  Windows,
  SysUtils;
 
// The generic stack tracing machinery
 
const
  MaxBlock = MaxInt-$f;
type
  PBytes  = ^TBytes;
  TBytes  = array[0..MaxBlock div SizeOf(byte)] of byte;
  PDWORDS = ^TDWORDS;
  TDWORDS = array[0..MaxBlock div SizeOf(DWORD)] of DWORD;
  PStackFrame = ^TStackFrame;
  TStackFrame = record
    CallersEBP : DWORD;
    CallerAdr  : DWORD;
  end;
  TStackInfo = record
    CallerAdr  : DWORD;
    Level      : DWORD;
    CallersEBP : DWORD;
    DumpSize   : DWORD;
    ParamSize  : DWORD;
    ParamPtr   : PDWORDS;
    case integer of
     0 : (StackFrame : PStackFrame);
     1 : (DumpPtr    : PBytes);
  end;
  TReportStackFrame = function(var StackInfo: TStackInfo; PrivateData: Pointer): boolean;
 
procedure TraceStackFrames(ReportStackFrame: TReportStackFrame; PrivateData: Pointer);
procedure TraceStackRaw(ReportStackFrame: TReportStackFrame; PrivateData: Pointer);
 
// Default stack tracer
 
const
  MaxStackLevels = 50;
type
  TStackInfoArray = array[0..MaxStackLevels-1] of TStackInfo;
var
  StackDump: TStackInfoArray;
  StackDumpCount: integer;
 
function PhysicalToLogical(Physical: DWORD): DWORD;
function DefaultReportStackFrame(var StackInfo: TStackInfo; PrivateData: Pointer): boolean;
procedure SaveStackTrace(Raw: boolean; IgnoreLevels: integer; FirstCaller: pointer);
 
implementation
 
uses
  HVPEUtils;
 
{$W-} // This routine should not have a EBP stack frame
function GetEBP: pointer;
// Return the current contents of the EBP register
asm
  MOV EAX, EBP
end;
 
function GetESP: pointer;
// Return the current contents of the ESP register
asm
  MOV EAX, ESP
end;
 
function GetStackTop: DWORD;
asm
  // Pick up the top of the stack from the Thread Information Block (TIB)
  // pointed to by the FS segment register.
  //
  // Reference: Matt Pietrek, MSJ, Under the hood, on TIBs:
  // PVOID pvStackUserTop  // 04h Top of user stack
  // http:{msdn.microsoft.com/library/periodic/period96/periodic/msj/F1/D6/S2CE.htm }
  //
  MOV EAX, FS:[4]
end;
 
var
  TopOfStack : DWORD;
  BaseOfStack: DWORD;
  BaseOfCode : DWORD;
  TopOfCode  : DWORD;
 
procedure InitGlobalVars;
var
  NTHeader: PImageNTHeaders;
begin
  { Get pointers into the EXE file image }
  if BaseOfCode = 0 then
  begin
    NTHeader := GetImageNtHeader(Pointer(hInstance));
    BaseOfCode := DWord(hInstance) + NTHeader.OptionalHeader.BaseOfCode;
    TopOfCode := BaseOfCode + NTHeader.OptionalHeader.SizeOfCode;
    TopOfStack := GetStackTop;
  end;
end;
 
function ValidStackAddr(StackAddr: DWORD): boolean;
begin
  Result := (BaseOfStack < StackAddr) and (StackAddr < TopOfStack);
end;
 
function ValidCodeAddr(CodeAddr: DWORD): boolean;
begin
  Result := (BaseOfCode < CodeAddr) and  (CodeAddr < TopOfCode);
end;
 
function ValidCallSite(CodeAddr: DWORD): boolean;
// Validate that the code address is a valid code site
//
// Information from Intel Manual 24319102(2).pdf, Download the 6.5 MBs from:
//  http://developer.intel.com/design/pentiumii/manuals/243191.htm
//  Instruction format, Chapter 2 and The CALL instruction: page 3-53, 3-54
var
  CodeDWORD4: DWORD;
  CodeDWORD8: DWORD;
begin
  // First check that the address is within range of our code segment! 
  Result := (BaseOfCode < CodeAddr) and  (CodeAddr < TopOfCode);

  // Now check to see if the instruction preceding the return address  
  // could be a valid CALL instruction 
  if Result then
  begin
    // Check the instruction prior to the potential call site. 
    // We consider it a valid call site if we find a CALL instruction there 
    // Check the most common CALL variants first 
    CodeDWORD8 := PDWORD(CodeAddr-8)^;
    CodeDWORD4 := PDWORD(CodeAddr-4)^;

    Result :=
          ((CodeDWORD8 and $FF000000) = $E8000000) // 5-byte, CALL [-$1234567] 
       or ((CodeDWORD4 and $38FF0000) = $10FF0000) // 2 byte, CALL EAX 
       or ((CodeDWORD4 and $0038FF00) = $0010FF00) // 3 byte, CALL [EBP+0x8] 
       or ((CodeDWORD4 and $000038FF) = $000010FF) // 4 byte, CALL ?? 
       or ((CodeDWORD8 and $38FF0000) = $10FF0000) // 6-byte, CALL ?? 
       or ((CodeDWORD8 and $0038FF00) = $0010FF00) // 7-byte, CALL [ESP-0x1234567] 
    // It is possible to simulate a CALL by doing a PUSH followed by RET, 
    // so we check for a RET just prior to the return address
       or ((CodeDWORD4 and $FF000000) = $C3000000);// PUSH XX, RET 

    // Because we're not doing a complete disassembly, we will potentially report
    // false positives. If there is odd code that uses the CALL 16:32 format, we 
    // can also get false negatives. 

  end;
end;
 
function NextStackFrame(var StackFrame: PStackFrame;
                        var StackInfo : TStackInfo): boolean;
begin
  // Only report this stack frame into the StackInfo structure 
  // if the StackFrame pointer, EBP on the stack and return 
  // address on the stack are valid addresses 
  while ValidStackAddr(DWORD(StackFrame)) do
  begin
    // CallerAdr within current process space, code segment etc. 
    if ValidCodeAddr(StackFrame^.CallerAdr) then
    begin
      Inc(StackInfo.Level);
      StackInfo.StackFrame := StackFrame;
      StackInfo.ParamPtr   := PDWORDS(DWORD(StackFrame) + SizeOf(TStackFrame));
      StackInfo.CallersEBP := StackFrame^.CallersEBP;
      StackInfo.CallerAdr  := StackFrame^.CallerAdr;
      StackInfo.DumpSize   := StackFrame^.CallersEBP - DWORD(StackFrame);
      StackInfo.ParamSize  := (StackInfo.DumpSize - SizeOf(TStackFrame)) div 4;
      // Step to the next stack frame by following the EBP pointer 
      StackFrame           := PStackFrame(StackFrame^.CallersEBP);
      Result := true;
      Exit;
    end;
    // Step to the next stack frame by following the EBP pointer
    StackFrame := PStackFrame(StackFrame^.CallersEBP);
  end;
  Result := false;
end;
 
{$W+} // We must have stack-frames on for this routine
 
procedure TraceStackFrames(ReportStackFrame: TReportStackFrame; PrivateData: Pointer);
var
  StackFrame : PStackFrame;
  StackInfo  : TStackInfo;
begin
  // Start at level 0 
  StackInfo.Level := 0;

  // Make sure the global variables are correctly set 
  InitGlobalVars;

  // Get the current stack from from the EBP register 
  StackFrame := GetEBP;

  // We define the bottom of the valid stack to be the current EBP Pointer 
  // There is a TIB field called pvStackUserBase, but this includes more of the 
  // stack than what would define valid stack frames. 
  BaseOfStack := DWORD(StackFrame) - 1;

  // Loop over and report all valid stackframes
  while NextStackFrame(StackFrame, StackInfo) and
        ReportStackFrame(StackInfo, PrivateData) do
    {Loop};
end;
 
procedure TraceStackRaw(ReportStackFrame: TReportStackFrame; PrivateData: Pointer);
var
  StackInfo : TStackInfo;
  StackPtr : PDWORD;
  PrevCaller: DWORD;
begin
  // We define the bottom of the valid stack to be the current ESP pointer
  BaseOfStack := DWORD(GetESP);

  // We will not be able to fill in all the fields in the StackInfo record,
  // so just blank it all out first
  FillChar(StackInfo, SizeOf(StackInfo), 0);

  // Make sure the global variables are correctly set
  InitGlobalVars;

  // Clear the previous call address
  PrevCaller := 0;

  // Get a pointer to the current bottom of the stack
  StackPtr := PDWORD(BaseOfStack);
 
  // Loop through all of the valid stack space
  while DWORD(StackPtr) < TopOfStack do
  begin

    // If the current DWORD on the stack,
    // refers to a valid call site...
    if ValidCallSite(StackPtr^) and (StackPtr^ <> PrevCaller) then
    begin
      // then pick up the callers address 
      StackInfo.CallerAdr := StackPtr^;

      // remeber to callers address so that we don't report it repeatedly 
      PrevCaller := StackPtr^;

      // increase the stack level 
      Inc(StackInfo.Level);

      // then report it back to our caller 
      if not ReportStackFrame(StackInfo, PrivateData) then
        Break;
    end;

    // Look at the next DWORD on the stack 
    Inc(StackPtr);
  end;
end;
 
function DefaultReportStackFrame(var StackInfo: TStackInfo; PrivateData: Pointer): boolean;
begin
  Result := (StackDumpCount < MaxStackLevels-1);
  if Result                                 and  // We have an available slot 
     (DWORD(PrivateData) < StackInfo.Level) then // We're not going to skip this level 
  begin
    // Save the contents of this stack frame
    StackDump[StackDumpCount] := StackInfo;
    Inc(StackDumpCount);
  end;
end;
 
procedure SaveStackTrace(Raw: boolean; IgnoreLevels: integer; FirstCaller: pointer);
begin
  FillChar(StackDump, SizeOf(StackDump), 0);
  StackDumpCount := 0;
  // Fill the first slot, if we are given an address directly
  if Assigned(FirstCaller) then
  begin
    StackDump[0].CallerAdr := DWORD(FirstCaller);
    StackDumpCount := 1;
  end;
  if Raw
  then TraceStackRaw   (DefaultReportStackFrame, Pointer(IgnoreLevels))
  else TraceStackFrames(DefaultReportStackFrame, Pointer(IgnoreLevels));
end;
 
const
  LinkerOffset = $1000;
 
function PhysicalToLogical(Physical: DWORD): DWORD;
begin
  Result :=   Physical
            - DWORD(HInstance)
            - LinkerOffset;
end;
 
end.

"To Stack Frame, or not to Stack Frame – that is the Question

There are generally two different types of algorithms to choose from when implementing a stack tracer: the more elegant stack frame based algorithm and the raw brute force algorithm.

[...]

The frame-based stack tracing is elegant and fairly fast, but it has one major weakness. It will not find callers that have no stack frames. With the current crop of optimising compilers, most smaller routines will not have stack frames and this reduces the usefulness of the stack tracer dramatically. There are two solutions to this. Either force stack frames for all your code – and preferably the VCL and RTL, too. Or use another algorithm.

[...]

[T]he brute-force method is much more primitive. The algorithm is very easy: just look at all the DWORDs stored on the stack. If a DWORD happens to be a value that falls within the valid code segment of this module, include it in the stack trace. To avoid getting too many false positives, we can add some more constraints."

"Dusting off the RTLI

While having the stack trace in hand is a great step in the right direction, it is still rather cumbersome having to locate the correct copy of the project’s MAP file (providing that we have it somewhere) and then start searching for each logical address from the stack trace.

Ideally, the stack trace itself should include symbolic information such as the unit name, filename, line number and routine name the logical address corresponds to. Thanks to Vitaly Miryanov and his RTLI^[ii], we get this wonderful capability almost for free. He has already developed the framework and set of routines to make this possible. We just have to tweak the code a little to make it work with the newer compiler versions."

HVEST was a step in the right direction and using it is certainly better than nothing. If you are already using it you your code today, by all means continue to do so. But time has moved on and there are now more mature solutions available - including the open source JclDebug (as part of the JCL library) and the commercial madExcept, Exceptional Magic and EurekaLog. JclDebug was in part based on my HVEST code and brought forward by Petr Vones and others. If you haven't already, you should seriously consider using one of these - you will not regret it, believe me! ;)

As usual you can read the full article (PDF) and download the full, original code (zip). Enjoy!

---

[i] Matt Pietrek, MSJ March 1994: Peering inside the PE: A Tour of the Win32 Portable Executable File Format: http://msdn.microsoft.com/library/techart/msdn_peeringpe.htm

[ii] Vitaly Miryanov, TDM Issue 22, June 1997, Run-Time Location Information In Delphi 2