mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-23 03:29:41 +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;
|
||||
|
||||
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 }
|
||||
|
@ -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
|
||||
|
@ -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;
|
||||
|
Loading…
Reference in New Issue
Block a user