TDM#1: Yet Another Stack Tracer

"Have you ever had any really hard-to-find bugs in your code? If not, you can skip this article, otherwise you’d better keep on reading!"

The above quote was the enticing introduction to my first full-feature Delphi Magazine article with the ironic title Yet Another Stack Tracer (or YAST for short). It was published in the seventh TDM issue, March 1996. The contents page said:

"YAST: Yet Another Stack Tracer!
Hallvard Vassbotn delves deeply into your programs’ operation to show how stack tracing can help in finding those really nasty bugs and presents a code unit you can plug straight in"

Prior to this I had written and got published a number of smaller Delphi tips, but this (almost) four page article on low-level stack probing to help diagnose run-time problems at customer sites without a debugger present, was my first real article. And as far as I know it was the first article published on stack tracing from a Delphi perspective.

Delphi 1 Nostalgia

When the article was published, Delphi 1 was the latest and greatest, but Borland Pascal 7.0 was still alive and kicking (at least some people were still using it). In those days it was possible to write DOS-based programs in real-mode and protected mode and Windows programs in protected mode. Protected mode meant 16-bit 80286-level protection with segment registers, 16-bit offsets and segment protection descriptors. Routines could be 'near' or 'far' and the size of the generated code of a single unit was limited to 64 kB.

16-bit Stack Tracer

The article and code presents a technique to walk the stack frames on the stack to dump a trace that shows the calls, parameters and local variables that led up to a specific leaf routine where typically an error condition had occurred. As the conclusion in the article said:

"With a stack tracer tool such as the one I’ve presented here, you are better equipped to track down errors and bugs that would otherwise be very difficult to find. A real debugger (like Turbo Debugger) is of course better to use when you are in the development phase, but
for error-reporting at user-sites, automatic logging with a stack trace facility could save your day (and possibly your contract!)."

