+ 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 -
This commit is contained in:
sergei 2011-12-14 10:47:26 +00:00
parent b3335abe75
commit abdbe49861
3 changed files with 50 additions and 10 deletions

View File

@ -124,10 +124,15 @@ type
ExceptClass = class of Exception; ExceptClass = class of Exception;
EExternal = class(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 public
{$ifdef win32} property ExceptionRecord : PExceptionRecord read GetExceptionRecord;
ExceptionRecord : PExceptionRecord; {$endif windows}
{$endif win32}
end; end;
{ integer math exceptions } { integer math exceptions }

View File

@ -267,24 +267,27 @@
ErrCode:=Code; ErrCode:=Code;
end; end;
{$ifdef windows}
function EExternal.GetExceptionRecord: PExceptionRecord;
begin
result:=@FExceptionRecord;
end;
{$endif windows}
{$push} {$push}
{$S-} {$S-}
Procedure CatchUnhandledException (Obj : TObject; Addr: Pointer; FrameCount: Longint; Frames: PPointer);[public,alias:'FPC_BREAK_UNHANDLED_EXCEPTION']; Procedure CatchUnhandledException (Obj : TObject; Addr: Pointer; FrameCount: Longint; Frames: PPointer);[public,alias:'FPC_BREAK_UNHANDLED_EXCEPTION'];
Var Var
Message : String;
i : longint; i : longint;
hstdout : ^text; hstdout : ^text;
begin begin
hstdout:=@stdout; 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 if Obj is exception then
begin Writeln(hstdout^,Obj.ClassName,': ',Exception(Obj).Message)
Message:=Exception(Obj).ClassName+' : '+Exception(Obj).Message;
Writeln(hstdout^,Message);
end
else 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)); Writeln(hstdout^,BackTraceStrFunc(Addr));
if (FrameCount>0) then if (FrameCount>0) then
begin begin

View File

@ -1264,10 +1264,42 @@ procedure InitWin32Widestrings;
widestringmanager.CompareTextUnicodeStringProc:=@Win32CompareTextUnicodeString; widestringmanager.CompareTextUnicodeStringProc:=@Win32CompareTextUnicodeString;
end; 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 Initialization
InitWin32Widestrings; InitWin32Widestrings;
InitExceptions; { Initialize exceptions. OS independent } 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 } InitInternational; { Initialize internationalization settings }
LoadVersionInfo; LoadVersionInfo;
InitSysConfigDir; InitSysConfigDir;