Просмотр исходного кода

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

J. Gareth "Curious Kit" Moreton 1 год назад
Родитель
Сommit
179fc5848b
8 измененных файлов с 66 добавлено и 18 удалено
  1. 1 1
      compiler/jvm/njvmcnv.pas
  2. 2 2
      compiler/ncal.pas
  3. 1 1
      compiler/ncgld.pas
  4. 1 1
      compiler/ninl.pas
  5. 57 6
      compiler/nld.pas
  6. 0 4
      compiler/node.pas
  7. 2 2
      compiler/nopt.pas
  8. 2 1
      compiler/pexpr.pas

+ 1 - 1
compiler/jvm/njvmcnv.pas

@@ -502,7 +502,7 @@ implementation
           end;
           end;
         if not assigned(procdefparas) then
         if not assigned(procdefparas) then
           procdefparas:=carrayconstructornode.create(nil,nil);
           procdefparas:=carrayconstructornode.create(nil,nil);
-        procdefparas.allow_array_constructor:=true;
+        Include(procdefparas.arrayconstructornodeflags, acnf_allow_array_constructor);
         constrparas:=ccallparanode.create(procdefparas,constrparas);
         constrparas:=ccallparanode.create(procdefparas,constrparas);
         result:=ccallnode.createinternmethod(cloadvmtaddrnode.create(ctypenode.create(tcpuprocvardef(resultdef).classdef)),'CREATE',constrparas);
         result:=ccallnode.createinternmethod(cloadvmtaddrnode.create(ctypenode.create(tcpuprocvardef(resultdef).classdef)),'CREATE',constrparas);
         { typecast to the procvar type }
         { typecast to the procvar type }

+ 2 - 2
compiler/ncal.pas

@@ -1224,11 +1224,11 @@ implementation
                     if is_array_of_const(parasym.vardef) then
                     if is_array_of_const(parasym.vardef) then
                      begin
                      begin
                        { force variant array }
                        { force variant array }
-                       include(left.flags,nf_forcevaria);
+                       include(tarrayconstructornode(left).arrayconstructornodeflags,acnf_forcevaria);
                      end
                      end
                     else
                     else
                      begin
                      begin
-                       include(left.flags,nf_novariaallowed);
+                       include(tarrayconstructornode(left).arrayconstructornodeflags,acnf_novariaallowed);
                        { now that the resultting type is know we can insert the required
                        { now that the resultting type is know we can insert the required
                          typeconvs for the array constructor }
                          typeconvs for the array constructor }
                        if parasym.vardef.typ=arraydef then
                        if parasym.vardef.typ=arraydef then

+ 1 - 1
compiler/ncgld.pas

@@ -1289,7 +1289,7 @@ implementation
         if is_packed_array(resultdef) then
         if is_packed_array(resultdef) then
           internalerror(200608042);
           internalerror(200608042);
         dovariant:=
         dovariant:=
-          ((nf_forcevaria in flags) or is_variant_array(resultdef)) and
+          ((acnf_forcevaria in arrayconstructornodeflags) or is_variant_array(resultdef)) and
           not(target_info.system in systems_managed_vm);
           not(target_info.system in systems_managed_vm);
         eledef:=tarraydef(resultdef).elementdef;
         eledef:=tarraydef(resultdef).elementdef;
         elesize:=eledef.size;
         elesize:=eledef.size;

+ 1 - 1
compiler/ninl.pas

@@ -5436,7 +5436,7 @@ implementation
                      inserttypeconv_internal(n,voidpointertype);
                      inserttypeconv_internal(n,voidpointertype);
                      arrconstr:=carrayconstructornode.create(n,arrconstr);
                      arrconstr:=carrayconstructornode.create(n,arrconstr);
                    end;
                    end;
-                 arrconstr.allow_array_constructor:=true;
+                 Include(arrconstr.arrayconstructornodeflags, acnf_allow_array_constructor);
 
 
                  { based on the code from nopt.genmultistringadd() }
                  { based on the code from nopt.genmultistringadd() }
                  tempnode:=ctempcreatenode.create(arrn.resultdef,arrn.resultdef.size,tt_persistent,true);
                  tempnode:=ctempcreatenode.create(arrn.resultdef,arrn.resultdef.size,tt_persistent,true);

+ 57 - 6
compiler/nld.pas

@@ -124,14 +124,25 @@ interface
        end;
        end;
        tarrayconstructorrangenodeclass = class of tarrayconstructorrangenode;
        tarrayconstructorrangenodeclass = class of tarrayconstructorrangenode;
 
 
