* gcc-interface/decl.c (gnat_to_gnu_entity) <case E_Record_Subtype>:
authorebotcazou <ebotcazou@138bc75d-0d04-0410-961f-82ee72b054a4>
Mon, 20 Jan 2014 10:51:46 +0000 (10:51 +0000)
committerebotcazou <ebotcazou@138bc75d-0d04-0410-961f-82ee72b054a4>
Mon, 20 Jan 2014 10:51:46 +0000 (10:51 +0000)
Tidy up.  For a subtype with discriminants and variant part, if a
variant is statically selected and the fields all have a constant
position, put them in order of increasing position.  Likewise if
no variant part but representation clause is present.
* gcc-interface/utils.c (make_packable_type): Robustify.
(maybe_pad_type): Use local variable and tidy up condition.  If no
alignment is specified, use the original one.
(create_type_stub_decl): Minor tweak.
(convert) <case VECTOR_CST>: Fix typo.
<case CONSTRUCTOR>: Deal with padding types around the same type.
Do not punt on missing fields.
(unchecked_convert): Call finish_record_type to lay out the special
record types made for conversions from/to problematic integer types.
Bump the alignment of CONSTRUCTORs before converting them to a more
aligned type.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@206796 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/ada/ChangeLog
gcc/ada/gcc-interface/decl.c
gcc/ada/gcc-interface/utils.c

index 357f1c4..4a93e9a 100644 (file)
@@ -1,5 +1,24 @@
 2014-01-20  Eric Botcazou  <ebotcazou@adacore.com>
 
+       * gcc-interface/decl.c (gnat_to_gnu_entity) <case E_Record_Subtype>:
+       Tidy up.  For a subtype with discriminants and variant part, if a
+       variant is statically selected and the fields all have a constant
+       position, put them in order of increasing position.  Likewise if
+       no variant part but representation clause is present.
+       * gcc-interface/utils.c (make_packable_type): Robustify.
+       (maybe_pad_type): Use local variable and tidy up condition.  If no
+       alignment is specified, use the original one.
+       (create_type_stub_decl): Minor tweak.
+       (convert) <case VECTOR_CST>: Fix typo.
+       <case CONSTRUCTOR>: Deal with padding types around the same type.
+       Do not punt on missing fields.
+       (unchecked_convert): Call finish_record_type to lay out the special
+       record types made for conversions from/to problematic integer types.
+       Bump the alignment of CONSTRUCTORs before converting them to a more
+       aligned type.
+
+2014-01-20  Eric Botcazou  <ebotcazou@adacore.com>
+
        * gcc-interface/decl.c (gnat_to_gnu_entity) <case E_Component>: Remove
        obsolete code for type_annotate_only mode, simplify code and slightly
        improve wording of comments.
index 9e1ecb0..dd912f3 100644 (file)
@@ -6,7 +6,7 @@
  *                                                                          *
  *                          C Implementation File                           *
  *                                                                          *
- *          Copyright (C) 1992-2013, Free Software Foundation, Inc.         *
+ *          Copyright (C) 1992-2014, Free Software Foundation, Inc.         *
  *                                                                          *
  * GNAT is free software;  you can  redistribute it  and/or modify it under *
  * terms of the  GNU General Public License as published  by the Free Soft- *
@@ -147,6 +147,7 @@ static bool array_type_has_nonaliased_component (tree, Entity_Id);
 static bool compile_time_known_address_p (Node_Id);
 static bool cannot_be_superflat_p (Node_Id);
 static bool constructor_address_p (tree);
+static int compare_field_bitpos (const PTR, const PTR);
 static bool components_to_record (tree, Node_Id, tree, int, bool, bool, bool,
                                  bool, bool, bool, bool, bool, tree, tree *);
 static Uint annotate_value (tree);
