paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-04 10:39:40 +01:00
Code Issues Packages Projects Releases Wiki Activity

+ first basically working (not all node types yet) dfa implementation determining life information

Browse Source 
git-svn-id: trunk@7294 -
This commit is contained in:
florian 2007-05-06 21:33:39 +00:00
parent 31a34e03c2
commit 45cda67f3f
6 changed files with 315 additions and 88 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
compiler/defcmp.pas
View File

@ -914,6 +914,24 @@ implementation
eq:=te_convert_l1; eq:=te_convert_l1;
end; end;
end; end;
{
enumdef :
begin
{ allow explicit typecasts from enums to pointer.
Support for delphi compatibility
}
if (eq=te_incompatible) and
(((cdo_explicit in cdoptions) and
(m_delphi in current_settings.modeswitches)
) or
(cdo_internal in cdoptions)
) then
begin
doconv:=tc_int_2_int;
eq:=te_convert_l1;
end;
end;
}
arraydef : arraydef :
begin begin
{ string constant (which can be part of array constructor) { string constant (which can be part of array constructor)

5
compiler/globtype.pas
View File

@ -153,7 +153,8 @@ interface
toptimizerswitch = (cs_opt_none, toptimizerswitch = (cs_opt_none,
cs_opt_level1,cs_opt_level2,cs_opt_level3, cs_opt_level1,cs_opt_level2,cs_opt_level3,
cs_opt_regvar,cs_opt_uncertain,cs_opt_size,cs_opt_stackframe, cs_opt_regvar,cs_opt_uncertain,cs_opt_size,cs_opt_stackframe,
cs_opt_peephole,cs_opt_asmcse,cs_opt_loopunroll,cs_opt_tailrecursion,cs_opt_nodecse cs_opt_peephole,cs_opt_asmcse,cs_opt_loopunroll,cs_opt_tailrecursion,cs_opt_nodecse,
cs_opt_nodedfa
); );
toptimizerswitches = set of toptimizerswitch; toptimizerswitches = set of toptimizerswitch;
@ -161,7 +162,7 @@ interface
OptimizerSwitchStr : array[toptimizerswitch] of string[10] = ('', OptimizerSwitchStr : array[toptimizerswitch] of string[10] = ('',
'LEVEL1','LEVEL2','LEVEL3', 'LEVEL1','LEVEL2','LEVEL3',
'REGVAR','UNCERTAIN','SIZE','STACKFRAME', 'REGVAR','UNCERTAIN','SIZE','STACKFRAME',
'PEEPHOLE','ASMCSE','LOOPUNROLL','TAILREC','CSE' 'PEEPHOLE','ASMCSE','LOOPUNROLL','TAILREC','CSE','DFA'
); );
{ switches being applied to all CPUs at the given level } { switches being applied to all CPUs at the given level }

94
compiler/optbase.pas
View File

@ -32,6 +32,7 @@ unit optbase;
{ this should maybe replaced by a spare set, { this should maybe replaced by a spare set,
using a dyn. array makes assignments cheap } using a dyn. array makes assignments cheap }
tdfaset = array of byte; tdfaset = array of byte;
PDFASet = ^TDFASet;
toptinfo = record toptinfo = record
{ index of the current node inside the dfa sets, aword(-1) if no entry } { index of the current node inside the dfa sets, aword(-1) if no entry }
@ -44,31 +45,69 @@ unit optbase;
poptinfo = ^toptinfo; poptinfo = ^toptinfo;
{ basic set operations for dfa sets } { basic set operations for dfa sets }
procedure TDFASetInclude(var s : tdfaset;e : integer);
procedure TDFASetExclude(var s : tdfaset;e : integer); { add e to s }
function TDFASetIn(const s : tdfaset;e : integer) : boolean; procedure DFASetInclude(var s : tdfaset;e : integer);
procedure TDFASetUnion(var d : tdfaset;const s1,s2 : tdfaset);
procedure TDFASetIntersect(var d : tdfaset;const s1,s2 : tdfaset); { add s to d }
procedure TDFASetDiff(var d : tdfaset;const s1,s2 : tdfaset); procedure DFASetIncludeSet(var d : tdfaset;const s : tdfaset);
{ remove e from s }
procedure DFASetExclude(var s : tdfaset;e : integer);
{ test if s contains e }
function DFASetIn(const s : tdfaset;e : integer) : boolean;
{ d:=s1+s2; }
procedure DFASetUnion(var d : tdfaset;const s1,s2 : tdfaset);
{ d:=s1*s2; }
procedure DFASetIntersect(var d : tdfaset;const s1,s2 : tdfaset);
{ d:=s1-s2; }
procedure DFASetDiff(var d : tdfaset;const s1,s2 : tdfaset);
{ s1<>s2; }
function DFASetNotEqual(const s1,s2 : tdfaset) : boolean; function DFASetNotEqual(const s1,s2 : tdfaset) : boolean;
{ output DFA set }
procedure PrintDFASet(var f : text;s : TDFASet);
implementation implementation
uses uses
cutils; cutils;
procedure TDFASetInclude(var s : tdfaset;e : integer); procedure DFASetInclude(var s : tdfaset;e : integer);
var var
i,
oldhigh,
e8 : Integer; e8 : Integer;
begin begin
e8:=e div 8; e8:=e div 8;
if e8>high(s) then if e8>high(s) then
SetLength(s,e8+1); begin
oldhigh:=high(s);
SetLength(s,e8+1);
for i:=oldhigh+1 to high(s) do
s[i]:=0;
end;
s[e8]:=s[e8] or (1 shl (e mod 8)); s[e8]:=s[e8] or (1 shl (e mod 8));
end; end;
procedure TDFASetExclude(var s : tdfaset;e : integer); procedure DFASetIncludeSet(var d : tdfaset;const s : tdfaset);
var
i : integer;
begin
if length(s)>length(d) then
SetLength(d,length(s));
for i:=0 to high(s) do
d[i]:=d[i] or s[i];
end;
procedure DFASetExclude(var s : tdfaset;e : integer);
var var
e8 : Integer; e8 : Integer;
begin begin
@ -79,7 +118,7 @@ unit optbase;
end; end;
function TDFASetIn(const s : tdfaset;e : integer) : boolean; function DFASetIn(const s : tdfaset;e : integer) : boolean;
var var
e8 : Integer; e8 : Integer;
begin begin
@ -91,7 +130,7 @@ unit optbase;
end; end;
procedure TDFASetUnion(var d : tdfaset;const s1,s2 : tdfaset); procedure DFASetUnion(var d : tdfaset;const s1,s2 : tdfaset);
var var
i : integer; i : integer;
begin begin
@ -103,7 +142,7 @@ unit optbase;
end; end;
procedure TDFASetIntersect(var d : tdfaset;const s1,s2 : tdfaset); procedure DFASetIntersect(var d : tdfaset;const s1,s2 : tdfaset);
var var
i : integer; i : integer;
begin begin
@ -113,13 +152,16 @@ unit optbase;
end; end;
procedure TDFASetDiff(var d : tdfaset;const s1,s2 : tdfaset); procedure DFASetDiff(var d : tdfaset;const s1,s2 : tdfaset);
var var
i : integer; i : integer;
begin begin
SetLength(d,min(Length(s1),Length(s2))); SetLength(d,length(s1));
for i:=0 to min(high(s1),high(s2)) do for i:=0 to high(d) do
d[i]:=s1[i] and not(s2[i]); if i>high(s2) then
d[i]:=s1[i]
else
d[i]:=s1[i] and not(s2[i]);
end; end;
@ -152,4 +194,24 @@ unit optbase;
result:=false; result:=false;
end; end;
procedure PrintDFASet(var f : text;s : TDFASet);
var
i : integer;
first : boolean;
begin
first:=true;
for i:=0 to Length(s)*8 do
begin
if DFASetIn(s,i) then
begin
if not(first) then
write(f,',');
write(f,i);
first:=false;
end;
end;
end;
end. end.

190
compiler/optdfa.pas
View File

@ -19,6 +19,10 @@
**************************************************************************** ****************************************************************************
} }
{ $define DEBUG_DFA}
{ this unit implements routines to perform dfa }
unit optdfa; unit optdfa;
{$i fpcdefs.inc} {$i fpcdefs.inc}
@ -32,18 +36,21 @@ unit optdfa;
if the tree has been changed without updating dfa } if the tree has been changed without updating dfa }
procedure resetdfainfo(node : tnode); procedure resetdfainfo(node : tnode);
procedure createoptinfo(node : tnode); procedure createdfainfo(node : tnode);
implementation implementation
uses uses
globtype,globals, globtype,globals,
verbose,
cpuinfo, cpuinfo,
symdef,
nutils, nutils,
nbas,nflw,ncon,ninl,ncal, nbas,nflw,ncon,ninl,ncal,
optutils; optbase,optutils;
(*
function initnodes(var n:tnode; arg: pointer) : foreachnoderesult; function initnodes(var n:tnode; arg: pointer) : foreachnoderesult;
begin begin
{ node worth to add? } { node worth to add? }
@ -56,7 +63,7 @@ unit optdfa;
else else
result:=fen_norecurse_false; result:=fen_norecurse_false;
end; end;
*)
{ {
x:=f; read: [f] x:=f; read: [f]
@ -85,61 +92,104 @@ unit optdfa;
type type
tdfainfo = record tdfainfo = record
use : TDFASet; use : PDFASet;
def : TDFASet; def : PDFASet;
map : TIndexedNodeSet map : TIndexedNodeSet
end; end;
pdfainfo = ^tdfainfo;
procedure AddDefUse(s : TDFASet;m : ;n : tnode); function AddDefUse(var n: tnode; arg: pointer): foreachnoderesult;
begin begin
while true do case n.nodetype of
begin loadn:
case n.nodetype of begin
typeconvn: pdfainfo(arg)^.map.Add(n);
n:=ttypeconvnode(n).left; if nf_write in n.flags then
loadn: DFASetInclude(pdfainfo(arg)^.def^,n.optinfo^.index)
begin
m.Add(n);
TDFASetInclude(s,n.optinfo^.index);
end;
else else
internalerror(2007050601); DFASetInclude(pdfainfo(arg)^.use^,n.optinfo^.index);
{
write('Use Set: ');
PrintDFASet(output,pdfainfo(arg)^.use^);
write(' Def Set: ');
PrintDFASet(output,pdfainfo(arg)^.def^);
writeln;
}
end; end;
end; end;
result:=fen_false;
end; end;
procedure CreateLifeInfo(node : tnode); procedure CreateLifeInfo(node : tnode;map : TIndexedNodeSet);
var var
changed : boolean; changed : boolean;
procedure CreateInfo(node : tnode); procedure CreateInfo(node : tnode);
{ update life entry of a node with l, set changed if this changes
life info for the node
}
procedure updatelifeinfo(n : tnode;l : TDFASet); procedure updatelifeinfo(n : tnode;l : TDFASet);
var
b : boolean;
begin begin
changed:=changed or DFASetNotEqual(l,n.life); b:=DFASetNotEqual(l,n.optinfo^.life);
node.life:=l; {
if b then
begin
printnode(output,n);
printdfaset(output,l);
writeln;
printdfaset(output,n.optinfo^.life);
writeln;
end;
}
changed:=changed or b;
node.optinfo^.life:=l;
end; end;
procedure calclife(n : tnode); procedure calclife(n : tnode);
var var
l : TDFANode; l : TDFASet;
begin begin
if assigned(successor) then n.allocoptinfo;
if assigned(n.successor) then
begin begin
DFASetDiff(l,successor.optinfo^.life,n.optinfo^.def); {
write('Successor Life: ');
printdfaset(output,n.successor.optinfo^.life);
writeln;
write('Def.');
printdfaset(output,n.optinfo^.def);
writeln;
}
{ ensure we can access optinfo }
DFASetDiff(l,n.successor.optinfo^.life,n.optinfo^.def);
{
printdfaset(output,l);
writeln;
}
DFASetIncludeSet(l,n.optinfo^.use); DFASetIncludeSet(l,n.optinfo^.use);
updatelifeinfo(n,l); DFASetIncludeSet(l,n.optinfo^.life);
end end
end else
l:=n.optinfo^.use;
updatelifeinfo(n,l);
end;
var var
dfainfo : tdfainfo; dfainfo : tdfainfo;
l : TDFASet;
begin begin
if node=nil then
exit;
if nf_processing in node.flags then if nf_processing in node.flags then
exit; exit;
include(node,nf_processing); include(node.flags,nf_processing);
if assigned(node.successor) then if assigned(node.successor) then
CreateInfo(node.successor); CreateInfo(node.successor);
@ -147,20 +197,36 @@ unit optdfa;
{ life:=succesorlive-definition+use } { life:=succesorlive-definition+use }
case node.nodetype of case node.nodetype of
whilen: whilerepeatn:
begin begin
{ first, do things as usual, get life information from the successor } calclife(node);
if lnf_testatbegin in twhilerepeatnode(node).loopflags then
begin
{ first, do things as usual, get life information from the successor }
node.allocoptinfo;
if not(assigned(node.optinfo^.def)) and
not(assigned(node.optinfo^.use)) then
begin
dfainfo.use:=@node.optinfo^.use;
dfainfo.def:=@node.optinfo^.def;
dfainfo.map:=map;
foreachnodestatic(pm_postprocess,twhilerepeatnode(node).left,@AddDefUse,@dfainfo);
end;
calclife(node);
{ life:=succesorlive-definition+use } { now iterate through the loop }
CreateInfo(twhilerepeatnode(node).right);
{ now iterate through the loop } { update while node }
CreateInfo(twhilenode(node).left); { life:=life+use+right.life }
l:=node.optinfo^.life;
DFASetIncludeSet(l,node.optinfo^.use);
DFASetIncludeSet(l,twhilerepeatnode(node).right.optinfo^.life);
UpdateLifeInfo(node,l);
{ update while node } { ... and a second iteration for fast convergence }
{ life:=life+left.life } CreateInfo(twhilerepeatnode(node).right);
end;
{ ... and a second iteration for fast convergence }
CreateInfo(twhilenode(node).left);
end; end;
statementn: statementn:
begin begin
@ -168,30 +234,58 @@ unit optdfa;
case tstatementnode(node).statement.nodetype of case tstatementnode(node).statement.nodetype of
assignn: assignn:
begin begin
tstatementnode(node).allocoptinfo; node.allocoptinfo;
if not(assigned(tstatementnode(node).optinfo^.def)) or if not(assigned(node.optinfo^.def)) and
not(assigned(tstatementnode(node).optinfo^.use)) then not(assigned(node.optinfo^.use)) then
begin begin
dfainfo.use:=tstatementnode(node).optinfo^.use; dfainfo.use:=@node.optinfo^.use;
dfainfo.def:=tstatementnode(node).optinfo^.def; dfainfo.def:=@node.optinfo^.def;
Foreach dfainfo.map:=map;
foreachnodestatic(pm_postprocess,tstatementnode(node).left,@AddDefUse,@dfainfo);
end; end;
calclife(node); calclife(node);
end; end;
else
begin
{ nested statement }
CreateInfo(tstatementnode(node).statement);
{ inherit info }
node.allocoptinfo;
node.optinfo^.life:=tstatementnode(node).statement.optinfo^.life;
end;
end; end;
end; end;
blockn:
begin
CreateInfo(tblocknode(node).statements);
node.allocoptinfo;
if assigned(tblocknode(node).statements) then
node.optinfo^.life:=tblocknode(node).statements.optinfo^.life;
end;
else else
internalerror(2007050502); internalerror(2007050502);
end; end;
exclude(node,nf_processing); exclude(node.flags,nf_processing);
end; end;
var
runs : integer;
begin begin
runs:=0;
repeat repeat
inc(runs);
changed:=false; changed:=false;
CreateInfo(node); CreateInfo(node);
{$ifdef DEBUG_DFA}
PrintIndexedNodeSet(output,map);
PrintDFAInfo(output,node);
{$endif DEBUG_DFA}
until not(changed); until not(changed);
{$ifdef DEBUG_DFA}
writeln('DFA solver iterations: ',runs);
{$endif DEBUG_DFA}
end; end;
@ -203,13 +297,17 @@ unit optdfa;
procedure createdfainfo(node : tnode); procedure createdfainfo(node : tnode);
var
map : TIndexedNodeSet;
begin begin
map:=TIndexedNodeSet.Create;
{ add controll flow information } { add controll flow information }
SetNodeSucessors(node); SetNodeSucessors(node);
{ now, collect life information } { now, collect life information }
CreateLifeInfo(node); CreateLifeInfo(node,map);
map.free;
end; end;
end. end.

88
compiler/optutils.pas
View File

@ -26,6 +26,7 @@ unit optutils;
interface interface
uses uses
cclasses,
node; node;
type type
@ -37,16 +38,16 @@ unit optutils;
function Remove(node : tnode) : boolean; function Remove(node : tnode) : boolean;
end; end;
TNodeMap = class(TNodeSet)
function (node : tnode) : boolean;
end;
procedure SetNodeSucessors(p : tnode); procedure SetNodeSucessors(p : tnode);
procedure PrintDFAInfo(var f : text;p : tnode);
procedure PrintIndexedNodeSet(var f : text;s : TIndexedNodeSet);
implementation implementation
uses uses
nbas,nflw; verbose,
optbase,
nbas,nflw,nutils;
function TIndexedNodeSet.Add(node : tnode) : boolean; function TIndexedNodeSet.Add(node : tnode) : boolean;
var var
@ -62,7 +63,7 @@ unit optutils;
end end
else else
begin begin
i:=Add(node); i:=inherited Add(node);
node.optinfo^.index:=i; node.optinfo^.index:=i;
result:=true; result:=true;
end end
@ -73,10 +74,10 @@ unit optutils;
var var
i : longint; i : longint;
begin begin
for i:=0 to FCount-1 do for i:=0 to Count-1 do
if tnode(FList^[i]).isequal(node) then if tnode(List^[i]).isequal(node) then
begin begin
result:=tnode(FList^[i]); result:=tnode(List^[i]);
exit; exit;
end; end;
result:=nil; result:=nil;
@ -91,23 +92,47 @@ unit optutils;
p:=Includes(node); p:=Includes(node);
if assigned(p) then if assigned(p) then
begin begin
if Remove(p)<>-1 then if inherited Remove(p)<>-1 then
result:=true; result:=true;
end; end;
end; end;
procedure PrintIndexedNodeSet(f : text;s : TIndexedNodeSet); procedure PrintIndexedNodeSet(var f : text;s : TIndexedNodeSet);
var
i : integer;
begin begin
for i:=0 to high(s) do for i:=0 to s.count-1 do
begin begin
writeln(f,'=============================== Node ',i,' ==============================='); writeln(f,'=============================== Node ',i,' ===============================');
printnode(f,s[i]); printnode(f,tnode(s[i]));
writeln(f); writeln(f);
end; end;
end; end;
function PrintNodeDFA(var n: tnode; arg: pointer): foreachnoderesult;
begin
if assigned(n.optinfo) and ((n.optinfo^.life<>nil) or (n.optinfo^.use<>nil) or (n.optinfo^.def<>nil)) then
begin
write(text(arg^),nodetype2str[n.nodetype],'(',n.fileinfo.line,',',n.fileinfo.column,') Life: ');
PrintDFASet(text(arg^),n.optinfo^.life);
write(text(arg^),' Def: ');
PrintDFASet(text(arg^),n.optinfo^.def);
write(text(arg^),' Use: ');
PrintDFASet(text(arg^),n.optinfo^.use);
writeln(text(arg^));
end;
result:=fen_false;
end;
procedure PrintDFAInfo(var f : text;p : tnode);
begin
foreachnodestatic(pm_postprocess,p,@PrintNodeDFA,@f);
end;
procedure SetNodeSucessors(p : tnode); procedure SetNodeSucessors(p : tnode);
var var
Continuestack : TFPList; Continuestack : TFPList;
@ -119,6 +144,8 @@ unit optutils;
hp1,hp2 : tnode; hp1,hp2 : tnode;
begin begin
result:=nil; result:=nil;
if p=nil then
exit;
case p.nodetype of case p.nodetype of
statementn: statementn:
begin begin
@ -126,36 +153,41 @@ unit optutils;
result:=p; result:=p;
while assigned(hp1) do while assigned(hp1) do
begin begin
if assigned(tstatementnode(hp1).right) then { does another statement follow? }
if assigned(tstatementnode(hp1).next) then
begin begin
hp2:=DoSet(tstatementnode(hp1).statement,tstatementnode(hp1).next); hp2:=DoSet(tstatementnode(hp1).statement,tstatementnode(hp1).next);
if assigned(hp2) then if assigned(hp2) then
tstatementnode(hp1).successor:=hp2 tstatementnode(hp1).successor:=hp2
else else
tstatementnode(hp1).successor:=tstatementnode(hp1).right; tstatementnode(hp1).successor:=tstatementnode(hp1).next;
end end
else else
begin begin
hp2:=DoSet(tstatementnode(hp1).statement,successor); hp2:=DoSet(tstatementnode(hp1).statement,succ);
if assigned(hp2) then if assigned(hp2) then
tstatementnode(hp1).successor:=hp2 tstatementnode(hp1).successor:=hp2
else else
tstatementnode(hp1).successor:=successor; tstatementnode(hp1).successor:=succ;
end; end;
hp1:=tstatementnode(hp1).next;
end; end;
end; end;
blockn: blockn:
begin begin
result:=DoSet(tblocknode(p).statements,successor); result:=p;
DoSet(tblocknode(p).statements,succ);
p.successor:=succ;
end; end;
forn: forn:
begin begin
Breakstack.Add(successor); Breakstack.Add(succ);
Continuestack.Add(p); Continuestack.Add(p);
result:=p; result:=p;
DoSet(tfornode(p).statements,successor); { the successor of the last node of the for body is the for node itself }
Breakstack.Delete(Count-1); DoSet(tfornode(p).t2,p);
Continuestack.Delete(Count-1); Breakstack.Delete(Breakstack.Count-1);
Continuestack.Delete(Continuestack.Count-1);
end; end;
breakn: breakn:
begin begin
@ -167,6 +199,17 @@ unit optutils;
result:=p; result:=p;
p.successor:=tnode(Continuestack.Last); p.successor:=tnode(Continuestack.Last);
end; end;
whilerepeatn:
begin
Breakstack.Add(succ);
Continuestack.Add(p);
result:=p;
{ the successor of the last node of the for body is the while node itself }
DoSet(twhilerepeatnode(p).right,p);
p.successor:=succ;
Breakstack.Delete(Breakstack.Count-1);
Continuestack.Delete(Continuestack.Count-1);
end;
{ exit is actually a jump to some final. code { exit is actually a jump to some final. code
exitn: exitn:
begin begin
@ -175,7 +218,6 @@ unit optutils;
end; end;
} }
ifn, ifn,
whilerepeatn,
exitn, exitn,
withn, withn,
casen, casen,

8
compiler/psub.pas
View File

@ -103,7 +103,8 @@ implementation
tgobj,cgbase,cgobj,dbgbase, tgobj,cgbase,cgobj,dbgbase,
ncgutil,regvars, ncgutil,regvars,
opttail, opttail,
optcse optcse,
optdfa
{$if defined(arm) or defined(powerpc) or defined(powerpc64)} {$if defined(arm) or defined(powerpc) or defined(powerpc64)}
,aasmcpu ,aasmcpu
{$endif arm} {$endif arm}
@ -755,6 +756,11 @@ implementation
(pi_is_recursive in flags) then (pi_is_recursive in flags) then
do_opttail(code,procdef); do_opttail(code,procdef);
if cs_opt_nodedfa in current_settings.optimizerswitches then
begin
createdfainfo(code);
end;
if cs_opt_nodecse in current_settings.optimizerswitches then if cs_opt_nodecse in current_settings.optimizerswitches then
do_optcse(code); do_optcse(code);