* Internal implementations of get_frame, get_caller_frame and get_caller_addr.

    Not yet activated.

git-svn-id: trunk@3517 -

compiler/compinnr.inc

@@ -63,6 +63,9 @@ const
    in_cycle             = 52; {macpas}
    in_slice_x           = 53;
    in_unaligned_x       = 54;
+   in_get_frame         = 56;
+   in_get_caller_addr   = 57;
+   in_get_caller_frame  = 58;
 
 { Internal constant functions }
    in_const_sqr        = 100;

compiler/ncginl.pas

@@ -47,6 +47,9 @@ interface
           procedure second_cos_real; virtual;
           procedure second_sin_real; virtual;
           procedure second_assigned; virtual;
+          procedure second_get_frame;virtual;
+          procedure second_get_caller_frame;virtual;
+          procedure second_get_caller_addr;virtual;
           procedure second_prefetch; virtual;
        end;
 
@@ -79,77 +82,49 @@ implementation
 
          case inlinenumber of
             in_assert_x_y:
-              begin
-                 second_Assert;
-              end;
+              second_Assert;
             in_sizeof_x,
             in_typeof_x :
-              begin
-                 second_SizeofTypeOf;
-              end;
+              second_SizeofTypeOf;
             in_length_x :
-              begin
-                 second_Length;
-              end;
+              second_Length;
             in_pred_x,
             in_succ_x:
-              begin
-                 second_PredSucc;
-              end;
+               second_PredSucc;
             in_dec_x,
             in_inc_x :
-              begin
-                second_IncDec;
-              end;
+              second_IncDec;
             in_typeinfo_x:
-               begin
-                  second_TypeInfo;
-               end;
+              second_TypeInfo;
             in_include_x_y,
             in_exclude_x_y:
-              begin
-                 second_IncludeExclude;
-              end;
+              second_IncludeExclude;
             in_pi_real:
-              begin
-                second_pi;
-              end;
+              second_pi;
             in_sin_real:
-              begin
-                second_sin_real;
-              end;
+              second_sin_real;
             in_arctan_real:
-              begin
-                second_arctan_real;
-              end;
+              second_arctan_real;
             in_abs_real:
-              begin
-                second_abs_real;
-              end;
+              second_abs_real;
             in_sqr_real:
-              begin
-                second_sqr_real;
-              end;
+              second_sqr_real;
             in_sqrt_real:
-              begin
-                second_sqrt_real;
-              end;
+              second_sqrt_real;
             in_ln_real:
-              begin
-                second_ln_real;
-              end;
+              second_ln_real;
             in_cos_real:
-              begin
-                 second_cos_real;
-              end;
+               second_cos_real;
             in_prefetch_var:
-              begin
-                second_prefetch;
-              end;
+              second_prefetch;
             in_assigned_x:
-              begin
-                second_assigned;
-              end;
+              second_assigned;
+            in_get_frame:
+              second_get_frame;
+            in_get_caller_frame:
+              second_get_caller_frame;
+            in_get_caller_addr:
+              second_get_caller_addr;
 {$ifdef SUPPORT_UNALIGNED}
             in_unaligned_x:
               begin
@@ -700,6 +675,69 @@ implementation
         location_reset(location,LOC_JUMP,OS_NO);
       end;
 
