* activated internal get_frame for x86

  * turn off stackframe optimizations on x86 if get_frame is called
    in the current routine, or if the address of a nested function
    is taken in the current routine
  + test for the above
  * this fixes the IDE when compiled with stackframe optimizations
    on x86

git-svn-id: trunk@5146 -

.gitattributes

@@ -6044,6 +6044,7 @@ tests/tbs/tb0504.pp svneol=native#text/plain
 tests/tbs/tb0505.pp svneol=native#text/plain
 tests/tbs/tb0506.pp svneol=native#text/plain
 tests/tbs/tb0507.pp svneol=native#text/plain
+tests/tbs/tb0508.pp svneol=native#text/plain
 tests/tbs/ub0060.pp svneol=native#text/plain
 tests/tbs/ub0069.pp svneol=native#text/plain
 tests/tbs/ub0119.pp svneol=native#text/plain

compiler/globtype.pas

@@ -300,7 +300,9 @@ interface
          { set if the procedure has at least one got }
          pi_has_goto,
          { calls itself recursive }
-         pi_is_recursive
+         pi_is_recursive,
+         { stack frame optimization not possible (only on x86 probably) }
+         pi_needs_stackframe
        );
        tprocinfoflags=set of tprocinfoflag;
 

compiler/ncginl.pas

@@ -682,12 +682,14 @@ implementation
     procedure Tcginlinenode.second_get_frame;
 
     begin
+{$ifdef x86}
       if current_procinfo.framepointer=NR_STACK_POINTER_REG then
         begin
           location_reset(location,LOC_CONSTANT,OS_ADDR);
           location.value:=0;
         end
       else
+{$endif x86}
         begin
           location_reset(location,LOC_CREGISTER,OS_ADDR);
           location.register:=current_procinfo.framepointer;

compiler/ncnv.pas

@@ -2235,6 +2235,11 @@ implementation
     function ttypeconvnode.first_proc_to_procvar : tnode;
       begin
          first_proc_to_procvar:=nil;
+         { if we take the address of a nested function, it'll  }
+         { probably be used in a foreach() construct and then  }
+         { the parent needs a stackframe                       }
+         if (tprocdef(left.resultdef).parast.symtablelevel>=normal_function_level) then
+           include(current_procinfo.flags,pi_needs_stackframe);
          if tabstractprocdef(resultdef).is_addressonly then
           begin
             registersint:=left.registersint;

compiler/ninl.pas

@@ -2533,6 +2533,7 @@ implementation
             end;
          in_get_frame:
             begin
+              include(current_procinfo.flags,pi_needs_stackframe);
               expectloc:=LOC_CREGISTER;
             end;
          in_get_caller_frame:

compiler/options.pas

@@ -1900,7 +1900,7 @@ begin
   def_system_macro('FPC_HASFIXED64BITVARIANT');
   def_system_macro('FPC_HASINTERNALOLEVARIANT2VARIANTCAST');
 {$ifdef x86}
-{  def_system_macro('INTERNAL_BACKTRACE');}
+  def_system_macro('INTERNAL_BACKTRACE');
 {$endif}
   def_system_macro('STR_CONCAT_PROCS');
   if pocall_default = pocall_register then

compiler/pexpr.pas

@@ -858,11 +858,11 @@ 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

compiler/psub.pas

@@ -759,7 +759,8 @@ implementation
             if (cs_opt_stackframe in current_settings.optimizerswitches) and
                not(po_assembler in procdef.procoptions) and
                ((flags*[pi_has_assembler_block,pi_uses_exceptions,pi_is_assembler,
-                       pi_needs_implicit_finally,pi_has_implicit_finally,pi_has_stackparameter])=[]) then
+                       pi_needs_implicit_finally,pi_has_implicit_finally,pi_has_stackparameter,
+                       pi_needs_stackframe])=[]) then
                begin
                  { we need the parameter info here to determine if the procedure gets
                    parameters on the stack

compiler/psystem.pas

@@ -93,6 +93,9 @@ implementation
         systemunit.insert(tsyssym.create('Length',in_length_x));
         systemunit.insert(tsyssym.create('New',in_new_x));
         systemunit.insert(tsyssym.create('Dispose',in_dispose_x));
+{$ifdef x86}
+        systemunit.insert(tsyssym.create('Get_Frame',in_get_frame));
+{$endif x86}
 {$ifdef SUPPORT_UNALIGNED}
         systemunit.insert(tsyssym.create('Unaligned',in_unaligned_x));
 {$endif SUPPORT_UNALIGNED}

rtl/i386/i386.inc

@@ -958,6 +958,7 @@ function get_frame:pointer;assembler;nostackframe;{$ifdef SYSTEMINLINE}inline;{$
 asm
         movl    %ebp,%eax
 end ['EAX'];
+{$ENDIF not INTERNAL_BACKTRACE}
 
 
 {$define FPC_SYSTEM_HAS_GET_CALLER_ADDR}
@@ -984,7 +985,6 @@ asm
         movl    (%eax),%eax
 .Lgnf_null:
 end ['EAX'];
-{$ENDIF}
 
 {****************************************************************************
                                  Math

rtl/inc/systemh.inc

@@ -655,14 +655,19 @@ Procedure getdir(drivenr:byte;var dir:ansistring);
 
 { os independent calls to allow backtraces }
 {$IFDEF INTERNAL_BACKTRACE}
-function get_frame:pointer;[INTERNPROC:fpc_in_get_frame];
+// inserted in compiler/psystem.pas
+//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];
+*)
 {$ELSE}
 function get_frame:pointer;{$ifdef SYSTEMINLINE}inline;{$endif}
+{$ENDIF}
+
 function get_caller_addr(framebp:pointer):pointer;{$ifdef SYSTEMINLINE}inline;{$endif}
 function get_caller_frame(framebp:pointer):pointer;{$ifdef SYSTEMINLINE}inline;{$endif}
-{$ENDIF}
 
 Function IOResult:Word;{$ifdef SYSTEMINLINE}inline;{$endif}
 Function Sptr:Pointer;{$ifdef SYSTEMINLINE}inline;{$endif}[internconst:fpc_in_const_ptr];

rtl/x86_64/x86_64.inc

@@ -41,6 +41,7 @@ function get_frame:pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif}
 asm
         movq    %rbp,%rax
 end ['RAX'];
+{$ENDIF not INTERNAL_BACKTRACE}
 
 
 {$define FPC_SYSTEM_HAS_GET_CALLER_ADDR}
@@ -75,7 +76,7 @@ asm
 {$endif win64}
 .Lg_a_null:
 end ['RAX'];
-{$ENDIF}
+
 (*
 {$define FPC_SYSTEM_HAS_MOVE}
 procedure Move(const source;var dest;count:longint);[public, alias: 'FPC_MOVE'];assembler;

tests/tbs/tb0508.pp

@@ -0,0 +1,39 @@
+type
+  PointerLocal = procedure(_EBP: Pointer);
+
+procedure proccall(p: pointer);
+begin
+  PointerLocal(p)(get_caller_frame(get_frame));
+end;
+
+procedure t1;
+var
+  l : longint;
+
+  procedure t2;
+
+    procedure t3;
+
+      procedure t4;
+        begin
+          l := 5;
+        end;
+
+      begin { t3 }
+        proccall(@t4);
+      end;
+
+    begin { t2 }
+      t3;
+    end;
+
+  begin { t1 }
+    l := 0;
+    t2;
+    if (l <> 5) then
+      halt(1);
+  end;
+
+begin
+  t1;
+end.