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

* Disabled regvars in __FPC_default_handler by adding an empty assembler block, it is necessary because RtlUnwind does not preserve registers.

Browse Source 
* Fixed backtrace for non-language exceptions in programs without SysUtils unit.

git-svn-id: trunk@27093 -
This commit is contained in:
sergei 2014-03-11 12:34:36 +00:00
parent ab7e5cdda1
commit abc1468a7a
1 changed files with 16 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
rtl/win32/seh32.inc
View File

@ -145,17 +145,30 @@ begin
if (rec.ExceptionFlags and EXCEPTION_UNWIND)=0 then if (rec.ExceptionFlags and EXCEPTION_UNWIND)=0 then
begin begin
RtlUnwind(@frame,nil,@rec,nil); RtlUnwind(@frame,nil,@rec,nil);
asm
{ RtlUnwind destroys nonvolatile registers, this assembler block prevents
regvar optimizations. }
end ['ebx','esi','edi'];
if rec.ExceptionCode<>FPC_EXCEPTION_CODE then if rec.ExceptionCode<>FPC_EXCEPTION_CODE then
begin begin
code:=RunErrorCode(rec); code:=RunErrorCode(rec);
if code<0 then if code<0 then
SysResetFPU; SysResetFPU;
code:=abs(code);
Adr:=rec.ExceptionAddress; Adr:=rec.ExceptionAddress;
Obj:=nil; Obj:=nil;
if Assigned(ExceptObjProc) then if Assigned(ExceptObjProc) then
Obj:=TObject(TExceptObjProc(ExceptObjProc)(abs(code),rec)); Obj:=TObject(TExceptObjProc(ExceptObjProc)(code,rec));
if Obj=nil then if Obj=nil then
RunError(abs(code)); begin
{ This works because RtlUnwind does not actually unwind the stack on i386
(and only on i386) }
errorcode:=word(code);
errorbase:=pointer(context.Ebp);
erroraddr:=pointer(context.Eip);
Halt(code);
end;
end end
else else
begin begin
@ -169,7 +182,7 @@ begin
Halt(217); Halt(217);
end end
else else
RunError(abs(code)); RunError(code);
end; end;
result:=ExceptionContinueExecution; result:=ExceptionContinueExecution;
end; end;