+ Added additional addr pointer parameter to

  get_caller_frame, get_caller_addr and dump_stack
  with default NIL value to systemh.inc.
  + Added new get_addr function.
  system.inc: Use get_addr and get_frame to call
  HandleErrorAddrFrame instead of HandleErrorFrame
  in several error functions.
  Modify dump_stack to use frame and addr parameters.
  Provide a dummy get_addr function returning nil.
  i386/i386.inc, x86_64./x86_64.inc: Provide real
  implementation of get_addr function.

git-svn-id: trunk@21697 -

rtl/arm/arm.inc

@@ -52,7 +52,7 @@ begin
     // mask "exception happened" and overflow flags
     and  r0,r0,#0xffffff20
     // mask exception flags
-    and  r0,r0,#0xffff40ff    
+    and  r0,r0,#0xffff40ff
 {$ifndef darwin}
     // Floating point exceptions cause kernel panics on iPhoneOS 2.2.1...
 
@@ -110,7 +110,7 @@ end;
 {$ENDIF not INTERNAL_BACKTRACE}
 
 {$define FPC_SYSTEM_HAS_GET_CALLER_ADDR}
-function get_caller_addr(framebp:pointer):pointer;assembler;nostackframe;
+function get_caller_addr(framebp:pointer;addr:pointer=nil):pointer;assembler;nostackframe;
 asm
   cmp r0,#0
 {$ifndef darwin}
@@ -122,7 +122,7 @@ end;
 
 
 {$define FPC_SYSTEM_HAS_GET_CALLER_FRAME}
-function get_caller_frame(framebp:pointer):pointer;assembler;nostackframe;
+function get_caller_frame(framebp:pointer;addr:pointer=nil):pointer;assembler;nostackframe;
 asm
   cmp r0,#0
 {$ifndef darwin}

rtl/avr/avr.inc

@@ -38,13 +38,13 @@ function get_frame:pointer;assembler;nostackframe;
 
 
 {$define FPC_SYSTEM_HAS_GET_CALLER_ADDR}
-function get_caller_addr(framebp:pointer):pointer;assembler;
+function get_caller_addr(framebp:pointer;addr:pointer=nil):pointer;assembler;
   asm
   end;
 
 
 {$define FPC_SYSTEM_HAS_GET_CALLER_FRAME}
-function get_caller_frame(framebp:pointer):pointer;assembler;
+function get_caller_frame(framebp:pointer;addr:pointer=nil):pointer;assembler;
   asm
   end;
 

rtl/i386/i386.inc

@@ -1061,8 +1061,14 @@ end;
 {$ENDIF not INTERNAL_BACKTRACE}
 
 
+{$define FPC_SYSTEM_HAS_GET_ADDR}
+Function Get_addr : Pointer;assembler;nostackframe;
+asm
+        movl    (%esp),%eax
+end;
+
 {$define FPC_SYSTEM_HAS_GET_CALLER_ADDR}
-function get_caller_addr(framebp:pointer):pointer;nostackframe;assembler;
+function get_caller_addr(framebp:pointer;addr:pointer=nil):pointer;nostackframe;assembler;
 asm
         orl     %eax,%eax
         jz      .Lg_a_null
@@ -1072,7 +1078,7 @@ end;
 
 
 {$define FPC_SYSTEM_HAS_GET_CALLER_FRAME}
-function get_caller_frame(framebp:pointer):pointer;nostackframe;assembler;
+function get_caller_frame(framebp:pointer;addr:pointer=nil):pointer;nostackframe;assembler;
 asm
         orl     %eax,%eax
         jz      .Lgnf_null

rtl/inc/system.inc

@@ -78,6 +78,7 @@ Const
 
 Procedure HandleError (Errno : Longint); forward;
 Procedure HandleErrorFrame (Errno : longint;frame : Pointer); forward;
+Procedure HandleErrorAddrFrame (Errno : longint;addr,frame : Pointer); forward;
 
 {$ifdef FPC_HAS_FEATURE_TEXTIO}
 type
@@ -668,33 +669,43 @@ End;
                              Miscellaneous
 *****************************************************************************}
 
