瀏覽代碼

+ (incomplete) node_complexity function to assess the complexity of a
tree
+ support for inlining value and const parameters at the node level
(all procedures without local variables and without formal parameters
can now be inlined at the node level)

Jonas Maebe 21 年之前
父節點
當前提交
c7fbf7b11b
共有 4 個文件被更改,包括 164 次插入27 次删除
  1. 73 14
      compiler/ncal.pas
  2. 9 3
      compiler/ninl.pas
  3. 68 4
      compiler/nutils.pas
  4. 14 6
      compiler/psub.pas

+ 73 - 14
compiler/ncal.pas

@@ -64,6 +64,7 @@ interface
           procedure convert_carg_array_of_const;
           procedure convert_carg_array_of_const;
           procedure order_parameters;
           procedure order_parameters;
 
 
+          procedure createinlineparas(var createstatement, deletestatement: tstatementnode);
           function replaceparaload(var n: tnode; arg: pointer): foreachnoderesult;
           function replaceparaload(var n: tnode; arg: pointer): foreachnoderesult;
        protected
        protected
           pushedparasize : longint;
           pushedparasize : longint;
@@ -744,7 +745,8 @@ type
                  para := tcallparanode(para.right);
                  para := tcallparanode(para.right);
               end;
               end;
             { no hidden resultpara found, error! }
             { no hidden resultpara found, error! }
-            internalerror(200306087);
+            if not(procdefinition.proccalloption = pocall_inline) then
+              internalerror(200306087);
           end;
           end;
       end;
       end;
 
 
@@ -1864,23 +1866,66 @@ type
       end;
       end;
 
 
 
 
+    procedure tcallnode.createinlineparas(var createstatement, deletestatement: tstatementnode);
+      var
+        para: tcallparanode;
+        tempnode: ttempcreatenode;
+        hp: tnode;
+      begin
+        { parameters }
+        para := tcallparanode(left);
+        while assigned(para) do
+          begin
+            { create temps for value parameters, and also for const parameters }
+            { which are passed by value instead of by reference                }
+            if (para.paraitem.paratyp = vs_value) or
+               ((para.paraitem.paratyp = vs_const) and
+                not paramanager.push_addr_param(vs_const,para.left.resulttype.def,procdefinition.proccalloption)) then
+              begin
+                if (cs_regvars in aktglobalswitches) and
+                   (vo_regable in tvarsym(para.paraitem.parasym).varoptions) and
+                   (not tvarsym(para.paraitem.parasym).vartype.def.needs_inittable) then
+                  tempnode := ctempcreatenode.create_reg(para.left.resulttype,para.left.resulttype.def.size,tt_persistent)
+                else
+                  tempnode := ctempcreatenode.create(para.left.resulttype,para.left.resulttype.def.size,tt_persistent);
+                addstatement(createstatement,tempnode);
+                addstatement(createstatement,cassignmentnode.create(ctemprefnode.create(tempnode),
+                  para.left));
+                para.left := ctemprefnode.create(tempnode);
+                addstatement(deletestatement,ctempdeletenode.create(tempnode));
+              end
+            else if not node_complexity(para.left) > 1 then
+              begin
+                if (cs_regvars in aktglobalswitches) and
+                   not tvarsym(para.paraitem.parasym).vartype.def.needs_inittable then
+                  tempnode := ctempcreatenode.create_reg(voidpointertype,voidpointertype.def.size,tt_persistent)
+                else
+                  tempnode := ctempcreatenode.create(voidpointertype,voidpointertype.def.size,tt_persistent);
+                addstatement(createstatement,tempnode);
+                addstatement(createstatement,cassignmentnode.create(ctemprefnode.create(tempnode),
+                  caddrnode.create(para.left)));
+                hp := cderefnode.create(ctemprefnode.create(tempnode));
+                inserttypeconv_explicit(hp,para.left.resulttype);
+                para.left := hp;
+                addstatement(deletestatement,ctempdeletenode.create(tempnode));
+              end;
+            para := tcallparanode(para.right);
+          end;
+      end;
+
+
     function tcallnode.pass_1 : tnode;
     function tcallnode.pass_1 : tnode;
-{$ifdef m68k}
       var
       var
-         regi : tregister;
-{$endif}
+        createstatement,deletestatement: tstatementnode;
+        createblock,deleteblock: tblocknode;
       label
       label
         errorexit;
         errorexit;
       begin
       begin
          result:=nil;
          result:=nil;
 
 
          if (procdefinition.proccalloption=pocall_inline) and
          if (procdefinition.proccalloption=pocall_inline) and
-            { can we inline this kind of parameters? }
-            (tprocdef(procdefinition).inlininginfo^.inlinenode) and
-            { no locals }
-            (tprocdef(procdefinition).localst.symsearch.count = 0) and
-            { procedure, not function }
-            is_void(resulttype.def) then
+            { can we inline this procedure at the node level? }
+            (tprocdef(procdefinition).inlininginfo^.inlinenode) then
            begin
            begin
               { inherit flags }
               { inherit flags }
               current_procinfo.flags := current_procinfo.flags + ((procdefinition as tprocdef).inlininginfo^.flags*inherited_inlining_flags);
               current_procinfo.flags := current_procinfo.flags + ((procdefinition as tprocdef).inlininginfo^.flags*inherited_inlining_flags);
