paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-12-16 05:50:40 +01:00
Code Issues Packages Projects Releases Wiki Activity

* nf_pass1_done, nf_error, nf_processing and nf_do_not_execute

Browse Source 
have been moved to a new "transientflags" node field that
    isn't stored in PPU files
This commit is contained in:
J. Gareth "Curious Kit" Moreton 2024-03-03 01:39:28 +00:00 committed by FPK
parent dd858f37aa
commit 2b7df4237b
18 changed files with 116 additions and 78 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
compiler/aarch64/ncpuadd.pas
View File

@ -415,7 +415,7 @@ interface
secondpass(left);
{ Skip the not node completely }
Include(right.flags, nf_do_not_execute);
Include(right.transientflags, tnf_do_not_execute);
secondpass(tnotnode(right).left);
{ allocate registers }

2
compiler/hlcgobj.pas
View File

@ -4478,7 +4478,7 @@ implementation
var
storepos : tfileposinfo;
begin
if nf_error in p.flags then
if tnf_error in p.transientflags then
exit;
storepos:=current_filepos;
current_filepos:=p.fileinfo;

2
compiler/nadd.pas
View File

@ -1906,7 +1906,7 @@ implementation
else
nt:=equaln;
result:=caddnode.create(nt,t,cordconstnode.create(0,vl.resultdef,false));
Include(flags, nf_do_not_execute);
Include(transientflags,tnf_do_not_execute);
if t=left then
left:=nil
else

2
compiler/nbas.pas
View File

@ -471,7 +471,7 @@ implementation
function terrornode.pass_typecheck:tnode;
begin
result:=nil;
include(flags,nf_error);
include(transientflags,tnf_error);
codegenerror:=true;
resultdef:=generrordef;
end;

2
compiler/ncal.pas
View File

@ -5602,7 +5602,7 @@ implementation
typecheckpass(tnode(inlineblock));
doinlinesimplify(tnode(inlineblock));
node_reset_flags(tnode(inlineblock),[nf_pass1_done]);
node_reset_flags(tnode(inlineblock),[],[tnf_pass1_done]);
firstpass(tnode(inlineblock));
result:=inlineblock;

2
compiler/ncgutil.pas
View File

@ -236,7 +236,7 @@ implementation
storepos : tfileposinfo;
tmpreg : tregister;
begin
if nf_error in p.flags then
if tnf_error in p.transientflags then
exit;
storepos:=current_filepos;
current_filepos:=p.fileinfo;

6
compiler/nflw.pas
View File

