From 6b463bfd0d058ec50a0514eb4fb1bc8145710c65 Mon Sep 17 00:00:00 2001 From: florian Date: Mon, 9 Oct 2006 21:51:33 +0000 Subject: [PATCH] + tail recursion optimization code, needs some fixes, but works basically, not yet activated git-svn-id: trunk@4845 - --- .gitattributes | 1 + compiler/opttail.pas | 166 +++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 167 insertions(+) create mode 100644 compiler/opttail.pas diff --git a/.gitattributes b/.gitattributes index 89a36bf92c..67aa8e8792 100644 --- a/.gitattributes +++ b/.gitattributes @@ -275,6 +275,7 @@ compiler/oglx.pas svneol=native#text/plain compiler/ogmap.pas svneol=native#text/plain compiler/optcse.pas svneol=native#text/plain compiler/options.pas svneol=native#text/plain +compiler/opttail.pas svneol=native#text/plain compiler/optunrol.pas svneol=native#text/plain compiler/owar.pas svneol=native#text/plain compiler/owbase.pas svneol=native#text/plain diff --git a/compiler/opttail.pas b/compiler/opttail.pas new file mode 100644 index 0000000000..7f9de1bcf0 --- /dev/null +++ b/compiler/opttail.pas @@ -0,0 +1,166 @@ +{ + Tail recursion optimization + + Copyright (c) 2006 by Florian Klaempfl + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + + **************************************************************************** +} +unit opttail; + +{$i fpcdefs.inc} + + interface + + uses + symdef,node; + + procedure do_opttail(var n : tnode;p : tprocdef); + + implementation + + uses + globtype, + defcmp, + nbas,nflw,ncal,nld,ncnv, + pass_1; + + procedure do_opttail(var n : tnode;p : tprocdef); + var + labelnode : tlabelnode; + function find_and_replace_tailcalls(var n : tnode) : boolean; + + var + usedcallnode : tcallnode; + + function is_recursivecall(n : tnode) : boolean; + begin + result:=(n.nodetype=calln) and (tcallnode(n).procdefinition=p); + if result then + usedcallnode:=tcallnode(n) + else + { obsolete type cast? } + result:=((n.nodetype=typeconvn) and (ttypeconvnode(n).convtype=tc_equal) and is_recursivecall(ttypeconvnode(n).left)); + end; + + function is_resultassignment(n : tnode) : boolean; + begin + result:=((n.nodetype=loadn) and (tloadnode(n).symtableentry=p.funcretsym)) or + ((n.nodetype=typeconvn) and (ttypeconvnode(n).convtype=tc_equal) and is_resultassignment(ttypeconvnode(n).left)); + end; + + var + calcnodes, + copynodes, + hp : tnode; + nodes, + calcstatements, + copystatements : tstatementnode; + paranode : tcallparanode; + tempnode : ttempcreatenode; + begin + { no tail call found and replaced so far } + result:=false; + if n=nil then + exit; + case n.nodetype of + statementn: + begin + hp:=n; + { search last node } + while assigned(tstatementnode(hp).right) do + hp:=tstatementnode(hp).right; + result:=find_and_replace_tailcalls(tstatementnode(hp).left); + end; + ifn: + begin + result:=find_and_replace_tailcalls(tifnode(n).right); + { avoid short bool eval here } + result:=find_and_replace_tailcalls(tifnode(n).t1) or result; + end; + assignn: + begin + if is_resultassignment(tbinarynode(n).left) and + is_recursivecall(tbinarynode(n).right) then + begin + { found one! } + { + writeln('tail recursion optimization for ',p.mangledname); + printnode(output,n); + } + { create assignments for all parameters } + + { this is hairy to do because one parameter could be used to calculate another one, so + assign them first to temps and then add them } + + calcnodes:=internalstatements(calcstatements); + copynodes:=internalstatements(copystatements); + paranode:=tcallparanode(usedcallnode.left); + while assigned(paranode) do + begin + tempnode:=ctempcreatenode.create(paranode.left.resulttype,paranode.left.resulttype.def.size,tt_persistent,true); + addstatement(calcstatements,tempnode); + addstatement(calcstatements, + cassignmentnode.create( + ctemprefnode.create(tempnode), + paranode.left + )); + addstatement(copystatements, + cassignmentnode.create( + cloadnode.create(paranode.parasym,paranode.parasym.owner), + ctemprefnode.create(tempnode) + )); + addstatement(copystatements,ctempdeletenode.create_normal_temp(tempnode)); + + { reused } + paranode.left:=nil; + paranode:=tcallparanode(paranode.right); + end; + + n.free; + n:=internalstatements(nodes); + addstatement(nodes,calcnodes); + addstatement(nodes,copynodes); + + { create goto } + addstatement(nodes,cgotonode.create(labelnode)); + + do_firstpass(n); + result:=true; + end; + end; + blockn: + result:=find_and_replace_tailcalls(tblocknode(n).left); + end; + end; + var + s : tstatementnode; + oldnodes : tnode; + begin + labelnode:=clabelnode.create(cnothingnode.create); + if find_and_replace_tailcalls(n) then + begin + oldnodes:=n; + n:=internalstatements(s); + addstatement(s,labelnode); + addstatement(s,oldnodes); + end + else + labelnode.free; + end; + +end. +