+{$ifndef FPC_SYSTEM_HAS_GET_ADDR}
+  { This provides a dummy implementation
+    of get_addr function, for CPU's that don't need
+    the instruction address to walk the stack. }
+function get_addr : pointer;
+begin
+  get_addr:=nil;
+end;
+{$endif ndef FPC_SYSTEM_HAS_GET_ADDR}
+
 procedure fpc_rangeerror;[public,alias:'FPC_RANGEERROR']; compilerproc;
 begin
-  HandleErrorFrame(201,get_frame);
+  HandleErrorAddrFrame(201,get_addr,get_frame);
 end;
 
 
 procedure fpc_divbyzero;[public,alias:'FPC_DIVBYZERO']; compilerproc;
 begin
-  HandleErrorFrame(200,get_frame);
+  HandleErrorAddrFrame(200,get_addr,get_frame);
 end;
 
 
 procedure fpc_overflow;[public,alias:'FPC_OVERFLOW']; compilerproc;
 begin
-  HandleErrorFrame(215,get_frame);
+  HandleErrorAddrFrame(215,get_addr,get_frame);
 end;
 
 
 procedure fpc_threaderror; [public,alias:'FPC_THREADERROR'];
 begin
-  HandleErrorFrame(6,get_frame);
+  HandleErrorAddrFrame(6,get_addr,get_frame);
 end;
 
 
 procedure fpc_invalidpointer; [public,alias:'FPC_INVALIDPOINTER'];
 begin
-  HandleErrorFrame(216,get_frame);
+  HandleErrorAddrFrame(216,get_addr,get_frame);
 end;
 
 
@@ -708,7 +719,7 @@ begin
    begin
      l:=HInOutRes^;
      HInOutRes^:=0;
-     HandleErrorFrame(l,get_frame);
+     HandleErrorAddrFrame(l,get_addr,get_frame);
    end;
 end;
 
@@ -737,7 +748,7 @@ begin
     begin
       if assigned(SafeCallErrorProc) then
         SafeCallErrorProc(res,get_frame);
-      HandleErrorFrame(229,get_frame);
+      HandleErrorAddrFrame(229,get_addr,get_frame);
     end;
   result:=res;
 end;
@@ -1024,15 +1035,15 @@ Procedure HandleError (Errno : longint);[public,alias : 'FPC_HANDLEERROR'];
   Internal function should ALWAYS call HandleError instead of RunError.
 }
 begin
-  HandleErrorFrame(Errno,get_frame);
+  HandleErrorAddrFrame(Errno,get_frame,get_addr);
 end;
 
 
 procedure RunError(w : word);[alias: 'FPC_RUNERROR'];
 begin
   errorcode:=w;
-  erroraddr:=get_caller_addr(get_frame);
-  errorbase:=get_caller_frame(get_frame);
+  erroraddr:=get_caller_addr(get_frame,get_addr);
+  errorbase:=get_caller_frame(get_frame,get_addr);
   Halt(errorcode);
 end;
 
@@ -1055,10 +1066,11 @@ begin
 end;
 
 
-Procedure dump_stack(var f : text;bp : Pointer);
+Procedure dump_stack(var f : text;bp,addr : Pointer);
 var
   i : Longint;
   prevbp : Pointer;
+  prevaddr : pointer;
   is_dev : boolean;
   caller_frame,
   caller_addr : Pointer;
@@ -1067,12 +1079,13 @@ Begin
   try
 {$endif FPC_HAS_FEATURE_EXCEPTIONS}
     prevbp:=bp-1;
+    prevaddr:=nil;
     i:=0;
     is_dev:=do_isdevice(textrec(f).Handle);
     while bp > prevbp Do
      Begin
-       caller_addr := get_caller_addr(bp);
-       caller_frame := get_caller_frame(bp);
+       caller_addr := get_caller_addr(bp,addr);
+       caller_frame := get_caller_frame(bp,addr);
        if (caller_addr=nil) then
          break;
        Writeln(f,BackTraceStrFunc(caller_addr));
