decl.c (variant_desc): Add AUX field.
authorEric Botcazou <ebotcazou@adacore.com>
Tue, 12 Jun 2018 09:51:26 +0000 (09:51 +0000)
committerEric Botcazou <ebotcazou@gcc.gnu.org>
Tue, 12 Jun 2018 09:51:26 +0000 (09:51 +0000)
* gcc-interface/decl.c (variant_desc): Add AUX field.
(gnat_to_gnu_entity) <discrete_type>: Do not call compute_record_mode
directly.
(reverse_sort_field_list): New static function.
(components_to_record): Place the variant part at the beginning of the
field list when there is an obvious order of increasing position.
(build_variant_list): Initialize it.
(create_variant_part_from): Do not call compute_record_mode directly.
(copy_and_substitute_in_layout): Likewise.  Always sort the fields with
fixed position in order of increasing position, in the record and all
the variants, in any.  Call reverse_sort_field_list.
* gcc-interface/utils.c (make_packable_type): Compute the sizes before
calling finish_record_type.  Do not call compute_record_mode directly.
(finish_record_type): Overhaul final processing depending on REP_LEVEL
and call finish_bitfield_layout if it is equal to one or two.

From-SVN: r261479

gcc/ada/ChangeLog
gcc/ada/gcc-interface/decl.c
gcc/ada/gcc-interface/utils.c
gcc/testsuite/ChangeLog
gcc/testsuite/gnat.dg/opt72_pkg.ads [new file with mode: 0644]
gcc/testsuite/gnat.dg/opt72a.adb [new file with mode: 0644]
gcc/testsuite/gnat.dg/opt72b.adb [new file with mode: 0644]

index 91907fb35fe4d9bb25b40cfe831197c107387515..091ba237370cf1d567706496e4784947cb1619ab 100644 (file)
@@ -1,3 +1,21 @@
+2018-06-12  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gcc-interface/decl.c (variant_desc): Add AUX field.
+       (gnat_to_gnu_entity) <discrete_type>: Do not call compute_record_mode
+       directly.
+       (reverse_sort_field_list): New static function.
+       (components_to_record): Place the variant part at the beginning of the
+       field list when there is an obvious order of increasing position.
+       (build_variant_list): Initialize it.
+       (create_variant_part_from): Do not call compute_record_mode directly.
+       (copy_and_substitute_in_layout): Likewise.  Always sort the fields with
+       fixed position in order of increasing position, in the record and all
+       the variants, in any.  Call reverse_sort_field_list.
+       * gcc-interface/utils.c (make_packable_type): Compute the sizes before
+       calling finish_record_type.  Do not call compute_record_mode directly.
+       (finish_record_type): Overhaul final processing depending on REP_LEVEL
+       and call finish_bitfield_layout if it is equal to one or two.
+
 2018-06-11  Eric Botcazou  <ebotcazou@adacore.com>
 
        * gcc-interface/decl.c (gnat_to_gnu_entity) <E_Array_Type>: Reuse the
index 2f8955bd21e84b1c8eaf051597849566d28ae6c0..a79cb0070246599523806ed84f516ec6e5765502 100644 (file)
@@ -123,6 +123,9 @@ typedef struct variant_desc_d {
 
   /* The type of the variant after transformation.  */
   tree new_type;
+
+  /* The auxiliary data.  */
+  tree aux;
 } variant_desc;
 
 
@@ -1927,7 +1930,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
 
          /* We will output additional debug info manually below.  */
          finish_record_type (gnu_type, gnu_field, 2, false);
-         compute_record_mode (gnu_type);
          TYPE_JUSTIFIED_MODULAR_P (gnu_type) = 1;
 
          if (debug_info_p)
@@ -7228,6 +7230,28 @@ compare_field_bitpos (const PTR rt1, const PTR rt2)
   return ret ? ret : (int) (DECL_UID (field1) - DECL_UID (field2));
 }
 