@@ -3341,9 +3342,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
            {
              vec<subst_pair> gnu_subst_list
                = build_subst_list (gnat_entity, gnat_base_type, definition);
-             tree gnu_unpad_base_type, gnu_rep_part, gnu_variant_part, t;
+             tree gnu_unpad_base_type, gnu_rep_part, gnu_variant_part;
              tree gnu_pos_list, gnu_field_list = NULL_TREE;
-             bool selected_variant = false;
+             bool selected_variant = false, all_constant_pos = true;
              Entity_Id gnat_field;
              vec<variant_desc> gnu_variant_list;
 
@@ -3362,7 +3363,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
              else
                gnu_unpad_base_type = gnu_base_type;
 
-             /* Look for a variant part in the base type.  */
+             /* Look for REP and variant parts in the base type.  */
+             gnu_rep_part = get_rep_part (gnu_unpad_base_type);
              gnu_variant_part = get_variant_part (gnu_unpad_base_type);
 
              /* If there is a variant part, we must compute whether the
@@ -3414,13 +3416,17 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
                  selected_variant = false;
                }
 
+             /* Make a list of fields and their position in the base type.  */
              gnu_pos_list
                = build_position_list (gnu_unpad_base_type,
                                       gnu_variant_list.exists ()
-                                         && !selected_variant,
+                                      && !selected_variant,
                                       size_zero_node, bitsize_zero_node,
                                       BIGGEST_ALIGNMENT, NULL_TREE);
 
+             /* Now go down every component in the subtype and compute its
+                size and position from those of the component in the base
+                type and from the constraints of the subtype.  */
              for (gnat_field = First_Entity (gnat_entity);
                   Present (gnat_field);
                   gnat_field = Next_Entity (gnat_field))
@@ -3428,8 +3434,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
                     || Ekind (gnat_field) == E_Discriminant)
                    && !(Present (Corresponding_Discriminant (gnat_field))
                         && Is_Tagged_Type (gnat_base_type))
