+ 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;
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 }

View File

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

View File

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