paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-20 07:39:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Win64 SEH: don't call RunError in exception handler, because it always prints backtrace from caller's context. Instead, print the correct backtrace explicitly.

Browse Source 
git-svn-id: trunk@29678 -
This commit is contained in:
sergei 2015-02-13 05:02:20 +00:00
parent cd166e6ff6
commit 896c1ff6d6
1 changed files with 19 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
rtl/win64/seh64.inc
View File

@ -375,6 +375,8 @@ label L1;
var
exc: PExceptObject;
obj: TObject;
hstdout: ^text;
i,code: Longint;
begin
if (rec.ExceptionFlags and EXCEPTION_UNWIND)=0 then
begin
@ -391,7 +393,19 @@ begin
begin
Exc:=ExceptObjectStack;
if Exc^.FObject=nil then
RunError(abs(RunErrorCodex64(rec,context))) // !!prints wrong backtrace
begin
hstdout:=@stdout;
code:=abs(RunErrorCodex64(rec,context));
Writeln(hstdout^,'Runtime error ',code,' at $',hexstr(Exc^.addr));
Writeln(hstdout^,BackTraceStrFunc(Exc^.Addr));
if (Exc^.FrameCount>0) then
begin
for i:=0 to Exc^.FrameCount-1 do
Writeln(hstdout^,BackTraceStrFunc(Exc^.Frames[i]));
end;
Writeln(hstdout^,'');
Halt(code);
end
else
begin
{ if ExceptObjProc=nil, ExceptProc is typically also nil,
@ -404,8 +418,10 @@ begin
L1:
{ RtlUnwindEx above resets execution context to the point where the handler
was installed, i.e. main_wrapper. It makes exiting this procedure no longer
possible, halting is the only possible action here. }
RunError(217);
possible. Halting is the only possible action here.
Furthermore, this is not expected to execute at all, because the above block
definitely halts. }
Halt(217);
end;
end;
result:=ExceptionContinueSearch;