paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-08 09:28:19 +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
begin
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
begin
code:=RunErrorCode(rec);
if code<0 then
SysResetFPU;
code:=abs(code);
Adr:=rec.ExceptionAddress;
Obj:=nil;
if Assigned(ExceptObjProc) then
Obj:=TObject(TExceptObjProc(ExceptObjProc)(abs(code),rec));
Obj:=TObject(TExceptObjProc(ExceptObjProc)(code,rec));
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
else
begin
@ -169,7 +182,7 @@ begin
Halt(217);
end
else
RunError(abs(code));
RunError(code);
end;
result:=ExceptionContinueExecution;
end;