From 1bba83cebbc3a6584a2727cc0d4320bd8ea774af Mon Sep 17 00:00:00 2001 From: "J. Gareth \"Curious Kit\" Moreton" Date: Thu, 29 Feb 2024 22:15:13 +0000 Subject: [PATCH] * Flags specific to TVecNode have been moved to their own field --- compiler/htypechk.pas | 2 +- compiler/i386/n386mem.pas | 2 +- compiler/ncgmem.pas | 4 +-- compiler/nmem.pas | 67 ++++++++++++++++++++++++++++++++++++--- compiler/node.pas | 8 ++--- compiler/pexpr.pas | 6 ++-- compiler/pstatmnt.pas | 2 +- 7 files changed, 73 insertions(+), 18 deletions(-) diff --git a/compiler/htypechk.pas b/compiler/htypechk.pas index 9c1d9f730b..051e4f07d3 100644 --- a/compiler/htypechk.pas +++ b/compiler/htypechk.pas @@ -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, diff --git a/compiler/i386/n386mem.pas b/compiler/i386/n386mem.pas index 6cc8b825e4..894b5ca516 100644 --- a/compiler/i386/n386mem.pas +++ b/compiler/i386/n386mem.pas @@ -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; diff --git a/compiler/ncgmem.pas b/compiler/ncgmem.pas index d5d44188bc..3e288982a9 100644 --- a/compiler/ncgmem.pas +++ b/compiler/ncgmem.pas @@ -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!!!!!} diff --git a/compiler/nmem.pas b/compiler/nmem.pas index 48b89d3ba0..5472903e90 100644 --- a/compiler/nmem.pas +++ b/compiler/nmem.pas @@ -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); diff --git a/compiler/node.pas b/compiler/node.pas index 8e437cd27d..074ee345f3 100644 --- a/compiler/node.pas +++ b/compiler/node.pas @@ -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; diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas index 8a89f0cf1b..1cd61f1e4e 100644 --- a/compiler/pexpr.pas +++ b/compiler/pexpr.pas @@ -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); diff --git a/compiler/pstatmnt.pas b/compiler/pstatmnt.pas index 71b7b6a7d8..f50fb133f0 100644 --- a/compiler/pstatmnt.pas +++ b/compiler/pstatmnt.pas @@ -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