paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-11 16:09:22 +02:00
Code Issues Packages Projects Releases Wiki Activity

* nflw.pas: Add lnf_simplify_processing loopflag value.

Browse Source 
* nutils.pas: Adapt dosimplify to handle loop nodes so that the condition
  is simplified before any of the possible alternatives to avoid compilation
  failures as was appearing for a while on 64-bit compiler if DEBUG=1 was used.

git-svn-id: trunk@15848 -
This commit is contained in:
pierre 2010-08-18 16:08:30 +00:00
parent 6adfa3999d
commit 11654d5f8c
2 changed files with 68 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
compiler/nflw.pas
View File

@ -45,7 +45,9 @@ interface
{ Negate the loop test? }
lnf_checknegate,
{ Should the value of the loop variable on exit be correct. }
lnf_dont_mind_loopvar_on_exit);
lnf_dont_mind_loopvar_on_exit,
{ Loop simplify flag }
lnf_simplify_processing);
tloopflags = set of tloopflag;
const
@ -1830,7 +1832,7 @@ implementation
include(current_procinfo.flags,pi_has_label);
if assigned(labsym) and labsym.nonlocal then
if assigned(labsym) and labsym.nonlocal then
include(current_procinfo.flags,pi_has_interproclabel);
if assigned(left) then

83
compiler/nutils.pas
View File

@ -46,7 +46,8 @@ interface
fen_norecurse_true
);
tforeachprocmethod = (pm_preprocess,pm_postprocess);
tforeachprocmethod = (pm_preprocess,pm_postprocess,
pm_postandagain);
foreachnodefunction = function(var n: tnode; arg: pointer): foreachnoderesult of object;
staticforeachnodefunction = function(var n: tnode; arg: pointer): foreachnoderesult;
@ -183,8 +184,22 @@ implementation
fen_false:
result := false; }
end;
if procmethod=pm_postprocess then
if (procmethod=pm_postprocess) or (procmethod=pm_postandagain) then
result:=process_children(result);
if procmethod=pm_postandagain then
begin
case f(n,arg) of
fen_norecurse_false:
exit;
fen_norecurse_true:
begin
result := true;
exit;
end;
fen_true:
result := true;
end;
end;
end;
@ -266,8 +281,22 @@ implementation
fen_false:
result := false; }
end;
if procmethod=pm_postprocess then
if (procmethod=pm_postprocess) or (procmethod=pm_postandagain) then
result:=process_children(result);
if procmethod=pm_postandagain then
begin
case f(n,arg) of
fen_norecurse_false:
exit;
fen_norecurse_true:
begin
result := true;
exit;
end;
fen_true:
result := true;
end;
end;
end;
@ -929,38 +958,54 @@ implementation
foreachnodestatic(n,@setnodefilepos,@filepos);
end;
{$ifdef FPCMT}
threadvar
{$else FPCMT}
var
{$endif FPCMT}
treechanged : boolean;
function callsimplify(var n: tnode; arg: pointer): foreachnoderesult;
var
hn : tnode;
treechanged : ^boolean;
begin
result:=fen_false;
// do_typecheckpass(n);
hn:=n.simplify;
if assigned(hn) then
if n.inheritsfrom(tloopnode) and
not (lnf_simplify_processing in tloopnode(n).loopflags) then
begin
treechanged:=true;
n.free;
n:=hn;
typecheckpass(n);
// Try to simplify condition
dosimplify(tloopnode(n).left);
// call directly second part below,
// which might change the loopnode into
// something else if the conditino is a constant node
include(tloopnode(n).loopflags,lnf_simplify_processing);
callsimplify(n,arg);
// Be careful, n might have change node type
if n.inheritsfrom(tloopnode) then
exclude(tloopnode(n).loopflags,lnf_simplify_processing);
end
else
begin
hn:=n.simplify;
if assigned(hn) then
begin
treechanged := arg;
if assigned(treechanged) then
treechanged^:=true
else
internalerror (201008181);
n.free;
n:=hn;
typecheckpass(n);
end;
end;
end;
{ tries to simplify the given node calling the simplify method recursively }
procedure dosimplify(var n : tnode);
var
treechanged : boolean;
begin
// Optimize if code first
repeat
treechanged:=false;
foreachnodestatic(pm_preprocess,n,@callsimplify,nil);
foreachnodestatic(pm_postandagain,n,@callsimplify,@treechanged);
until not(treechanged);
end;