* Do not use the LOC_VOID location to indicate unused parameters.

* Added the tprocdef.parentfpsym property. Set parentfpsym.varstate to vs_read instead of using the pio_needs_parentfp flag.
* Replaced tcgcallparanode.push_zero_sized_value_para by tparamanager.has_strict_proc_signature.

git-svn-id: trunk@45454 -

compiler/jvm/cpupara.pas

@@ -51,6 +51,7 @@ interface
         function param_use_paraloc(const cgpara: tcgpara): boolean; override;
         function ret_in_param(def:tdef;pd:tabstractprocdef):boolean;override;
         function is_stack_paraloc(paraloc: pcgparalocation): boolean;override;
+        function has_strict_proc_signature: boolean;override;
       private
         procedure create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; paras: tparalist;
                                              var parasize:longint);
@@ -209,6 +210,12 @@ implementation
       end;
 
 
+    function tcpuparamanager.has_strict_proc_signature: boolean;
+      begin
+        result:=true;
+      end;
+
+
     function tcpuparamanager.create_varargs_paraloc_info(p : tabstractprocdef; side: tcallercallee; varargspara:tvarargsparalist):longint;
       var
         parasize : longint;

compiler/jvm/njvmcal.pas

@@ -33,8 +33,6 @@ interface
     type
        tjvmcallparanode = class(tcgcallparanode)
         protected
-         function push_zero_sized_value_para: boolean; override;
-
          procedure push_formal_para; override;
          procedure push_copyout_para; override;
 
@@ -74,13 +72,6 @@ implementation
                            TJVMCALLPARANODE
 *****************************************************************************}
 