+       TArrayConstructorNodeFlag =
+       (
+         acnf_allow_array_constructor,
+         acnf_forcevaria,
+         acnf_novariaallowed
+       );
+
+       TArrayConstructorNodeFlags = set of TArrayConstructorNodeFlag;
+
        tarrayconstructornode = class(tbinarynode)
        tarrayconstructornode = class(tbinarynode)
-          allow_array_constructor : boolean;
+          arrayconstructornodeflags: TArrayConstructorNodeFlags;
          private
          private
           function has_range_node:boolean;
           function has_range_node:boolean;
          protected
          protected
           procedure wrapmanagedvarrec(var n: tnode);virtual;abstract;
           procedure wrapmanagedvarrec(var n: tnode);virtual;abstract;
          public
          public
           constructor create(l,r : tnode);virtual;
           constructor create(l,r : tnode);virtual;
+          constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
+          procedure ppuwrite(ppufile:tcompilerppufile);override;
           function dogetcopy : tnode;override;
           function dogetcopy : tnode;override;
           function pass_1 : tnode;override;
           function pass_1 : tnode;override;
           function pass_typecheck:tnode;override;
           function pass_typecheck:tnode;override;
@@ -139,6 +150,9 @@ interface
           procedure force_type(def:tdef);
           procedure force_type(def:tdef);
           procedure insert_typeconvs;
           procedure insert_typeconvs;
           function isempty : boolean;
           function isempty : boolean;
+{$ifdef DEBUG_NODE_XML}
+          procedure XMLPrintNodeInfo(var t : text);override;
+{$endif DEBUG_NODE_XML}
        end;
        end;
        tarrayconstructornodeclass = class of tarrayconstructornode;
        tarrayconstructornodeclass = class of tarrayconstructornode;
 
 
@@ -1161,7 +1175,21 @@ implementation
     constructor tarrayconstructornode.create(l,r : tnode);
     constructor tarrayconstructornode.create(l,r : tnode);
       begin
       begin
          inherited create(arrayconstructorn,l,r);
          inherited create(arrayconstructorn,l,r);
-         allow_array_constructor:=false;
+         arrayconstructornodeflags := [];
+      end;
+
+
+    constructor tarrayconstructornode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
+      begin
+        inherited ppuload(t,ppufile);
+        ppufile.getset(tppuset1(arrayconstructornodeflags));
+      end;
+
+
+    procedure tarrayconstructornode.ppuwrite(ppufile:tcompilerppufile);
+      begin
+        inherited ppuwrite(ppufile);
+        ppufile.putset(tppuset1(arrayconstructornodeflags));
       end;
       end;
 
 
 
 
@@ -1170,6 +1198,7 @@ implementation
          n : tarrayconstructornode;
          n : tarrayconstructornode;
       begin
       begin
          n:=tarrayconstructornode(inherited dogetcopy);
          n:=tarrayconstructornode(inherited dogetcopy);
+         n.arrayconstructornodeflags := arrayconstructornodeflags;
          result:=n;
          result:=n;
       end;
       end;
 
 
@@ -1214,7 +1243,7 @@ implementation
         Do this only if we didn't convert the arrayconstructor yet. This
         Do this only if we didn't convert the arrayconstructor yet. This
         is needed for the cases where the resultdef is forced for a second
         is needed for the cases where the resultdef is forced for a second
         run }
         run }
-        if not allow_array_constructor or has_range_node then
+        if not (acnf_allow_array_constructor in arrayconstructornodeflags) or has_range_node then
          begin
          begin
            hp:=tarrayconstructornode(getcopy);
            hp:=tarrayconstructornode(getcopy);
            arrayconstructor_to_set(tnode(hp));
            arrayconstructor_to_set(tnode(hp));
@@ -1270,7 +1299,7 @@ implementation
                            hdef:=hp.left.resultdef;
                            hdef:=hp.left.resultdef;
                        end
                        end
                      else
                      else
-                       if (nf_novariaallowed in flags) then
+                       if (acnf_novariaallowed in arrayconstructornodeflags) then
                          varia:=true;
                          varia:=true;
                    end;
                    end;
                end;
                end;
@@ -1320,7 +1349,7 @@ implementation
         hp        : tarrayconstructornode;
         hp        : tarrayconstructornode;
         dovariant : boolean;
         dovariant : boolean;
       begin
       begin
-        dovariant:=(nf_forcevaria in flags) or (ado_isvariant in tarraydef(resultdef).arrayoptions);
+        dovariant:=(acnf_forcevaria in arrayconstructornodeflags) or (ado_isvariant in tarraydef(resultdef).arrayoptions);
         { only pass left tree, right tree contains next construct if any }
         { only pass left tree, right tree contains next construct if any }
         if assigned(left) then
         if assigned(left) then
          begin
          begin
