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

* Flags specific to TVecNode have been moved to their own field

Browse Source
This commit is contained in:
J. Gareth "Curious Kit" Moreton 2024-02-29 22:15:13 +00:00 committed by florian
parent b1b5c13671
commit 1bba83cebb
7 changed files with 73 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
compiler/htypechk.pas
View File

@ -1403,7 +1403,7 @@ implementation
case p.nodetype of
vecn:
begin
include(p.flags,nf_callunique);
include(tvecnode(p).vecnodeflags,vnf_callunique);
break;
end;
typeconvn,

2
compiler/i386/n386mem.pas
View File

@ -81,7 +81,7 @@ implementation
procedure ti386vecnode.pass_generate_code;
begin
inherited pass_generate_code;
if nf_memseg in flags then
if vnf_memseg in vecnodeflags then
location.reference.segment:=NR_FS;
end;

4
compiler/ncgmem.pas
View File

@ -610,7 +610,7 @@ implementation
function tcgvecnode.get_mul_size : asizeint;
begin
if nf_memindex in flags then
if vnf_memindex in vecnodeflags then
get_mul_size:=1
else
begin
@ -892,7 +892,7 @@ implementation
if is_ansistring(left.resultdef) or
is_wide_or_unicode_string(left.resultdef) then
begin
if nf_callunique in flags then
if vnf_callunique in vecnodeflags then
internalerror(200304236);
{DM!!!!!}

67
compiler/nmem.pas
View File

@ -131,17 +131,30 @@ interface
end;
tsubscriptnodeclass = class of tsubscriptnode;
TVecNodeFlag = (
vnf_memindex,
vnf_memseg,
vnf_callunique
);
TVecNodeFlags = set of TVecNodeFlag;
tvecnode = class(tbinarynode)
protected
function first_arraydef: tnode; virtual;
function gen_array_rangecheck: tnode; virtual;
public
vecnodeflags: TVecNodeFlags;
constructor create(l,r : tnode);virtual;
constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
procedure ppuwrite(ppufile:tcompilerppufile);override;
function pass_1 : tnode;override;
function pass_typecheck:tnode;override;
function simplify(forinline : boolean) : tnode; override;
function dogetcopy : tnode;override;
procedure mark_write;override;
{$ifdef DEBUG_NODE_XML}
procedure XMLPrintNodeInfo(var T: Text); override;
procedure XMLPrintNodeData(var T: Text); override;
{$endif DEBUG_NODE_XML}
end;
@ -1012,9 +1025,23 @@ implementation
*****************************************************************************}
constructor tvecnode.create(l,r : tnode);
begin
inherited create(vecn,l,r);
vecnodeflags := [];
end;
constructor tvecnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
begin
inherited ppuload(t, ppufile);
ppufile.getset(tppuset1(vecnodeflags));
end;
procedure tvecnode.ppuwrite(ppufile:tcompilerppufile);
begin
inherited ppuwrite(ppufile);
ppufile.putset(tppuset1(vecnodeflags));
end;
@ -1312,7 +1339,7 @@ implementation
if codegenerror then
exit;
if (nf_callunique in flags) and
if (vnf_callunique in vecnodeflags) and
(is_ansistring(left.resultdef) or
is_unicodestring(left.resultdef) or
(is_widestring(left.resultdef) and not(tf_winlikewidestring in target_info.flags))) then
@ -1324,10 +1351,10 @@ implementation
firstpass(left);
{ double resultdef passes somwhere else may cause this to be }
{ reset though :/ }
exclude(flags,nf_callunique);
exclude(vecnodeflags,vnf_callunique);
end
else if is_widestring(left.resultdef) and (tf_winlikewidestring in target_info.flags) then
exclude(flags,nf_callunique);
exclude(vecnodeflags,vnf_callunique);
{ a range node as array index can only appear in function calls, and
those convert the range node into something else in
@ -1393,6 +1420,16 @@ implementation
end;
function tvecnode.dogetcopy: tnode;
var
n: tvecnode;
begin
n:=tvecnode(inherited dogetcopy);
n.vecnodeflags := vecnodeflags;
result:=n;
end;
function tvecnode.first_arraydef: tnode;
begin
result:=nil;
@ -1486,6 +1523,28 @@ implementation
{$ifdef DEBUG_NODE_XML}
procedure TVecNode.XMLPrintNodeInfo(var T: Text);
var
i: TVecNodeFlag;
First: Boolean;
begin
inherited XMLPrintNodeInfo(T);
First := True;
for i in vecnodeflags do
begin
if First then
begin
Write(T, ' vecnodeflags="', i);
First := False;
end
else
Write(T, ',', i)
end;
if not First then
Write(T, '"');
end;
procedure TVecNode.XMLPrintNodeData(var T: Text);
begin
XMLPrintNode(T, Left);

8
compiler/node.pas
View File

@ -234,10 +234,6 @@ interface
{ tderefnode }
nf_no_checkpointer,
{ tvecnode }
nf_memindex,
nf_memseg,
nf_callunique,
{ tloadnode/ttypeconvnode }
nf_absolute,
@ -783,7 +779,7 @@ implementation
ppufile.getset(tppuset5(localswitches));
verbosity:=ppufile.getlongint;
ppufile.getderef(resultdefderef);
ppufile.getset(tppuset5(flags));
ppufile.getset(tppuset4(flags));
{ updated by firstpass }
expectloc:=LOC_INVALID;
{ updated by secondpass }
@ -798,7 +794,7 @@ implementation
ppufile.putset(tppuset5(localswitches));
ppufile.putlongint(verbosity);
ppufile.putderef(resultdefderef);
ppufile.putset(tppuset5(flags));
ppufile.putset(tppuset4(flags));
end;

6
compiler/pexpr.pas
View File

@ -2349,8 +2349,8 @@ implementation
{ Support mem[$a000:$0000..$07ff] which returns array [0..$7ff] of memtype.}
p2:=crangenode.create(p2,caddnode.create(addn,comp_expr([ef_accept_equal]),p3.getcopy));
p1:=cvecnode.create(p1,p2);
include(tvecnode(p1).flags,nf_memseg);
include(tvecnode(p1).flags,nf_memindex);
include(tvecnode(p1).vecnodeflags,vnf_memseg);
include(tvecnode(p1).vecnodeflags,vnf_memindex);
end
else
begin
@ -2358,7 +2358,7 @@ implementation
{ Support mem[$80000000..$80000002] which returns array [0..2] of memtype.}
p2:=crangenode.create(p2,comp_expr([ef_accept_equal]));
p1:=cvecnode.create(p1,p2);
include(tvecnode(p1).flags,nf_memindex);
include(tvecnode(p1).vecnodeflags,vnf_memindex);
end;
{$else}
internalerror(2013053105);

2
compiler/pstatmnt.pas
View File

@ -622,7 +622,7 @@ implementation
do_typecheckpass(p);
if (p.nodetype=vecn) and
(nf_memseg in p.flags) then
(vnf_memseg in tvecnode(p).vecnodeflags) then
CGMessage(parser_e_no_with_for_variable_in_other_segments);
{ "with procvar" can never mean anything, so always try