@ -1860,7 +1860,7 @@ implementation
(cs_opt_loopunroll in current_settings.optimizerswitches) and
assigned(t2) and
{ statements must be error free }
not(nf_error in t2.flags) then
not(tnf_error in t2.transientflags) then
begin
typecheckpass(t2);
res:=t2.simplify(false);
@ -1925,7 +1925,7 @@ implementation
begin
{ get rid of nf_write etc. as the left node is now only read }
leftcopy:=left.getcopy;
node_reset_flags(leftcopy,[nf_pass1_done,nf_modify,nf_write]);
node_reset_flags(leftcopy,[nf_modify,nf_write],[tnf_pass1_done]);
if fw then
addstatement(s,
@ -2079,7 +2079,7 @@ implementation
{ get rid of nf_write etc. as the left node is now only read }
leftcopy:=left.getcopy;
node_reset_flags(leftcopy,[nf_pass1_done,nf_modify,nf_write]);
node_reset_flags(leftcopy,[nf_modify,nf_write],[tnf_pass1_done]);
if needsifblock then
begin

90
compiler/node.pas
View File

@ -208,14 +208,10 @@ interface
type
{ all boolean field of ttree are now collected in flags }
tnodeflag = (
{ tbinop operands can be swaped }
nf_swapable,
{ tbinop operands are swaped }
nf_swapped,
nf_error,
{ general }
nf_pass1_done,
{ Node is written to }
nf_write,
{ Node is modified }
@ -224,7 +220,6 @@ interface
nf_address_taken,
nf_is_funcret,
nf_isproperty,
nf_processing,
{ Node cannot be assigned to }
nf_no_lvalue,
{ this node is the user code entry, if a node with this flag is removed
@ -255,19 +250,34 @@ interface
nf_ignore_for_wpo, { we know that this loadvmtaddrnode cannot be used to construct a class instance }
{ node is derived from generic parameter }
nf_generic_para,
{ internal flag to indicate that this node has been removed from the tree or must otherwise not be
execute. Running it through firstpass etc. will raise an internal error }
nf_do_not_execute
nf_generic_para
);
tnodeflags = set of tnodeflag;
TTransientNodeFlag = (
{ general }
tnf_pass1_done,
tnf_error,
{ tbinop operands can be swaped }
tnf_swapable,
tnf_processing,
{ internal flag to indicate that this node has been removed from the tree or must otherwise not be
execute. Running it through firstpass etc. will raise an internal error }
tnf_do_not_execute
);
TTransientNodeFlags = set of TTransientNodeFlag;
const
{ contains the flags which must be equal for the equality }
{ of nodes }
flagsequal : tnodeflags = [nf_error];
flagsequal : tnodeflags = [];
transientflagsequal : TTransientNodeFlags = [tnf_error];
type
tnodelist = class
@ -296,6 +306,7 @@ interface
successor : tnode;
{ there are some properties about the node stored }
flags : tnodeflags;
transientflags : TTransientNodeFlags;
resultdef : tdef;
resultdefderef : tderef;
fileinfo : tfileposinfo;
@ -759,7 +770,7 @@ implementation
ppufile.getset(tppuset5(localswitches));
verbosity:=ppufile.getlongint;
ppufile.getderef(resultdefderef);
ppufile.getset(tppuset4(flags));
ppufile.getset(tppuset2(flags));
{ updated by firstpass }
expectloc:=LOC_INVALID;
{ updated by secondpass }
@ -774,7 +785,7 @@ implementation
ppufile.putset(tppuset5(localswitches));
ppufile.putlongint(verbosity);
ppufile.putderef(resultdefderef);
ppufile.putset(tppuset4(flags));
ppufile.putset(tppuset2(flags));
end;
@ -867,7 +878,7 @@ implementation
write(t, i);
end;
write(t,']');
if (nf_pass1_done in flags) then
if (tnf_pass1_done in transientflags) then
write(t,', cmplx = ',node_complexity(self));
if assigned(optinfo) then
write(t,', optinfo = ',HexStr(optinfo));
@ -895,7 +906,8 @@ implementation
instead call XMLPrintNode to write a complete tree }
procedure tnode.XMLPrintNodeInfo(var T: Text);
var
i: TNodeFlag;
i_nf: TNodeFlag;
i_tnf: TTransientNodeFlag;
first: Boolean;
begin
if Assigned(resultdef) then
@ -904,19 +916,31 @@ implementation
Write(T,' pos="',fileinfo.line,',',fileinfo.column);
First := True;
for i := Low(TNodeFlag) to High(TNodeFlag) do
if i in flags then
begin
if First then
begin
Write(T, '" flags="', i);
First := False;
end
else
Write(T, ',', i)
end;
write(t,'"');
if (nf_pass1_done in flags) then
for i_nf in flags do
begin
if First then
begin
Write(T, '" flags="', i_nf);
First := False;
end
else
Write(T, ',', i_nf)
end;
First := True;
for i_tnf in transientflags do
begin
if First then
begin
Write(T, '" transientflags="', i_tnf);
First := False;
end
else
Write(T, ',', i_tnf)
end;
write(T,'"');
if (tnf_pass1_done in transientflags) then
write(t,' complexity="',node_complexity(self),'"');
end;
@ -947,6 +971,7 @@ implementation
(p.classtype=classtype) and
(p.nodetype=nodetype) and
(flags*flagsequal=p.flags*flagsequal) and
(transientflags*transientflagsequal=p.transientflags*transientflagsequal) and
docompare(p));
end;
@ -1000,6 +1025,7 @@ implementation
p.expectloc:=expectloc;
p.location:=location;
p.flags:=flags;
p.transientflags:=transientflags;
p.resultdef:=resultdef;
p.fileinfo:=fileinfo;
p.localswitches:=localswitches;
@ -1128,7 +1154,7 @@ implementation
begin
Result := left;
left := nil;
Include(flags, nf_do_not_execute);
Include(transientflags, tnf_do_not_execute);
end;
@ -1282,7 +1308,7 @@ implementation
begin
Result := right;
right := nil;
Include(flags, nf_do_not_execute);
Include(transientflags, tnf_do_not_execute);
end;
@ -1397,7 +1423,7 @@ implementation
begin
Result := third;
third := nil;
Include(flags, nf_do_not_execute);
Include(transientflags, tnf_do_not_execute);
end;
@ -1415,7 +1441,7 @@ implementation
begin
docompare:=(inherited docompare(p)) or
{ if that's in the flags, is p then always a tbinopnode (?) (JM) }
((nf_swapable in flags) and
((tnf_swapable in transientflags) and
left.isequal(tbinopnode(p).right) and
right.isequal(tbinopnode(p).left));
end;

22
compiler/nutils.pas
View File

@ -162,7 +162,7 @@ interface
function get_open_const_array(p : tnode) : tnode;
{ excludes the flags passed in nf from the node tree passed }
procedure node_reset_flags(p : tnode;nf : tnodeflags);
procedure node_reset_flags(p : tnode;nf : TNodeFlags; tnf : TTransientNodeFlags);
{ include or exclude cs from p.localswitches }
procedure node_change_local_switch(p : tnode;cs : tlocalswitch;enable : boolean);
@ -1565,17 +1565,28 @@ implementation
result:=get_open_const_array(taddrnode(tderefnode(result).left).left);
end;
type
TFlagSet = record
nf : TNodeFlags;
tnf : TTransientNodeFlags;
end;
function do_node_reset_flags(var n: tnode; arg: pointer): foreachnoderesult;
begin
result:=fen_false;
n.flags:=n.flags-tnodeflags(arg^);
n.flags:=n.flags-TFlagSet(arg^).nf;
n.transientflags:=n.transientflags-TFlagSet(arg^).tnf;
end;
procedure node_reset_flags(p : tnode; nf : tnodeflags);
procedure node_reset_flags(p : tnode; nf : TNodeFlags; tnf : TTransientNodeFlags);
var
FlagSet: TFlagSet;
begin
foreachnodestatic(p,@do_node_reset_flags,@nf);
FlagSet.nf:=nf;
FlagSet.tnf:=tnf;
foreachnodestatic(p,@do_node_reset_flags,@FlagSet);
end;
type
@ -1709,7 +1720,8 @@ implementation
function _node_reset_pass1_write(var n: tnode; arg: pointer): foreachnoderesult;
begin
Result := fen_false;
n.flags := n.flags - [nf_pass1_done,nf_write,nf_modify];
n.flags := n.flags - [nf_write,nf_modify];
n.transientflags := n.transientflags - [tnf_pass1_done];
if n.nodetype = assignn then
begin
{ Force re-evaluation of assignments so nf_modify and nf_write

2
compiler/optconstprop.pas
View File

@ -288,7 +288,7 @@ unit optconstprop;
if n.nodetype<>callparan then
begin
if tree_modified then
exclude(n.flags,nf_pass1_done);
exclude(n.transientflags,tnf_pass1_done);
do_firstpass(n);
end;

2
compiler/optcse.pas
View File

@ -398,7 +398,7 @@ unit optcse;
{ the transformed tree could result in new possibilities to fold constants
so force a firstpass on the root node }
exclude(tbinarynode(n).right.flags,nf_pass1_done);
exclude(tbinarynode(n).right.transientflags,tnf_pass1_done);
do_firstpass(tbinarynode(n).right);
end
else

12
compiler/optdfa.pas
View File

@ -148,7 +148,7 @@ unit optdfa;
function ResetProcessing(var n: tnode; arg: pointer): foreachnoderesult;
begin
exclude(n.flags,nf_processing);
exclude(n.transientflags,tnf_processing);
{ dfa works only on normalized trees, so do not recurse into expressions, because
ResetProcessing eats a signififcant amount of time of CheckAndWarn
@ -237,9 +237,9 @@ unit optdfa;
{ ensure we've already optinfo set }
node.allocoptinfo;
if nf_processing in node.flags then
if tnf_processing in node.transientflags then
exit;
include(node.flags,nf_processing);
include(node.transientflags,tnf_processing);
if assigned(node.successor) then
CreateInfo(node.successor);
@ -609,7 +609,7 @@ unit optdfa;
CreateInfo(node);
foreachnodestatic(pm_postprocess,node,@ResetProcessing,nil);
{ the result node is not reached by foreachnodestatic }
exclude(resultnode.flags,nf_processing);
exclude(resultnode.transientflags,tnf_processing);
{$ifdef DEBUG_DFA}
PrintIndexedNodeSet(output,map);
PrintDFAInfo(output,node);
@ -895,9 +895,9 @@ unit optdfa;
if node=nil then
exit;
if nf_processing in node.flags then
if tnf_processing in node.transientflags then
exit;
include(node.flags,nf_processing);
include(node.transientflags,tnf_processing);
if not(assigned(node.optinfo)) or not(DFASetIn(node.optinfo^.life,nodetosearch.optinfo^.index)) then
exit;

2
compiler/optloop.pas
View File

@ -675,7 +675,7 @@ unit optloop;
cordconstnode.create(1,tfornode(n).left.resultdef,false));
tfornode(n).t1:=cordconstnode.create(1,tfornode(n).left.resultdef,false);
include(tfornode(n).loopflags,lnf_counter_not_used);
exclude(n.flags,nf_pass1_done);
exclude(n.transientflags,tnf_pass1_done);
do_firstpass(n);
{$ifdef DEBUG_OPTFORLOOP}
writeln('Loop reverted: ');

20
compiler/pass_1.pas
View File

@ -87,7 +87,7 @@ implementation
assigned(hp.resultdef);
if codegenerror then
begin
include(p.flags,nf_error);
include(p.transientflags,tnf_error);
{ default to errortype if no type is set yet }
if p.resultdef=nil then
p.resultdef:=generrordef;
@ -117,7 +117,7 @@ implementation
else
begin
{ update the codegenerror boolean with the previous result of this node }
if (nf_error in p.flags) then
if (tnf_error in p.transientflags) then
codegenerror:=true;
end;
end;
@ -156,10 +156,10 @@ implementation
hp : tnode;
nodechanged : boolean;
begin
if (nf_pass1_done in p.flags) then
if (tnf_pass1_done in p.transientflags) then
exit;
if not(nf_error in p.flags) then
if not(tnf_error in p.transientflags) then
begin
oldcodegenerror:=codegenerror;
oldpos:=current_filepos;
@ -168,8 +168,8 @@ implementation
codegenerror:=false;
repeat
{ The error flag takes precedence over the 'do not execute' flag,
as its assumed the node tree isn't tenable beyond this point }
if (nf_do_not_execute in p.flags) then
as it's assumed the node tree isn't tenable beyond this point }
if (tnf_do_not_execute in p.transientflags) then
InternalError(2022112401);
{ checks make always a call }
@ -182,7 +182,7 @@ implementation
end;
hp:=nil;
if not(nf_error in p.flags) then
if not(tnf_error in p.transientflags) then
begin
current_filepos:=p.fileinfo;
current_settings.localswitches:=p.localswitches;
@ -201,11 +201,11 @@ implementation
p:=hp;
end;
if codegenerror then
include(p.flags,nf_error);
include(p.transientflags,tnf_error);
end;
until not assigned(hp) or
(nf_pass1_done in hp.flags);
include(p.flags,nf_pass1_done);
(tnf_pass1_done in hp.transientflags);
include(p.transientflags,tnf_pass1_done);
{$ifdef EXTDEBUG}
if not(nf_error in p.flags) then
begin

10
compiler/pass_2.pas
View File

@ -187,11 +187,11 @@ implementation
begin
if not assigned(p) then
internalerror(200208221);
if not(nf_error in p.flags) then
if not(tnf_error in p.transientflags) then
begin
{ The error flag takes precedence over the 'do not execute' flag,
as its assumed the node tree isn't tenable beyond this point }
if (nf_do_not_execute in p.flags) then
as it's assumed the node tree isn't tenable beyond this point }
if (tnf_do_not_execute in p.transientflags) then
InternalError(2022112402);
oldcodegenerror:=codegenerror;
@ -237,7 +237,7 @@ implementation
end;
{$endif EXTDEBUG}
if codegenerror then
include(p.flags,nf_error);
include(p.transientflags,tnf_error);
codegenerror:=codegenerror or oldcodegenerror;
current_settings.localswitches:=oldlocalswitches;
current_filepos:=oldpos;
@ -256,7 +256,7 @@ implementation
{ clear errors before starting }
codegenerror:=false;
if not(nf_error in p.flags) then
if not(tnf_error in p.transientflags) then
secondpass(p);
do_secondpass:=codegenerror;
end;

2
compiler/ppu.pas
View File

@ -48,7 +48,7 @@ const
CurrentPPUVersion = 208;
{ for any other changes to the ppu format, increase this version number
(it's a cardinal) }
CurrentPPULongVersion = 23;
CurrentPPULongVersion = 24;
{ unit flags }
uf_big_endian = $000004;

8
compiler/x86/nx86add.pas
View File

@ -1976,7 +1976,7 @@ unit nx86add;
secondpass(left);
{ Skip the not node completely }
Include(right.flags, nf_do_not_execute);
Include(right.transientflags, tnf_do_not_execute);
secondpass(tnotnode(right).left);
{ allocate registers }
@ -2051,8 +2051,8 @@ unit nx86add;
secondpass(left);
{ Skip the subtract and shift nodes completely }
Include(right.flags, nf_do_not_execute);
Include(taddnode(right).left.flags, nf_do_not_execute);
Include(right.transientflags, tnf_do_not_execute);
Include(taddnode(right).left.transientflags, tnf_do_not_execute);
{ Helps avoid all the awkward typecasts }
indexnode := tshlshrnode(taddnode(right).left).right;
@ -2063,7 +2063,7 @@ unit nx86add;
begin
{ Convert to the 32-bit type }
indexnode.resultdef := resultdef;
node_reset_flags(indexnode,[nf_pass1_done]);
node_reset_flags(indexnode,[],[tnf_pass1_done]);
{ We should't be getting any new errors }
if do_firstpass(indexnode) then

6
compiler/x86/nx86inl.pas
View File

@ -658,15 +658,15 @@ implementation
(def_cgsize(TTypeConvNode(indexnode).resultdef) in [OS_64, OS_S64]) then
begin
{ Convert to the 32-bit type }
indexnode.resultdef := loadnode.resultdef;
node_reset_flags(indexnode,[nf_pass1_done]);
indexnode.resultdef:=loadnode.resultdef;
node_reset_flags(indexnode,[],[tnf_pass1_done]);
{ We should't be getting any new errors }
if do_firstpass(indexnode) then
InternalError(2022110202);
{ Keep things internally consistent in case indexnode changed }
tshlshrnode(taddnode(valuenode).left).right := indexnode;
tshlshrnode(taddnode(valuenode).left).right:=indexnode;
end;
{$endif x86_64}
secondpass(indexnode);