-    function tjvmcallparanode.push_zero_sized_value_para: boolean;
-      begin
-        { part of the signature -> need to be pushed }
-        result:=true;
-      end;
-
-
     procedure tjvmcallparanode.push_formal_para;
       begin
         { primitive values are boxed, so in all cases this is a pointer to

compiler/llvm/llvmpara.pas

@@ -51,6 +51,7 @@ unit llvmpara;
         function create_paraloc_info(p: tabstractprocdef; side: tcallercallee): longint; override;
         function create_varargs_paraloc_info(p: tabstractprocdef; side: tcallercallee; varargspara: tvarargsparalist): longint; override;
         function get_funcretloc(p: tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara; override;
+        function has_strict_proc_signature: boolean; override;
        private
         procedure create_paraloc_info_internllvm(p: tabstractprocdef; side: tcallercallee);
         procedure set_llvm_paraloc_name(p: tabstractprocdef; hp: tparavarsym; var para: tcgpara);
@@ -261,6 +262,12 @@ unit llvmpara;
     end;
 
 
+  function tllvmparamanager.has_strict_proc_signature: boolean;
+    begin
+      result:=true;
+    end;
+
+
   procedure tllvmparamanager.create_paraloc_info_internllvm(p: tabstractprocdef; side: tcallercallee);
     begin
       { on the calleeside, llvm declares the parameters similar to Pascal or C

compiler/llvm/nllvmcal.pas

@@ -32,8 +32,6 @@ interface
 
     type
       tllvmcallparanode = class(tcgcallparanode)
-       protected
-        function push_zero_sized_value_para: boolean; override;
       end;
 
       tllvmcallnode = class(tcgcallnode)
@@ -50,17 +48,6 @@ implementation
        verbose,
        symconst,symdef;
 
-{*****************************************************************************
-                          TLLVMCALLPARANODE
- *****************************************************************************}
-
-    function tllvmcallparanode.push_zero_sized_value_para: boolean;
-      begin
-        { part of the signature -> need to be pushed }
-        result:=true;
-      end;
-
-
 {*****************************************************************************
                            TLLVMCALLNODE
  *****************************************************************************}

compiler/ncal.pas

@@ -3522,9 +3522,6 @@ implementation
                         hiddentree:=cloadparentfpnode.create(current_procinfo.procdef,lpf_forpara)
                       else
                         internalerror(200309287);
-                      { Always use parentfp for forward-declared nested procedures }
-                      if (procdefinition.typ=procdef) and not tprocdef(procdefinition).is_implemented then
-                        include(tprocdef(procdefinition).implprocoptions,pio_needs_parentfp);
                     end
                   else if not(po_is_block in procdefinition.procoptions) then
                     hiddentree:=gen_procvar_context_tree_parentfp

compiler/ncgcal.pas

@@ -35,8 +35,6 @@ interface
     type
        tcgcallparanode = class(tcallparanode)
        protected
-          function push_zero_sized_value_para: boolean; virtual;
-
           procedure push_addr_para;
           procedure push_value_para;virtual;
           procedure push_formal_para;virtual;
@@ -140,6 +138,42 @@ implementation
       wpobase;
 
 
+    function can_opt_unused_para(parasym: tparavarsym): boolean;
+      var
+        pd: tprocdef;
+      begin
+        { The parameter can be optimized as unused when:
+            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:=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:
+            the parameter can be optimized as unused
+            and the target does not strictly require all parameters (has_strict_proc_signature = false)
+            and fixed stack is used
+              or the parameter is in a register
+              or the parameter is $parentfp. }
+        result:=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
+           (parasym.paraloc[callerside].Location^.Loc in [LOC_REGISTER,LOC_CREGISTER]));
+      end;
+
 {*****************************************************************************
                              TCGCALLPARANODE
 *****************************************************************************}
@@ -158,13 +192,6 @@ implementation
       end;
 
 
-    function tcgcallparanode.push_zero_sized_value_para: boolean;
-      begin
-        { nothing to push by default }
-        result:=false;
-      end;
-
-
     procedure tcgcallparanode.push_addr_para;
       var
         valuedef: tdef;
@@ -263,7 +290,7 @@ implementation
           -- except on platforms where the parameters are part of the signature
              and checked by the runtime/backend compiler (e.g. JVM, LLVM) }
         if (left.resultdef.size=0) and
-           not push_zero_sized_value_para then
+           not paramanager.has_strict_proc_signature then
           exit;
 
         if maybe_push_unused_para then
@@ -292,29 +319,12 @@ implementation
 
     function tcgcallparanode.maybe_push_unused_para: boolean;
       begin
-        { Check if the parameter is unused.
-          Only the $parentfp parameter is supported for now. }
-        result:=(vo_is_parentfp in parasym.varoptions) and (parasym.varstate<=vs_initialised);
+        { Check if the parameter is unused and can be optimized }
+        result:=can_opt_unused_para(parasym);
         if not result then
           exit;
-        { The parameter is unused.
-          We can skip loading of the parameter when:
-            - the target does not strictly require all parameters (push_zero_sized_value_para = false)
-            and
-            - fixed stack is used
-              or the parameter is in a register
-              or the parameter is $parentfp. }
-        if not push_zero_sized_value_para and
-          (paramanager.use_fixed_stack or
-           (vo_is_parentfp in parasym.varoptions) or
-           (parasym.paraloc[callerside].Location^.Loc in [LOC_REGISTER,LOC_CREGISTER])) then
-          begin
-            { Skip loading }
-            parasym.paraloc[callerside].Location^.Loc:=LOC_VOID;
-            tempcgpara.Location^.Loc:=LOC_VOID;
-          end
-        else
-          { Load an undefined dummy value }
+        { If we can't skip loading of the parameter, load an undefined dummy value. }
+        if not can_skip_para_push(parasym) then
           hlcg.a_load_undefined_cgpara(current_asmdata.CurrAsmList,left.resultdef,tempcgpara);
       end;
 
@@ -775,7 +785,8 @@ implementation
          ppn:=tcgcallparanode(left);
          while assigned(ppn) do
            begin
-             if (ppn.left.nodetype<>nothingn) then
+             if (ppn.left.nodetype<>nothingn) and
+               not can_skip_para_push(ppn.parasym) then
                begin
                  { better check for the real location of the parameter here, when stack passed parameters
                    are saved temporary in registers, checking for the tmpparaloc.loc is wrong
@@ -948,17 +959,9 @@ implementation
 
 
     function tcgcallnode.is_parentfp_pushed: boolean;
-      var
-        i : longint;
       begin
-        for i:=0 to procdefinition.paras.Count-1 do
-          with tparavarsym(procdefinition.paras[i]) do
-            if vo_is_parentfp in varoptions then
-              begin
-                result:=paraloc[callerside].Location^.Loc in [LOC_REFERENCE,LOC_CREFERENCE];
-                exit;
-              end;
-        result:=false;
+        result:=(procdefinition.typ<>procdef) or
+          not can_skip_para_push(tparavarsym(tprocdef(procdefinition).parentfpsym));
       end;
 
 

compiler/ncgmem.pas

@@ -170,7 +170,7 @@ implementation
             location_reset(location,LOC_REGISTER,def_cgsize(parentfpvoidpointertype));
             currpi:=current_procinfo;
             { load framepointer of current proc }
-            hsym:=parentfpsym;
+            hsym:=tparavarsym(currpi.procdef.parentfpsym);
             if (currpi.procdef.owner.symtablelevel=parentpd.parast.symtablelevel) and (hsym.localloc.loc in [LOC_REGISTER,LOC_CREGISTER]) then
               location.register:=hsym.localloc.register
             else
@@ -183,10 +183,7 @@ implementation
                     currpi:=currpi.parent;
                     if not assigned(currpi) then
                       internalerror(200311201);
-                    hsym:=tparavarsym(currpi.procdef.parast.Find('parentfp'));
-                    if not assigned(hsym) then
-                      internalerror(200309282);
-
+                    hsym:=tparavarsym(currpi.procdef.parentfpsym);
                     if hsym.localloc.loc<>LOC_REFERENCE then
                       internalerror(200309283);
 

compiler/ncgnstmm.pas

@@ -83,7 +83,7 @@ implementation
             while assigned(currpi) and
                   (currpi.procdef.parast.symtablelevel>parentpd.parast.symtablelevel) do
               begin
-                hsym:=tparavarsym(currpi.procdef.parast.Find('parentfp'));
+                hsym:=tparavarsym(currpi.procdef.parentfpsym);
                 maybe_add_sym_to_parentfpstruct(currpi.procdef,hsym,nextpi.procdef.parentfpstructptrtype,false);
                 currpi:=nextpi;
                 nextpi:=nextpi.parent;
@@ -125,7 +125,7 @@ implementation
           need }
         while (currpi.procdef.parast.symtablelevel>parentpd.parast.symtablelevel) do
           begin
-            hsym:=tparavarsym(currpi.procdef.parast.Find('parentfp'));
+            hsym:=tparavarsym(currpi.procdef.parentfpsym);
             fsym:=tfieldvarsym(find_sym_in_parentfpstruct(currpi.procdef,hsym));
             if not assigned(fsym) then
               internalerror(2011060405);

compiler/ncgutil.pas

@@ -866,10 +866,9 @@ implementation
                       location_reset(vs.initialloc,LOC_REGISTER,OS_ADDR);
                       vs.initialloc.register:=NR_FRAME_POINTER_REG;
                     end
-                  { Unused parameters ($parentfp for now) need to be kept in the original location
+                  { Unused parameters need to be kept in the original location
                     to prevent allocation of registers/resources for them. }
-                  else if (vs.varstate <= vs_initialised) and
-                    (vo_is_parentfp in vs.varoptions) then
+                  else if not tparavarsym(vs).is_used then
                     begin
                       tparavarsym(vs).paraloc[calleeside].get_location(vs.initialloc);
                     end
@@ -1065,7 +1064,7 @@ implementation
               add_regvars(rv^,tabstractnormalvarsym(tloadnode(n).symtableentry).localloc);
           loadparentfpn:
             if current_procinfo.procdef.parast.symtablelevel>tloadparentfpnode(n).parentpd.parast.symtablelevel then
-              add_regvars(rv^,tloadparentfpnode(n).parentfpsym.localloc);
+              add_regvars(rv^,tparavarsym(current_procinfo.procdef.parentfpsym).localloc);
           vecn:
             begin
               { range checks sometimes need the high parameter }

compiler/nmem.pas

@@ -53,10 +53,6 @@ interface
          lpf_forload
        );
        tloadparentfpnode = class(tunarynode)
-       private
-          _parentfpsym: tparavarsym;
-          function getparentfpsym: tparavarsym;
-       public
           parentpd : tprocdef;
           parentpdderef : tderef;
           kind: tloadparentfpkind;
@@ -69,7 +65,6 @@ interface
           function pass_typecheck:tnode;override;
           function docompare(p: tnode): boolean; override;
           function dogetcopy : tnode;override;
-          property parentfpsym: tparavarsym read getparentfpsym;
        end;
        tloadparentfpnodeclass = class of tloadparentfpnode;
 
@@ -389,18 +384,6 @@ implementation
         expectloc:=LOC_REGISTER;
       end;
 
-
-    function tloadparentfpnode.getparentfpsym: tparavarsym;
-      begin
-        if not assigned(_parentfpsym) then
-          begin
-            _parentfpsym:=tparavarsym(current_procinfo.procdef.parast.Find('parentfp'));
-            if not assigned(_parentfpsym) then
-              internalerror(200309281);
-          end;
-        result:=_parentfpsym;
-      end;
-
 {*****************************************************************************
                              TADDRNODE
 *****************************************************************************}

compiler/paramgr.pas

@@ -161,6 +161,10 @@ unit paramgr;
           function use_fixed_stack: boolean;
           { whether stack pointer can be changed in the middle of procedure }
           function use_stackalloc: boolean;
+          { Returns true for platforms where the parameters are part of the signature
+            and checked by the runtime/backend compiler (e.g. JVM, LLVM).
+            The default implementation returns false. }
+          function has_strict_proc_signature: boolean; virtual;
          strict protected
           { common part of get_funcretloc; returns true if retloc is completely
             initialized afterwards }
@@ -651,6 +655,12 @@ implementation
       end;
 
 
+    function tparamanager.has_strict_proc_signature: boolean;
+      begin
+        result:=false;
+      end;
+
+
     function tparamanager.set_common_funcretloc_info(p : tabstractprocdef; forcetempdef: tdef; out retcgsize: tcgsize; out retloc: tcgpara): boolean;
       var
         paraloc : pcgparalocation;

compiler/pparautl.pas

@@ -164,8 +164,6 @@ implementation
                 vs:=cparavarsym.create('$parentfp',paranr,vs_value,
                       tprocdef(pd.owner.defowner).parentfpstructptrtype,[vo_is_parentfp,vo_is_hidden_para]);
               end;
-            { Mark $parentfp as used by default }
-            vs.varstate:=vs_read;
             pd.parast.insert(vs);
 
             current_tokenpos:=storepos;

compiler/procinfo.pas

@@ -202,8 +202,8 @@ 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.
-            Sets both pio_needs_parentfp and pio_nested_access for all parent
+          { Mark the parentfp as used for the current nested procedure.
+            Mark the parentfp as used and set pio_nested_access for all parent
             procedures until parent_level }
           procedure set_needs_parentfp(parent_level: byte);
        end;
@@ -437,20 +437,29 @@ implementation
     procedure tprocinfo.set_needs_parentfp(parent_level: byte);
       var
         pi : tprocinfo;
+        p : tparavarsym;
       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;
-        { Set pio_needs_parentfp for the current proc }
+        { Mark parentfp as used for the current proc }
         pi:=Self;
-        include(pi.procdef.implprocoptions, pio_needs_parentfp);
-        { Set both pio_needs_parentfp and pio_nested_access for all parent procs until parent_level }
+        tparavarsym(pi.procdef.parentfpsym).varstate:=vs_read;
+        { Set both parentfp is used and pio_nested_access for all parent procs until parent_level }
         while pi.procdef.parast.symtablelevel>parent_level do
           begin
             pi:=pi.parent;
-            pi.procdef.implprocoptions:=pi.procdef.implprocoptions+[pio_needs_parentfp,pio_nested_access];
+            if pi.procdef.parast.symtablelevel>normal_function_level then
+              begin
+                p:=tparavarsym(pi.procdef.parentfpsym);
+                p.varstate:=vs_read;
+                { parentfp is accessed from a nested routine.
+                  Must be in the memory. }
+                p.varregable:=vr_none;
+              end;
+            include(pi.procdef.implprocoptions,pio_nested_access);
           end;
       end;
 

compiler/symconst.pas

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

compiler/symdef.pas

@@ -702,8 +702,6 @@ interface
        private
           procedure count_para(p:TObject;arg:pointer);
           procedure insert_para(p:TObject;arg:pointer);
-       protected
-          procedure handle_unused_paras(side: tcallercallee); virtual;
        end;
 
        tprocvardef = class(tabstractprocdef)
@@ -782,6 +780,7 @@ interface
 {$else symansistr}
          _mangledname : pshortstring;
 {$endif}
+         _parentfpsym : tsym;
          { information that is only required until the implementation of the
            procdef has been handled }
          implprocdefinfo : pimplprocdefinfo;
@@ -814,7 +813,7 @@ interface
          procedure SetIsEmpty(AValue: boolean);
          function GetHasInliningInfo: boolean;
          procedure SetHasInliningInfo(AValue: boolean);
-         procedure handle_unused_paras(side: tcallercallee); override;
+         function getparentfpsym: tsym;
        public
           messageinf : tmessageinf;
           dispid : longint;
@@ -937,6 +936,8 @@ interface
           property isempty: boolean read GetIsEmpty write SetIsEmpty;
           { true if all information required to inline this routine is available }
           property has_inlininginfo: boolean read GetHasInliningInfo write SetHasInliningInfo;
+          { returns the $parentfp parameter for nested routines }
+          property parentfpsym: tsym read getparentfpsym;
        end;
        tprocdefclass = class of tprocdef;
 
@@ -5276,11 +5277,6 @@ implementation
       end;
 
 
-    procedure tabstractprocdef.handle_unused_paras(side: tcallercallee);
-    begin
-    end;
-
-
     procedure tabstractprocdef.calcparas;
       var
         paracount : longint;
@@ -5714,7 +5710,6 @@ implementation
               has_paraloc_info:=callbothsides
             else
               has_paraloc_info:=callerside;
-            handle_unused_paras(callerside);
           end;
         if (side in [calleeside,callbothsides]) and
            not(has_paraloc_info in [calleeside,callbothsides]) then
@@ -5727,7 +5722,6 @@ implementation
               has_paraloc_info:=callbothsides
             else
               has_paraloc_info:=calleeside;
-            handle_unused_paras(calleeside);
           end;
       end;
 
@@ -5774,6 +5768,8 @@ implementation
           if tsym(parast.SymList[i]).typ=paravarsym then
             begin
               p:=tparavarsym(parast.SymList[i]);
+              if not p.is_used then
+                continue;
               { check if no parameter is located on the stack }
               if (is_open_array(p.vardef) or
                  is_array_of_const(p.vardef)) and (p.varspez=vs_value) then
@@ -5840,6 +5836,17 @@ implementation
                                   TPROCDEF
 ***************************************************************************}
 
+    function tprocdef.getparentfpsym: tsym;
+      begin
+        if not assigned(_parentfpsym) then
+          begin
+            _parentfpsym:=tsym(parast.Find('parentfp'));
+            if not assigned(_parentfpsym) then
+              internalerror(200309281);
+          end;
+        result:=_parentfpsym;
+      end;
+
 
     function tprocdef.store_localst: boolean;
       begin
@@ -6021,45 +6028,6 @@ implementation
       end;
 
 
-    procedure tprocdef.handle_unused_paras(side: tcallercallee);
-      var
-        i : longint;
-      begin
-        { Optimize unused parameters by preventing loading them on the callee side
-          and, if possible, preventing passing them on the caller side.
-          The caller side optimization is handled by tcgcallparanode.maybe_push_unused_para().
-        }
-        if (proctypeoption = potype_exceptfilter) or
-          (po_assembler in procoptions) then
-          exit;
-        { Only $parentfp is optmized for now. }
-        if not is_nested_pd(self) then
-          exit;
-        { Handle unused parameters }
-        for i:=0 to paras.Count-1 do
-          with tparavarsym(paras[i]) do
-            if vo_is_parentfp in varoptions then
-              begin
-                if pio_needs_parentfp in implprocoptions then
-                  begin
-                    { If this routine is accessed from other nested routine,
-                      $parentfp must be in a memory location. }
-                    if pio_nested_access in implprocoptions then
-                      varregable:=vr_none;
-                  end
-                else
-                  begin
-                    { Mark $parentfp as unused, since it has vs_read by default }
-                    varstate:=vs_initialised;
-                    if side=calleeside then
-                      { Set LOC_VOID as the parameter's location on the callee side }
-                      paraloc[side].location^.Loc:=LOC_VOID;
-                    break;
-                  end;
-              end;
-      end;
-
-
     procedure tprocdef.Setinterfacedef(AValue: boolean);
       begin
         if not assigned(implprocdefinfo) then

compiler/symsym.pas

@@ -283,6 +283,7 @@ interface
             override ppuwrite_platform instead }
           procedure ppuwrite(ppufile:tcompilerppufile);override;final;
           function needs_finalization: boolean;
+          function is_used: boolean;
       end;
       tparavarsymclass = class of tparavarsym;
 
@@ -2298,6 +2299,13 @@ implementation
           );
       end;
 
+
+    function tparavarsym.is_used: boolean;
+      begin
+        { Only the $parentfp parameter is supported for now }
+        result:=not (vo_is_parentfp in varoptions) or (varstate>vs_initialised);
+      end;
+
 {****************************************************************************
                                TABSOLUTEVARSYM
 ****************************************************************************}

compiler/utils/ppuutils/ppudump.pp

@@ -3232,8 +3232,7 @@ 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_needs_parentfp; str:'NeedsParentFP')
+    (mask:pio_inline_forbidden; str:'InlineForbidden')
   );
 var
   i: timplprocoption;