@@ -1082,7 +1095,9 @@ Begin
        If ((i>max_frame_dump) and is_dev) or (i>256) Then
          break;
        prevbp:=bp;
+       prevaddr:=addr;
        bp:=caller_frame;
+       addr:=caller_addr;
      End;
 {$ifdef FPC_HAS_FEATURE_EXCEPTIONS}
    except
@@ -1268,16 +1283,17 @@ procedure fpc_AbstractErrorIntern;compilerproc;[public,alias : 'FPC_ABSTRACTERRO
 begin
   If pointer(AbstractErrorProc)<>nil then
     AbstractErrorProc();
-  HandleErrorFrame(211,get_frame);
+  HandleErrorAddrFrame(211,get_addr,get_frame);
 end;
 
 
-Procedure fpc_assert(Const Msg,FName:Shortstring;LineNo:Longint;ErrorAddr:Pointer); [Public,Alias : 'FPC_ASSERT']; compilerproc;
+Procedure fpc_assert(Const Msg,FName:Shortstring;LineNo:Longint;
+   ErrorAddr:Pointer); [Public,Alias : 'FPC_ASSERT']; compilerproc;
 begin
   if pointer(AssertErrorProc)<>nil then
     AssertErrorProc(Msg,FName,LineNo,ErrorAddr)
   else
-    HandleErrorFrame(227,get_frame);
+    HandleErrorAddrFrame(227,get_addr,get_frame);
 end;
 
 

rtl/inc/systemh.inc

@@ -1059,15 +1059,17 @@ Procedure getdir(drivenr:byte;var dir:ansistring);
 //function get_frame:pointer;[INTERNPROC:fpc_in_get_frame];
 (*
 // still defined externally
-function get_caller_addr(framebp:pointer):pointer;[INTERNPROC:fpc_in_get_caller_addr];
-function get_caller_frame(framebp:pointer):pointer;[INTERNPROC:fpc_in_get_caller_frame];
+function get_caller_addr(framebp:pointer;addr:pointer=nil):pointer;[INTERNPROC:fpc_in_get_caller_addr];
+function get_caller_frame(framebp:pointer;addr:pointer=nil):pointer;[INTERNPROC:fpc_in_get_caller_frame];
 *)
 {$ELSE}
 function get_frame:pointer;{$ifdef SYSTEMINLINE}inline;{$endif}
 {$ENDIF}
 
-function get_caller_addr(framebp:pointer):pointer;
-function get_caller_frame(framebp:pointer):pointer;
+Function Get_addr : Pointer;
+
+function get_caller_addr(framebp:pointer;addr:pointer=nil):pointer;
+function get_caller_frame(framebp:pointer;addr:pointer=nil):pointer;
 
 Function IOResult:Word;
 Function Sptr:Pointer;[internconst:fpc_in_const_ptr];
@@ -1149,7 +1151,7 @@ Function  Paramcount:Longint;
 Function  ParamStr(l:Longint):string;
 {$endif FPC_HAS_FEATURE_COMMANDARGS}
 
-Procedure Dump_Stack(var f : text;bp:pointer);
+Procedure Dump_Stack(var f : text;bp:pointer;addr : pointer = nil);
 {$ifdef FPC_HAS_FEATURE_EXCEPTIONS}
 procedure DumpExceptionBackTrace(var f:text);
 {$endif FPC_HAS_FEATURE_EXCEPTIONS}

rtl/java/jsystemh.inc

@@ -591,15 +591,15 @@ Procedure getdir(drivenr:byte;var dir:ansistring);
 //function get_frame:pointer;[INTERNPROC:fpc_in_get_frame];
 (*
 // still defined externally
-function get_caller_addr(framebp:pointer):pointer;[INTERNPROC:fpc_in_get_caller_addr];
-function get_caller_frame(framebp:pointer):pointer;[INTERNPROC:fpc_in_get_caller_frame];
+function get_caller_addr(framebp:pointer;addr:pointer=nil):pointer;[INTERNPROC:fpc_in_get_caller_addr];
+function get_caller_frame(framebp:pointer;addr:pointer=nil):pointer;[INTERNPROC:fpc_in_get_caller_frame];
 *)
 {$ELSE}
 function get_frame:pointer;{$ifdef SYSTEMINLINE}inline;{$endif}
 {$ENDIF}
 (*
-function get_caller_addr(framebp:pointer):pointer;
-function get_caller_frame(framebp:pointer):pointer;
+function get_caller_addr(framebp:pointer;addr:pointer=nil):pointer;
+function get_caller_frame(framebp:pointer;addr:pointer=nil):pointer;
 *)
 
 //Function IOResult:Word;

rtl/jvm/jvm.inc

@@ -25,7 +25,7 @@ Procedure SysInitFPU;{$ifdef SYSTEMINLINE}inline;{$endif}
   begin
     softfloat_exception_mask:=float_flag_underflow or float_flag_inexact or float_flag_denormal;
   end;
-  
+
 {$define FPC_SYSTEM_HAS_SYSRESETFPU}
 Procedure SysResetFPU;{$ifdef SYSTEMINLINE}inline;{$endif}
   begin
@@ -49,14 +49,14 @@ function get_frame:pointer;
 
 
 {$define FPC_SYSTEM_HAS_GET_CALLER_ADDR}
-function get_caller_addr(framebp:pointer):pointer;
+function get_caller_addr(framebp:pointer;addr:pointer=nil):pointer;
   begin
     result:=nil;
   end;
 
 
 {$define FPC_SYSTEM_HAS_GET_CALLER_FRAME}
-function get_caller_frame(framebp:pointer):pointer;
+function get_caller_frame(framebp:pointer;addr:pointer=nil):pointer;
   begin
     result:=nil;
   end;

rtl/m68k/m68k.inc

@@ -41,7 +41,7 @@ function get_frame : pointer; assembler;
 
 
 {$define FPC_SYSTEM_HAS_GET_CALLER_ADDR}
-function get_caller_addr(framebp : pointer) : pointer;
+function get_caller_addr(framebp : pointer;addr:pointer=nil) : pointer;
   begin
      asm
         move.l framebp,a0
@@ -55,7 +55,7 @@ function get_caller_addr(framebp : pointer) : pointer;
 
 
 {$define FPC_SYSTEM_HAS_GET_CALLER_FRAME}
-function get_caller_frame(framebp : pointer) : pointer;
+function get_caller_frame(framebp : pointer;addr:pointer=nil) : pointer;
   begin
      asm
         move.l FRAMEBP,a0

rtl/mips/mips.inc

@@ -75,7 +75,7 @@ function get_frame:pointer;assembler;nostackframe;
 
 
 {$define FPC_SYSTEM_HAS_GET_CALLER_ADDR}
-function get_caller_addr(framebp:pointer):pointer;assembler;nostackframe;
+function get_caller_addr(framebp:pointer;addr:pointer=nil):pointer;assembler;nostackframe;
   asm
     // lw $2,4($4) // #movl    4(%eax),%eax
     lui $2,0
@@ -83,7 +83,7 @@ function get_caller_addr(framebp:pointer):pointer;assembler;nostackframe;
 
 
 {$define FPC_SYSTEM_HAS_GET_CALLER_FRAME}
-function get_caller_frame(framebp:pointer):pointer;assembler;nostackframe;
+function get_caller_frame(framebp:pointer;addr:pointer=nil):pointer;assembler;nostackframe;
   asm
     // lw $2,0($4) // #movl    (%eax),%eax
     lui $2,0

rtl/powerpc/powerpc.inc

@@ -1024,7 +1024,7 @@ indicated by the first bit set to 1. This is checked below.}
 {Both routines below assumes that framebp is a valid framepointer or nil.}
 
 {$define FPC_SYSTEM_HAS_GET_CALLER_ADDR}
