Improving TC's exception handler

[MarcinW]

This is a continuation of one of topics, that arised from discussion here. It's about improving TC's exception handler.

When a stack overflow exception is raised, there are only last 0x1000 bytes of stack that can be used to handle this exception.

Where did you find this? I didn't know that there is such a limit.

Apart from discussions about stack structure, a simple experiment can show this. And, to be precise, in the worst possible case there is even less than 0x1000 bytes of stack available - it's about 0xC00 bytes. This is because internal OS exception handler pushes some data structures on the stack before passing control to the application's exception handler.

Try the code below - please note that displaying stack state is performed outside the exception handler, because IntToHex and MessageBox functions need more stack space than available at the moment of exception handling - using these functions inside the exception handler would overflow the stack permanently and the application would be terminated immediately by the OS:

Code: Select all

{$M $00010000 $00100000}

program StackOverflowDemo;

uses
  Windows, SysUtils;

var
  StackStateData : record
    Valid : Boolean;
    CurrentESP : HINST;
    MemInfo : TMemoryBasicInformation;
  end;

procedure GetStackState;
var
  AllocationBase : HINST;
  CurrentAddr : HINST;
begin
  asm
    mov StackStateData.CurrentESP,esp
  end;

  with StackStateData do
  begin
    if VirtualQuery(Pointer(CurrentESP),MemInfo,SizeOf(MemInfo)) <> SizeOf(MemInfo) then
      Exit;
    if MemInfo.State = MEM_FREE then
      Exit;
    AllocationBase:=HINST(MemInfo.AllocationBase);
    CurrentAddr:=HINST(MemInfo.AllocationBase);
    repeat
      if VirtualQuery(Pointer(CurrentAddr),MemInfo,SizeOf(MemInfo)) <> SizeOf(MemInfo) then
        Exit;
      if MemInfo.State = MEM_FREE then
        Exit;
      if HINST(MemInfo.AllocationBase) <> AllocationBase then
        Exit;

      with MemInfo do
      begin
        if State = MEM_COMMIT then
        begin
          Valid:=True;
          Exit;
        end;

        Inc(CurrentAddr,RegionSize);
      end;
    until False;
  end;
end;

begin
  try
    asm
@@loop:
      push eax
      test esp,$FFF
      jnz @@loop
      sub esp,$FFC
      jmp @@loop
    end;
  except
    on EStackOverflow do
      GetStackState
    else
      raise;
  end;

  with StackStateData, MemInfo do
  if Valid then
    MessageBox(0,PChar('Stack pointer is: '+IntToHex(CurrentESP,SizeOf(CurrentESP)*2)+#13#10'Stack bottom is: '+IntToHex(HINST(BaseAddress),SizeOf(HINST)*2)),'Stack state during exception',MB_SETFOREGROUND);
end.

This code will show a message box like:

Code: Select all

Stack pointer is: 00031C08
Stack bottom is: 00031000

Therefore the better option would be to reduce the stack usage of the exception handler, e.g. by using static data blocks or allocated data.

It's some idea, however you can't use this trick for RTL or API functions called inside your exception handler, like IntToHex or MessageBox - they will always use their local stack variables and this will probably be more than the available stack space.

Static variables are not a good solution, because they may be overriden in two cases:
- exception handler may be potentially called simultaneously from more than one thread,
- there may be reentrance to the exception handler from the same thread.

Dynamically allocated variables are better, however controlled lifetime variables (like dynamic arrays) will not be finalized automatically - you must call Finalize procedure before freeing the variable itself.

But dynamically allocated variables are not a good solution in case of out of memory exceptions, so you may try a combined threadvar + GetMem solution - something like this:

Code: Select all

unit Unit1;

interface

uses
  SysUtils, Forms;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    procedure MyExceptionHandler(Sender : TObject; E : Exception);
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
  Application.OnException:=MyExceptionHandler;
end;

type
  PExceptionHandlerData = ^TExceptionHandlerData;
  TExceptionHandlerData = record
    InUse : Boolean;
    Str1 : string;
    Str2 : string;
  end;

threadvar
  DataStatic : TExceptionHandlerData;

procedure TForm1.MyExceptionHandler(Sender : TObject; E : Exception);
var
  Data : PExceptionHandlerData;
begin
  if (not DataStatic.InUse) and (E is EOutOfMemory) then
    Data:=@DataStatic
  else
  try
    GetMem(Data,SizeOf(Data^));
    FillChar(Data^,SizeOf(Data^),0);
  except
    Exit;
  end;

  with Data^ do
  try
    InUse:=True;

    Str1:='abcdefgh...';
    Str2:='01234567...';
    {...}
  finally
    InUse:=False;
    Finalize(Data^);
    if Data <> @DataStatic then
      FreeMem(Data);
  end;
end;

end.

Since Windows XP Professional x64 Edition and Windows Server 2003, there is a better solution, SetThreadStackGuarantee API function - it "Sets the minimum size of the stack associated with the calling thread or fiber that will be available during any stack overflow exceptions":

Code: Select all

var
  SetThreadStackGuarantee : function(var StackSizeInBytes : Cardinal) : LongBool; stdcall;
  StackSizeInBytes : Cardinal;
begin
  SetThreadStackGuarantee:=GetProcAddress(GetModuleHandle(kernel32),PAnsiChar('SetThreadStackGuarantee'));
  if Assigned(SetThreadStackGuarantee) then
  begin
    StackSizeInBytes:=$6000;
    SetThreadStackGuarantee(StackSizeInBytes);
  end;
end;

Probably the best solution would be to collect all required data inside the exception handler, using as little stack as possible - and to process this data and display exception message box after exception handling block, when there is enough stack again.



Regards

[ghisler(Author)]

Since Windows XP Professional x64 Edition and Windows Server 2003, there is a better solution, SetThreadStackGuarantee API function

Nice, I will try that!

[MarcinW]

You should only remember to call SetThreadStackGuarantee also at the beginning of Execute methods in all your TThread descendants.