Browse Source

* Disabled regvars in __FPC_default_handler by adding an empty assembler block, it is necessary because RtlUnwind does not preserve registers.
* Fixed backtrace for non-language exceptions in programs without SysUtils unit.

git-svn-id: trunk@27093 -

sergei 11 years ago
parent
commit
abc1468a7a
1 changed files with 16 additions and 3 deletions
  1. 16 3
      rtl/win32/seh32.inc

+ 16 - 3
rtl/win32/seh32.inc

@@ -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;