@@ -1898,10 +1943,17 @@ type
                 CGMessage(cg_e_no_code_for_inline_stored);
                 CGMessage(cg_e_no_code_for_inline_stored);
               if assigned(result) then
               if assigned(result) then
                 begin
                 begin
+                  createblock := internalstatements(createstatement);
+                  deleteblock := internalstatements(deletestatement);
+                  { replace complex parameters with temps }
+                  createinlineparas(createstatement,deletestatement);
                   { replace the parameter loads with the parameter values }
                   { replace the parameter loads with the parameter values }
-                  foreachnode(result,{$ifdef FPCPROCVAR}@{$endif}replaceparaload,nil);
-                  { consider it has not inlined if called
-                    again inside the args }
+                  foreachnode(result,{$ifdef FPCPROCVAR}@{$endif}replaceparaload,pointer(funcretnode));
+                  addstatement(createstatement,result);
+                  addstatement(createstatement,deleteblock);
+                  result := createblock;
+                  { consider it must not be inlined if called
+                    again inside the args or itself }
                   procdefinition.proccalloption:=pocall_default;
                   procdefinition.proccalloption:=pocall_default;
                   firstpass(result);
                   firstpass(result);
                   procdefinition.proccalloption:=pocall_inline;
                   procdefinition.proccalloption:=pocall_inline;
@@ -2206,7 +2258,14 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.240  2004-07-12 09:14:04  jonas
+  Revision 1.241  2004-07-15 19:55:39  jonas
+    + (incomplete) node_complexity function to assess the complexity of a
+      tree
+    + support for inlining value and const parameters at the node level
+      (all procedures without local variables and without formal parameters
+       can now be inlined at the node level)
+
+  Revision 1.240  2004/07/12 09:14:04  jonas
     * inline procedures at the node tree level, but only under some very
     * inline procedures at the node tree level, but only under some very
       limited circumstances for now (only procedures, and only if they have
       limited circumstances for now (only procedures, and only if they have
       no or only vs_out/vs_var parameters).
       no or only vs_out/vs_var parameters).

+ 9 - 3
compiler/ninl.pas

@@ -2189,8 +2189,7 @@ implementation
                      hpp := cordconstnode.create(1,tcallparanode(left).left.resulttype,false);
                      hpp := cordconstnode.create(1,tcallparanode(left).left.resulttype,false);
                    { make sure we don't call functions part of the left node twice (and generally }
                    { make sure we don't call functions part of the left node twice (and generally }
                    { optimize the code generation)                                                }
                    { optimize the code generation)                                                }
-                   if (tcallparanode(left).left.nodetype <> loadn) or
-                      (vo_is_thread_var in tvarsym(tloadnode(tcallparanode(left).left).symtableentry).varoptions) then
+                   if node_complexity(tcallparanode(left).left) > 1 then
                      begin
                      begin
                        tempnode := ctempcreatenode.create_reg(voidpointertype,voidpointertype.def.size,tt_persistent);
                        tempnode := ctempcreatenode.create_reg(voidpointertype,voidpointertype.def.size,tt_persistent);
                        addstatement(newstatement,tempnode);
                        addstatement(newstatement,tempnode);
@@ -2434,7 +2433,14 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.140  2004-07-14 21:40:52  olle
+  Revision 1.141  2004-07-15 19:55:39  jonas
+    + (incomplete) node_complexity function to assess the complexity of a
+      tree
+    + support for inlining value and const parameters at the node level
+      (all procedures without local variables and without formal parameters
+       can now be inlined at the node level)
+
+  Revision 1.140  2004/07/14 21:40:52  olle
     + added Ord(pointer) for macpas
     + added Ord(pointer) for macpas
 
 
   Revision 1.139  2004/07/14 14:38:35  jonas
   Revision 1.139  2004/07/14 14:38:35  jonas

+ 68 - 4
compiler/nutils.pas

@@ -29,6 +29,9 @@ interface
   uses
   uses
     symsym,node;
     symsym,node;
 
 
+  const
+    NODE_COMPLEXITY_INF = 255;
+
   type
   type
     { resulttype of functions that process on all nodes in a (sub)tree }
     { resulttype of functions that process on all nodes in a (sub)tree }
     foreachnoderesult = (
     foreachnoderesult = (
@@ -43,9 +46,8 @@ interface
     );
     );
 
 
 
 
-  foreachnodefunction = function(var n: tnode; arg: pointer): foreachnoderesult of object;
-  staticforeachnodefunction = function(var n: tnode; arg: pointer): foreachnoderesult;
-
+    foreachnodefunction = function(var n: tnode; arg: pointer): foreachnoderesult of object;
+    staticforeachnodefunction = function(var n: tnode; arg: pointer): foreachnoderesult;
 
 
     function foreachnode(var n: tnode; f: foreachnodefunction; arg: pointer): boolean;
     function foreachnode(var n: tnode; f: foreachnodefunction; arg: pointer): boolean;
     function foreachnodestatic(var n: tnode; f: staticforeachnodefunction; arg: pointer): boolean;
     function foreachnodestatic(var n: tnode; f: staticforeachnodefunction; arg: pointer): boolean;
