Browse Source

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

J. Gareth "Curious Kit" Moreton 1 year ago
parent
commit
1bba83cebb
7 changed files with 73 additions and 18 deletions
  1. 1 1
      compiler/htypechk.pas
  2. 1 1
      compiler/i386/n386mem.pas
  3. 2 2
      compiler/ncgmem.pas
  4. 63 4
      compiler/nmem.pas
  5. 2 6
      compiler/node.pas
  6. 3 3
      compiler/pexpr.pas
  7. 1 1
      compiler/pstatmnt.pas

+ 1 - 1
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,

+ 1 - 1
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;
 

+ 2 - 2
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!!!!!}

+ 63 - 4
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);

+ 2 - 6
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;
 
 

+ 3 - 3
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);

+ 1 - 1
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