From 02d0ac4c3ecd9196e7fb619c008f4bd4a905c1bd Mon Sep 17 00:00:00 2001
From: florian <florian@freepascal.org>
Date: Tue, 10 Oct 2006 20:29:48 +0000
Subject: [PATCH] + 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 | 4 +++-
compiler/htypechk.pas | 9 +++++----
compiler/ncal.pas | 5 +++++
compiler/node.pas | 4 ++++
compiler/opttail.pas | 26 +++++++++++++++++++++++---
compiler/psub.pas | 5 +++--
6 files changed, 43 insertions(+), 10 deletions(-)
diff --git a/compiler/globtype.pas b/compiler/globtype.pas
index a148eacff4..afad5a73ea 100644
--- a/compiler/globtype.pas
+++ b/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;
diff --git a/compiler/htypechk.pas b/compiler/htypechk.pas
index e9952b50b9..60abc3b20f 100644
--- a/compiler/htypechk.pas
+++ b/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;
diff --git a/compiler/ncal.pas b/compiler/ncal.pas
index ae15444706..7e4702d943 100644
--- a/compiler/ncal.pas
+++ b/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
diff --git a/compiler/node.pas b/compiler/node.pas
index 4783bf806a..a6e558afba 100644
--- a/compiler/node.pas
+++ b/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,
diff --git a/compiler/opttail.pas b/compiler/opttail.pas
index 7f9de1bcf0..0ae5a7a061 100644
--- a/compiler/opttail.pas
+++ b/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;
diff --git a/compiler/psub.pas b/compiler/psub.pas
index 4ae49ffbd2..ae12ee49c5 100644
--- a/compiler/psub.pas
+++ b/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 }