@@ -63,6 +65,7 @@ interface
     function initialize_data_node(p:tnode):tnode;
     function initialize_data_node(p:tnode):tnode;
     function finalize_data_node(p:tnode):tnode;
     function finalize_data_node(p:tnode):tnode;
 
 
+    function node_complexity(p: tnode): cardinal;
 
 
 implementation
 implementation
 
 
@@ -434,11 +437,72 @@ implementation
       end;
       end;
 
 
 
 
+    { this function must return a very high value ("infinity") for   }
+    { trees containing a call, the rest can be balanced more or less }
+    { at will, probably best mainly in terms of required memory      }
+    { accesses                                                       }
+    function node_complexity(p: tnode): cardinal;
+      begin
+        result := 0;
+        while true do
+          begin
+            case p.nodetype of
+              loadn:
+                begin
+                  if not(vo_is_thread_var in tvarsym(tloadnode(p).symtableentry).varoptions) then
+                    inc(result)
+                  else
+                    inc(result,5);
+                  if (result >= NODE_COMPLEXITY_INF) then
+                    begin
+                      result := NODE_COMPLEXITY_INF;
+                      exit;
+                    end;
+                end;
+              subscriptn:
+                p := tunarynode(p).left;
+              derefn:
+                begin
+                  inc(result);
+                  if (result = NODE_COMPLEXITY_INF) then
+                    exit;
+                  p := tunarynode(p).left;
+                end;
+              vecn:
+                begin
+                  inc(result,node_complexity(tbinarynode(p).left));
+                  if (result >= NODE_COMPLEXITY_INF) then
+                    begin
+                      result := NODE_COMPLEXITY_INF;
+                      exit;
+                    end;
+                  p := tbinarynode(p).right;
+                end;
+              ordconstn,
+              pointerconstn:
+                exit;
+              else
+                begin
+                  result := NODE_COMPLEXITY_INF;
+                  exit;
+                end;
+            end;
+        end;
+      end;
+
+
 end.
 end.
 
 
 {
 {
   $Log$
   $Log$
-  Revision 1.15  2004-07-12 09:14:04  jonas
+  Revision 1.16  2004-07-15 19:55:40  jonas
+    + (incomplete) node_complexity function to assess the complexity of a
+      tree
+    + support for inlining value and const parameters at the node level
+      (all procedures without local variables and without formal parameters
+       can now be inlined at the node level)
+
+  Revision 1.15  2004/07/12 09:14:04  jonas
     * inline procedures at the node tree level, but only under some very
     * inline procedures at the node tree level, but only under some very
       limited circumstances for now (only procedures, and only if they have
       limited circumstances for now (only procedures, and only if they have
       no or only vs_out/vs_var parameters).
       no or only vs_out/vs_var parameters).

+ 14 - 6
compiler/psub.pas

@@ -969,7 +969,11 @@ implementation
       begin
       begin
         result := false;
         result := false;
         if not assigned(procdef.inlininginfo^.code) or
         if not assigned(procdef.inlininginfo^.code) or
-           (po_assembler in procdef.procoptions) then
+           (po_assembler in procdef.procoptions) or
+            { no locals }
+            (tprocdef(procdef).localst.symsearch.count <> 0) or
+            { procedure, not function }
+            (not is_void(procdef.rettype.def)) then
           exit;
           exit;
         paraitem:=tparaitem(procdef.para.first);
         paraitem:=tparaitem(procdef.para.first);
 
 
@@ -983,10 +987,7 @@ implementation
           begin
           begin
             { we can't handle formaldefs, nor valuepara's which get a new value }
             { we can't handle formaldefs, nor valuepara's which get a new value }
             if ((paraitem.paratyp in [vs_out,vs_var]) and
             if ((paraitem.paratyp in [vs_out,vs_var]) and
-                (paraitem.paratype.def.deftype=formaldef)) or
-              { in this case we may have to create a temp for the para, }
-              { not yet handled                                         }
-               (paraitem.paratyp = vs_value) then 
+                (paraitem.paratype.def.deftype=formaldef)) then
               exit;
               exit;
             paraitem := tparaitem(paraitem.next);
             paraitem := tparaitem(paraitem.next);
           end;
           end;
@@ -1426,7 +1427,14 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.200  2004-07-12 09:14:04  jonas
+  Revision 1.201  2004-07-15 19:55:40  jonas
+    + (incomplete) node_complexity function to assess the complexity of a
+      tree
+    + support for inlining value and const parameters at the node level
+      (all procedures without local variables and without formal parameters
+       can now be inlined at the node level)
+
+  Revision 1.200  2004/07/12 09:14:04  jonas
     * inline procedures at the node tree level, but only under some very
     * inline procedures at the node tree level, but only under some very
       limited circumstances for now (only procedures, and only if they have
       limited circumstances for now (only procedures, and only if they have
       no or only vs_out/vs_var parameters).
       no or only vs_out/vs_var parameters).