+/* Sort the LIST of fields in reverse order of increasing position.  */
+
+static tree
+reverse_sort_field_list (tree list)
+{
+  const int len = list_length (list);
+  tree *field_arr = XALLOCAVEC (tree, len);
+
+  for (int i = 0; list; list = DECL_CHAIN (list), i++)
+    field_arr[i] = list;
+
+  qsort (field_arr, len, sizeof (tree), compare_field_bitpos);
+
+  for (int i = 0; i < len; i++)
+    {
+      DECL_CHAIN (field_arr[i]) = list;
+      list = field_arr[i];
+    }
+
+  return list;
+}
+
 /* Reverse function from gnat_to_gnu_field: return the GNAT field present in
    either GNAT_COMPONENT_LIST or the discriminants of GNAT_RECORD_TYPE, and
    corresponding to the GNU tree GNU_FIELD.  */
@@ -8037,7 +8061,23 @@ components_to_record (Node_Id gnat_component_list, Entity_Id gnat_record_type,
 
   /* Chain the variant part at the end of the field list.  */
   if (gnu_variant_part)
-    gnu_field_list = chainon (gnu_field_list, gnu_variant_part);
+    {
+      /* We make an exception if the variant part is at offset 0, has a fixed
+        size, and there is a single rep'ed field placed after it because, in
+        this case, there is an obvious order of increasing position.  */
+      if (variants_have_rep
+         && TREE_CODE (DECL_SIZE_UNIT (gnu_variant_part)) == INTEGER_CST
+         && gnu_rep_list
+         && gnu_field_list == gnu_rep_list
+         && !tree_int_cst_lt (DECL_FIELD_OFFSET (gnu_rep_list),
+                              DECL_SIZE_UNIT (gnu_variant_part)))
+       {
+         DECL_CHAIN (gnu_variant_part) = gnu_field_list;
+         gnu_field_list = gnu_variant_part;
+       }
+      else
+       gnu_field_list = chainon (gnu_field_list, gnu_variant_part);
+    }
 
   if (cancel_alignment)
     SET_TYPE_ALIGN (gnu_record_type, 0);
@@ -8527,7 +8567,8 @@ build_variant_list (tree qual_union_type, vec<subst_pair> subst_list,
       if (!integer_zerop (qual))
        {
          tree variant_type = TREE_TYPE (gnu_field), variant_subpart;
-         variant_desc v = { variant_type, gnu_field, qual, NULL_TREE };
+         variant_desc v
+           = { variant_type, gnu_field, qual, NULL_TREE, NULL_TREE };
 
          gnu_list.safe_push (v);
 
@@ -9301,7 +9342,6 @@ create_variant_part_from (tree old_variant_part,
 
       /* Finish up the new variant and create the field.  */
       finish_record_type (new_variant, nreverse (field_list), 2, debug_info_p);
-      compute_record_mode (new_variant);
       create_type_decl (TYPE_NAME (new_variant), new_variant, true,
                        debug_info_p, Empty);
 
@@ -9319,7 +9359,6 @@ create_variant_part_from (tree old_variant_part,
      reverse the field list because VARIANT_LIST has been traversed in reverse
      order.  */
   finish_record_type (new_union_type, union_field_list, 2, debug_info_p);
-  compute_record_mode (new_union_type);
   create_type_decl (TYPE_NAME (new_union_type), new_union_type, true,
                    debug_info_p, Empty);
 
@@ -9417,7 +9456,8 @@ copy_and_substitute_in_layout (Entity_Id gnat_new_type,
 {
   const bool is_subtype = (Ekind (gnat_new_type) == E_Record_Subtype);
   tree gnu_field_list = NULL_TREE;
-  bool selected_variant, all_constant_pos = true;
+  tree gnu_variable_field_list = NULL_TREE;
+  bool selected_variant;
   vec<variant_desc> gnu_variant_list;
 
   /* Look for REP and variant parts in the old type.  */
@@ -9501,6 +9541,7 @@ copy_and_substitute_in_layout (Entity_Id gnat_new_type,
         tree gnu_context = DECL_CONTEXT (gnu_old_field);
        tree gnu_field, gnu_field_type, gnu_size, gnu_pos;
        tree gnu_cont_type, gnu_last = NULL_TREE;
+       variant_desc *v = NULL;
 
        /* If the type is the same, retrieve the GCC type from the
           old field to take into account possible adjustments.  */
@@ -9549,7 +9590,6 @@ copy_and_substitute_in_layout (Entity_Id gnat_new_type,
          gnu_cont_type = gnu_new_type;
        else
          {
-           variant_desc *v;
            unsigned int i;
            tree rep_part;
 
@@ -9562,7 +9602,7 @@ copy_and_substitute_in_layout (Entity_Id gnat_new_type,
            if (v)
              gnu_cont_type = selected_variant ? gnu_new_type : v->new_type;
            else
-             /* The front-end may pass us "ghost" components if it fails to
+             /* The front-end may pass us zombie components if it fails to
                 recognize that a constrain statically selects a particular
                 variant.  Discard them.  */
              continue;
@@ -9578,8 +9618,16 @@ copy_and_substitute_in_layout (Entity_Id gnat_new_type,
        /* If the context is a variant, put it in the new variant directly.  */
        if (gnu_cont_type != gnu_new_type)
          {
-           DECL_CHAIN (gnu_field) = TYPE_FIELDS (gnu_cont_type);
-           TYPE_FIELDS (gnu_cont_type) = gnu_field;
+           if (TREE_CODE (gnu_pos) == INTEGER_CST)
+             {
+               DECL_CHAIN (gnu_field) = TYPE_FIELDS (gnu_cont_type);
+               TYPE_FIELDS (gnu_cont_type) = gnu_field;
+             }
+           else
+             {
+               DECL_CHAIN (gnu_field) = v->aux;
+               v->aux = gnu_field;
+             }
          }
 
        /* To match the layout crafted in components_to_record, if this is
@@ -9598,12 +9646,18 @@ copy_and_substitute_in_layout (Entity_Id gnat_new_type,
        /* Otherwise, put it after the other fields.  */
        else
          {
-           DECL_CHAIN (gnu_field) = gnu_field_list;
-           gnu_field_list = gnu_field;
-           if (!gnu_last)
-             gnu_last = gnu_field;
-           if (TREE_CODE (gnu_pos) != INTEGER_CST)
-             all_constant_pos = false;
+           if (TREE_CODE (gnu_pos) == INTEGER_CST)
+             {
+               DECL_CHAIN (gnu_field) = gnu_field_list;
+               gnu_field_list = gnu_field;
+               if (!gnu_last)
+                 gnu_last = gnu_field;
+             }
+           else
+             {
+               DECL_CHAIN (gnu_field) = gnu_variable_field_list;
+               gnu_variable_field_list = gnu_field;
+             }
          }
 
        /* For a stored discriminant in a derived type, replace the field.  */
@@ -9616,31 +9670,32 @@ copy_and_substitute_in_layout (Entity_Id gnat_new_type,
          save_gnu_tree (gnat_field, gnu_field, false);
       }
 
-  /* If there is no variant list or a selected variant and the fields all have
-     constant position, put them in order of increasing position to match that
-     of constant CONSTRUCTORs.  */
-  if ((!gnu_variant_list.exists () || selected_variant) && all_constant_pos)
-    {
-      const int len = list_length (gnu_field_list);
-      tree *field_arr = XALLOCAVEC (tree, len), t = gnu_field_list;
+  /* Put the fields with fixed position in order of increasing position.  */
+  if (gnu_field_list)
+    gnu_field_list = reverse_sort_field_list (gnu_field_list);
 
-      for (int i = 0; t; t = DECL_CHAIN (t), i++)
-       field_arr[i] = t;
+  /* Put the fields with variable position at the end.  */
+  if (gnu_variable_field_list)
+    gnu_field_list = chainon (gnu_variable_field_list, gnu_field_list);
 
-      qsort (field_arr, len, sizeof (tree), compare_field_bitpos);
+  /* If there is a variant list and no selected variant, we need to create the
+     nest of variant parts from the old nest.  */
+  if (gnu_variant_list.exists () && !selected_variant)
+    {
+      variant_desc *v;
+      unsigned int i;
 
-      gnu_field_list = NULL_TREE;
-      for (int i = 0; i < len; i++)
+      /* Same processing as above for the fields of each variant.  */
+      FOR_EACH_VEC_ELT (gnu_variant_list, i, v)
        {
-         DECL_CHAIN (field_arr[i]) = gnu_field_list;
-         gnu_field_list = field_arr[i];
+         if (TYPE_FIELDS (v->new_type))
+           TYPE_FIELDS (v->new_type)
+             = reverse_sort_field_list (TYPE_FIELDS (v->new_type));
+         if (v->aux)
+           TYPE_FIELDS (v->new_type)
+             = chainon (v->aux, TYPE_FIELDS (v->new_type));
        }
-    }
 
-  /* If there is a variant list and no selected variant, we need to create the
-     nest of variant parts from the old nest.  */
-  else if (gnu_variant_list.exists () && !selected_variant)
-    {
       tree new_variant_part
        = create_variant_part_from (gnu_variant_part, gnu_variant_list,
                                    gnu_new_type, gnu_pos_list,
@@ -9652,17 +9707,10 @@ copy_and_substitute_in_layout (Entity_Id gnat_new_type,
   gnu_variant_list.release ();
   gnu_subst_list.release ();
 
-  gnu_field_list = nreverse (gnu_field_list);
-
   /* If NEW_TYPE is a subtype, it inherits all the attributes from OLD_TYPE.
      Otherwise sizes and alignment must be computed independently.  */
-  if (is_subtype)
-    {
-      finish_record_type (gnu_new_type, gnu_field_list, 2, debug_info_p);
-      compute_record_mode (gnu_new_type);
-    }
-  else
-    finish_record_type (gnu_new_type, gnu_field_list, 1, debug_info_p);
+  finish_record_type (gnu_new_type, nreverse (gnu_field_list),
+                     is_subtype ? 2 : 1, debug_info_p);
 
   /* Now go through the entities again looking for Itypes that we have not yet
      elaborated (e.g. Etypes of fields that have Original_Components).  */
index d415f492cb94b0b91950ec79eeba8be2a9eec91b..992d56825bf7c35d9c051b067ee3c5d51d28b421 100644 (file)
@@ -1054,12 +1054,6 @@ make_packable_type (tree type, bool in_record, unsigned int max_align)
       new_field_list = new_field;
     }
 
-  finish_record_type (new_type, nreverse (new_field_list), 2, false);
-  relate_alias_sets (new_type, type, ALIAS_SET_COPY);
-  if (TYPE_STUB_DECL (type))
-    SET_DECL_PARALLEL_TYPE (TYPE_STUB_DECL (new_type),
-                           DECL_PARALLEL_TYPE (TYPE_STUB_DECL (type)));
-
   /* If this is a padding record, we never want to make the size smaller
      than what was specified.  For QUAL_UNION_TYPE, also copy the size.  */
   if (TYPE_IS_PADDING_P (type) || TREE_CODE (type) == QUAL_UNION_TYPE)
@@ -1077,7 +1071,11 @@ make_packable_type (tree type, bool in_record, unsigned int max_align)
   if (!TYPE_CONTAINS_TEMPLATE_P (type))
     SET_TYPE_ADA_SIZE (new_type, TYPE_ADA_SIZE (type));
 
-  compute_record_mode (new_type);
+  finish_record_type (new_type, nreverse (new_field_list), 2, false);
+  relate_alias_sets (new_type, type, ALIAS_SET_COPY);
+  if (TYPE_STUB_DECL (type))
+    SET_DECL_PARALLEL_TYPE (TYPE_STUB_DECL (new_type),
+                           DECL_PARALLEL_TYPE (TYPE_STUB_DECL (type)));
 
   /* Try harder to get a packable type if necessary, for example
      in case the record itself contains a BLKmode field.  */
@@ -1951,33 +1949,40 @@ finish_record_type (tree record_type, tree field_list, int rep_level,
   if (code == QUAL_UNION_TYPE)
     nreverse (field_list);
 
-  if (rep_level < 2)
+  /* We need to set the regular sizes if REP_LEVEL is one.  */
+  if (rep_level == 1)
     {
       /* If this is a padding record, we never want to make the size smaller
         than what was specified in it, if any.  */
       if (TYPE_IS_PADDING_P (record_type) && TYPE_SIZE (record_type))
        size = TYPE_SIZE (record_type);
 
+      tree size_unit = had_size_unit
+                      ? TYPE_SIZE_UNIT (record_type)
+                      : convert (sizetype,
+                                 size_binop (CEIL_DIV_EXPR, size,
+                                             bitsize_unit_node));
+      const unsigned int align = TYPE_ALIGN (record_type);
+
+      TYPE_SIZE (record_type) = variable_size (round_up (size, align));
+      TYPE_SIZE_UNIT (record_type)
+       = variable_size (round_up (size_unit, align / BITS_PER_UNIT));
+    }
+
+  /* We need to set the Ada size if REP_LEVEL is zero or one.  */
+  if (rep_level < 2)
+    {
       /* Now set any of the values we've just computed that apply.  */
       if (!TYPE_FAT_POINTER_P (record_type)
          && !TYPE_CONTAINS_TEMPLATE_P (record_type))
        SET_TYPE_ADA_SIZE (record_type, ada_size);
+    }
 
-      if (rep_level > 0)
-       {
-         tree size_unit = had_size_unit
-                          ? TYPE_SIZE_UNIT (record_type)
-                          : convert (sizetype,
-                                     size_binop (CEIL_DIV_EXPR, size,
-                                                 bitsize_unit_node));
-         unsigned int align = TYPE_ALIGN (record_type);
-
-         TYPE_SIZE (record_type) = variable_size (round_up (size, align));
-         TYPE_SIZE_UNIT (record_type)
-           = variable_size (round_up (size_unit, align / BITS_PER_UNIT));
-
-         compute_record_mode (record_type);
-       }
+  /* We need to set the mode if REP_LEVEL is one or two.  */
+  if (rep_level > 0)
+    {
+      compute_record_mode (record_type);
+      finish_bitfield_layout (record_type);
     }
 
   /* Reset the TYPE_MAX_ALIGN field since it's private to gigi.  */
index b1e6944319470369765cbc39805773c72938fc85..56b600816473654c826ce2096aaea2cacaaa59ac 100644 (file)
@@ -1,3 +1,8 @@
+2018-06-12  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gnat.dg/opt72a.ad[sb]: New test.
+       * gnat.dg/opt72_pkg.ads: New helper.
+
 2018-06-12  Tom de Vries  <tdevries@suse.de>
 
        * gcc.dg-selftests/dg-final.exp: New file.
diff --git a/gcc/testsuite/gnat.dg/opt72_pkg.ads b/gcc/testsuite/gnat.dg/opt72_pkg.ads
new file mode 100644 (file)
index 0000000..92255fb
--- /dev/null
@@ -0,0 +1,12 @@
+package Opt72_Pkg is
+
+   type Rec is record
+      Flag : Boolean;
+      Size : Positive;
+   end record;
+   for Rec use record
+      Flag at 0 range 0 .. 0;
+      Size at 0 range 1 .. 31;
+   end record;
+
+end Opt72_Pkg;
diff --git a/gcc/testsuite/gnat.dg/opt72a.adb b/gcc/testsuite/gnat.dg/opt72a.adb
new file mode 100644 (file)
index 0000000..db1d28c
--- /dev/null
@@ -0,0 +1,12 @@
+-- { dg-do compile }
+-- { dg-require-effective-target store_merge }
+-- { dg-options "-O2 -fdump-tree-store-merging" }
+
+with Opt72_Pkg; use Opt72_Pkg;
+
+procedure Opt72a (X : not null access Rec; Size : Positive) is
+begin
+   X.all := (Flag => True, Size => Size);
+end;
+
+-- { dg-final { scan-tree-dump "Merging successful" "store-merging" } }
diff --git a/gcc/testsuite/gnat.dg/opt72b.adb b/gcc/testsuite/gnat.dg/opt72b.adb
new file mode 100644 (file)
index 0000000..e4a708b
--- /dev/null
@@ -0,0 +1,12 @@
+-- { dg-do compile }
+-- { dg-require-effective-target store_merge }
+-- { dg-options "-O2 -fdump-tree-store-merging" }
+
+with Opt72_Pkg; use Opt72_Pkg;
+
+procedure Opt72b (X : not null access Rec; Y : not null access Rec) is
+begin
+   X.all := (Flag => True, Size => Y.Size);
+end;
+
+-- { dg-final { scan-tree-dump "Merging successful" "store-merging" } }