* Improved the parentfp optimization to properly handle cases when a nested routine calls other nested routines.

git-svn-id: https://svn.freepascal.org/svn/fpc/trunk@45665 3ad0048d-3df7-0310-abae-a5850022a9f2

6 files changed, 44 insertions, 30 deletions

diff --git a/compiler/ncal.pas b/compiler/ncal.pas
index 0f64d05b87..1e495e4449 100644
--- a/compiler/ncal.pas
+++ b/compiler/ncal.pas
@@ -3516,7 +3516,19 @@ implementation
                   if not assigned(right) then
                     begin
                       if assigned(procdefinition.owner.defowner) then
-                        hiddentree:=cloadparentfpnode.create(tprocdef(procdefinition.owner.defowner),lpf_forpara)
+                        begin
+                          if paramanager.can_opt_unused_para(currpara) and
+                            (procdefinition<>current_procinfo.procdef) then
+                            { If parentfp is unused by the target proc, create loadparentfpnode which loads 
+                              the current frame pointer to prevent generation of unneeded code. }
+                            hiddentree:=cloadparentfpnode.create(current_procinfo.procdef,lpf_forpara)
+                          else
+                            begin
+                              hiddentree:=cloadparentfpnode.create(tprocdef(procdefinition.owner.defowner),lpf_forpara);
+                              if is_nested_pd(current_procinfo.procdef) then
+                                current_procinfo.set_needs_parentfp(tprocdef(procdefinition.owner.defowner).parast.symtablelevel);
+                           end;
+                        end
                       { exceptfilters called from main level are not owned }
                       else if procdefinition.proctypeoption=potype_exceptfilter then
                         hiddentree:=cloadparentfpnode.create(current_procinfo.procdef,lpf_forpara)
diff --git a/compiler/ncgcal.pas b/compiler/ncgcal.pas
index 1961b90cde..967499914c 100644
--- a/compiler/ncgcal.pas
+++ b/compiler/ncgcal.pas
@@ -138,29 +138,6 @@ implementation
       wpobase;
 
 
-    function can_opt_unused_para(parasym: tparavarsym): boolean;
-      var
-        pd: tprocdef;
-      begin
-        { The parameter can be optimized as unused when:
-            optimization level 1 and higher
-            this is a direct call to a routine, not a procvar
-            and the routine is not an exception filter
-            and the parameter is not used by the routine
-            and implementation of the routine is already processed.
-        }
-        result:=(cs_opt_level1 in current_settings.optimizerswitches) and
-          assigned(parasym.Owner) and
-          (parasym.Owner.defowner.typ=procdef);
-        if not result then
-          exit;
-        pd:=tprocdef(parasym.Owner.defowner);
-        result:=(pd.proctypeoption<>potype_exceptfilter) and
-          not parasym.is_used and
-          pd.is_implemented;
-      end;
-
-
     function can_skip_para_push(parasym: tparavarsym): boolean;
       begin
         { We can skip passing the parameter when:
@@ -169,7 +146,7 @@ implementation
             and fixed stack is used
               or the parameter is in a register
               or the parameter is $parentfp. }
-        result:=can_opt_unused_para(parasym) and
+        result:=paramanager.can_opt_unused_para(parasym) and
           not paramanager.has_strict_proc_signature and
           (paramanager.use_fixed_stack or
            (vo_is_parentfp in parasym.varoptions) or
@@ -322,7 +299,7 @@ implementation
     function tcgcallparanode.maybe_push_unused_para: boolean;
       begin
         { Check if the parameter is unused and can be optimized }
-        result:=can_opt_unused_para(parasym);
+        result:=paramanager.can_opt_unused_para(parasym);
         if not result then
           exit;
         { If we can't skip loading of the parameter, load an undefined dummy value. }
diff --git a/compiler/nld.pas b/compiler/nld.pas
index ab970f915f..e2bccbc080 100644
--- a/compiler/nld.pas
+++ b/compiler/nld.pas
@@ -357,6 +357,7 @@ implementation
                    if assigned(left) then
                      internalerror(200309289);
                    left:=cloadparentfpnode.create(tprocdef(symtable.defowner),lpf_forload);
+                   current_procinfo.set_needs_parentfp(tprocdef(symtable.defowner).parast.symtablelevel);
                    { reference in nested procedures, variable needs to be in memory }
                    { and behaves as if its address escapes its parent block         }
                    make_not_regable(self,[ra_different_scope]);
diff --git a/compiler/nmem.pas b/compiler/nmem.pas
index ebaa11ca1a..d093c3e216 100644
--- a/compiler/nmem.pas
+++ b/compiler/nmem.pas
@@ -316,8 +316,6 @@ 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;
 
 
diff --git a/compiler/paramgr.pas b/compiler/paramgr.pas
index 879a2328da..bbc548288e 100644
--- a/compiler/paramgr.pas
+++ b/compiler/paramgr.pas
@@ -165,6 +165,8 @@ unit paramgr;
             and checked by the runtime/backend compiler (e.g. JVM, LLVM).
             The default implementation returns false. }
           function has_strict_proc_signature: boolean; virtual;
+          { Returns true if parasym is unused and can be optimized. }
+          function can_opt_unused_para(parasym: tparavarsym): boolean;
          strict protected
           { common part of get_funcretloc; returns true if retloc is completely
             initialized afterwards }
@@ -195,6 +197,7 @@ implementation
 
     uses
        systems,
+       globals,
        cgobj,tgobj,
        defutil,verbose,
        hlcgobj;
@@ -833,6 +836,28 @@ implementation
       end;
 
 
+    function tparamanager.can_opt_unused_para(parasym: tparavarsym): boolean;
+      var
+        pd: tprocdef;
+      begin
+        { The parameter can be optimized as unused when:
+            optimization level 1 and higher
+            this is a direct call to a routine, not a procvar
+            and the routine is not an exception filter
+            and the parameter is not used by the routine
+            and implementation of the routine is already processed.
+        }
+        result:=(cs_opt_level1 in current_settings.optimizerswitches) and
+          assigned(parasym.Owner) and
+          (parasym.Owner.defowner.typ=procdef);
+        if not result then
+          exit;
+        pd:=tprocdef(parasym.Owner.defowner);
+        result:=(pd.proctypeoption<>potype_exceptfilter) and
+          not parasym.is_used and
+          pd.is_implemented;
+      end;
+
 initialization
   ;
 finalization
diff --git a/compiler/procinfo.pas b/compiler/procinfo.pas
index 2affe89275..f520063180 100644
--- a/compiler/procinfo.pas
+++ b/compiler/procinfo.pas
@@ -439,9 +439,10 @@ implementation
         pi : tprocinfo;
         p : tparavarsym;
       begin
-        if (procdef.parast.symtablelevel<=normal_function_level)
-          or (procdef.parast.symtablelevel<=parent_level) then
+        if procdef.parast.symtablelevel<=normal_function_level then
           Internalerror(2020050302);
+        if procdef.parast.symtablelevel<=parent_level then
+          exit;
         if parent_level<normal_function_level then
           parent_level:=normal_function_level;
         { Mark parentfp as used for the current proc }