-function get_caller_addr(framebp:pointer):pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe;
+function get_caller_addr(framebp:pointer;addr:pointer=nil):pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe;
 asm
    cmplwi  r3,0
    beq     .Lcaller_addr_invalid
@@ -1048,7 +1048,7 @@ end;
 
 
 {$define FPC_SYSTEM_HAS_GET_CALLER_FRAME}
-function get_caller_frame(framebp:pointer):pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe;
+function get_caller_frame(framebp:pointer;addr:pointer=nil):pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe;
 asm
     cmplwi  r3,0
     beq     .Lcaller_frame_invalid

rtl/powerpc64/powerpc64.inc

@@ -520,7 +520,7 @@ asm
 end;
 
 {$define FPC_SYSTEM_HAS_GET_CALLER_ADDR}
-function get_caller_addr(framebp:pointer):pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe;
+function get_caller_addr(framebp:pointer;addr:pointer=nil):pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe;
 asm
   cmpldi  r3,0
   beq     .Lcaller_addr_frame_null
@@ -534,7 +534,7 @@ end;
 
 
 {$define FPC_SYSTEM_HAS_GET_CALLER_FRAME}
-function get_caller_frame(framebp:pointer):pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe;
+function get_caller_frame(framebp:pointer;addr:pointer=nil):pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif} nostackframe;
 asm
   cmpldi  r3,0
   beq     .Lcaller_frame_null

