paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-30 23:30:18 +02:00
Code Issues Packages Projects Releases Wiki Activity

* SysUtils functions related to exceptions and stacktraces updated to use CodePointer

Browse Source 
git-svn-id: trunk@25515 -
This commit is contained in:
nickysn 2013-09-17 21:58:53 +00:00
parent 5973b231ec
commit 5e09b7a56f
2 changed files with 10 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
rtl/objpas/sysutils/sysutilh.inc
View File

@ -217,9 +217,9 @@ type
{ Exception handling routines } { Exception handling routines }
function ExceptObject: TObject; function ExceptObject: TObject;
function ExceptAddr: Pointer; function ExceptAddr: CodePointer;
function ExceptFrameCount: Longint; function ExceptFrameCount: Longint;
function ExceptFrames: PPointer; function ExceptFrames: PCodePointer;
function ExceptionErrorMessage(ExceptObject: TObject; ExceptAddr: Pointer; function ExceptionErrorMessage(ExceptObject: TObject; ExceptAddr: Pointer;
Buffer: PChar; Size: Integer): Integer; Buffer: PChar; Size: Integer): Integer;
procedure ShowException(ExceptObject: TObject; ExceptAddr: Pointer); procedure ShowException(ExceptObject: TObject; ExceptAddr: Pointer);

13
rtl/objpas/sysutils/sysutils.inc
View File

@ -281,13 +281,16 @@ end;
{$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: CodePointer; FrameCount: Longint; Frames: PCodePointer);[public,alias:'FPC_BREAK_UNHANDLED_EXCEPTION'];
Var Var
i : longint; i : longint;
hstdout : ^text; hstdout : ^text;
begin begin
hstdout:=@stdout; hstdout:=@stdout;
{$if defined(CPUI8086) and (defined(FPC_MM_MEDIUM) or defined(FPC_MM_LARGE) or defined(FPC_MM_HUGE))}
{$else}
Writeln(hstdout^,'An unhandled exception occurred at $',HexStr(Addr),':'); Writeln(hstdout^,'An unhandled exception occurred at $',HexStr(Addr),':');
{$endif}
if Obj is exception then if Obj is exception then
Writeln(hstdout^,Obj.ClassName,': ',Exception(Obj).Message) Writeln(hstdout^,Obj.ClassName,': ',Exception(Obj).Message)
else else
@ -364,7 +367,7 @@ Var OutOfMemory : EOutOfMemory;
InValidPointer : EInvalidPointer; InValidPointer : EInvalidPointer;
Procedure RunErrorToExcept (ErrNo : Longint; Address,Frame : Pointer); Procedure RunErrorToExcept (ErrNo : Longint; Address : CodePointer; Frame : Pointer);
var var
E: Exception; E: Exception;
HS: PString; HS: PString;
@ -495,7 +498,7 @@ begin
Result:=RaiseList^.FObject; Result:=RaiseList^.FObject;
end; end;
function ExceptAddr: Pointer; function ExceptAddr: CodePointer;
begin begin
If RaiseList=Nil then If RaiseList=Nil then
@ -513,7 +516,7 @@ begin
Result:=RaiseList^.Framecount; Result:=RaiseList^.Framecount;
end; end;
function ExceptFrames: PPointer; function ExceptFrames: PCodePointer;
begin begin
If RaiseList=Nil then If RaiseList=Nil then
@ -565,7 +568,7 @@ end;
procedure Abort; procedure Abort;
begin begin
Raise EAbort.Create(SAbortError) at Pointer(Get_Caller_addr(Get_Frame)); Raise EAbort.Create(SAbortError) at CodePointer(Get_Caller_addr(Get_Frame));
end; end;
procedure OutOfMemoryError; procedure OutOfMemoryError;