-                   && Underlying_Type (Scope (Original_Record_Component
-                                              (gnat_field)))
+                   && Underlying_Type
+                      (Scope (Original_Record_Component (gnat_field)))
                       == gnat_base_type)
                  {
                    Name_Id gnat_name = Chars (gnat_field);
@@ -3438,7 +3444,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
                    tree gnu_old_field
                      = gnat_to_gnu_field_decl (gnat_old_field);
                    tree gnu_context = DECL_CONTEXT (gnu_old_field);
-                   tree gnu_field, gnu_field_type, gnu_size;
+                   tree gnu_field, gnu_field_type, gnu_size, gnu_pos;
                    tree gnu_cont_type, gnu_last = NULL_TREE;
 
                    /* If the type is the same, retrieve the GCC type from the
@@ -3489,24 +3495,21 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
                       and put the field either in the new type if there is a
                       selected variant or in one of the new variants.  */
                    if (gnu_context == gnu_unpad_base_type
-                       || ((gnu_rep_part = get_rep_part (gnu_unpad_base_type))
+                       || (gnu_rep_part
                            && gnu_context == TREE_TYPE (gnu_rep_part)))
                      gnu_cont_type = gnu_type;
                    else
                      {
                        variant_desc *v;
                        unsigned int i;
+                       tree rep_part;
 
-                       t = NULL_TREE;
                        FOR_EACH_VEC_ELT (gnu_variant_list, i, v)
                          if (gnu_context == v->type
-                             || ((gnu_rep_part = get_rep_part (v->type))
-                                 && gnu_context == TREE_TYPE (gnu_rep_part)))
-                           {
-                             t = v->type;
-                             break;
-                           }
-                       if (t)
+                             || ((rep_part = get_rep_part (v->type))
+                                 && gnu_context == TREE_TYPE (rep_part)))
+                           break;
+                       if (v)
                          {
                            if (selected_variant)
                              gnu_cont_type = gnu_type;
@@ -3525,6 +3528,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
                      = create_field_decl_from (gnu_old_field, gnu_field_type,
                                                gnu_cont_type, gnu_size,
                                                gnu_pos_list, gnu_subst_list);
+                   gnu_pos = DECL_FIELD_OFFSET (gnu_field);
 
                    /* Put it in one of the new variants directly.  */
                    if (gnu_cont_type != gnu_type)
@@ -3557,14 +3561,42 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
                        gnu_field_list = gnu_field;
                        if (!gnu_last)
                          gnu_last = gnu_field;
+                       if (TREE_CODE (gnu_pos) != INTEGER_CST)
+                         all_constant_pos = false;
                      }
 
                    save_gnu_tree (gnat_field, gnu_field, false);
                  }
 
+             /* If there is a variant list, a selected variant and the fields
+                all have a constant position, put them in order of increasing
+                position to match that of constant CONSTRUCTORs.  Likewise if
+                there is no variant list but a REP part, since the latter has
+                been flattened in the process.  */
+             if (((gnu_variant_list.exists () && selected_variant)
+                  || (!gnu_variant_list.exists () && gnu_rep_part))
+                 && all_constant_pos)
+               {
+                 const int len = list_length (gnu_field_list);
+                 tree *field_arr = XALLOCAVEC (tree, len), t;
+                 int i;
+
+                 for (t = gnu_field_list, i = 0; t; t = DECL_CHAIN (t), i++)
+                   field_arr[i] = t;
+
+                 qsort (field_arr, len, sizeof (tree), compare_field_bitpos);
+
+                 gnu_field_list = NULL_TREE;
+                 for (i = 0; i < len; i++)
+                   {
+                     DECL_CHAIN (field_arr[i]) = gnu_field_list;
+                     gnu_field_list = field_arr[i];
+                   }
+               }
+
              /* 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)
+             else if (gnu_variant_list.exists () && !selected_variant)
                {
                  tree new_variant_part
                    = create_variant_part_from (gnu_variant_part,
index 36e5b2d..69ea026 100644 (file)
@@ -6,7 +6,7 @@
  *                                                                          *
  *                          C Implementation File                           *
  *                                                                          *
- *          Copyright (C) 1992-2013, Free Software Foundation, Inc.         *
+ *          Copyright (C) 1992-2014, Free Software Foundation, Inc.         *
  *                                                                          *
  * GNAT is free software;  you can  redistribute it  and/or modify it under *
  * terms of the  GNU General Public License as published  by the Free Soft- *
@@ -869,8 +869,9 @@ make_packable_type (tree type, bool in_record)
 
   finish_record_type (new_type, nreverse (field_list), 2, false);
   relate_alias_sets (new_type, type, ALIAS_SET_COPY);
-  SET_DECL_PARALLEL_TYPE (TYPE_STUB_DECL (new_type),
-                         DECL_PARALLEL_TYPE (TYPE_STUB_DECL (type)));
+  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.  */
@@ -1049,6 +1050,7 @@ maybe_pad_type (tree type, tree size, unsigned int align,
                bool is_user_type, bool definition, bool set_rm_size)
 {
   tree orig_size = TYPE_SIZE (type);
+  unsigned int orig_align = TYPE_ALIGN (type);
   tree record, field;
 
   /* If TYPE is a padded type, see if it agrees with any size and alignment
@@ -1059,21 +1061,18 @@ maybe_pad_type (tree type, tree size, unsigned int align,
   if (TYPE_IS_PADDING_P (type))
     {
       if ((!size
-          || operand_equal_p (round_up (size,
-                                        MAX (align, TYPE_ALIGN (type))),
-                              round_up (TYPE_SIZE (type),
-                                        MAX (align, TYPE_ALIGN (type))),
-                              0))
-         && (align == 0 || align == TYPE_ALIGN (type)))
+          || operand_equal_p (round_up (size, orig_align), orig_size, 0))
+         && (align == 0 || align == orig_align))
        return type;
 
       if (!size)
-       size = TYPE_SIZE (type);
+       size = orig_size;
       if (align == 0)
-       align = TYPE_ALIGN (type);
+       align = orig_align;
 
       type = TREE_TYPE (TYPE_FIELDS (type));
       orig_size = TYPE_SIZE (type);
+      orig_align = TYPE_ALIGN (type);
     }
 
   /* If the size is either not being changed or is being made smaller (which
@@ -1086,7 +1085,7 @@ maybe_pad_type (tree type, tree size, unsigned int align,
              && tree_int_cst_lt (size, orig_size))))
     size = NULL_TREE;
 
-  if (align == TYPE_ALIGN (type))
+  if (align == orig_align)
     align = 0;
 
   if (align == 0 && !size)
@@ -1110,7 +1109,7 @@ maybe_pad_type (tree type, tree size, unsigned int align,
   if (Present (gnat_entity))
     TYPE_NAME (record) = create_concat_name (gnat_entity, "PAD");
 
-  TYPE_ALIGN (record) = align;
+  TYPE_ALIGN (record) = align ? align : orig_align;
   TYPE_SIZE (record) = size ? size : orig_size;
   TYPE_SIZE_UNIT (record)
     = convert (sizetype,
@@ -2063,8 +2062,7 @@ create_type_stub_decl (tree type_name, tree type)
   /* Using a named TYPE_DECL ensures that a type name marker is emitted in
      STABS while setting DECL_ARTIFICIAL ensures that no DW_TAG_typedef is
      emitted in DWARF.  */
-  tree type_decl = build_decl (input_location,
-                              TYPE_DECL, type_name, type);
+  tree type_decl = build_decl (input_location, TYPE_DECL, type_name, type);
   DECL_ARTIFICIAL (type_decl) = 1;
   TYPE_ARTIFICIAL (type) = 1;
   return type_decl;
@@ -4626,7 +4624,7 @@ convert (tree type, tree expr)
       break;
 
     case VECTOR_CST:
-      /* If we are converting a VECTOR_CST to a mere variant type, just make
+      /* If we are converting a VECTOR_CST to a mere type variant, just make
         a new one in the proper type.  */
       if (code == ecode && gnat_types_compatible_p (type, etype))
        {
@@ -4636,9 +4634,15 @@ convert (tree type, tree expr)
        }
 
     case CONSTRUCTOR:
-      /* If we are converting a CONSTRUCTOR to a mere variant type, just make
-        a new one in the proper type.  */
-      if (code == ecode && gnat_types_compatible_p (type, etype))
+      /* If we are converting a CONSTRUCTOR to a mere type variant, or to
+        another padding type around the same type, just make a new one in
+        the proper type.  */
+      if (code == ecode
+         && (gnat_types_compatible_p (type, etype)
+             || (code == RECORD_TYPE
+                 && TYPE_PADDING_P (type) && TYPE_PADDING_P (etype)
+                 && TREE_TYPE (TYPE_FIELDS (type))
+                    == TREE_TYPE (TYPE_FIELDS (etype)))))
        {
          expr = copy_node (expr);
          TREE_TYPE (expr) = type;
@@ -4669,13 +4673,17 @@ convert (tree type, tree expr)
 
          FOR_EACH_CONSTRUCTOR_ELT(e, idx, index, value)
            {
-             /* We expect only simple constructors.  */
-             if (!SAME_FIELD_P (index, efield))
-               break;
+             /* Skip the missing fields in the CONSTRUCTOR.  */
+             while (efield && field && !SAME_FIELD_P (efield, index))
+               {
+                 efield = DECL_CHAIN (efield);
+                 field = DECL_CHAIN (field);
+               }
              /* The field must be the same.  */
-             if (!SAME_FIELD_P (efield, field))
+             if (!(efield && field && SAME_FIELD_P (efield, field)))
                break;
-             constructor_elt elt = {field, convert (TREE_TYPE (field), value)};
+             constructor_elt elt
+               = {field, convert (TREE_TYPE (field), value)};
              v->quick_push (elt);
 
              /* If packing has made this field a bitfield and the input
@@ -5321,10 +5329,9 @@ unchecked_convert (tree type, tree expr, bool notrunc_p)
       SET_TYPE_RM_SIZE (field_type, TYPE_RM_SIZE (type));
 
       field = create_field_decl (get_identifier ("OBJ"), field_type, rec_type,
-                                NULL_TREE, NULL_TREE, 1, 0);
+                                NULL_TREE, bitsize_zero_node, 1, 0);
 
-      TYPE_FIELDS (rec_type) = field;
-      layout_type (rec_type);
+      finish_record_type (rec_type, field, 1, false);
 
       expr = unchecked_convert (rec_type, expr, notrunc_p);
       expr = build_component_ref (expr, NULL_TREE, field, false);
@@ -5352,10 +5359,9 @@ unchecked_convert (tree type, tree expr, bool notrunc_p)
       SET_TYPE_RM_SIZE (field_type, TYPE_RM_SIZE (etype));
 
       field = create_field_decl (get_identifier ("OBJ"), field_type, rec_type,
-                                NULL_TREE, NULL_TREE, 1, 0);
+                                NULL_TREE, bitsize_zero_node, 1, 0);
 
-      TYPE_FIELDS (rec_type) = field;
-      layout_type (rec_type);
+      finish_record_type (rec_type, field, 1, false);
 
       expr = fold_build1 (NOP_EXPR, field_type, expr);
       CONSTRUCTOR_APPEND_ELT (v, field, expr);
@@ -5412,6 +5418,19 @@ unchecked_convert (tree type, tree expr, bool notrunc_p)
                                       etype))
     expr = convert (type, expr);
 
+  /* If we are converting a CONSTRUCTOR to a more aligned RECORD_TYPE, bump
+     the alignment of the CONSTRUCTOR to speed up the copy operation.  */
+  else if (TREE_CODE (expr) == CONSTRUCTOR
+          && code == RECORD_TYPE
+          && TYPE_ALIGN (etype) < TYPE_ALIGN (type))
+    {
+      expr = convert (maybe_pad_type (etype, NULL_TREE, TYPE_ALIGN (type),
+                                     Empty, false, false, false, true),
+                     expr);
+      return unchecked_convert (type, expr, notrunc_p);
+    }
+
+  /* Otherwise, just build a VIEW_CONVERT_EXPR of the expression.  */
   else
     {
       expr = maybe_unconstrained_array (expr);