+ only procedures doing recursive calls are checked for tail recursivity

+ parameters are tested if they are usable with tail recursion removal

git-svn-id: trunk@4853 -

compiler/globtype.pas

@@ -299,7 +299,9 @@ than 255 characters. That's why using Ansi Strings}
          { set if the procedure has to push parameters onto the stack }
          pi_has_stackparameter,
          { set if the procedure has at least one got }
-         pi_has_goto
+         pi_has_goto,
+         { calls itself recursive }
+         pi_is_recursive
        );
        tprocinfoflags=set of tprocinfoflag;
 

compiler/htypechk.pas

@@ -1255,11 +1255,12 @@ implementation
                        if (tabstractvarsym(tloadnode(hp).symtableentry).varspez=vs_const) then
                         begin
                           { allow p^:= constructions with p is const parameter }
-                          if gotderef or gotdynarray or (Valid_Const in opts) then
-                           result:=true
+                          if gotderef or gotdynarray or (Valid_Const in opts) or
+                            (nf_isinternal_ignoreconst in tloadnode(hp).flags) then
+                            result:=true
                           else
-                           if report_errors then
-                            CGMessagePos(tloadnode(hp).fileinfo,type_e_no_assign_to_const);
+                            if report_errors then
+                              CGMessagePos(tloadnode(hp).fileinfo,type_e_no_assign_to_const);
                           exit;
                         end;
                        result:=true;

compiler/ncal.pas

@@ -1766,6 +1766,11 @@ type
               end;
            end;
 
+          { recursive call? }
+          if assigned(current_procinfo) and
+             (procdefinition=current_procinfo.procdef) then
+            include(current_procinfo.flags,pi_is_recursive);
+
           { handle predefined procedures }
           is_const:=(po_internconst in procdefinition.procoptions) and
                     ((block_type in [bt_const,bt_type]) or

compiler/node.pas

@@ -216,6 +216,10 @@ interface
          nf_is_self,
          nf_load_self_pointer,
          nf_inherited,
+         { the loadnode is generated internally and a varspez=vs_const should be ignore,
+           this requires that the parameter is actually passed by value
+           Be really carefull when using this flag! }
+         nf_isinternal_ignoreconst,
 
          { taddnode }
          nf_is_currency,

compiler/opttail.pas

@@ -34,13 +34,17 @@ unit opttail;
 
     uses
       globtype,
+      symconst,symsym,
       defcmp,
       nbas,nflw,ncal,nld,ncnv,
-      pass_1;
+      pass_1,
+      paramgr;
 
     procedure do_opttail(var n : tnode;p : tprocdef);
+
       var
         labelnode : tlabelnode;
+
       function find_and_replace_tailcalls(var n : tnode) : boolean;
 
         var
@@ -71,6 +75,7 @@ unit opttail;
           copystatements : tstatementnode;
           paranode : tcallparanode;
           tempnode : ttempcreatenode;
+          loadnode : tloadnode;
         begin
           { no tail call found and replaced so far }
           result:=false;
@@ -118,12 +123,17 @@ unit opttail;
                             ctemprefnode.create(tempnode),
                             paranode.left
                             ));
+
+                        { "cast" away const varspezs }
+                        loadnode:=cloadnode.create(paranode.parasym,paranode.parasym.owner);
+                        include(loadnode.flags,nf_isinternal_ignoreconst);
+
                         addstatement(copystatements,
                           cassignmentnode.create(
-                            cloadnode.create(paranode.parasym,paranode.parasym.owner),
+                            loadnode,
                             ctemprefnode.create(tempnode)
                             ));
-                       addstatement(copystatements,ctempdeletenode.create_normal_temp(tempnode));
+                        addstatement(copystatements,ctempdeletenode.create_normal_temp(tempnode));
 
                         { reused }
                         paranode.left:=nil;
@@ -146,11 +156,21 @@ unit opttail;
               result:=find_and_replace_tailcalls(tblocknode(n).left);
           end;
         end;
+
       var
         s : tstatementnode;
         oldnodes : tnode;
+        i : aint;
       begin
         labelnode:=clabelnode.create(cnothingnode.create);
+
+        { check if the parameters actually would support tail recursion elimination }
+        for i:=0 to p.paras.count-1 do
+          with tparavarsym(p.paras[i]) do
+            if (varspez in [vs_out,vs_var]) or
+              ((varspez=vs_const) and
+               (paramanager.push_addr_param(varspez,vartype.def,p.proccalloption))) then
+               exit;
         if find_and_replace_tailcalls(n) then
           begin
             oldnodes:=n;

compiler/psub.pas

@@ -729,9 +729,10 @@ implementation
           include(flags,pi_uses_fpu);
 
         { do this before adding the entry code else the tail recursion recognition won't work,
-          if this causes troubles, it must be ifdef'ed
+          if this causes troubles, it must be if'ed
         }
-        if cs_opt_tailrecursion in aktoptimizerswitches then
+        if (cs_opt_tailrecursion in aktoptimizerswitches) and
+          (pi_is_recursive in flags) then
           do_opttail(code,procdef);
 
         { add implicit entry and exit code }