+ support for simplifying simple inline functions down to a single

    constant node (rather than to just a blocknode with a statement
    assigning a constant to a temp)


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

4 files changed, 174 insertions, 4 deletions

diff --git a/compiler/nbas.pas b/compiler/nbas.pas
index 09a69a8ceb..f83c18ce41 100644
--- a/compiler/nbas.pas
+++ b/compiler/nbas.pas
@@ -70,6 +70,7 @@ interface
 
        tstatementnode = class(tbinarynode)
           constructor create(l,r : tnode);virtual;
+          function simplify : tnode; override;
           function pass_1 : tnode;override;
           function pass_typecheck:tnode;override;
           procedure printnodetree(var t:text);override;
@@ -81,6 +82,7 @@ interface
        tblocknode = class(tunarynode)
           constructor create(l : tnode);virtual;
           destructor destroy; override;
+          function simplify : tnode; override;
           function pass_1 : tnode;override;
           function pass_typecheck:tnode;override;
 {$ifdef state_tracking}
@@ -307,6 +309,58 @@ implementation
          inherited create(statementn,l,r);
       end;
 
+
+    function tstatementnode.simplify : tnode;
+      begin
+        result:=nil;
+        { these "optimizations" are only to make it more easy to recognise    }
+        { blocknodes which at the end of inlining only contain one single     }
+        { statement. Simplifying inside blocknode.simplify could be dangerous }
+        { because if the main blocknode which makes up a procedure/function   }
+        { body were replaced with a statementn/nothingn, this could cause     }
+        { problems elsewhere in the compiler which expects a blocknode        }
+
+        { remove next statement if it's a nothing-statement (since if it's }
+        { the last, it won't remove itself -- see next simplification)     }
+        while assigned(right) and
+              (tstatementnode(right).left.nodetype = nothingn) do
+          begin
+            result:=tstatementnode(right).right;
+            tstatementnode(right).right:=nil;
+            right.free;
+            right:=result;
+            result:=nil;
+          end;
+
+        { Remove initial nothingn if there are other statements. If there }
+        { are no other statements, returning nil doesn't help (will be    }
+        { interpreted as "can't be simplified") and replacing the         }
+        { statementnode with a nothingnode cannot be done (because it's   }
+        { possible this statementnode is a child of a blocknode, and      }
+        { blocknodes are expected to only contain statementnodes)         }
+        if (left.nodetype = nothingn) and
+           assigned(right) then
+          begin
+            result:=right;
+            right:=nil;
+            exit;
+          end;
+
+        { if the current statement contains a block with one statement, }
+        { replace the current statement with that block's statement     }
+        if (left.nodetype = blockn) and
+           assigned(tblocknode(left).left) and
+           not assigned(tstatementnode(tblocknode(left).left).right) then
+          begin
+            result:=tblocknode(left).left;
+            tstatementnode(result).right:=right;
+            right:=nil;
+            tblocknode(left).left:=nil;
+            exit;
+          end;
+      end;
+
+
     function tstatementnode.pass_typecheck:tnode;
       begin
          result:=nil;
@@ -387,6 +441,31 @@ implementation
         inherited destroy;
       end;
 
+
+    function tblocknode.simplify: tnode;
+      var
+        hp, next: tstatementnode;
+      begin
+        result := nil;
+        { Warning: never replace a blocknode with another node type,      }
+        {  since the block may be the main block of a procedure/function/ }
+        {  main program body, and those nodes should always be blocknodes }
+        {  since that's what the compiler expects elsewhere.              }
+
+        { if the current block contains only one statement, and   }
+        { this one statement only contains another block, replace }
+        { this block with that other block.                       }
+        if assigned(left) and
+           not assigned(tstatementnode(left).right) and
+           (tstatementnode(left).left.nodetype = blockn) then
+          begin
+            result:=tstatementnode(left).left;
+            tstatementnode(left).left:=nil;
+            exit;
+          end;
+      end;
+
+
     function tblocknode.pass_typecheck:tnode;
       var
          hp : tstatementnode;
diff --git a/compiler/ncal.pas b/compiler/ncal.pas
index c4e690c4c8..061dc8e0c0 100644
--- a/compiler/ncal.pas
+++ b/compiler/ncal.pas
@@ -71,6 +71,7 @@ interface
           function  replaceparaload(var n: tnode; arg: pointer): foreachnoderesult;
           procedure createlocaltemps(p:TObject;arg:pointer);
           function  pass1_inline:tnode;
+          function  getfuncretassignment(inlineblock: tblocknode): tnode;
        protected
           pushedparasize : longint;
        public
@@ -2628,6 +2629,62 @@ implementation
       end;
 
 
+    function tcallnode.getfuncretassignment(inlineblock: tblocknode): tnode;
+      var
+        hp: tstatementnode;
+        resassign: tnode;
+      begin
+        result:=nil;
+        if not assigned(funcretnode) or
+           not(cnf_return_value_used in callnodeflags) then
+        exit;
+
+        { tempcreatenode for the function result }
+        hp:=tstatementnode(inlineblock.left);
+        if not(assigned(hp)) or
+           (hp.left.nodetype <> tempcreaten) then
+          exit;
+
+        { assignment to the result }
+        hp:=tstatementnode(hp.right);
+        if not(assigned(hp)) or
+           (hp.left.nodetype<>assignn) or
+           { left must be function result }
+           (not(tassignmentnode(hp.left).left.isequal(funcretnode)) and
+            { can have extra type conversion due to absolute mapping }
+            { of <fucntionname> on function result var               }
+            not((tassignmentnode(hp.left).left.nodetype = typeconvn) and
+                (ttypeconvnode(tassignmentnode(hp.left).left).convtype = tc_equal) and
+                (ttypeconvnode(tassignmentnode(hp.left).left).left.isequal(funcretnode)))) or
+           { right must be a constant (mainly to avoid trying to reuse    }
+           { local temps which may already be freed afterwards once these }
+           { checks are made looser)                                      }
+           not is_constnode(tassignmentnode(hp.left).right) then
+          exit
+        else
+          resassign:=hp.left;
+
+        { tempdelete to normal of the function result }
+        hp:=tstatementnode(hp.right);
+        if not(assigned(hp)) or
+           (hp.left.nodetype <> tempdeleten) then
+          exit;
+        
+        { the function result once more }
+        hp:=tstatementnode(hp.right);
+        if not(assigned(hp)) or
+           not(hp.left.isequal(funcretnode)) then
+          exit;
+
+        { should be the end }
+        if assigned(hp.right) then
+          exit;
+
+        { we made it! }
+        result:=tassignmentnode(resassign).right.getcopy;
+        firstpass(result);
+      end;
+
 
     function tcallnode.pass1_inline:tnode;
       var
@@ -2676,11 +2733,22 @@ implementation
         exclude(procdefinition.procoptions,po_inline);
 
         dosimplify(createblock);
-
         firstpass(createblock);
         include(procdefinition.procoptions,po_inline);
-        { return inlined block }
-        result := createblock;
+
+        { if all that's left of the inlined function is an constant       }
+        { assignment to the result, replace the whole block with what's   }
+        { assigned to the result. There will also be a tempcreatenode for }
+        { the function result itself though, so ignore it. The statement/ }
+        { blocknode simplification code will have removed all nothingn-   }
+        { statements empty nested blocks, so we don't have to care about  }
+        { those                                                           }
+        result := getfuncretassignment(createblock);
+        if assigned(result) then
+          createblock.free
+        else
+          { return inlined block }
+          result := createblock;
 
 {$ifdef DEBUGINLINE}
         writeln;
diff --git a/compiler/pass_1.pas b/compiler/pass_1.pas
index 4faa88c5c7..8efd883e15 100644
--- a/compiler/pass_1.pas
+++ b/compiler/pass_1.pas
@@ -170,7 +170,19 @@ implementation
                     firstpass(hp);
                     { switch to new node }
                     p:=hp;
-                  end;
+                  end
+                 else
+                   begin
+                     { inlining happens in pass_1 and can cause new }
+                     { simplify opportunities                       }
+                     hp:=p.simplify;
+                     if assigned(hp) then
+                       begin
+                         p.free;
+                         firstpass(hp);
+                         p:=hp;
+                       end;
+                   end;
                  if codegenerror then
                   include(p.flags,nf_error)
                  else
diff --git a/tests/test/tinline7.pp b/tests/test/tinline7.pp
new file mode 100644
index 0000000000..0439d49b31
--- /dev/null
+++ b/tests/test/tinline7.pp
@@ -0,0 +1,11 @@
+{$inline on}
+
+function f(const a,b: longint): longint; inline;
+begin
+  f:=a*b;
+end;
+
+begin
+  if (f(f(f(2,5),3),4) <> 120) then
+    halt(1);
+end.