* inline procedures at the node tree level, but only under some very

    limited circumstances for now (only procedures, and only if they have
    no or only vs_out/vs_var parameters).
  * fixed ppudump for inline procedures
  * fixed ppudump for ppc

compiler/ncal.pas

@@ -30,7 +30,7 @@ interface
        cutils,cclasses,
        globtype,cpuinfo,
        paramgr,
-       node,nbas,
+       node,nbas,nutils,
        {$ifdef state_tracking}
        nstate,
        {$endif state_tracking}
@@ -63,6 +63,8 @@ interface
           procedure setfuncretnode(const returnnode: tnode);
           procedure convert_carg_array_of_const;
           procedure order_parameters;
+
+          function replaceparaload(var n: tnode; arg: pointer): foreachnoderesult;
        protected
           pushedparasize : longint;
        public
@@ -176,7 +178,7 @@ implementation
       verbose,globals,
       symconst,defutil,defcmp,
       htypechk,pass_1,
-      ncnv,nld,ninl,nadd,ncon,nmem,nutils,
+      ncnv,nld,ninl,nadd,ncon,nmem,
       procinfo,
       cgbase
       ;
@@ -1840,6 +1842,28 @@ type
       end;
 
 
+    function tcallnode.replaceparaload(var n: tnode; arg: pointer): foreachnoderesult;
+      var
+        paras: tcallparanode;
+      begin
+        result := fen_false;
+        if (n.nodetype = loadn) then
+          begin
+            paras := tcallparanode(left);
+            while assigned(paras) and
+                  (paras.paraitem.parasym <> tloadnode(n).symtableentry) do
+              paras := tcallparanode(paras.right);
+            if assigned(paras) then
+              begin
+                n.free;
+                n := paras.left.getcopy;
+                resulttypepass(n);
+                result := fen_true;
+              end;
+          end;
+      end;
+
+
     function tcallnode.pass_1 : tnode;
 {$ifdef m68k}
       var
@@ -1850,6 +1874,41 @@ type
       begin
          result:=nil;
 
+         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
+           begin
+              { inherit flags }
+              current_procinfo.flags := current_procinfo.flags + ((procdefinition as tprocdef).inlininginfo^.flags*inherited_inlining_flags);
+
+              if assigned(methodpointer) then
+                CGMessage(cg_e_unable_inline_object_methods);
+              if assigned(right) then
+                CGMessage(cg_e_unable_inline_procvar);
+              if assigned(inlinecode) then
+                internalerror(2004071110);
+
+              if assigned(tprocdef(procdefinition).inlininginfo^.code) then
+                result:=tprocdef(procdefinition).inlininginfo^.code.getcopy
+              else
+                CGMessage(cg_e_no_code_for_inline_stored);
+              if assigned(result) then
+                begin
+                  { 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 }
+                  procdefinition.proccalloption:=pocall_default;
+                  firstpass(result);
+                  procdefinition.proccalloption:=pocall_inline;
+                  exit;
+                end;
+           end;
+
          { calculate the parameter info for the procdef }
          if not procdefinition.has_paraloc_info then
            begin
@@ -1900,7 +1959,7 @@ type
               if (procdefinition.proccalloption=pocall_inline) then
                 begin
                    { 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);
 
                    if assigned(methodpointer) then
                      CGMessage(cg_e_unable_inline_object_methods);
@@ -2147,7 +2206,14 @@ begin
 end.
 {
   $Log$
-  Revision 1.239  2004-06-20 08:55:29  florian
+  Revision 1.240  2004-07-12 09:14:04  jonas
+    * inline procedures at the node tree level, but only under some very
+      limited circumstances for now (only procedures, and only if they have
+      no or only vs_out/vs_var parameters).
+    * fixed ppudump for inline procedures
+    * fixed ppudump for ppc
+
+  Revision 1.239  2004/06/20 08:55:29  florian
     * logs truncated
 
   Revision 1.238  2004/06/16 20:07:08  florian

compiler/nutils.pas

@@ -43,12 +43,12 @@ interface
     );
 
 
