mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-13 01:50:49 +02:00
+ constant propagation, based on a patch by Jeppe Johansen
git-svn-id: trunk@25958 -
This commit is contained in:
florian
parent
d39b9059d6
commit
e8787c4b48
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -458,6 +458,7 @@ compiler/ogmacho.pas svneol=native#text/plain
|
||||
compiler/ogmap.pas svneol=native#text/plain
|
||||
compiler/ognlm.pas svneol=native#text/plain
|
||||
compiler/optbase.pas svneol=native#text/plain
|
||||
compiler/optconstprop.pas svneol=native#text/pascal
|
||||
compiler/optcse.pas svneol=native#text/plain
|
||||
compiler/optdead.pas svneol=native#text/plain
|
||||
compiler/optdfa.pas svneol=native#text/plain
|
||||
|
||||
326
compiler/optconstprop.pas
Normal file
326
compiler/optconstprop.pas
Normal file
@ -0,0 +1,326 @@
|
||||
{
|
||||
Constant propagation across statements
|
||||
|
||||
Copyright (c) 2005-2012 by Jeppe Johansen and 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 optconstprop;
|
||||
|
||||
{$i fpcdefs.inc}
|
||||
|
||||
{ $define DEBUG_CONSTPROP}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
node;
|
||||
|
||||
{ does constant propagation for rootnode
|
||||
|
||||
The approach is simple: It search for constant assignment statements. As soon as such
|
||||
a statement is found, the following statements are search if they contain
|
||||
a usage of the assigned variable. If this is a the case, the variable is
|
||||
replaced by the constant. This does not work across points where the
|
||||
program flow joins so e.g.
|
||||
|
||||
if ... then
|
||||
...
|
||||
a:=1;
|
||||
...
|
||||
else
|
||||
...
|
||||
a:=1;
|
||||
...
|
||||
writeln(a);
|
||||
|
||||
will not result in any constant propagation.
|
||||
}
|
||||
function do_optconstpropagate(var rootnode : tnode) : tnode;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
fmodule,
|
||||
pass_1,procinfo,
|
||||
symsym, symconst,
|
||||
nutils, nbas, ncnv, nld, nflw, ncal;
|
||||
|
||||
function check_written(var n: tnode; arg: pointer): foreachnoderesult;
|
||||
begin
|
||||
result:=fen_false;
|
||||
|
||||
if n.isequal(tnode(arg)) and
|
||||
((n.flags*[nf_write,nf_modify])<>[]) then
|
||||
begin
|
||||
result:=fen_norecurse_true;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{ propagates the constant assignment passed in arg into n }
|
||||
function replaceBasicAssign(var n: tnode; arg: tnode; var tree_modified: boolean): boolean;
|
||||
var
|
||||
st2, oldnode: tnode;
|
||||
old: pnode;
|
||||
changed, tree_modified2,tree_modified3: boolean;
|
||||
written : Boolean;
|
||||
begin
|
||||
result:=true;
|
||||
|
||||
if n = nil then
|
||||
exit;
|
||||
|
||||
tree_modified:=false;
|
||||
tree_modified2:=false;
|
||||
tree_modified3:=false;
|
||||
|
||||
{ while it might be usefull, to use foreach to iterate all nodes, it is safer to
|
||||
iterate manually here so we have full controll how all nodes are processed }
|
||||
|
||||
{ We cannot analyze beyond those nodes, so we terminate to be on the safe side }
|
||||
if (n.nodetype in [addrn,derefn,dataconstn,asmn,withn,casen,whilerepeatn,forn,labeln,continuen,breakn,
|
||||
tryexceptn,raisen,tryfinallyn,onn,loadparentfpn,loadvmtaddrn,guidconstn,rttin,addoptn,asn,goton,
|
||||
objcselectorn,objcprotocoln]) then
|
||||
exit(false)
|
||||
else if n.nodetype=assignn then
|
||||
begin
|
||||
tree_modified:=false;
|
||||
|
||||
{ we can propage the constant in both branches because the evaluation order is not defined }
|
||||
result:=replaceBasicAssign(tassignmentnode(n).right, arg, tree_modified);
|
||||
{ do not use the intuitive way result:=result and replace... because this would prevent
|
||||
replaceBasicAssign being called if the result is already false }
|
||||
result:=replaceBasicAssign(tassignmentnode(n).left, arg, tree_modified2) and result;
|
||||
tree_modified:=tree_modified or tree_modified2;
|
||||
|
||||
{ but we have to check if left writes to the currently searched variable ... }
|
||||
written:=foreachnodestatic(pm_postprocess, tassignmentnode(n).left, @check_written, tassignmentnode(arg).left);
|
||||
{ ... if this is the case, we have to stop searching }
|
||||
result:=result and not(written);
|
||||
end
|
||||
else if n.isequal(tassignmentnode(arg).left) and ((n.flags*[nf_write,nf_modify])=[]) then
|
||||
begin
|
||||
n.Free;
|
||||
n:=tassignmentnode(arg).right.getcopy;
|
||||
inserttypeconv_internal(n, tassignmentnode(arg).left.resultdef);
|
||||
|
||||
tree_modified:=true;
|
||||
end
|
||||
else if n.nodetype=statementn then
|
||||
result:=replaceBasicAssign(tstatementnode(n).left, arg, tree_modified)
|
||||
else if n.nodetype=blockn then
|
||||
begin
|
||||
changed:=false;
|
||||
|
||||
st2:=tstatementnode(tblocknode(n).statements);
|
||||
old:=@tblocknode(n).statements;
|
||||
while assigned(st2) do
|
||||
begin
|
||||
repeat
|
||||
oldnode:=st2;
|
||||
|
||||
tree_modified2:=false;
|
||||
if not replaceBasicAssign(st2, arg, tree_modified2) then
|
||||
begin
|
||||
old^:=st2;
|
||||
oldnode:=nil;
|
||||
changed:=changed or tree_modified2;
|
||||
result:=false;
|
||||
break;
|
||||
end
|
||||
else
|
||||
old^:=st2;
|
||||
changed:=changed or tree_modified2;
|
||||
until oldnode=st2;
|
||||
|
||||
if oldnode = nil then
|
||||
break;
|
||||
|
||||
old:=@tstatementnode(st2).next;
|
||||
st2:=tstatementnode(st2).next;
|
||||
end;
|
||||
|
||||
tree_modified:=changed;
|
||||
end
|
||||
else if n.nodetype=ifn then
|
||||
begin
|
||||
result:=replaceBasicAssign(tifnode(n).left, arg, tree_modified);
|
||||
|
||||
if result then
|
||||
begin
|
||||
if assigned(tifnode(n).t1) then
|
||||
begin
|
||||
{ we can propagate the constant in both branches of an if statement
|
||||
because even if the the branch writes to it, the else branch gets the
|
||||
unmodified value }
|
||||
result:=replaceBasicAssign(tifnode(n).right, arg, tree_modified2);
|
||||
|
||||
{ do not use the intuitive way result:=result and replace... because this would prevent
|
||||
replaceBasicAssign being called if the result is already false }
|
||||
result:=replaceBasicAssign(tifnode(n).t1, arg, tree_modified3) and result;
|
||||
|
||||
tree_modified:=tree_modified or tree_modified2 or tree_modified3;
|
||||
end
|
||||
else
|
||||
begin
|
||||
result:=replaceBasicAssign(tifnode(n).right, arg, tree_modified2);
|
||||
tree_modified:=tree_modified or tree_modified2;
|
||||
end;
|
||||
end;
|
||||
end
|
||||
else if n.nodetype in [calln,inlinen] then
|
||||
begin
|
||||
if might_have_sideeffects(n) and (n.nodetype=inlinen) then
|
||||
exit(false);
|
||||
|
||||
if n.nodetype=calln then
|
||||
exit(false);
|
||||
|
||||
replaceBasicAssign(tunarynode(n).left, arg, tree_modified);
|
||||
result:=false;
|
||||
end
|
||||
else if n.InheritsFrom(tbinarynode) then
|
||||
begin
|
||||
result:=replaceBasicAssign(tbinarynode(n).left, arg, tree_modified);
|
||||
if result then
|
||||
result:=replaceBasicAssign(tbinarynode(n).right, arg, tree_modified2);
|
||||
tree_modified:=tree_modified or tree_modified2;
|
||||
end
|
||||
else if n.InheritsFrom(tunarynode) then
|
||||
begin
|
||||
result:=replaceBasicAssign(tunarynode(n).left, arg, tree_modified);
|
||||
end;
|
||||
|
||||
if n.nodetype<>callparan then
|
||||
begin
|
||||
if tree_modified then
|
||||
exclude(n.flags,nf_pass1_done);
|
||||
|
||||
do_firstpass(n);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
function propagate(var n: tnode; arg: pointer): foreachnoderesult;
|
||||
var
|
||||
l,
|
||||
st, st2, oldnode: tnode;
|
||||
old: pnode;
|
||||
a: tassignmentnode;
|
||||
tree_mod, changed: boolean;
|
||||
begin
|
||||
result:=fen_true;
|
||||
|
||||
changed:=false;
|
||||
PBoolean(arg)^:=false;
|
||||
|
||||
if not assigned(n) then
|
||||
exit;
|
||||
|
||||
if n.nodetype in [calln] then
|
||||
exit(fen_norecurse_true);
|
||||
|
||||
if n.nodetype=blockn then
|
||||
begin
|
||||
st:=tblocknode(n).statements;
|
||||
|
||||
while assigned(st) and
|
||||
(st.nodetype=statementn) and
|
||||
assigned(tstatementnode(st).statement) do
|
||||
begin
|
||||
if tstatementnode(st).statement.nodetype=assignn then
|
||||
begin
|
||||
a:=tassignmentnode(tstatementnode(st).statement);
|
||||
|
||||
l:=a.left;
|
||||
|
||||
if (((l.nodetype=loadn) and
|
||||
(tloadnode(l).symtableentry.typ=localvarsym) and
|
||||
(tloadnode(l).symtable=current_procinfo.procdef.localst)
|
||||
) or
|
||||
((l.nodetype=loadn) and
|
||||
(tloadnode(l).symtableentry.typ=paravarsym) and
|
||||
(tloadnode(l).symtable=current_procinfo.procdef.parast)
|
||||
) or
|
||||
(l.nodetype = temprefn)) and
|
||||
(is_constintnode(a.right) or
|
||||
is_constboolnode(a.right) or
|
||||
is_constcharnode(a.right) or
|
||||
is_constenumnode(a.right) or
|
||||
is_conststringnode(a.right)) then
|
||||
begin
|
||||
st2:=tstatementnode(tstatementnode(st).right);
|
||||
old:=@tstatementnode(st).right;
|
||||
while assigned(st2) do
|
||||
begin
|
||||
repeat
|
||||
oldnode:=st2;
|
||||
|
||||
{ Simple assignment of constant found }
|
||||
tree_mod:=false;
|
||||
if not replaceBasicAssign(st2, a, tree_mod) then
|
||||
begin
|
||||
old^:=st2;
|
||||
oldnode:=nil;
|
||||
changed:=changed or tree_mod;
|
||||
break;
|
||||
end
|
||||
else
|
||||
old^:=st2;
|
||||
changed:=changed or tree_mod;
|
||||
until oldnode=st2;
|
||||
|
||||
if oldnode = nil then
|
||||
break;
|
||||
|
||||
old:=@tstatementnode(st2).next;
|
||||
st2:=tstatementnode(st2).next;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
st:=tstatementnode(st).next;
|
||||
end;
|
||||
end;
|
||||
|
||||
PBoolean(arg)^:=changed;
|
||||
end;
|
||||
|
||||
|
||||
function do_optconstpropagate(var rootnode: tnode): tnode;
|
||||
var
|
||||
changed: boolean;
|
||||
begin
|
||||
{$ifdef DEBUG_CONSTPROP}
|
||||
writeln('************************ before constant propagation ***************************');
|
||||
printnode(rootnode);
|
||||
{$endif DEBUG_CONSTPROP}
|
||||
repeat
|
||||
changed:=false;
|
||||
foreachnodestatic(pm_postandagain, rootnode, @propagate, @changed);
|
||||
until changed=false;
|
||||
{$ifdef DEBUG_CONSTPROP}
|
||||
writeln('************************ after constant propagation ***************************');
|
||||
printnode(rootnode);
|
||||
writeln('*******************************************************************************');
|
||||
{$endif DEBUG_CONSTPROP}
|
||||
result:=rootnode;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@ -113,7 +113,9 @@ implementation
|
||||
ncgutil,regvars,
|
||||
optbase,
|
||||
opttail,
|
||||
optcse,optloop
|
||||
optcse,
|
||||
optloop,
|
||||
optconstprop
|
||||
{$if defined(arm) or defined(avr) or defined(fpc_compiler_has_fixup_jmps)}
|
||||
,aasmcpu
|
||||
{$endif arm}
|
||||
@ -1251,6 +1253,9 @@ implementation
|
||||
(pi_is_recursive in flags) then
|
||||
do_opttail(code,procdef);
|
||||
|
||||
if (cs_opt_constant_propagate in current_settings.optimizerswitches) then
|
||||
do_optconstpropagate(code);
|
||||
|
||||
if (cs_opt_nodedfa in current_settings.optimizerswitches) and
|
||||
{ creating dfa is not always possible }
|
||||
((flags*[pi_has_assembler_block,pi_uses_exceptions,pi_is_assembler,
|
||||
|
||||
Loading…
Reference in New Issue
Block a user