(Note: Turbo Debugger was a separate purchase at the time - it could do stuff the D1 integrated debugger couldn't).

The central piece of code, the YAST unit, cross-compiled to BP 7.0 (DOS real- and protected-mode) and Delphi1 (16-bit Windows).

unit YAST;

{ Yet-Another-Stack-Tracer

  Description: A general call-back based stack-trace utility.

  Compiles with Delphi 1.0 and BP 7.0 in real-mode, DPMI and Windows mode.
  Requires the ValidPtr unit if compiled for DOS.

  Written by Hallvard Vassbotn, January 1996 (hallvard@falcon.no)    }

interface

type
  PBytes = ^TBytes;
  TBytes = array[0..(High(Word)-$f) div sizeof(byte)] of byte;
  PWords = ^TWords;
  TWords = array[0..(High(Word)-$f) div sizeof(word)] of word;
  TStackInfo = record
    CallersBP : word;
    DumpSize  : word;
    ParamSize : word;
    IsFar     : boolean;
    ReturnLog : word;
    case integer of
    1: (CallerAdr : pointer;
        ReturnAdr : pointer;
        DumpPtr   : PBytes;
        ParamPtr  : PWords);
    2: (CallerOfs : word;
        CallerSeg : word;
        ReturnOfs : word;
        ReturnSeg : word;
        DumpOfs   : word;
        DumpSeg   : word;
        ParamOfs  : word;
        ParamSeg  : word)
  end;
  TReportStackFrame = function(var StackInfo: TStackInfo; PrivateData: Pointer): boolean;

procedure TraceStack(ReportStackFrame: TReportStackFrame; PrivateData: Pointer);

implementation

uses
{$IFDEF WINDOWS}
  {$IFDEF VER80}
    WinProcs;
  {$ELSE}
    Win31;
  {$ENDIF}
{$ELSE}
  ValidPtr;
{$ENDIF}

type
  PtrRec = record
    Ofs, Seg : Word;
  end;
  TFarStackFrame = record
    CallersBP : word;
    case integer of
    1: (CallerAdr : pointer);
    2: (CallerOfs : word;
        CallerSeg : word)
  end;
  TNearStackFrame = record
    CallersBP : word;
    CallerOfs : word;
  end;
  PStackFrame = ^TStackFrame;
  TStackFrame = TFarStackFrame;

function GetSSBPPtr: pointer; inline
($8C/$D2    { MOV DX, SS }
/$89/$E8);  { MOV AX, BP }

function LogSeg(Seg: word): word;
begin
{$IFDEF MSDOS}
  LogSeg := Seg;
{$ELSE}
  if Seg <> 0 then
    LogSeg := Word(Ptr(Seg, 0)^)
  else
    LogSeg := Seg;
{$ENDIF}
end;

procedure CorrectBP(var BP: word);
{ Handle Windows stack frames (i.e. Inc BP in far prolog code) }
begin
  if Odd(BP) then Dec(BP);
end;

function IsFarCode(Addr: pointer): boolean;
begin
{$IFDEF WINDOWS}
  IsFarCode := not IsBadCodePtr(Addr);
{$ELSE}
  IsFarCode := ValidCodePointer(Addr, 1);
{$ENDIF}
end;

function NextStackFrame(var StackFrame: PStackFrame;
                        var StackInfo : TStackInfo): boolean;
var
  More: boolean;
begin
  More := (StackFrame^.CallersBP <> 0) and (StackFrame^.CallerAdr <> nil);
  if More then
    with StackInfo do
    begin
      CallersBP  := StackFrame^.CallersBP;
      CorrectBP(CallersBP);
      CallerAdr  := StackFrame^.CallerAdr;
      DumpPtr    := Pointer(StackFrame);
      DumpSize   := (CallersBP - PtrRec(StackFrame).Ofs);
      ParamPtr   := Pointer(DumpPtr);
      ParamSize  := DumpSize div 2;
      IsFar      := IsFarCode(CallerAdr);
      if IsFar then
      begin
        ReturnAdr := CallerAdr;
        Dec(ParamSize, SizeOf(TFarStackFrame) div 2);
        Inc(ParamOfs , SizeOf(TFarStackFrame));
      end
      else
      begin
        ReturnOfs := CallerOfs;
        Dec(ParamSize, SizeOf(TNearStackFrame) div 2);
        Inc(ParamOfs , SizeOf(TNearStackFrame));
      end;
      ReturnLog := LogSeg(ReturnSeg);

      PtrRec(StackFrame).Ofs := StackFrame^.CallersBP;
      CorrectBP(PtrRec(StackFrame).Ofs);
    end;
  NextStackFrame := More;
end;

procedure TraceStack(ReportStackFrame: TReportStackFrame; PrivateData: Pointer);
var
  StackFrame : PStackFrame;
  StackInfo  : TStackInfo;
begin
  FillChar(StackInfo, SizeOf(StackInfo), 0);
  StackInfo.ReturnSeg := CSeg;
  StackFrame := GetSSBPPtr;
  while NextStackFrame(StackFrame, StackInfo) and
        ReportStackFrame(StackInfo, PrivateData) do
    {Loop};
end;

end.

Notice the kewl inline machine code instructions encoded in hex (the GetSSBPPtr function). When encountering a call to this function, the compiler would just inject the bytes encoded there directly into the instruction streaming of the "calling" routine. You really had to know what you were doing back then. There was no BASM and no inlining of normal routines. [OTOH, it is not possible to write inlined  BASM today (Delphi 2007)... ;)] The inline machine code bytes was the only way to get at the current contents of the SS and BP registers without resorting to an external assembler like TASM (Turbo Assembler, another add-on).

Some three years later, this article and code would form the basics for a slightly more feature-complete 32-bit exception stack tracer, HVEST. In that sense the YAST code provided one of the humble starting seeds for the current JclDebug unit, the open source project that competes with commercial alternatives such as madExcept, Exceptional Magic and EurekaLog.

We'll come back to the HVEST (or Exceptional Stack Tracing) article later. I have made both the whole original YAST article in PDF format and the full code available from my Google Pages storage area.