-  foreachnodefunction = function(var n: tnode): foreachnoderesult of object;
-  staticforeachnodefunction = function(var n: tnode): 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): boolean;
-    function foreachnodestatic(var n: tnode; f: staticforeachnodefunction): boolean;
+    function foreachnode(var n: tnode; f: foreachnodefunction; arg: pointer): boolean;
+    function foreachnodestatic(var n: tnode; f: staticforeachnodefunction; arg: pointer): boolean;
 
     procedure load_procvar_from_calln(var p1:tnode);
     function maybe_call_procvar(var p1:tnode;tponly:boolean):boolean;
@@ -74,12 +74,12 @@ implementation
       cgbase,procinfo,
       pass_1;
 
-  function foreachnode(var n: tnode; f: foreachnodefunction): boolean;
+  function foreachnode(var n: tnode; f: foreachnodefunction; arg: pointer): boolean;
     begin
       result := false;
       if not assigned(n) then
         exit;
-      case f(n) of
+      case f(n,arg) of
         fen_norecurse_false:
           exit;
         fen_norecurse_true:
@@ -97,36 +97,36 @@ implementation
         calln:
           begin
             { not in one statement, won't work because of b- }
-            result := foreachnode(tcallnode(n).methodpointer,f) or result;
-            result := foreachnode(tcallnode(n).inlinecode,f) or result;
+            result := foreachnode(tcallnode(n).methodpointer,f,arg) or result;
+            result := foreachnode(tcallnode(n).inlinecode,f,arg) or result;
           end;
         ifn, whilerepeatn, forn:
           begin
             { not in one statement, won't work because of b- }
-            result := foreachnode(tloopnode(n).t1,f) or result;
-            result := foreachnode(tloopnode(n).t2,f) or result;
+            result := foreachnode(tloopnode(n).t1,f,arg) or result;
+            result := foreachnode(tloopnode(n).t2,f,arg) or result;
           end;
         raisen:
-          result := foreachnode(traisenode(n).frametree,f) or result;
+          result := foreachnode(traisenode(n).frametree,f,arg) or result;
         casen:
-          result := foreachnode(tcasenode(n). elseblock,f) or result;
+          result := foreachnode(tcasenode(n). elseblock,f,arg) or result;
       end;
       if n.inheritsfrom(tbinarynode) then
         begin
-          result := foreachnode(tbinarynode(n).right,f) or result;
-          result := foreachnode(tbinarynode(n).left,f) or result;
+          result := foreachnode(tbinarynode(n).right,f,arg) or result;
+          result := foreachnode(tbinarynode(n).left,f,arg) or result;
         end
       else if n.inheritsfrom(tunarynode) then
-        result := foreachnode(tunarynode(n).left,f) or result;
+        result := foreachnode(tunarynode(n).left,f,arg) or result;
     end;
 
 
-  function foreachnodestatic(var n: tnode; f: staticforeachnodefunction): boolean;
+  function foreachnodestatic(var n: tnode; f: staticforeachnodefunction; arg: pointer): boolean;
     begin
       result := false;
       if not assigned(n) then
         exit;
-      case f(n) of
+      case f(n,arg) of
         fen_norecurse_false:
           exit;
         fen_norecurse_true:
@@ -143,27 +143,27 @@ implementation
       case n.nodetype of
         calln:
           begin
-            result := foreachnodestatic(tcallnode(n).methodpointer,f) or result;
-            result := foreachnodestatic(tcallnode(n).inlinecode,f) or result;
+            result := foreachnodestatic(tcallnode(n).methodpointer,f,arg) or result;
+            result := foreachnodestatic(tcallnode(n).inlinecode,f,arg) or result;
           end;
         ifn, whilerepeatn, forn:
           begin
             { not in one statement, won't work because of b- }
-            result := foreachnodestatic(tloopnode(n).t1,f) or result;
-            result := foreachnodestatic(tloopnode(n).t2,f) or result;
+            result := foreachnodestatic(tloopnode(n).t1,f,arg) or result;
+            result := foreachnodestatic(tloopnode(n).t2,f,arg) or result;
           end;
         raisen:
-          result := foreachnodestatic(traisenode(n).frametree,f) or result;
+          result := foreachnodestatic(traisenode(n).frametree,f,arg) or result;
         casen:
-          result := foreachnodestatic(tcasenode(n). elseblock,f) or result;
+          result := foreachnodestatic(tcasenode(n). elseblock,f,arg) or result;
       end;
       if n.inheritsfrom(tbinarynode) then
         begin
-          result := foreachnodestatic(tbinarynode(n).right,f) or result;
-          result := foreachnodestatic(tbinarynode(n).left,f) or result;
+          result := foreachnodestatic(tbinarynode(n).right,f,arg) or result;
+          result := foreachnodestatic(tbinarynode(n).left,f,arg) or result;
         end
       else if n.inheritsfrom(tunarynode) then
-        result := foreachnodestatic(tunarynode(n).left,f) or result;
+        result := foreachnodestatic(tunarynode(n).left,f,arg) or result;
     end;
 
 
@@ -438,7 +438,14 @@ end.
 
 {
   $Log$
-  Revision 1.14  2004-06-20 08:55:29  florian
+  Revision 1.15  2004-07-12 09:14:04  jonas
+    * inline procedures at the node tree level, but only under some very
+      limited circumstances for now (only procedures, and only if they have
+      no or only vs_out/vs_var parameters).
+    * fixed ppudump for inline procedures
+    * fixed ppudump for ppc
+
+  Revision 1.14  2004/06/20 08:55:29  florian
     * logs truncated
 
   Revision 1.13  2004/06/16 20:07:09  florian

compiler/ppu.pas

@@ -45,9 +45,9 @@ type
 
 const
 {$ifdef ansistring_bits}
-  CurrentPPUVersion=41;
+  CurrentPPUVersion=42;
 {$else}
-  CurrentPPUVersion=41;
+  CurrentPPUVersion=42;
 {$endif}
 
 { buffer sizes }
@@ -1053,7 +1053,14 @@ end;
 end.
 {
   $Log$
-  Revision 1.52  2004-07-09 23:11:05  peter
+  Revision 1.53  2004-07-12 09:14:04  jonas
+    * inline procedures at the node tree level, but only under some very
+      limited circumstances for now (only procedures, and only if they have
+      no or only vs_out/vs_var parameters).
+    * fixed ppudump for inline procedures
+    * fixed ppudump for ppc
+
+  Revision 1.52  2004/07/09 23:11:05  peter
     * new format
 
   Revision 1.51  2004/06/20 08:55:30  florian

compiler/psub.pas

@@ -954,6 +954,47 @@ implementation
        end;
 
 
+    function containsforbiddennode(var n: tnode; arg: pointer): foreachnoderesult;
+      begin
+        if (n.nodetype <> exitn) then
+          result := fen_false
+        else
+          result := fen_norecurse_true;
+      end;
+
+
+    function checknodeinlining(procdef: tprocdef): boolean;
+      var
+        paraitem: tparaitem;
+      begin
+        result := false;
+        if not assigned(procdef.inlininginfo^.code) or
+           (po_assembler in procdef.procoptions) then
+          exit;
+        paraitem:=tparaitem(procdef.para.first);
+
+        { all call by reference parameters, or parameters which don't }
+        { get a new value? }
+        { also note: in theory, if there are only value parameters and none of those  }
+        {   are changed, we could also inline the paras. However, the compiler does   }
+        {   not distinguish between "used but not changed" and "used and changed"     }
+        {   (both are represented by vs_used), so that this not yet possible to do    }
+        while assigned(paraitem) do
+          begin
+            { we can't handle formaldefs, nor valuepara's which get a new value }
+            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 
+              exit;
+            paraitem := tparaitem(paraitem.next);
+          end;
+        { we currently can't handle exit-statements (would exit the caller) }
+        result := not foreachnodestatic(procdef.inlininginfo^.code,{$ifdef FPCPROCVAR}@{$endif}containsforbiddennode,nil);
+      end;
+
+
     procedure tcgprocinfo.parse_body;
       var
          oldprocinfo : tprocinfo;
@@ -1039,6 +1080,7 @@ implementation
            begin
              procdef.inlininginfo^.code:=code.getcopy;
              procdef.inlininginfo^.flags:=current_procinfo.flags;
+             procdef.inlininginfo^.inlinenode:=checknodeinlining(procdef);
            end
          else
            procdef.inlininginfo^.code:=code;
@@ -1384,7 +1426,14 @@ implementation
 end.
 {
   $Log$
-  Revision 1.199  2004-07-10 20:24:34  peter
+  Revision 1.200  2004-07-12 09:14:04  jonas
+    * inline procedures at the node tree level, but only under some very
+      limited circumstances for now (only procedures, and only if they have
+      no or only vs_out/vs_var parameters).
+    * fixed ppudump for inline procedures
+    * fixed ppudump for ppc
+
+  Revision 1.199  2004/07/10 20:24:34  peter
     * put every proc in a new object file
 
   Revision 1.198  2004/07/09 22:17:32  peter

compiler/symdef.pas

@@ -507,6 +507,7 @@ interface
          { node tree }
           code : tnode;
           flags : tprocinfoflags;
+          inlinenode : boolean;
        end;
        pinlininginfo = ^tinlininginfo;
 
@@ -3688,6 +3689,7 @@ implementation
              ppufile.getderef(funcretsymderef);
              new(inlininginfo);
              ppufile.getsmallset(inlininginfo^.flags);
+             inlininginfo^.inlinenode:=boolean(ppufile.getbyte);
            end
          else
            funcretsym:=nil;
@@ -3818,6 +3820,7 @@ implementation
            begin
              ppufile.putderef(funcretsymderef);
              ppufile.putsmallset(inlininginfo^.flags);
+             ppufile.putbyte(byte(inlininginfo^.inlinenode));
            end;
 
          ppufile.do_crc:=oldintfcrc;
@@ -6129,7 +6132,14 @@ implementation
 end.
 {
   $Log$
-  Revision 1.245  2004-07-09 22:17:32  peter
+  Revision 1.246  2004-07-12 09:14:04  jonas
+    * inline procedures at the node tree level, but only under some very
+      limited circumstances for now (only procedures, and only if they have
+      no or only vs_out/vs_var parameters).
+    * fixed ppudump for inline procedures
+    * fixed ppudump for ppc
+
+  Revision 1.245  2004/07/09 22:17:32  peter
     * revert has_localst patch
     * replace aktstaticsymtable/aktglobalsymtable with current_module
 

compiler/utils/ppudump.pp

@@ -1335,10 +1335,19 @@ begin
              readposinfo;
              write  (space,'       SymOptions : ');
              readsymoptions;
+{$ifdef powerpc}
+             { library symbol for AmigaOS/MorphOS }
+             write  (space,'   Library symbol : ');
+             readderef;
+{$endif powerpc}
              if (calloption=pocall_inline) then
               begin
                 write  (space,'       FuncretSym : ');
                 readderef;
+                ppufile.getsmallset(procinfooptions);
+                writeln(space,'  ProcInfoOptions : ',dword(procinfooptions));
+                b := ppufile.getbyte;
+                writeln(space,' Inline node tree : ',b);
               end;
              if not EndOfEntry then
               Writeln('!! Entry has more information stored');
@@ -1347,18 +1356,14 @@ begin
              readdefinitions('parast',false);
              readsymbols('parast');
              { localst }
-             if (po_haslocalst in procoptions) then
+             if (po_haslocalst in procoptions) or
+                (calloption = pocall_inline) then
               begin
                 readdefinitions('localst',false);
                 readsymbols('localst');
               end;
-             { code }
              if (calloption=pocall_inline) then
-               begin
-                 readnodetree;
-                 ppufile.getsmallset(procinfooptions);
-                 writeln(space,'  ProcInfoOptions : ',dword(procinfooptions));
-               end;
+               readnodetree;
              delete(space,1,4);
            end;
 
@@ -1981,7 +1986,14 @@ begin
 end.
 {
   $Log$
-  Revision 1.52  2004-07-09 22:17:32  peter
+  Revision 1.53  2004-07-12 09:14:04  jonas
+    * inline procedures at the node tree level, but only under some very
+      limited circumstances for now (only procedures, and only if they have
+      no or only vs_out/vs_var parameters).
+    * fixed ppudump for inline procedures
+    * fixed ppudump for ppc
+
+  Revision 1.52  2004/07/09 22:17:32  peter
     * revert has_localst patch
     * replace aktstaticsymtable/aktglobalsymtable with current_module