瀏覽代碼

+ SysUtils part of SEH (enabled only for win64)
* EExternal.ExceptionRecord changed from field to property and made available on all Windows, not just win32.
* CatchUnhandledException: removed AnsiString variable, ideally there should be no memory allocations in this code path.

git-svn-id: trunk@19849 -

sergei 13 年之前
父節點
當前提交
abdbe49861
共有 3 個文件被更改,包括 50 次插入10 次删除
  1. 8 3
      rtl/objpas/sysutils/sysutilh.inc
  2. 10 7
      rtl/objpas/sysutils/sysutils.inc
  3. 32 0
      rtl/win/sysutils.pp

+ 8 - 3
rtl/objpas/sysutils/sysutilh.inc

@@ -124,10 +124,15 @@ type
    ExceptClass = class of Exception;
 
    EExternal = class(Exception)
+{$ifdef windows}
+   { OS-provided exception record is stored on stack and has very limited lifetime.
+     Therefore store a complete copy. }
+   private
+     FExceptionRecord: TExceptionRecord;
+     function GetExceptionRecord: PExceptionRecord;
    public
-{$ifdef win32}
-     ExceptionRecord : PExceptionRecord;
-{$endif win32}
+     property ExceptionRecord : PExceptionRecord read GetExceptionRecord;
+{$endif windows}
    end;
 
    { integer math exceptions }

+ 10 - 7
rtl/objpas/sysutils/sysutils.inc

@@ -267,24 +267,27 @@
        ErrCode:=Code;
     end;
 
+{$ifdef windows}
+function EExternal.GetExceptionRecord: PExceptionRecord;
+begin
+  result:=@FExceptionRecord;
+end;
+
+{$endif windows}
 
 {$push}
 {$S-}
 Procedure CatchUnhandledException (Obj : TObject; Addr: Pointer; FrameCount: Longint; Frames: PPointer);[public,alias:'FPC_BREAK_UNHANDLED_EXCEPTION'];
 Var
-  Message : String;
   i : longint;
   hstdout : ^text;
 begin
   hstdout:=@stdout;
-  Writeln(hstdout^,'An unhandled exception occurred at $',HexStr(PtrUInt(Addr),sizeof(PtrUInt)*2),' :');
+  Writeln(hstdout^,'An unhandled exception occurred at $',HexStr(Addr),':');
   if Obj is exception then
-   begin
-     Message:=Exception(Obj).ClassName+' : '+Exception(Obj).Message;
-     Writeln(hstdout^,Message);
-   end
+    Writeln(hstdout^,Obj.ClassName,': ',Exception(Obj).Message)
   else
-   Writeln(hstdout^,'Exception object ',Obj.ClassName,' is not of class Exception.');
+    Writeln(hstdout^,'Exception object ',Obj.ClassName,' is not of class Exception.');
   Writeln(hstdout^,BackTraceStrFunc(Addr));
   if (FrameCount>0) then
     begin

+ 32 - 0
rtl/win/sysutils.pp

@@ -1264,10 +1264,42 @@ procedure InitWin32Widestrings;
     widestringmanager.CompareTextUnicodeStringProc:=@Win32CompareTextUnicodeString;
   end;
 
+{ Platform-specific exception support }
+
+function WinExceptionObject(code: Longint; const rec: TExceptionRecord): Exception;
+var
+  entry: PExceptMapEntry;
+begin
+  entry := FindExceptMapEntry(code);
+  if assigned(entry) then
+    result:=entry^.cls.CreateRes(entry^.msg)
+  else
+    result:=EExternalException.CreateResFmt(@SExternalException,[rec.ExceptionCode]);
+
+  if result is EExternal then
+    EExternal(result).FExceptionRecord:=rec;
+end;
+
+function WinExceptionClass(code: longint): ExceptClass;
+var
+  entry: PExceptMapEntry;
+begin
+  entry := FindExceptMapEntry(code);
+  if assigned(entry) then
+    result:=entry^.cls
+  else
+    result:=EExternalException;
+end;
+
 
 Initialization
   InitWin32Widestrings;
   InitExceptions;       { Initialize exceptions. OS independent }
+{$ifdef win64}          { Nothing win64-specific here, just keeping exe size down
+                          as these procedures aren't used in generic exception handling }
+  ExceptObjProc:=@WinExceptionObject;
+  ExceptClsProc:=@WinExceptionClass;
+{$endif win64}
   InitInternational;    { Initialize internationalization settings }
   LoadVersionInfo;
   InitSysConfigDir;