mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-11 09:26:15 +02:00
+ 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:
parent
b3335abe75
commit
abdbe49861
@ -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 }
|
||||||
|
@ -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
|
||||||
|
@ -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;
|
||||||
|
Loading…
Reference in New Issue
Block a user