decl.c (gnat_to_gnu_entity): Tidy up.

	* 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.

From-SVN: r206796

gcc/ada/ChangeLog

 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.

gcc/ada/gcc-interface/decl.c

@@ -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,

gcc/ada/gcc-interface/utils.c

@@ -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);