From c1b0fb81f15cd8d59c209e2fd26e4706a9b57e7a Mon Sep 17 00:00:00 2001
From: nickysn <nickysn@gmail.com>
Date: Tue, 17 Sep 2013 21:25:26 +0000
Subject: [PATCH] * updated all the RTL helper functions related to exceptions
and stack traces to use codepointer instead of pointer
git-svn-id: trunk@25513 -
---
rtl/i8086/i8086.inc | 14 ++++++++++----
rtl/inc/compproc.inc | 4 ++--
rtl/inc/except.inc | 16 ++++++++--------
rtl/inc/heaptrc.pp | 24 +++++++++++++++---------
rtl/inc/lineinfo.pp | 2 +-
rtl/inc/objpas.inc | 2 +-
rtl/inc/objpash.inc | 8 ++++----
rtl/inc/system.inc | 38 ++++++++++++++++++++++++--------------
rtl/inc/systemh.inc | 18 +++++++++---------
9 files changed, 74 insertions(+), 52 deletions(-)
diff --git a/rtl/i8086/i8086.inc b/rtl/i8086/i8086.inc
index 25a95a530f..c8d3fee6e2 100644
--- a/rtl/i8086/i8086.inc
+++ b/rtl/i8086/i8086.inc
@@ -53,26 +53,32 @@ asm
end;
{$define FPC_SYSTEM_HAS_GET_CALLER_ADDR}
-function get_caller_addr(framebp:pointer;addr:pointer=nil):pointer;nostackframe;assembler;
+function get_caller_addr(framebp:pointer;addr:codepointer=nil):codepointer;nostackframe;assembler;
asm
push bp
mov bp, sp
- mov ax, ss:[bp + 6 + extra_param_offset] // framebp
+{$ifdef FPC_X86_CODE_FAR}
+ xor dx, dx
+{$endif FPC_X86_CODE_FAR}
+ mov ax, ss:[bp + 6 + extra_param_offset + extra_param_offset] // framebp
or ax, ax
jz @@Lg_a_null
xchg ax, bx
mov bx, [bx+2]
+{$ifdef FPC_X86_CODE_FAR}
+ mov dx, [bx+4]
+{$endif FPC_X86_CODE_FAR}
xchg ax, bx
@@Lg_a_null:
pop bp
end;
{$define FPC_SYSTEM_HAS_GET_CALLER_FRAME}
-function get_caller_frame(framebp:pointer;addr:pointer=nil):pointer;nostackframe;assembler;
+function get_caller_frame(framebp:pointer;addr:codepointer=nil):pointer;nostackframe;assembler;
asm
push bp
mov bp, sp
- mov ax, ss:[bp + 6 + extra_param_offset] // framebp
+ mov ax, ss:[bp + 6 + extra_param_offset + extra_param_offset] // framebp
or ax, ax
jz @@Lgnf_null
xchg ax, bx
diff --git a/rtl/inc/compproc.inc b/rtl/inc/compproc.inc
index 4a6e28019e..dc4cdd9d9e 100644
--- a/rtl/inc/compproc.inc
+++ b/rtl/inc/compproc.inc
@@ -592,14 +592,14 @@ procedure fpc_dispatch_by_id(Result: Pointer; const Dispatch: pointer;DispDesc:
{$ifdef FPC_HAS_FEATURE_EXCEPTIONS}
Function fpc_PushExceptAddr (Ft: {$ifdef CPU16}SmallInt{$else}Longint{$endif};_buf,_newaddr : pointer): PJmp_buf ; compilerproc;
-Function fpc_Raiseexception (Obj : TObject; AnAddr,AFrame : Pointer) : TObject; compilerproc;
+Function fpc_Raiseexception (Obj : TObject; AnAddr : CodePointer; AFrame : Pointer) : TObject; compilerproc;
Procedure fpc_PopAddrStack; compilerproc;
function fpc_PopObjectStack : TObject; compilerproc;
function fpc_PopSecondObjectStack : TObject; compilerproc;
Procedure fpc_ReRaise; compilerproc;
Function fpc_Catches(Objtype : TClass) : TObject; compilerproc;
Procedure fpc_DestroyException(o : TObject); compilerproc;
-function fpc_GetExceptionAddr : Pointer; compilerproc;
+function fpc_GetExceptionAddr : CodePointer; compilerproc;
function fpc_safecallhandler(obj: TObject): HResult; compilerproc;
function fpc_safecallcheck(res : hresult) : hresult; compilerproc; {$ifdef CPU86} register; {$endif}
procedure fpc_doneexception; compilerproc;
diff --git a/rtl/inc/except.inc b/rtl/inc/except.inc
index d14104366f..c2de88e519 100644
--- a/rtl/inc/except.inc
+++ b/rtl/inc/except.inc
@@ -112,18 +112,18 @@ end;
{$define FPC_CHECK_GET_CALLER_EXCEPTIONS}
{$endif}
-Procedure PushExceptObject(Obj : TObject; AnAddr,AFrame : Pointer);
+Procedure PushExceptObject(Obj : TObject; AnAddr : CodePointer; AFrame : Pointer);
var
Newobj : PExceptObject;
_ExceptObjectStack : ^PExceptObject;
framebufsize,
framecount : longint;
- frames : PPointer;
+ frames : PCodePointer;
prev_frame,
curr_frame,
+ caller_frame : Pointer;
curr_addr,
- caller_frame,
- caller_addr : Pointer;
+ caller_addr : CodePointer;
begin
{$ifdef excdebug}
writeln ('In PushExceptObject');
@@ -179,7 +179,7 @@ begin
if (framecount>=framebufsize) then
begin
inc(framebufsize,16);
- reallocmem(frames,framebufsize*sizeof(pointer));
+ reallocmem(frames,framebufsize*sizeof(codepointer));
end;
frames[framecount]:=caller_addr;
inc(framecount);
@@ -211,7 +211,7 @@ begin
end;
{$ifndef FPC_SYSTEM_HAS_RAISEEXCEPTION}
-Function fpc_RaiseException (Obj : TObject; AnAddr,AFrame : Pointer) : TObject;[Public, Alias : 'FPC_RAISEEXCEPTION']; compilerproc;
+Function fpc_RaiseException (Obj : TObject; AnAddr : CodePointer; AFrame : Pointer) : TObject;[Public, Alias : 'FPC_RAISEEXCEPTION']; compilerproc;
var
_ExceptObjectStack : PExceptObject;
_ExceptAddrstack : PExceptAddr;
@@ -376,7 +376,7 @@ begin
end;
{ TODO: no longer used, clean up }
-function fpc_GetExceptionAddr : Pointer;[Public, Alias : 'FPC_GETEXCEPTIONADDR']; compilerproc;
+function fpc_GetExceptionAddr : CodePointer;[Public, Alias : 'FPC_GETEXCEPTIONADDR']; compilerproc;
var
_ExceptObjectStack : PExceptObject;
begin
@@ -411,7 +411,7 @@ end;
function fpc_safecallhandler(obj: TObject): HResult; [public,alias:'FPC_SAFECALLHANDLER']; compilerproc;
var
raiselist: PExceptObject;
- adr: Pointer;
+ adr: CodePointer;
exc: TObject;
begin
raiselist:=ExceptObjectStack;
diff --git a/rtl/inc/heaptrc.pp b/rtl/inc/heaptrc.pp
index 6e80e8e66d..337485326d 100644
--- a/rtl/inc/heaptrc.pp
+++ b/rtl/inc/heaptrc.pp
@@ -132,7 +132,7 @@ type
release_sig : longword;
prev_valid : pheap_mem_info;
{$endif EXTRA}
- calls : array [1..tracesize] of pointer;
+ calls : array [1..tracesize] of codepointer;
exact_info_size : word;
extra_info_size : word;
extra_info : pheap_extra_info;
@@ -336,7 +336,8 @@ end;
procedure dump_already_free(p : pheap_mem_info;var ptext : text);
var
- bp, pcaddr : pointer;
+ bp : pointer;
+ pcaddr : codepointer;
begin
Writeln(ptext,'Marked memory at $',HexStr(pointer(p)+sizeof(theap_mem_info)),' released');
call_free_stack(p,ptext);
@@ -349,7 +350,8 @@ end;
procedure dump_error(p : pheap_mem_info;var ptext : text);
var
- bp, pcaddr : pointer;
+ bp : pointer;
+ pcaddr : codepointer;
begin
Writeln(ptext,'Marked memory at $',HexStr(pointer(p)+sizeof(theap_mem_info)),' invalid');
Writeln(ptext,'Wrong signature $',hexstr(p^.sig,8),' instead of ',hexstr(calculate_sig(p),8));
@@ -382,7 +384,8 @@ end;
procedure dump_wrong_size(p : pheap_mem_info;size : ptruint;var ptext : text);
var
- bp, pcaddr : pointer;
+ bp : pointer;
+ pcaddr : codepointer;
begin
Writeln(ptext,'Marked memory at $',HexStr(pointer(p)+sizeof(theap_mem_info)),' invalid');
Writeln(ptext,'Wrong size : ',p^.size,' allocated ',size,' freed');
@@ -464,7 +467,8 @@ Function TraceGetMem(size:ptruint):pointer;
var
allocsize,i : ptruint;
oldbp,
- bp,pcaddr : pointer;
+ bp : pointer;
+ pcaddr : codepointer;
pl : pdword;
p : pointer;
pp : pheap_mem_info;
@@ -573,7 +577,8 @@ function CheckFreeMemSize(loc_info: pheap_info; pp: pheap_mem_info;
size, ppsize: ptruint): boolean; inline;
var
i: ptruint;
- bp,pcaddr : pointer;
+ bp : pointer;
+ pcaddr : codepointer;
ptext : ^text;
{$ifdef EXTRA}
pp2 : pheap_mem_info;
@@ -798,8 +803,8 @@ var
movesize,
i : ptruint;
oldbp,
- bp,
- pcaddr : pointer;
+ bp : pointer;
+ pcaddr : codepointer;
pl : pdword;
pp : pheap_mem_info;
oldsize,
@@ -1005,7 +1010,8 @@ var
{$ifdef morphos}
stack_top: longword;
{$endif morphos}
- bp,pcaddr : pointer;
+ bp : pointer;
+ pcaddr : codepointer;
ptext : ^text;
label
_exit;
diff --git a/rtl/inc/lineinfo.pp b/rtl/inc/lineinfo.pp
index c4573e17e3..4bb56f997f 100644
--- a/rtl/inc/lineinfo.pp
+++ b/rtl/inc/lineinfo.pp
@@ -258,7 +258,7 @@ begin
end;
-function StabBackTraceStr(addr:Pointer):shortstring;
+function StabBackTraceStr(addr:CodePointer):shortstring;
var
func,
source : string;
diff --git a/rtl/inc/objpas.inc b/rtl/inc/objpas.inc
index 22f8d3c66d..5e7596cbd8 100644
--- a/rtl/inc/objpas.inc
+++ b/rtl/inc/objpas.inc
@@ -501,7 +501,7 @@
end;
function TObject.SafeCallException(exceptobject : tobject;
- exceptaddr : pointer) : HResult;
+ exceptaddr : codepointer) : HResult;
begin
safecallexception:=E_UNEXPECTED;
diff --git a/rtl/inc/objpash.inc b/rtl/inc/objpash.inc
index 4be3fb6f7c..aa9d02de39 100644
--- a/rtl/inc/objpash.inc
+++ b/rtl/inc/objpash.inc
@@ -196,7 +196,7 @@
class function newinstance : tobject;virtual;
procedure FreeInstance;virtual;
function SafeCallException(exceptobject : tobject;
- exceptaddr : pointer) : HResult;virtual;
+ exceptaddr : codepointer) : HResult;virtual;
procedure DefaultHandler(var message);virtual;
procedure Free;
@@ -322,17 +322,17 @@
PInterface = PUnknown;
- TExceptProc = Procedure (Obj : TObject; Addr : Pointer; FrameCount:Longint; Frame: PPointer);
+ TExceptProc = Procedure (Obj : TObject; Addr : CodePointer; FrameCount:Longint; Frame: PCodePointer);
{ Exception object stack }
PExceptObject = ^TExceptObject;
TExceptObject = record
FObject : TObject;
- Addr : pointer;
+ Addr : codepointer;
Next : PExceptObject;
refcount : Longint;
Framecount : Longint;
- Frames : PPointer;
+ Frames : PCodePointer;
end;
Const
diff --git a/rtl/inc/system.inc b/rtl/inc/system.inc
index 0c4bebc037..47d1637531 100644
--- a/rtl/inc/system.inc
+++ b/rtl/inc/system.inc
@@ -69,8 +69,8 @@ Const
Procedure HandleError (Errno : Longint); external name 'FPC_HANDLEERROR';
Procedure HandleErrorFrame (Errno : longint;frame : Pointer); forward;
-Procedure HandleErrorAddrFrame (Errno : longint;addr,frame : Pointer); forward;
-Procedure HandleErrorAddrFrameInd (Errno : longint;addr,frame : Pointer); forward;
+Procedure HandleErrorAddrFrame (Errno : longint;addr : CodePointer; frame : Pointer); forward;
+Procedure HandleErrorAddrFrameInd (Errno : longint;addr : CodePointer; frame : Pointer); forward;
{$ifdef FPC_HAS_FEATURE_TEXTIO}
type
@@ -686,7 +686,7 @@ End;
{ This provides a dummy implementation
of get_pc_addr function, for CPU's that don't need
the instruction address to walk the stack. }
-function get_pc_addr : pointer;
+function get_pc_addr : codepointer;
begin
get_pc_addr:=nil;
end;
@@ -697,9 +697,10 @@ end;
of get_caller_stackinfo procedure,
using get_caller_addr and get_caller_frame
functions. }
-procedure get_caller_stackinfo(var framebp,addr : pointer);
+procedure get_caller_stackinfo(var framebp : pointer; addr : codepointer);
var
- nextbp,nextaddr : pointer;
+ nextbp : pointer;
+ nextaddr : codepointer;
begin
nextbp:=get_caller_frame(framebp,addr);
nextaddr:=get_caller_addr(framebp,addr);
@@ -967,7 +968,11 @@ Begin
pstdout:=@stdout;
If erroraddr<>nil Then
Begin
+{$if defined(CPUI8086) and defined(FPC_X86_CODE_FAR)}
+ Writeln(pstdout^,'Runtime error ',Errorcode,' at $',hexstr(DWord(erroraddr) shr 16,4),':',hexstr(DWord(erroraddr) and $FFFF,4));
+{$else}
Writeln(pstdout^,'Runtime error ',Errorcode,' at $',hexstr(erroraddr));
+{$endif}
{ to get a nice symify }
Writeln(pstdout^,BackTraceStrFunc(Erroraddr));
dump_stack(pstdout^,ErrorBase,ErrorAddr);
@@ -1041,13 +1046,17 @@ Begin
end;
-function SysBackTraceStr (Addr: Pointer): ShortString;
+function SysBackTraceStr (Addr: CodePointer): ShortString;
begin
+{$if defined(CPUI8086) and defined(FPC_X86_CODE_FAR)}
+ SysBackTraceStr:=' $'+hexstr(DWord(addr) shr 16,4)+':'+hexstr(DWord(addr) and $FFFF,4);
+{$else}
SysBackTraceStr:=' $'+hexstr(addr);
+{$endif}
end;
-Procedure HandleErrorAddrFrame (Errno : longint;addr,frame : Pointer);[public,alias:'FPC_BREAK_ERROR']; {$ifdef CPUI386} register; {$endif}
+Procedure HandleErrorAddrFrame (Errno : longint;addr : CodePointer; frame : Pointer);[public,alias:'FPC_BREAK_ERROR']; {$ifdef CPUI386} register; {$endif}
begin
If pointer(ErrorProc)<>Nil then
ErrorProc(Errno,addr,frame);
@@ -1064,7 +1073,7 @@ end;
{ This is used internally by system skip first level,
and generated the same output as before, when
HandleErrorFrame function was used internally. }
-Procedure HandleErrorAddrFrameInd (Errno : longint;addr,frame : Pointer);
+Procedure HandleErrorAddrFrameInd (Errno : longint;addr : CodePointer; frame : Pointer);
begin
get_caller_stackinfo (frame, addr);
HandleErrorAddrFrame (Errno,addr,frame);
@@ -1093,7 +1102,8 @@ end;
procedure RunError(w : word);[alias: 'FPC_RUNERROR'];
var
- bp,pcaddr : pointer;
+ bp : pointer;
+ pcaddr : codepointer;
begin
errorcode:=w;
pcaddr:=get_pc_addr;
@@ -1123,14 +1133,14 @@ begin
end;
-Procedure dump_stack(var f : text;fp,addr : Pointer);
+Procedure dump_stack(var f : text;fp : Pointer; addr : CodePointer);
var
i : Longint;
prevfp : Pointer;
- prevaddr : pointer;
+ prevaddr : CodePointer;
is_dev : boolean;
- caller_frame,
- caller_addr : Pointer;
+ caller_frame : Pointer;
+ caller_addr : CodePointer;
Begin
{$ifdef FPC_HAS_FEATURE_EXCEPTIONS}
try
@@ -1171,7 +1181,7 @@ procedure DumpExceptionBackTrace(var f:text);
var
FrameNumber,
FrameCount : longint;
- Frames : PPointer;
+ Frames : PCodePointer;
begin
if RaiseList=nil then
exit;
diff --git a/rtl/inc/systemh.inc b/rtl/inc/systemh.inc
index 3631282117..0e1b0f7a62 100644
--- a/rtl/inc/systemh.inc
+++ b/rtl/inc/systemh.inc
@@ -618,7 +618,7 @@ const
{ Exit Procedure handling consts and types }
ExitProc : codepointer = nil;
- Erroraddr: pointer = nil;
+ Erroraddr: codepointer = nil;
Errorcode: Word = 0;
{ file input modes }
@@ -1258,11 +1258,11 @@ function get_caller_frame(framebp:pointer;addr:pointer=nil):pointer;[INTERNPROC:
function get_frame:pointer;{$ifdef SYSTEMINLINE}inline;{$endif}
{$ENDIF}
-Function Get_pc_addr : Pointer;
+Function Get_pc_addr : CodePointer;
-function get_caller_addr(framebp:pointer;addr:pointer=nil):pointer;
-function get_caller_frame(framebp:pointer;addr:pointer=nil):pointer;
-procedure get_caller_stackinfo(var framebp,addr : pointer);
+function get_caller_addr(framebp:pointer;addr:codepointer=nil):codepointer;
+function get_caller_frame(framebp:pointer;addr:codepointer=nil):pointer;
+procedure get_caller_stackinfo(var framebp : pointer; addr : codepointer);
Function IOResult:Word;
Function Sptr:Pointer;[internconst:fpc_in_const_ptr];
@@ -1344,7 +1344,7 @@ Function Paramcount:Longint;
Function ParamStr(l:Longint):string;
{$endif FPC_HAS_FEATURE_COMMANDARGS}
-Procedure Dump_Stack(var f : text;fp:pointer;addr : pointer = nil);
+Procedure Dump_Stack(var f : text;fp:pointer;addr : codepointer = nil);
{$ifdef FPC_HAS_FEATURE_EXCEPTIONS}
procedure DumpExceptionBackTrace(var f:text);
{$endif FPC_HAS_FEATURE_EXCEPTIONS}
@@ -1387,7 +1387,7 @@ Function StringToPPChar(S: PChar;ReserveEntries:integer):ppchar;
procedure AbstractError;external name 'FPC_ABSTRACTERROR';
procedure EmptyMethod;external name 'FPC_EMPTYMETHOD';
-Function SysBackTraceStr(Addr:Pointer): ShortString;
+Function SysBackTraceStr(Addr:CodePointer): ShortString;
Procedure SysAssert(const Msg,FName:ShortString;LineNo:Longint;ErrorAddr:Pointer);
(* Supposed to return address of previous CtrlBreakHandler *)
(* (may be nil), returned value of pointer (-1) means that *)
@@ -1396,8 +1396,8 @@ function SysSetCtrlBreakHandler (Handler: TCtrlBreakHandler): TCtrlBreakHandler;
{ Error handlers }
Type
- TBackTraceStrFunc = Function (Addr: Pointer): ShortString;
- TErrorProc = Procedure (ErrNo : Longint; Address,Frame : Pointer);
+ TBackTraceStrFunc = Function (Addr: CodePointer): ShortString;
+ TErrorProc = Procedure (ErrNo : Longint; Address : CodePointer; Frame : Pointer);
TAbstractErrorProc = Procedure;
TAssertErrorProc = Procedure(const msg,fname:ShortString;lineno:longint;erroraddr:pointer);
TSafeCallErrorProc = Procedure(error : HResult;addr : pointer);