rtl/sparc/sparc.inc

@@ -53,7 +53,7 @@ Procedure SysInitFPU;{$ifdef SYSTEMINLINE}inline;{$endif}
       round towards zero; ieee compliant arithmetics }
     set_fsr((get_fsr and $3fbfffff) or $09000000);
   end;
-  
+
 {$define FPC_SYSTEM_HAS_SYSRESETFPU}
 Procedure SysResetFPU;{$ifdef SYSTEMINLINE}inline;{$endif}
   begin
@@ -77,7 +77,7 @@ function get_frame:pointer;assembler;nostackframe;
 
 
 {$define FPC_SYSTEM_HAS_GET_CALLER_ADDR}
-function get_caller_addr(framebp:pointer):pointer;assembler;nostackframe;
+function get_caller_addr(framebp:pointer;addr:pointer=nil):pointer;assembler;nostackframe;
   asm
     { framebp = %o0 }
     subcc   %o0,0,%o0
@@ -93,7 +93,7 @@ function get_caller_addr(framebp:pointer):pointer;assembler;nostackframe;
 
 
 {$define FPC_SYSTEM_HAS_GET_CALLER_FRAME}
-function get_caller_frame(framebp:pointer):pointer;assembler;nostackframe;
+function get_caller_frame(framebp:pointer;addr:pointer=nil):pointer;assembler;nostackframe;
   asm
     { framebp = %o0 }
     subcc   %o0,0,%o0

rtl/x86_64/x86_64.inc

@@ -35,9 +35,14 @@ asm
 end;
 {$ENDIF not INTERNAL_BACKTRACE}
 
+{$define FPC_SYSTEM_HAS_GET_ADDR}
+function get_addr:pointer;assembler;
+asm
+        movq    (%rsp),%rax
+end;
 
 {$define FPC_SYSTEM_HAS_GET_CALLER_ADDR}
-function get_caller_addr(framebp:pointer):pointer;{$ifdef SYSTEMINLINE}inline;{$endif}
+function get_caller_addr(framebp:pointer;addr:pointer=nil):pointer;{$ifdef SYSTEMINLINE}inline;{$endif}
 begin
   get_caller_addr:=framebp;
   if assigned(framebp) then
@@ -46,7 +51,7 @@ end;
 
 
 {$define FPC_SYSTEM_HAS_GET_CALLER_FRAME}
-function get_caller_frame(framebp:pointer):pointer;{$ifdef SYSTEMINLINE}inline;{$endif}
+function get_caller_frame(framebp:pointer;addr:pointer=nil):pointer;{$ifdef SYSTEMINLINE}inline;{$endif}
 begin
   get_caller_frame:=framebp;
   if assigned(framebp) then
@@ -942,7 +947,7 @@ Procedure SysInitFPU;
     { these locals are so we don't have to hack pic code in the assembler }
     localmxcsr: dword;
     localfpucw: word;
- 
+
 begin
   localmxcsr:=mxcsr;
   localfpucw:=fpucw;