+    procedure Tcginlinenode.second_get_frame;
+
+    var frame_ref:Treference;
+
+    begin
+      if current_procinfo.framepointer=NR_STACK_POINTER_REG then
+        begin
+          location_reset(location,LOC_CONSTANT,OS_ADDR);
+          location.value:=0;
+        end
+      else
+        begin
+          location_reset(location,LOC_CREGISTER,OS_ADDR);
+          location.register:=current_procinfo.framepointer;
+        end;
+    end;
+
+    procedure Tcginlinenode.second_get_caller_frame;
+
+    var frame_ref:Treference;
+
+    begin
+      if current_procinfo.framepointer=NR_STACK_POINTER_REG then
+        begin
+          location_reset(location,LOC_CREGISTER,OS_ADDR);
+          location.register:=NR_FRAME_POINTER_REG;
+{          location_reset(location,LOC_REGISTER,OS_ADDR);
+          location.register:=cg.getaddressregister(current_asmdata.currasmlist);
+          cg.a_load_reg_reg(current_asmdata.currasmlist,OS_ADDR,OS_ADDR,NR_FRAME_POINTER_REG,location.register);}
+        end
+      else
+        begin
+          location_reset(location,LOC_REGISTER,OS_ADDR);
+          location.register:=cg.getaddressregister(current_asmdata.currasmlist);
+          reference_reset_base(frame_ref,current_procinfo.framepointer,0);
+          cg.a_load_ref_reg(current_asmdata.currasmlist,OS_ADDR,OS_ADDR,frame_ref,location.register);
+        end;
+    end;
+
+    procedure Tcginlinenode.second_get_caller_addr;
+
+    var frame_ref:Treference;
+
+    begin
+      if current_procinfo.framepointer=NR_STACK_POINTER_REG then
+        begin
+          location_reset(location,LOC_REGISTER,OS_ADDR);
+          location.register:=cg.getaddressregister(current_asmdata.currasmlist);
+          reference_reset_base(frame_ref,NR_STACK_POINTER_REG,0);
+          cg.a_load_ref_reg(current_asmdata.currasmlist,OS_ADDR,OS_ADDR,frame_ref,location.register);
+        end
+      else
+        begin
+          location_reset(location,LOC_REGISTER,OS_ADDR);
+          location.register:=cg.getaddressregister(current_asmdata.currasmlist);
+        {$ifdef cpu64bit}
+          reference_reset_base(frame_ref,current_procinfo.framepointer,8);
+        {$else}
+          reference_reset_base(frame_ref,current_procinfo.framepointer,4);
+        {$endif}
+          cg.a_load_ref_reg(current_asmdata.currasmlist,OS_ADDR,OS_ADDR,frame_ref,location.register);
+        end;
+    end;
 
 begin
    cinlinenode:=tcginlinenode;

compiler/ninl.pas

@@ -2056,7 +2056,12 @@ implementation
                    else
                      include(current_procinfo.flags,pi_do_call);
                 end;
-
+              in_get_frame,
+              in_get_caller_frame,
+              in_get_caller_addr:
+                begin
+                  resulttype:=voidpointertype;
+                end;
                else
                 internalerror(8);
             end;
@@ -2410,6 +2415,20 @@ implementation
               { should be handled by det_resulttype }
               internalerror(200108234);
             end;
+         in_get_frame:
+            begin
+              expectloc:=LOC_CREGISTER;
+            end;
+         in_get_caller_frame:
+            begin
+              expectloc:=LOC_REGISTER;
+              registersint:=1;
+            end;
+         in_get_caller_addr:
+            begin
+              expectloc:=LOC_REGISTER;
+              registersint:=1;
+            end;
 
          in_prefetch_var:
            begin
@@ -2422,7 +2441,7 @@ implementation
            end;
 {$endif SUPPORT_UNALIGNED}
           else
-            internalerror(8);
+            internalerror(89);
           end;
          dec(parsing_para_level);
        end;

compiler/options.pas

@@ -1873,6 +1873,7 @@ begin
   def_system_macro('PARAOUTFILE');
   def_system_macro('RESSTRSECTIONS');
   def_system_macro('FPC_HASFIXED64BITVARIANT');
+{  def_system_macro('INTERNAL_BACKTRACE');}
 
   if pocall_default = pocall_register then
     def_system_macro('REGCALL');

compiler/pexpr.pas

@@ -827,6 +827,24 @@ implementation
               statement_syssym:=geninlinenode(l,false,ccallparanode.create(p1,ccallparanode.create(p2,nil)));
               consume(_RKLAMMER);
             end;
+          in_get_frame:
+            begin
+              statement_syssym:=geninlinenode(l,false,nil);
+            end;
+          in_get_caller_frame:
+            begin
+              if try_to_consume(_LKLAMMER) then
+                begin
+                  {You used to call get_caller_frame as get_caller_frame(get_frame),
+                   however, as a stack frame may not exist, it does more harm than
+                   good, so ignore it.}
+                  in_args:=true;
+                  p1:=comp_expr(true);
+                  p1.destroy;
+                  consume(_RKLAMMER);
+                end;
+              statement_syssym:=geninlinenode(l,false,nil);
+            end;
 
           else
             internalerror(15);