* If a nested procedure does not access its parent's frame pointer, optimize it by removing the hidden $parentfp parameter.

* Improved the tisogoto1.pp test.

git-svn-id: trunk@45292 -

compiler/defcmp.pas

@@ -2347,6 +2347,7 @@ implementation
                 (global procedures can be converted into nested procvars)
              d) if def1 is a nested procedure, then def2 has to be a nested
                 procvar and def1 has to have the po_delphi_nested_cc option
+                or does not use parentfp
              e) if def1 is a procvar, def1 and def2 both have to be nested or
                 non-nested (we don't allow assignments from non-nested to
                 nested procvars to make sure that we can still implement
@@ -2365,7 +2366,8 @@ implementation
               not is_nested_pd(def2))) or
             ((def1.typ=procdef) and                                 { d) }
              is_nested_pd(def1) and
-             (not(po_delphi_nested_cc in def1.procoptions) or
+             ((not(po_delphi_nested_cc in def1.procoptions) and
+              (pio_needs_parentfp in tprocdef(def1).implprocoptions)) or
               not is_nested_pd(def2))) or
             ((def1.typ=procvardef) and                              { e) }
              (is_nested_pd(def1)<>is_nested_pd(def2))) then

compiler/nmem.pas

@@ -316,6 +316,8 @@ implementation
           internalerror(200309284);
         parentpd:=pd;
         kind:=fpkind;
+        if current_procinfo.procdef.parast.symtablelevel>pd.parast.symtablelevel then
+          current_procinfo.set_needs_parentfp(pd.parast.symtablelevel);
       end;
 
 

compiler/pexpr.pas

@@ -337,6 +337,8 @@ implementation
                                 begin
                                   include(current_procinfo.flags,pi_has_nested_exit);
                                   exclude(current_procinfo.procdef.procoptions,po_inline);
+                                  if is_nested_pd(current_procinfo.procdef) then
+                                    current_procinfo.set_needs_parentfp(exit_procinfo.procdef.parast.symtablelevel);
 
                                   exit_procinfo.nestedexitlabel:=clabelsym.create('$nestedexit');
 

compiler/procinfo.pas

@@ -202,6 +202,9 @@ unit procinfo;
           procedure start_eh(list : TAsmList); virtual;
           { called to insert needed eh info into the exit code }
           procedure end_eh(list : TAsmList); virtual;
+          { Sets the pio_needs_parentfp flag for the current nested procedure and
+            all its parent procedures until parent_level }
+          procedure set_needs_parentfp(parent_level: byte);
        end;
        tcprocinfo = class of tprocinfo;
 
@@ -429,4 +432,21 @@ implementation
         { no action by default }
       end;
 
+
+    procedure tprocinfo.set_needs_parentfp(parent_level: byte);
+    var
+      pi : tprocinfo;
+    begin
+      if (procdef.parast.symtablelevel<=normal_function_level)
+        or (procdef.parast.symtablelevel<=parent_level) then
+        Internalerror(2020050302);
+      if parent_level<normal_function_level then
+        parent_level:=normal_function_level;
+      pi:=Self;
+      repeat
+        include(pi.procdef.implprocoptions, pio_needs_parentfp);
+        pi:=pi.parent;
+      until pi.procdef.parast.symtablelevel<=parent_level;
+    end;
+
 end.

compiler/pstatmnt.pas

@@ -1187,6 +1187,8 @@ implementation
                              if not(m_non_local_goto in current_settings.modeswitches) then
                                Message(parser_e_goto_outside_proc);
                              include(current_procinfo.flags,pi_has_global_goto);
+                             if is_nested_pd(current_procinfo.procdef) then
+                               current_procinfo.set_needs_parentfp(srsym.owner.symtablelevel);
                            end;
                          code:=cgotonode.create(tlabelsym(srsym));
                          tgotonode(code).labelsym:=tlabelsym(srsym);

compiler/psub.pas

@@ -2306,6 +2306,7 @@ implementation
          parentfpinitblock: tnode;
          old_parse_generic: boolean;
          recordtokens : boolean;
+         parentfp_sym: TSymEntry;
 
       begin
          old_current_procinfo:=current_procinfo;
@@ -2382,6 +2383,19 @@ implementation
          { parse the code ... }
          code:=block(current_module.islibrary);
 
+         if is_nested_pd(procdef) and not (pio_needs_parentfp in procdef.implprocoptions) then
+           begin
+             { If this nested procedure does not access its parent's frame pointer,
+               we can optimize it by removing the hidden $parentfp parameter.
+             }
+             exclude(procdef.procoptions, po_delphi_nested_cc);
+             parentfp_sym:=procdef.parast.Find('parentfp');
+             if parentfp_sym = nil then
+               Internalerror(2020050301);
+             procdef.parast.Delete(parentfp_sym);
+             procdef.calcparas;
+           end;
+
          if recordtokens then
            begin
              { stop token recorder for generic template }

compiler/symconst.pas

@@ -455,7 +455,9 @@ type
     { compiled with fastmath enabled }
     pio_fastmath,
     { inline is forbidden (calls get_frame) }
-    pio_inline_forbidden
+    pio_inline_forbidden,
+    { a nested routine uses the frame pointer of the parent routine }
+    pio_needs_parentfp
   );
   timplprocoptions = set of timplprocoption;
 

compiler/utils/ppuutils/ppudump.pp

@@ -3232,7 +3232,8 @@ const
     (mask:pio_nested_access; str:'NestedAccess'),
     (mask:pio_thunk; str:'Thunk'),
     (mask:pio_fastmath; str:'FastMath'),
-    (mask:pio_inline_forbidden; str:'InlineForbidden')
+    (mask:pio_inline_forbidden; str:'InlineForbidden'),
+    (mask:pio_needs_parentfp; str:'NeedsParentFP')
   );
 var
   i: timplprocoption;

tests/test/tisogoto1.pp

@@ -3,10 +3,22 @@ procedure test;
   label
     1;
   procedure p;
+    label
+      2;
+    procedure pp;
+      begin
+        goto 2;
+        halt(1);
+      end;
+
     begin
+      pp;
+      halt(1);
+    2:
       goto 1;
       halt(1);
     end;
+
   begin
     p;
     halt(1);