paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-16 10:19:17 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ Implemented back-tracing with Win32 SEH (not very clean, but works).

Browse Source 
git-svn-id: trunk@27146 -
This commit is contained in:
sergei 2014-03-15 17:40:07 +00:00
parent fb8cbfdc92
commit d728a1636d
1 changed files with 34 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
rtl/win32/seh32.inc
View File

@ -48,10 +48,25 @@ end;
function GetBacktrace(Context: TContext; StartingFrame: Pointer; out Frames: PPointer): Longint; function GetBacktrace(Context: TContext; StartingFrame: Pointer; out Frames: PPointer): Longint;
var
FrameCount: Longint;
oldebp: Cardinal;
begin begin
// TODO Frames:=AllocMem(RaiseMaxFrameCount*sizeof(pointer));
Frames:=nil; FrameCount:=0;
result:=0; repeat
oldebp:=context.ebp;
{ get_caller_stackinfo checks against StackTop on i386 }
get_caller_stackinfo(pointer(Context.Ebp),codepointer(Context.Eip));
if (Context.ebp<=oldebp) or (FrameCount>=RaiseMaxFrameCount) then
break;
if (Pointer(Context.ebp)>StartingFrame) or (FrameCount>0) then
begin
Frames[FrameCount]:=Pointer(Context.eip);
Inc(FrameCount);
end;
until False;
result:=FrameCount;
end; end;
@ -60,11 +75,13 @@ var
ctx: TContext; ctx: TContext;
args: array[0..3] of PtrUint; args: array[0..3] of PtrUint;
begin begin
//RtlCaptureContext(ctx); ctx.Ebp:=Cardinal(AFrame);
ctx.Eip:=Cardinal(AnAddr);
args[0]:=PtrUint(AnAddr); args[0]:=PtrUint(AnAddr);
args[1]:=PtrUint(Obj); args[1]:=PtrUint(Obj);
args[2]:=GetBacktrace(ctx,AFrame,PPointer(args[3])); args[2]:=GetBacktrace(ctx,AFrame,PPointer(args[3]));
RaiseException(FPC_EXCEPTION_CODE,EXCEPTION_NONCONTINUABLE,4,@args[0]); args[4]:=PtrUInt(AFrame);
RaiseException(FPC_EXCEPTION_CODE,EXCEPTION_NONCONTINUABLE,5,@args[0]);
end; end;
@ -141,6 +158,8 @@ var
code: longint; code: longint;
Obj: TObject; Obj: TObject;
Adr: Pointer; Adr: Pointer;
Frames: PCodePointer;
FrameCount: Longint;
begin begin
if (rec.ExceptionFlags and EXCEPTION_UNWIND)=0 then if (rec.ExceptionFlags and EXCEPTION_UNWIND)=0 then
begin begin
@ -169,20 +188,28 @@ begin
erroraddr:=pointer(context.Eip); erroraddr:=pointer(context.Eip);
Halt(code); Halt(code);
end; end;
FrameCount:=GetBacktrace(context,nil,Frames);
end end
else else
begin begin
Obj:=TObject(rec.ExceptionInformation[1]); Obj:=TObject(rec.ExceptionInformation[1]);
Adr:=rec.ExceptionInformation[0]; Adr:=rec.ExceptionInformation[0];
Frames:=PCodePointer(rec.ExceptionInformation[3]);
FrameCount:=ptruint(rec.ExceptionInformation[2]);
code:=217; code:=217;
end; end;
if Assigned(ExceptProc) then if Assigned(ExceptProc) then
begin begin
ExceptProc(Obj,Adr,0,nil {TODO: backtrace}); ExceptProc(Obj,Adr,FrameCount,Frames);
Halt(217); Halt(217);
end end
else else
RunError(code); begin
errorcode:=word(code);
errorbase:=pointer(rec.ExceptionInformation[4]);
erroraddr:=pointer(Adr);
Halt(code);
end;
end; end;
result:=ExceptionContinueExecution; result:=ExceptionContinueExecution;
end; end;