@@ -1344,7 +1373,7 @@ implementation
         do_variant,
         do_variant,
         do_managed_variant:boolean;
         do_managed_variant:boolean;
       begin
       begin
-        do_variant:=(nf_forcevaria in flags) or (ado_isvariant in tarraydef(resultdef).arrayoptions);
+        do_variant:=(acnf_forcevaria in arrayconstructornodeflags) or (ado_isvariant in tarraydef(resultdef).arrayoptions);
         do_managed_variant:=
         do_managed_variant:=
           do_variant and
           do_variant and
           (target_info.system in systems_managed_vm);
           (target_info.system in systems_managed_vm);
@@ -1387,6 +1416,28 @@ implementation
         docompare:=inherited docompare(p);
         docompare:=inherited docompare(p);
       end;
       end;
 
 
+{$ifdef DEBUG_NODE_XML}
+    procedure TArrayConstructorNode.XMLPrintNodeInfo(var T: Text);
+      var
+        i: TArrayConstructorNodeFlag;
+        First: Boolean;
+      begin
+        inherited XMLPrintNodeInfo(T);
+        First := True;
+        for i in arrayconstructornodeflags do
+          begin
+            if First then
+              begin
+                Write(T, ' arrayconstructornodeflags="', i);
+                First := False;
+              end
+            else
+              Write(T, ',', i)
+          end;
+        if not First then
+          Write(T, '"');
+      end;
+{$endif DEBUG_NODE_XML}
 
 
 {*****************************************************************************
 {*****************************************************************************
                               TTYPENODE
                               TTYPENODE

+ 0 - 4
compiler/node.pas

@@ -243,10 +243,6 @@ interface
          { if the result type of a node is currency, then this flag denotes, that the value is already mulitplied by 10000 }
          { if the result type of a node is currency, then this flag denotes, that the value is already mulitplied by 10000 }
          nf_is_currency,
          nf_is_currency,
 
 
-         { tarrayconstructnode }
-         nf_forcevaria,
-         nf_novariaallowed,
-
          { ttypeconvnode, and the first one also treal/ord/pointerconstn }
          { ttypeconvnode, and the first one also treal/ord/pointerconstn }
          { second one also for subtractions of u32-u32 implicitly upcasted to s64 }
          { second one also for subtractions of u32-u32 implicitly upcasted to s64 }
          { last one also used on addnode to inhibit procvar calling }
          { last one also used on addnode to inhibit procvar calling }

+ 2 - 2
compiler/nopt.pas

@@ -339,7 +339,7 @@ begin
       include(sn.flags,nf_internal);
       include(sn.flags,nf_internal);
     end;
     end;
   arrp:=carrayconstructornode.create(sn,arrp);
   arrp:=carrayconstructornode.create(sn,arrp);
-  arrp.allow_array_constructor:=true;
+  Include(arrp.arrayconstructornodeflags, acnf_allow_array_constructor);
   if assigned(aktassignmentnode) and
   if assigned(aktassignmentnode) and
      (aktassignmentnode.right=p) and
      (aktassignmentnode.right=p) and
      (
      (
@@ -452,7 +452,7 @@ begin
     end;
     end;
   sn:=ctypeconvnode.create_internal(hp.getcopy,voidpointertype);
   sn:=ctypeconvnode.create_internal(hp.getcopy,voidpointertype);
   arrp:=carrayconstructornode.create(sn,arrp);
   arrp:=carrayconstructornode.create(sn,arrp);
-  arrp.allow_array_constructor:=true;
+  Include(arrp.arrayconstructornodeflags, acnf_allow_array_constructor);
   if assigned(aktassignmentnode) and
   if assigned(aktassignmentnode) and
      (aktassignmentnode.right=p) and
      (aktassignmentnode.right=p) and
      (aktassignmentnode.left.resultdef=p.resultdef) and
      (aktassignmentnode.left.resultdef=p.resultdef) and

+ 2 - 1
compiler/pexpr.pas

@@ -3639,7 +3639,8 @@ implementation
                end;
                end;
            { there could be more elements }
            { there could be more elements }
            until not try_to_consume(_COMMA);
            until not try_to_consume(_COMMA);
-           buildp.allow_array_constructor:=block_type in [bt_body,bt_except];
+           if block_type in [bt_body,bt_except] then
+             Include(buildp.arrayconstructornodeflags, acnf_allow_array_constructor);
            factor_read_set:=buildp;
            factor_read_set:=buildp;
          end;
          end;