CbC/CbC_gcc: gcc/ada/gcc-interface/decl.c comparison

comparison gcc/ada/gcc-interface/decl.c @ 145:1830386684a0

gcc-9.2.0

author	anatofuz
date	Thu, 13 Feb 2020 11:34:05 +0900
parents	84e7813d76e9
children

comparison

equal deleted inserted replaced

-:84e7813d76e9
+:1830386684a0
 *                                                                          *
 *                                 D E C L                                  *
 *                                                                          *
 *                          C Implementation File                           *
 *                                                                          *
-*          Copyright (C) 1992-2018, Free Software Foundation, Inc.         *
+*          Copyright (C) 1992-2019, 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- *
 * ware  Foundation;  either version 3,  or (at your option) any later ver- *
 * sion.  GNAT is distributed in the hope that it will be useful, but WITH- *
 (MAIN_STACK_BOUNDARY < PREFERRED_STACK_BOUNDARY)
 #else
 #define FOREIGN_FORCE_REALIGN_STACK 0
 #endif
+/* The largest TYPE_ARRAY_MAX_SIZE value we set on an array type.
+It's an artibrary limit (256 MB) above which we consider that
+the allocation is essentially unbounded.  */
+#define TYPE_ARRAY_SIZE_LIMIT (1 << 28)
 struct incomplete
 {
 struct incomplete *next;
 tree old_type;
 Entity_Id full_type;
 				   enum attrib_type, tree, tree, Node_Id);
 static void prepend_one_attribute_pragma (struct attrib **, Node_Id);
 static void prepend_attributes (struct attrib **, Entity_Id);
 static tree elaborate_expression (Node_Id, Entity_Id, const char *, bool, bool,
 				  bool);
-static bool type_has_variable_size (tree);
 static tree elaborate_expression_1 (tree, Entity_Id, const char *, bool, bool);
 static tree elaborate_expression_2 (tree, Entity_Id, const char *, bool, bool,
 				    unsigned int);
 static tree elaborate_reference (tree, Entity_Id, bool, tree *);
 static tree gnat_to_gnu_component_type (Entity_Id, bool, bool);
 static tree gnat_to_gnu_subprog_type (Entity_Id, bool, bool, tree *);
 static int adjust_packed (tree, tree, int);
 static tree gnat_to_gnu_field (Entity_Id, tree, int, bool, bool);
+static enum inline_status_t inline_status_for_subprog (Entity_Id);
 static tree gnu_ext_name_for_subprog (Entity_Id, tree);
 static void set_nonaliased_component_on_array_type (tree);
 static void set_reverse_storage_order_on_array_type (tree);
 static bool same_discriminant_p (Entity_Id, Entity_Id);
 static bool array_type_has_nonaliased_component (tree, Entity_Id);
 static bool compile_time_known_address_p (Node_Id);
 static bool cannot_be_superflat (Node_Id);
 static bool constructor_address_p (tree);
 static bool allocatable_size_p (tree, bool);
 static bool initial_value_needs_conversion (tree, tree);
+static tree update_n_elem (tree, tree, tree);
 static int compare_field_bitpos (const PTR, const PTR);
 static bool components_to_record (Node_Id, Entity_Id, tree, tree, int, bool,
 				  bool, bool, bool, bool, bool, bool, tree,
 				  tree *);
 static Uint annotate_value (tree);
 static void annotate_rep (Entity_Id, tree);
 static tree build_position_list (tree, bool, tree, tree, unsigned int, tree);
 static vec<subst_pair> build_subst_list (Entity_Id, Entity_Id, bool);
 static vec<variant_desc> build_variant_list (tree, vec<subst_pair>,
 					     vec<variant_desc>);
-static tree validate_size (Uint, tree, Entity_Id, enum tree_code, bool, bool);
+static tree maybe_saturate_size (tree);
+static tree validate_size (Uint, tree, Entity_Id, enum tree_code, bool, bool,
+			   const char *, const char *);
 static void set_rm_size (Uint, tree, Entity_Id);
 static unsigned int validate_alignment (Uint, Entity_Id, unsigned int);
 static unsigned int promote_object_alignment (tree, Entity_Id);
 static void check_ok_for_atomic_type (tree, Entity_Id, bool);
 static tree create_field_decl_from (tree, tree, tree, tree, tree,
 = (Is_Imported (gnat_entity) && No (Address_Clause (gnat_entity)));
 /* True if this entity has a foreign convention.  */
 const bool foreign = Has_Foreign_Convention (gnat_entity);
 /* For a type, contains the equivalent GNAT node to be used in gigi.  */
 Entity_Id gnat_equiv_type = Empty;
+/* For a type, contains the GNAT node to be used for back-annotation.  */
+Entity_Id gnat_annotate_type = Empty;
 /* Temporary used to walk the GNAT tree.  */
 Entity_Id gnat_temp;
 /* Contains the GCC DECL node which is equivalent to the input GNAT node.
 This node will be associated with the GNAT node by calling at the end
 of the `switch' statement.  */
 tree gnu_type = NULL_TREE;
 /* Contains the GCC size tree to be used for the GCC node.  */
 tree gnu_size = NULL_TREE;
 /* Contains the GCC name to be used for the GCC node.  */
 tree gnu_entity_name;
-/* True if we have already saved gnu_decl as a GNAT association.  */
+/* True if we have already saved gnu_decl as a GNAT association.  This can
+also be used to purposely avoid making such an association but this use
+case ought not to be applied to types because it can break the deferral
+mechanism implemented for access types.  */
 bool saved = false;
 /* True if we incremented defer_incomplete_level.  */
 bool this_deferred = false;
 /* True if we incremented force_global.  */
 bool this_global = false;
 /* Contains the list of attributes directly attached to the entity.  */
 struct attrib *attr_list = NULL;
 /* Since a use of an Itype is a definition, process it as such if it is in
 the main unit, except for E_Access_Subtype because it's actually a use
-of its base type, and for E_Record_Subtype with cloned subtype because
+of its base type, see below.  */
-it's actually a use of the cloned subtype, see below.  */
 if (!definition
 && is_type
 && Is_Itype (gnat_entity)
-&& !(kind == E_Access_Subtype
+&& Ekind (gnat_entity) != E_Access_Subtype
-	   || (kind == E_Record_Subtype
-	       && Present (Cloned_Subtype (gnat_entity))))
 && !present_gnu_tree (gnat_entity)
 && In_Extended_Main_Code_Unit (gnat_entity))
 {
 /* Ensure that we are in a subprogram mentioned in the Scope chain of
 	 this entity, our current scope is global, or we encountered a task
 	      return get_gnu_tree (gnat_entity);
 	    }
 	}
 /* This abort means the Itype has an incorrect scope, i.e. that its
-	 scope does not correspond to the subprogram it is declared in.  */
+	 scope does not correspond to the subprogram it is first used in.  */
 gcc_unreachable ();
 }
 /* If we've already processed this entity, return what we got last time.
 If we are defining the node, we should not have already processed it.
 In that case, we will abort below when we try to save a new GCC tree
 for this object.  We also need to handle the case of getting a dummy
 type when a Full_View exists but be careful so as not to trigger its
-premature elaboration.  */
+premature elaboration.  Likewise for a cloned subtype without its own
+freeze node, which typically happens when a generic gets instantiated
+on an incomplete or private type.  */
 if ((!definition || (is_type && imported_p))
 && present_gnu_tree (gnat_entity))
 {
 gnu_decl = get_gnu_tree (gnat_entity);
 	  && Present (Full_View (gnat_entity))
 	  && (present_gnu_tree (Full_View (gnat_entity))
 	      || No (Freeze_Node (Full_View (gnat_entity)))))
 	{
 	  gnu_decl
-	    = gnat_to_gnu_entity (Full_View (gnat_entity), NULL_TREE, false);
+	    = gnat_to_gnu_entity (Full_View (gnat_entity), NULL_TREE,
+				  false);
+	  save_gnu_tree (gnat_entity, NULL_TREE, false);
+	  save_gnu_tree (gnat_entity, gnu_decl, false);
+	}
+if (TREE_CODE (gnu_decl) == TYPE_DECL
+	  && TYPE_IS_DUMMY_P (TREE_TYPE (gnu_decl))
+	  && Ekind (gnat_entity) == E_Record_Subtype
+	  && No (Freeze_Node (gnat_entity))
+	  && Present (Cloned_Subtype (gnat_entity))
+	  && (present_gnu_tree (Cloned_Subtype (gnat_entity))
+	      || No (Freeze_Node (Cloned_Subtype (gnat_entity)))))
+	{
+	  gnu_decl
+	    = gnat_to_gnu_entity (Cloned_Subtype (gnat_entity), NULL_TREE,
+				  false);
 	  save_gnu_tree (gnat_entity, NULL_TREE, false);
 	  save_gnu_tree (gnat_entity, gnu_decl, false);
 	}
 return gnu_decl;
 /* If we get here, it means we have not yet done anything with this entity.
 If we are not defining it, it must be a type or an entity that is defined
 elsewhere or externally, otherwise we should have defined it already.  */
 gcc_assert (definition
-	      || type_annotate_only
 	      || is_type
 	      || kind == E_Discriminant
 	      || kind == E_Component
 	      || kind == E_Label
 	      || (kind == E_Constant && Present (Full_View (gnat_entity)))
-	      || Is_Public (gnat_entity));
+	      || Is_Public (gnat_entity)
+	      || type_annotate_only);
 /* Get the name of the entity and set up the line number and filename of
 the original definition for use in any decl we make.  Make sure we do
 not inherit another source location.  */
 gnu_entity_name = get_entity_name (gnat_entity);
 	/* Here we have no GCC type and this is a reference rather than a
 	   definition.  This should never happen.  Most likely the cause is
 	   reference before declaration in the GNAT tree for gnat_entity.  */
 	gcc_unreachable ();
 }
+case E_Named_Integer:
+case E_Named_Real:
+{
+	tree gnu_ext_name = NULL_TREE;
+	if (Is_Public (gnat_entity))
+	  gnu_ext_name = create_concat_name (gnat_entity, NULL);
+	/* All references are supposed to be folded in the front-end.  */
+	gcc_assert (definition && gnu_expr);
+	gnu_type = gnat_to_gnu_type (Etype (gnat_entity));
+	gnu_expr = convert (gnu_type, gnu_expr);
+	/* Build a CONST_DECL for debugging purposes exclusively.  */
+	gnu_decl
+	  = create_var_decl (gnu_entity_name, gnu_ext_name, gnu_type,
+			     gnu_expr, true, Is_Public (gnat_entity),
+			     false, false, false, artificial_p,
+			     debug_info_p, NULL, gnat_entity, true);
+}
+break;
 case E_Constant:
 /* Ignore constant definitions already marked with the error node.  See
 	 the N_Object_Declaration case of gnat_to_gnu for the rationale.  */
 if (definition
 	/* Likewise, if a size is specified, use it if valid.  */
 	if (Known_Esize (gnat_entity))
 	  gnu_size
 	    = validate_size (Esize (gnat_entity), gnu_type, gnat_entity,
-			     VAR_DECL, false, Has_Size_Clause (gnat_entity));
+			     VAR_DECL, false, Has_Size_Clause (gnat_entity),
+			     NULL, NULL);
 	if (gnu_size)
 	  {
 	    gnu_type
 	      = make_type_from_size (gnu_type, gnu_size,
 				     Has_Biased_Representation (gnat_entity));
 	  SET_DECL_RENAMED_OBJECT (gnu_decl, renamed_obj);
 	/* If this is a constant and we are defining it or it generates a real
 	   symbol at the object level and we are referencing it, we may want
 	   or need to have a true variable to represent it:
-	     - if optimization isn't enabled, for debugging purposes,
 	     - if the constant is public and not overlaid on something else,
 	     - if its address is taken,
-	     - if either itself or its type is aliased.  */
+	     - if it is aliased,
+	     - if optimization isn't enabled, for debugging purposes.  */
 	if (TREE_CODE (gnu_decl) == CONST_DECL
 	    && (definition || Sloc (gnat_entity) > Standard_Location)
-	    && ((!optimize && debug_info_p)
+	    && ((Is_Public (gnat_entity) && No (Address_Clause (gnat_entity)))
-		|| (Is_Public (gnat_entity)
-		    && No (Address_Clause (gnat_entity)))
 		|| Address_Taken (gnat_entity)
 		|| Is_Aliased (gnat_entity)
-		|| Is_Aliased (gnat_type)))
+		|| (!optimize && debug_info_p)))
 	  {
 	    tree gnu_corr_var
 	      = create_var_decl (gnu_entity_name, gnu_ext_name, gnu_type,
 				 gnu_expr, true, Is_Public (gnat_entity),
 				 !definition, static_flag, volatile_flag,
 				 artificial_p, debug_info_p && definition,
 				 attr_list, gnat_entity, false);
 	    SET_DECL_CONST_CORRESPONDING_VAR (gnu_decl, gnu_corr_var);
+	    DECL_IGNORED_P (gnu_decl) = 1;
 	  }
 	/* If this is a constant, even if we don't need a true variable, we
 	   may need to avoid returning the initializer in every case.  That
 	   can happen for the address of a (constant) constructor because,
 }
 goto discrete_type;
 case E_Modular_Integer_Type:
 {
+	/* Packed Array Impl. Types are supposed to be subtypes only.  */
+	gcc_assert (!Is_Packed_Array_Impl_Type (gnat_entity));
 	/* For modular types, make the unsigned type of the proper number
 	   of bits and then set up the modulus, if required.  */
-	tree gnu_modulus, gnu_high = NULL_TREE;
-	/* Packed Array Impl. Types are supposed to be subtypes only.  */
-	gcc_assert (!Is_Packed_Array_Impl_Type (gnat_entity));
 	gnu_type = make_unsigned_type (esize);
-	/* Get the modulus in this type.  If it overflows, assume it is because
+	/* Get the modulus in this type.  If the modulus overflows, assume
-	   it is equal to 2**Esize.  Note that there is no overflow checking
+	   that this is because it was equal to 2**Esize.  Note that there
-	   done on unsigned type, so we detect the overflow by looking for
+	   is no overflow checking done on unsigned types, so we detect the
-	   a modulus of zero, which is otherwise invalid.  */
+	   overflow by looking for a modulus of zero, which is invalid.  */
-	gnu_modulus = UI_To_gnu (Modulus (gnat_entity), gnu_type);
+	tree gnu_modulus = UI_To_gnu (Modulus (gnat_entity), gnu_type);
+	/* If the modulus is not 2**Esize, then this also means that the upper
+	   bound of the type, i.e. modulus - 1, is not maximal, so we create an
+	   extra subtype to carry it and set the modulus on the base type.  */
 	if (!integer_zerop (gnu_modulus))
 	  {
+	    TYPE_NAME (gnu_type) = create_concat_name (gnat_entity, "UMT");
 	    TYPE_MODULAR_P (gnu_type) = 1;
 	    SET_TYPE_MODULUS (gnu_type, gnu_modulus);
-	    gnu_high = fold_build2 (MINUS_EXPR, gnu_type, gnu_modulus,
+	    tree gnu_high = fold_build2 (MINUS_EXPR, gnu_type, gnu_modulus,
-				    build_int_cst (gnu_type, 1));
+					 build_int_cst (gnu_type, 1));
-	  }
+	    gnu_type
+	      = create_extra_subtype (gnu_type, TYPE_MIN_VALUE (gnu_type),
-	/* If the upper bound is not maximal, make an extra subtype.  */
+				      gnu_high);
-	if (gnu_high
-	    && !tree_int_cst_equal (gnu_high, TYPE_MAX_VALUE (gnu_type)))
-	  {
-	    tree gnu_subtype = make_unsigned_type (esize);
-	    SET_TYPE_RM_MAX_VALUE (gnu_subtype, gnu_high);
-	    TREE_TYPE (gnu_subtype) = gnu_type;
-	    TYPE_EXTRA_SUBTYPE_P (gnu_subtype) = 1;
-	    TYPE_NAME (gnu_type) = create_concat_name (gnat_entity, "UMT");
-	    gnu_type = gnu_subtype;
 	  }
 }
 goto discrete_type;
 case E_Signed_Integer_Subtype:
 if (TREE_CODE (gnu_type) == INTEGER_TYPE)
 	TYPE_BIASED_REPRESENTATION_P (gnu_type)
 	  = Has_Biased_Representation (gnat_entity);
 /* Do the same processing for Character subtypes as for types.  */
-if (TYPE_STRING_FLAG (TREE_TYPE (gnu_type)))
+if (TREE_CODE (TREE_TYPE (gnu_type)) == INTEGER_TYPE
+	  && TYPE_STRING_FLAG (TREE_TYPE (gnu_type)))
 	{
 	  TYPE_NAME (gnu_type) = gnu_entity_name;
 	  TYPE_STRING_FLAG (gnu_type) = 1;
 	  TYPE_ARTIFICIAL (gnu_type) = artificial_p;
 	  finish_character_type (gnu_type);
 	tree gnu_template_type;
 	tree gnu_ptr_template;
 	tree gnu_template_reference, gnu_template_fields, gnu_fat_type;
 	tree *gnu_index_types = XALLOCAVEC (tree, ndim);
 	tree *gnu_temp_fields = XALLOCAVEC (tree, ndim);
-	tree gnu_max_size = size_one_node, gnu_max_size_unit, tem, t;
+	tree gnu_max_size = size_one_node, tem, t;
 	Entity_Id gnat_index, gnat_name;
 	int index;
 	tree comp_type;
 	/* Create the type for the component now, as it simplifies breaking
 	     index += (convention_fortran_p ? - 1 : 1),
 	     gnat_index = Next_Index (gnat_index))
 	  {
 	    char field_name[16];
 	    tree gnu_index_type = get_unpadded_type (Etype (gnat_index));
-	    tree gnu_index_base_type
+	    tree gnu_orig_min = TYPE_MIN_VALUE (gnu_index_type);
-	      = maybe_character_type (get_base_type (gnu_index_type));
+	    tree gnu_orig_max = TYPE_MAX_VALUE (gnu_index_type);
-	    tree gnu_lb_field, gnu_hb_field, gnu_orig_min, gnu_orig_max;
+	    tree gnu_index_base_type = get_base_type (gnu_index_type);
+	    tree gnu_lb_field, gnu_hb_field;
 	    tree gnu_min, gnu_max, gnu_high;
+	    /* Update the maximum size of the array in elements.  */
+	    if (gnu_max_size)
+	      gnu_max_size
+		= update_n_elem (gnu_max_size, gnu_orig_min, gnu_orig_max);
+	    /* Now build the self-referential bounds of the index type.  */
+	    gnu_index_type = maybe_character_type (gnu_index_type);
+	    gnu_index_base_type = maybe_character_type (gnu_index_base_type);
 	    /* Make the FIELD_DECLs for the low and high bounds of this
 	       type and then make extractions of these fields from the
 	       template.  */
 	    sprintf (field_name, "LB%d", index);
 	    gnu_lb_field = create_field_decl (get_identifier (field_name),
-					      gnu_index_base_type,
+					      gnu_index_type,
 					      gnu_template_type, NULL_TREE,
 					      NULL_TREE, 0, 0);
 	    Sloc_to_locus (Sloc (gnat_entity),
 			   &DECL_SOURCE_LOCATION (gnu_lb_field));
 	    field_name[0] = 'U';
 	    gnu_hb_field = create_field_decl (get_identifier (field_name),
-					      gnu_index_base_type,
+					      gnu_index_type,
 					      gnu_template_type, NULL_TREE,
 					      NULL_TREE, 0, 0);
 	    Sloc_to_locus (Sloc (gnat_entity),
 			   &DECL_SOURCE_LOCATION (gnu_hb_field));
 	    gnu_temp_fields[index] = chainon (gnu_lb_field, gnu_hb_field);
 	    /* We can't use build_component_ref here since the template type
 	       isn't complete yet.  */
-	    gnu_orig_min = build3 (COMPONENT_REF, gnu_index_base_type,
+	    gnu_orig_min = build3 (COMPONENT_REF, TREE_TYPE (gnu_lb_field),
 				   gnu_template_reference, gnu_lb_field,
 				   NULL_TREE);
-	    gnu_orig_max = build3 (COMPONENT_REF, gnu_index_base_type,
+	    gnu_orig_max = build3 (COMPONENT_REF, TREE_TYPE (gnu_hb_field),
 				   gnu_template_reference, gnu_hb_field,
 				   NULL_TREE);
 	    TREE_READONLY (gnu_orig_min) = TREE_READONLY (gnu_orig_max) = 1;
 	    gnu_min = convert (sizetype, gnu_orig_min);
 	      = create_index_type (gnu_min, gnu_high,
 				   create_range_type (gnu_index_base_type,
 						      gnu_orig_min,
 						      gnu_orig_max),
 				   gnat_entity);
-	    /* Update the maximum size of the array in elements.  */
-	    if (gnu_max_size)
-	      {
-		tree gnu_min
-		  = convert (sizetype, TYPE_MIN_VALUE (gnu_index_type));
-		tree gnu_max
-		  = convert (sizetype, TYPE_MAX_VALUE (gnu_index_type));
-		tree gnu_this_max
-		  = size_binop (PLUS_EXPR, size_one_node,
-				size_binop (MINUS_EXPR, gnu_max, gnu_min));
-		if (TREE_CODE (gnu_this_max) == INTEGER_CST
-		    && TREE_OVERFLOW (gnu_this_max))
-		  gnu_max_size = NULL_TREE;
-		else
-		  gnu_max_size
-		    = size_binop (MULT_EXPR, gnu_max_size, gnu_this_max);
-	      }
 	    TYPE_NAME (gnu_index_types[index])
 	      = create_concat_name (gnat_entity, field_name);
 	  }
 	   size of the component.  */
 	if (Unknown_Component_Size (gnat_entity))
 	  Set_Component_Size (gnat_entity,
 annotate_value (TYPE_SIZE (comp_type)));
-	/* Compute the maximum size of the array in units and bits.  */
+	/* Compute the maximum size of the array in units.  */
 	if (gnu_max_size)
-	  {
+	  gnu_max_size
-	    gnu_max_size_unit = size_binop (MULT_EXPR, gnu_max_size,
+	    = size_binop (MULT_EXPR, gnu_max_size, TYPE_SIZE_UNIT (comp_type));
-					    TYPE_SIZE_UNIT (comp_type));
-	    gnu_max_size = size_binop (MULT_EXPR,
-				       convert (bitsizetype, gnu_max_size),
-				       TYPE_SIZE (comp_type));
-	  }
-	else
-	  gnu_max_size_unit = NULL_TREE;
 	/* Now build the array type.  */
 tem = comp_type;
 	for (index = ndim - 1; index >= 0; index--)
 	  {
 	/* If the maximum size doesn't overflow, use it.  */
 	if (gnu_max_size
 	    && TREE_CODE (gnu_max_size) == INTEGER_CST
 	    && !TREE_OVERFLOW (gnu_max_size)
-	    && TREE_CODE (gnu_max_size_unit) == INTEGER_CST
+	    && compare_tree_int (gnu_max_size, TYPE_ARRAY_SIZE_LIMIT) <= 0)
-	    && !TREE_OVERFLOW (gnu_max_size_unit))
+	  TYPE_ARRAY_MAX_SIZE (tem) = gnu_max_size;
-	  {
-	    TYPE_SIZE (tem) = size_binop (MIN_EXPR, gnu_max_size,
-					  TYPE_SIZE (tem));
-	    TYPE_SIZE_UNIT (tem) = size_binop (MIN_EXPR, gnu_max_size_unit,
-					       TYPE_SIZE_UNIT (tem));
-	  }
 	create_type_decl (create_concat_name (gnat_entity, "XUA"), tem,
 			  artificial_p, debug_info_p, gnat_entity);
 	/* If told to generate GNAT encodings for them (GDB rely on them at the
 	  const bool convention_fortran_p
 	    = (Convention (gnat_entity) == Convention_Fortran);
 	  const int ndim = Number_Dimensions (gnat_entity);
 	  tree gnu_base_type = gnu_type;
 	  tree *gnu_index_types = XALLOCAVEC (tree, ndim);
-	  tree gnu_max_size = size_one_node, gnu_max_size_unit;
+	  tree gnu_max_size = size_one_node;
 	  bool need_index_type_struct = false;
 	  int index;
 	  /* First create the GCC type for each index and find out whether
 	     special types are needed for debugging information.  */
 	       index += (convention_fortran_p ? - 1 : 1),
 	       gnat_index = Next_Index (gnat_index),
 	       gnat_base_index = Next_Index (gnat_base_index))
 	    {
 	      tree gnu_index_type = get_unpadded_type (Etype (gnat_index));
-	      tree gnu_index_base_type
+	      tree gnu_orig_min = TYPE_MIN_VALUE (gnu_index_type);
-		= maybe_character_type (get_base_type (gnu_index_type));
+	      tree gnu_orig_max = TYPE_MAX_VALUE (gnu_index_type);
-	      tree gnu_orig_min
+	      tree gnu_index_base_type = get_base_type (gnu_index_type);
-		= convert (gnu_index_base_type,
-			   TYPE_MIN_VALUE (gnu_index_type));
-	      tree gnu_orig_max
-		= convert (gnu_index_base_type,
-			   TYPE_MAX_VALUE (gnu_index_type));
-	      tree gnu_min = convert (sizetype, gnu_orig_min);
-	      tree gnu_max = convert (sizetype, gnu_orig_max);
 	      tree gnu_base_index_type
 		= get_unpadded_type (Etype (gnat_base_index));
-	      tree gnu_base_index_base_type
+	      tree gnu_base_orig_min = TYPE_MIN_VALUE (gnu_base_index_type);
-	        = maybe_character_type (get_base_type (gnu_base_index_type));
+	      tree gnu_base_orig_max = TYPE_MAX_VALUE (gnu_base_index_type);
-	      tree gnu_base_orig_min
+	      tree gnu_min, gnu_max, gnu_high;
-		= convert (gnu_base_index_base_type,
-			   TYPE_MIN_VALUE (gnu_base_index_type));
+	      /* We try to define subtypes for discriminants used as bounds
-	      tree gnu_base_orig_max
+		 that are more restrictive than those declared by using the
-	        = convert (gnu_base_index_base_type,
+		 bounds of the index type of the base array type.  This will
-			   TYPE_MAX_VALUE (gnu_base_index_type));
+		 make it possible to calculate the maximum size of the record
-	      tree gnu_high;
+		 type more conservatively.  This may have already been done by
+		 the front-end (Exp_Ch3.Adjust_Discriminants), in which case
+		 there will be a conversion that needs to be removed first.  */
+	      if (CONTAINS_PLACEHOLDER_P (gnu_orig_min)
+		  && TYPE_RM_SIZE (gnu_base_index_type)
+		  && !tree_int_cst_lt (TYPE_RM_SIZE (gnu_index_type),
+				       TYPE_RM_SIZE (gnu_base_index_type)))
+		{
+		  gnu_orig_min = remove_conversions (gnu_orig_min, false);
+		  TREE_TYPE (gnu_orig_min)
+		    = create_extra_subtype (TREE_TYPE (gnu_orig_min),
+					    gnu_base_orig_min,
+					    gnu_base_orig_max);
+		}
+	      if (CONTAINS_PLACEHOLDER_P (gnu_orig_max)
+		  && TYPE_RM_SIZE (gnu_base_index_type)
+		  && !tree_int_cst_lt (TYPE_RM_SIZE (gnu_index_type),
+				       TYPE_RM_SIZE (gnu_base_index_type)))
+		{
+		  gnu_orig_max = remove_conversions (gnu_orig_max, false);
+		  TREE_TYPE (gnu_orig_max)
+		    = create_extra_subtype (TREE_TYPE (gnu_orig_max),
+					    gnu_base_orig_min,
+					    gnu_base_orig_max);
+		}
+	      /* Update the maximum size of the array in elements.  Here we
+		 see if any constraint on the index type of the base type
+		 can be used in the case of self-referential bounds on the
+		 index type of the array type. We look for a non-"infinite"
+		 and non-self-referential bound from any type involved and
+		 handle each bound separately.  */
+	      if (gnu_max_size)
+		{
+		  if (CONTAINS_PLACEHOLDER_P (gnu_orig_min))
+		    gnu_min = gnu_base_orig_min;
+		  else
+		    gnu_min = gnu_orig_min;
+		  if (TREE_CODE (gnu_min) != INTEGER_CST
+		      || TREE_OVERFLOW (gnu_min))
+		    gnu_min = TYPE_MIN_VALUE (TREE_TYPE (gnu_min));
+		  if (CONTAINS_PLACEHOLDER_P (gnu_orig_max))
+		    gnu_max = gnu_base_orig_max;
+		  else
+		    gnu_max = gnu_orig_max;
+		  if (TREE_CODE (gnu_max) != INTEGER_CST
+		      || TREE_OVERFLOW (gnu_max))
+		    gnu_max = TYPE_MAX_VALUE (TREE_TYPE (gnu_max));
+		  gnu_max_size
+		    = update_n_elem (gnu_max_size, gnu_min, gnu_max);
+		}
+	      /* Convert the bounds to the base type for consistency below.  */
+	      gnu_index_base_type = maybe_character_type (gnu_index_base_type);
+	      gnu_orig_min = convert (gnu_index_base_type, gnu_orig_min);
+	      gnu_orig_max = convert (gnu_index_base_type, gnu_orig_max);
+	      gnu_min = convert (sizetype, gnu_orig_min);
+	      gnu_max = convert (sizetype, gnu_orig_max);
 	      /* See if the base array type is already flat.  If it is, we
 		 are probably compiling an ACATS test but it will cause the
 		 code below to malfunction if we don't handle it specially.  */
 	      if (TREE_CODE (gnu_base_orig_min) == INTEGER_CST
 	      else if (TREE_CODE (gnu_min) == INTEGER_CST
 		       && TREE_CODE (gnu_max) == INTEGER_CST
 		       && TREE_OVERFLOW (gnu_min) && TREE_OVERFLOW (gnu_max)
 		       && !TREE_OVERFLOW
 			   (convert (sizetype,
-				     fold_build2 (MINUS_EXPR, gnu_index_type,
+				     fold_build2 (MINUS_EXPR,
+						  gnu_index_base_type,
 						  gnu_orig_max,
 						  gnu_orig_min))))
 		{
 		  TREE_OVERFLOW (gnu_min) = 0;
 		  TREE_OVERFLOW (gnu_max) = 0;
 				       int_const_binop (PLUS_EXPR, gnu_max,
 							size_one_node));
 		}
 	      /* Finally we use (hb >= lb) ? hb : lb - 1 for the upper bound
-		 in all the other cases.  Note that, here as well as above,
+		 in all the other cases.  Note that we use int_const_binop for
-		 the condition used in the comparison must be equivalent to
+		 the shift by 1 if the bound is constant to avoid any unwanted
-		 the condition (length != 0).  This is relied upon in order
+		 overflow.  */
-		 to optimize array comparisons in compare_arrays.  Moreover
-		 we use int_const_binop for the shift by 1 if the bound is
-		 constant to avoid any unwanted overflow.  */
 	      else
 		gnu_high
 		  = build_cond_expr (sizetype,
 				     build_binary_op (GE_EXPR,
 						      boolean_type_node,
 	      /* Reuse the index type for the range type.  Then make an index
 		 type with the size range in sizetype.  */
 	      gnu_index_types[index]
 		= create_index_type (gnu_min, gnu_high, gnu_index_type,
 				     gnat_entity);
-	      /* Update the maximum size of the array in elements.  Here we
-		 see if any constraint on the index type of the base type
-		 can be used in the case of self-referential bound on the
-		 index type of the subtype.  We look for a non-"infinite"
-		 and non-self-referential bound from any type involved and
-		 handle each bound separately.  */
-	      if (gnu_max_size)
-		{
-		  tree gnu_base_min = convert (sizetype, gnu_base_orig_min);
-		  tree gnu_base_max = convert (sizetype, gnu_base_orig_max);
-		  tree gnu_base_base_min
-		    = convert (sizetype,
-			       TYPE_MIN_VALUE (gnu_base_index_base_type));
-		  tree gnu_base_base_max
-		    = convert (sizetype,
-			       TYPE_MAX_VALUE (gnu_base_index_base_type));
-		  if (!CONTAINS_PLACEHOLDER_P (gnu_min)
-		      || !(TREE_CODE (gnu_base_min) == INTEGER_CST
-			   && !TREE_OVERFLOW (gnu_base_min)))
-		    gnu_base_min = gnu_min;
-		  if (!CONTAINS_PLACEHOLDER_P (gnu_max)
-		      || !(TREE_CODE (gnu_base_max) == INTEGER_CST
-			   && !TREE_OVERFLOW (gnu_base_max)))
-		    gnu_base_max = gnu_max;
-		  if ((TREE_CODE (gnu_base_min) == INTEGER_CST
-		       && TREE_OVERFLOW (gnu_base_min))
-		      || operand_equal_p (gnu_base_min, gnu_base_base_min, 0)
-		      || (TREE_CODE (gnu_base_max) == INTEGER_CST
-			  && TREE_OVERFLOW (gnu_base_max))
-		      || operand_equal_p (gnu_base_max, gnu_base_base_max, 0))
-		    gnu_max_size = NULL_TREE;
-		  else
-		    {
-		      tree gnu_this_max;
-		      /* Use int_const_binop if the bounds are constant to
-			 avoid any unwanted overflow.  */
-		      if (TREE_CODE (gnu_base_min) == INTEGER_CST
-			  && TREE_CODE (gnu_base_max) == INTEGER_CST)
-			gnu_this_max
-			  = int_const_binop (PLUS_EXPR, size_one_node,
-					     int_const_binop (MINUS_EXPR,
-							      gnu_base_max,
-							      gnu_base_min));
-		      else
-			gnu_this_max
-			  = size_binop (PLUS_EXPR, size_one_node,
-					size_binop (MINUS_EXPR,
-						    gnu_base_max,
-						    gnu_base_min));
-		      gnu_max_size
-			= size_binop (MULT_EXPR, gnu_max_size, gnu_this_max);
-		    }
-		}
 	      /* We need special types for debugging information to point to
 		 the index types if they have variable bounds, are not integer
 		 types, are biased or are wider than sizetype.  These are GNAT
 		 encodings, so we have to include them only when all encodings
 		  maybe_present = true;
 		  break;
 		}
 	    }
-	  /* Compute the maximum size of the array in units and bits.  */
+	  /* Compute the maximum size of the array in units.  */
 	  if (gnu_max_size)
-	    {
+	    gnu_max_size
-	      gnu_max_size_unit = size_binop (MULT_EXPR, gnu_max_size,
+	      = size_binop (MULT_EXPR, gnu_max_size, TYPE_SIZE_UNIT (gnu_type));
-					      TYPE_SIZE_UNIT (gnu_type));
-	      gnu_max_size = size_binop (MULT_EXPR,
-					 convert (bitsizetype, gnu_max_size),
-					 TYPE_SIZE (gnu_type));
-	    }
-	  else
-	    gnu_max_size_unit = NULL_TREE;
 	  /* Now build the array type.  */
 	  for (index = ndim - 1; index >= 0; index --)
 	    {
 	      gnu_type = build_nonshared_array_type (gnu_type,
 	   can output the appropriate description for them.  */
 	  TYPE_PACKED (gnu_type)
 	    = (Is_Packed (gnat_entity)
 	       || Is_Packed_Array_Impl_Type (gnat_entity));
-	  /* If the size is self-referential and the maximum size doesn't
+	  /* If the maximum size doesn't overflow, use it.  */
-	     overflow, use it.  */
+	  if (gnu_max_size
-	  if (CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_type))
+	      && TREE_CODE (gnu_max_size) == INTEGER_CST
-	      && gnu_max_size
+	      && !TREE_OVERFLOW (gnu_max_size)
-	      && !(TREE_CODE (gnu_max_size) == INTEGER_CST
+	      && compare_tree_int (gnu_max_size, TYPE_ARRAY_SIZE_LIMIT) <= 0)
-		   && TREE_OVERFLOW (gnu_max_size))
+	    TYPE_ARRAY_MAX_SIZE (gnu_type) = gnu_max_size;
-	      && !(TREE_CODE (gnu_max_size_unit) == INTEGER_CST
-		   && TREE_OVERFLOW (gnu_max_size_unit)))
-	    {
-	      TYPE_SIZE (gnu_type) = size_binop (MIN_EXPR, gnu_max_size,
-						 TYPE_SIZE (gnu_type));
-	      TYPE_SIZE_UNIT (gnu_type)
-		= size_binop (MIN_EXPR, gnu_max_size_unit,
-			      TYPE_SIZE_UNIT (gnu_type));
-	    }
 	  /* Set our alias set to that of our base type.  This gives all
 	     array subtypes the same alias set.  */
 	  relate_alias_sets (gnu_type, gnu_base_type, ALIAS_SET_COPY);
 		    {
 		      /* The TYPE_ACTUAL_BOUNDS field is overloaded with the
 			 TYPE_MODULUS for modular types so we make an extra
 			 subtype if necessary.  */
 		      if (TYPE_MODULAR_P (gnu_inner))
-			{
+			gnu_inner
-			  tree gnu_subtype
+			  = create_extra_subtype (gnu_inner,
-			    = make_unsigned_type (TYPE_PRECISION (gnu_inner));
+						  TYPE_MIN_VALUE (gnu_inner),
-			  TREE_TYPE (gnu_subtype) = gnu_inner;
+						  TYPE_MAX_VALUE (gnu_inner));
-			  TYPE_EXTRA_SUBTYPE_P (gnu_subtype) = 1;
-			  SET_TYPE_RM_MIN_VALUE (gnu_subtype,
-						 TYPE_MIN_VALUE (gnu_inner));
-			  SET_TYPE_RM_MAX_VALUE (gnu_subtype,
-						 TYPE_MAX_VALUE (gnu_inner));
-			  gnu_inner = gnu_subtype;
-			}
 		      TYPE_HAS_ACTUAL_BOUNDS_P (gnu_inner) = 1;
 		      /* Check for other cases of overloading.  */
 		      gcc_checking_assert (!TYPE_ACTUAL_BOUNDS (gnu_inner));
 	    : Component_Alignment (gnat_entity) == Calign_Storage_Unit
 	      ? -1
 	      : 0;
 	const bool has_align = Known_Alignment (gnat_entity);
 	const bool has_discr = Has_Discriminants (gnat_entity);
-	const bool has_rep = Has_Specified_Layout (gnat_entity);
 	const bool is_extension
 	  = (Is_Tagged_Type (gnat_entity)
 	     && Nkind (record_definition) == N_Derived_Type_Definition);
+	const bool has_rep
+	  = is_extension
+	    ? Has_Record_Rep_Clause (gnat_entity)
+	    : Has_Specified_Layout (gnat_entity);
 	const bool is_unchecked_union = Is_Unchecked_Union (gnat_entity);
 	bool all_rep = has_rep;
 	/* See if all fields have a rep clause.  Stop when we find one
 	   that doesn't.  */
 	  {
 	    if (!type_annotate_only
 		|| Present (Record_Extension_Part (record_definition)))
 	      record_definition = Record_Extension_Part (record_definition);
-	    gcc_assert (type_annotate_only
+	    gcc_assert (Present (Parent_Subtype (gnat_entity))
-			|| Present (Parent_Subtype (gnat_entity)));
+		        || type_annotate_only);
 	  }
 	/* Make a node for the record.  If we are not defining the record,
 	   suppress expanding incomplete types.  */
 	gnu_type = make_node (tree_code_for_record_type (gnat_entity));
 					      gnat_entity, 0));
 	else
 	  {
 	    SET_TYPE_ALIGN (gnu_type, 0);
-	    /* If a type needs strict alignment, the minimum size will be the
+	    /* If a type needs strict alignment, then its type size will also
-	       type size instead of the RM size (see validate_size).  Cap the
+	       be the RM size (see below).  Cap the alignment if needed, lest
-	       alignment lest it causes this type size to become too large.  */
+	       it may cause this type size to become too large.  */
 	    if (Strict_Alignment (gnat_entity) && Known_RM_Size (gnat_entity))
 	      {
 		unsigned int max_size = UI_To_Int (RM_Size (gnat_entity));
+		unsigned int max_align = max_size & -max_size;
+		if (max_align < BIGGEST_ALIGNMENT)
+		  TYPE_MAX_ALIGN (gnu_type) = max_align;
+	      }
+	    /* Similarly if an Object_Size clause has been specified.  */
+	    else if (Known_Esize (gnat_entity))
+	      {
+		unsigned int max_size = UI_To_Int (Esize (gnat_entity));
 		unsigned int max_align = max_size & -max_size;
 		if (max_align < BIGGEST_ALIGNMENT)
 		  TYPE_MAX_ALIGN (gnu_type) = max_align;
 	      }
 	  }
 	    if (Nkind (Node (gnat_constr)) == N_Identifier
 		/* Ignore access discriminants.  */
 		&& !Is_Access_Type (Etype (Node (gnat_constr)))
 		&& Ekind (Entity (Node (gnat_constr))) == E_Discriminant)
 	      {
-		Entity_Id gnat_discr = Entity (Node (gnat_constr));
+		const Entity_Id gnat_discr = Entity (Node (gnat_constr));
 		tree gnu_discr_type = gnat_to_gnu_type (Etype (gnat_discr));
 		tree gnu_ref
 		  = gnat_to_gnu_entity (Original_Record_Component (gnat_discr),
 					NULL_TREE, false);
 		/* GNU_REF must be an expression using a PLACEHOLDER_EXPR built
 		   just above for one of the stored discriminants.  */
 		gcc_assert (TREE_TYPE (TREE_OPERAND (gnu_ref, 0)) == gnu_type);
 		if (gnu_discr_type != TREE_TYPE (gnu_ref))
-		  {
+		  TREE_TYPE (gnu_ref)
-		    const unsigned prec = TYPE_PRECISION (TREE_TYPE (gnu_ref));
+		    = create_extra_subtype (TREE_TYPE (gnu_ref),
-		    tree gnu_subtype
+					    TYPE_MIN_VALUE (gnu_discr_type),
-		      = TYPE_UNSIGNED (TREE_TYPE (gnu_ref))
+					    TYPE_MAX_VALUE (gnu_discr_type));
-		        ? make_unsigned_type (prec) : make_signed_type (prec);
-		    TREE_TYPE (gnu_subtype) = TREE_TYPE (gnu_ref);
-		    TYPE_EXTRA_SUBTYPE_P (gnu_subtype) = 1;
-		    SET_TYPE_RM_MIN_VALUE (gnu_subtype,
-					   TYPE_MIN_VALUE (gnu_discr_type));
-		    SET_TYPE_RM_MAX_VALUE (gnu_subtype,
-					   TYPE_MAX_VALUE (gnu_discr_type));
-		    TREE_TYPE (gnu_ref)
-		      = TREE_TYPE (TREE_OPERAND (gnu_ref, 1)) = gnu_subtype;
-		  }
 	      }
 	/* If this is a derived type with discriminants and these discriminants
 	   affect the initial shape it has inherited, factor them in.  */
 	if (has_discr
 		TYPE_SIZE (gnu_type) = bitsize_unit_node;
 		TYPE_SIZE_UNIT (gnu_type) = size_one_node;
 		compute_record_mode (gnu_type);
 	      }
+	    /* If the type needs strict alignment, then no object of the type
+	       may have a size smaller than the natural size, which means that
+	       the RM size of the type is equal to the type size.  */
+	    if (Strict_Alignment (gnat_entity))
+	      SET_TYPE_ADA_SIZE (gnu_type, TYPE_SIZE (gnu_type));
 	    /* If there are entities in the chain corresponding to components
 	       that we did not elaborate, ensure we elaborate their types if
 	       they are Itypes.  */
 	    for (gnat_temp = First_Entity (gnat_entity);
 		 Present (gnat_temp);
 /* ... fall through ... */
 case E_Record_Subtype:
 /* If Cloned_Subtype is Present it means this record subtype has
 	 identical layout to that type or subtype and we should use
-	 that GCC type for this one.  The front end guarantees that
+	 that GCC type for this one.  The front-end guarantees that
 	 the component list is shared.  */
 if (Present (Cloned_Subtype (gnat_entity)))
 	{
 	  gnu_decl = gnat_to_gnu_entity (Cloned_Subtype (gnat_entity),
 					 NULL_TREE, false);
-	  saved = true;
+	  gnat_annotate_type = Cloned_Subtype (gnat_entity);
+	  maybe_present = true;
 	  break;
 	}
 /* Otherwise, first ensure the base type is elaborated.  Then, if we are
 	 changing the type, make a new type with each field having the type of
 	  /* When the subtype has discriminants and these discriminants affect
 	     the initial shape it has inherited, factor them in.  But for an
 	     Unchecked_Union (it must be an Itype), just return the type.  */
 	  if (Has_Discriminants (gnat_entity)
 	      && Stored_Constraint (gnat_entity) != No_Elist
-	      && !Is_For_Access_Subtype (gnat_entity)
 	      && Is_Record_Type (gnat_base_type)
 	      && !Is_Unchecked_Union (gnat_base_type))
 	    {
 	      vec<subst_pair> gnu_subst_list
 		= build_subst_list (gnat_entity, gnat_base_type, definition);
 break;
 case E_Access_Subtype:
 /* We treat this as identical to its base type; any constraint is
 	 meaningful only to the front-end.  */
-gnu_decl = gnat_to_gnu_entity (Etype (gnat_entity), NULL_TREE, false);
+gnu_decl = gnat_to_gnu_entity (gnat_equiv_type, NULL_TREE, false);
-saved = true;
+maybe_present = true;
 /* The designated subtype must be elaborated as well, if it does
 	 not have its own freeze node.  But designated subtypes created
 	 for constrained components of records with discriminants are
 	 not frozen by the front-end and not elaborated here, because
 case E_Function:
 case E_Procedure:
 {
 	tree gnu_ext_name
 	  = gnu_ext_name_for_subprog (gnat_entity, gnu_entity_name);
-	enum inline_status_t inline_status
+	const enum inline_status_t inline_status
-	  = Has_Pragma_No_Inline (gnat_entity)
+	  = inline_status_for_subprog (gnat_entity);
-	    ? is_suppressed
-	    : Has_Pragma_Inline_Always (gnat_entity)
-	      ? is_required
-	      : (Is_Inlined (gnat_entity) ? is_enabled : is_disabled);
 	bool public_flag = Is_Public (gnat_entity) || imported_p;
 	/* Subprograms marked both Intrinsic and Always_Inline need not
 	   have a body of their own.  */
 	bool extern_flag
 	  = ((Is_Public (gnat_entity) && !definition)
 {
 gnu_decl = get_gnu_tree (gnat_entity);
 saved = true;
 }
-/* If we are processing a type and there is either no decl for it or
+/* If we are processing a type and there is either no DECL for it or
 we just made one, do some common processing for the type, such as
 handling alignment and possible padding.  */
 if (is_type && (!gnu_decl || this_made_decl))
 {
 gcc_assert (!TYPE_IS_DUMMY_P (gnu_type));
 /* Process the attributes, if not already done.  Note that the type is
 	 already defined so we cannot pass true for IN_PLACE here.  */
 process_attributes (&gnu_type, &attr_list, false, gnat_entity);
-/* ??? Don't set the size for a String_Literal since it is either
+/* See if a size was specified, by means of either an Object_Size or
+a regular Size clause, and validate it if so.
+	 ??? Don't set the size for a String_Literal since it is either
 	 confirming or we don't handle it properly (if the low bound is
 	 non-constant).  */
 if (!gnu_size && kind != E_String_Literal_Subtype)
 	{
-	  Uint gnat_size = Known_Esize (gnat_entity)
+	  if (Known_Esize (gnat_entity))
-			   ? Esize (gnat_entity) : RM_Size (gnat_entity);
+	    gnu_size
-	  gnu_size
+	      = validate_size (Esize (gnat_entity), gnu_type, gnat_entity,
-	    = validate_size (gnat_size, gnu_type, gnat_entity, TYPE_DECL,
+			       VAR_DECL, false, false, NULL, NULL);
-			     false, Has_Size_Clause (gnat_entity));
+	  else
+	    gnu_size
+	      = validate_size (RM_Size (gnat_entity), gnu_type, gnat_entity,
+			       TYPE_DECL, false, Has_Size_Clause (gnat_entity),
+			       NULL, NULL);
 	}
 /* If a size was specified, see if we can make a new type of that size
 	 by rearranging the type, for example from a fat to a thin pointer.  */
 if (gnu_size)
 	gnu_entity_name = TYPE_IDENTIFIER (gnu_type);
 /* Now set the RM size of the type.  We cannot do it before padding
 	 because we need to accept arbitrary RM sizes on integral types.  */
 set_rm_size (RM_Size (gnat_entity), gnu_type, gnat_entity);
+/* Back-annotate the alignment of the type if not already set.  */
+if (Unknown_Alignment (gnat_entity))
+	{
+	  unsigned int double_align, align;
+	  bool is_capped_double, align_clause;
+	  /* If the default alignment of "double" or larger scalar types is
+	     specifically capped and this is not an array with an alignment
+	     clause on the component type, return the cap.  */
+	  if ((double_align = double_float_alignment) > 0)
+	    is_capped_double
+	      = is_double_float_or_array (gnat_entity, &align_clause);
+	  else if ((double_align = double_scalar_alignment) > 0)
+	    is_capped_double
+	      = is_double_scalar_or_array (gnat_entity, &align_clause);
+	  else
+	    is_capped_double = align_clause = false;
+	  if (is_capped_double && !align_clause)
+	    align = double_align;
+	  else
+	    align = TYPE_ALIGN (gnu_type) / BITS_PER_UNIT;
+	  Set_Alignment (gnat_entity, UI_From_Int (align));
+	}
+/* Likewise for the size, if any.  */
+if (Unknown_Esize (gnat_entity) && TYPE_SIZE (gnu_type))
+	{
+	  tree gnu_size = TYPE_SIZE (gnu_type);
+	  /* If the size is self-referential, annotate the maximum value
+	     after saturating it, if need be, to avoid a No_Uint value.  */
+	  if (CONTAINS_PLACEHOLDER_P (gnu_size))
+	    gnu_size = maybe_saturate_size (max_size (gnu_size, true));
+	  /* If we are just annotating types and the type is tagged, the tag
+	     and the parent components are not generated by the front-end so
+	     alignment and sizes must be adjusted.  */
+	  if (type_annotate_only && Is_Tagged_Type (gnat_entity))
+	    {
+	      const bool derived_p = Is_Derived_Type (gnat_entity);
+	      const Entity_Id gnat_parent
+		= derived_p ? Etype (Base_Type (gnat_entity)) : Empty;
+	      const unsigned int inherited_align
+		= derived_p
+		  ? UI_To_Int (Alignment (gnat_parent)) * BITS_PER_UNIT
+		  : POINTER_SIZE;
+	      const unsigned int align
+		= MAX (TYPE_ALIGN (gnu_type), inherited_align);
+	      Set_Alignment (gnat_entity, UI_From_Int (align / BITS_PER_UNIT));
+	      /* If there is neither size clause nor representation clause, the
+		 sizes need to be adjusted.  */
+	      if (Unknown_RM_Size (gnat_entity)
+		  && !VOID_TYPE_P (gnu_type)
+		  && (!TYPE_FIELDS (gnu_type)
+		      || integer_zerop (bit_position (TYPE_FIELDS (gnu_type)))))
+		{
+		  tree offset
+		    = derived_p
+		      ? UI_To_gnu (Esize (gnat_parent), bitsizetype)
+		      : bitsize_int (POINTER_SIZE);
+		  if (TYPE_FIELDS (gnu_type))
+		    offset
+		      = round_up (offset, DECL_ALIGN (TYPE_FIELDS (gnu_type)));
+		  gnu_size = size_binop (PLUS_EXPR, gnu_size, offset);
+		}
+	      gnu_size = maybe_saturate_size (round_up (gnu_size, align));
+	      Set_Esize (gnat_entity, annotate_value (gnu_size));
+	      /* Tagged types are Strict_Alignment so RM_Size = Esize.  */
+	      if (Unknown_RM_Size (gnat_entity))
+		Set_RM_Size (gnat_entity, Esize (gnat_entity));
+	    }
+	  /* Otherwise no adjustment is needed.  */
+	  else
+	    Set_Esize (gnat_entity, annotate_value (gnu_size));
+	}
+/* Likewise for the RM size, if any.  */
+if (Unknown_RM_Size (gnat_entity) && TYPE_SIZE (gnu_type))
+	Set_RM_Size (gnat_entity, annotate_value (rm_size (gnu_type)));
 /* If we are at global level, GCC will have applied variable_size to
 	 the type, but that won't have done anything.  So, if it's not
 	 a constant or self-referential, call elaborate_expression_1 to
 	 make a variable for the size rather than calculating it each time.
 		     the call to create_type_decl below.  */
 		  MARK_VISITED (DECL_FIELD_OFFSET (gnu_field));
 		}
 	    }
+/* Now check if the type allows atomic access.  */
 if (Is_Atomic_Or_VFA (gnat_entity))
 	check_ok_for_atomic_type (gnu_type, gnat_entity, false);
 /* If this is not an unconstrained array type, set some flags.  */
 if (TREE_CODE (gnu_type) != UNCONSTRAINED_ARRAY_TYPE)
 else
 	gnu_decl = create_type_decl (gnu_entity_name, gnu_type, artificial_p,
 				     debug_info_p, gnat_entity);
 }
-/* If we got a type that is not dummy, back-annotate the alignment of the
+/* Otherwise, for a type reusing an existing DECL, back-annotate values.  */
-type if not already in the tree.  Likewise for the size, if any.  */
+else if (is_type
-if (is_type && !TYPE_IS_DUMMY_P (TREE_TYPE (gnu_decl)))
+	   && !TYPE_IS_DUMMY_P (TREE_TYPE (gnu_decl))
+	   && Present (gnat_annotate_type))
 {
-gnu_type = TREE_TYPE (gnu_decl);
 if (Unknown_Alignment (gnat_entity))
-	{
+	Set_Alignment (gnat_entity, Alignment (gnat_annotate_type));
-	  unsigned int double_align, align;
+if (Unknown_Esize (gnat_entity))
-	  bool is_capped_double, align_clause;
+	Set_Esize (gnat_entity, Esize (gnat_annotate_type));
+if (Unknown_RM_Size (gnat_entity))
-	  /* If the default alignment of "double" or larger scalar types is
+	Set_RM_Size (gnat_entity, RM_Size (gnat_annotate_type));
-	     specifically capped and this is not an array with an alignment
-	     clause on the component type, return the cap.  */
-	  if ((double_align = double_float_alignment) > 0)
-	    is_capped_double
-	      = is_double_float_or_array (gnat_entity, &align_clause);
-	  else if ((double_align = double_scalar_alignment) > 0)
-	    is_capped_double
-	      = is_double_scalar_or_array (gnat_entity, &align_clause);
-	  else
-	    is_capped_double = align_clause = false;
-	  if (is_capped_double && !align_clause)
-	    align = double_align;
-	  else
-	    align = TYPE_ALIGN (gnu_type) / BITS_PER_UNIT;
-	  Set_Alignment (gnat_entity, UI_From_Int (align));
-	}
-if (Unknown_Esize (gnat_entity) && TYPE_SIZE (gnu_type))
-	{
-	  tree gnu_size = TYPE_SIZE (gnu_type);
-	  /* If the size is self-referential, annotate the maximum value.  */
-	  if (CONTAINS_PLACEHOLDER_P (gnu_size))
-	    gnu_size = max_size (gnu_size, true);
-	  /* If we are just annotating types and the type is tagged, the tag
-	     and the parent components are not generated by the front-end so
-	     alignment and sizes must be adjusted if there is no rep clause.  */
-	  if (type_annotate_only
-	      && Is_Tagged_Type (gnat_entity)
-	      && Unknown_RM_Size (gnat_entity)
-	      && !VOID_TYPE_P (gnu_type)
-	      && (!TYPE_FIELDS (gnu_type)
-		  || integer_zerop (bit_position (TYPE_FIELDS (gnu_type)))))
-	    {
-	      tree offset;
-	      if (Is_Derived_Type (gnat_entity))
-		{
-		  Entity_Id gnat_parent = Etype (Base_Type (gnat_entity));
-		  offset = UI_To_gnu (Esize (gnat_parent), bitsizetype);
-		  Set_Alignment (gnat_entity, Alignment (gnat_parent));
-		}
-	      else
-		{
-		  unsigned int align
-		    = MAX (TYPE_ALIGN (gnu_type), POINTER_SIZE) / BITS_PER_UNIT;
-		  offset = bitsize_int (POINTER_SIZE);
-		  Set_Alignment (gnat_entity, UI_From_Int (align));
-		}
-	      if (TYPE_FIELDS (gnu_type))
-		offset
-		  = round_up (offset, DECL_ALIGN (TYPE_FIELDS (gnu_type)));
-	      gnu_size = size_binop (PLUS_EXPR, gnu_size, offset);
-	      gnu_size = round_up (gnu_size, POINTER_SIZE);
-	      Uint uint_size = annotate_value (gnu_size);
-	      Set_RM_Size (gnat_entity, uint_size);
-	      Set_Esize (gnat_entity, uint_size);
-	    }
-	  /* If there is a rep clause, only adjust alignment and Esize.  */
-	  else if (type_annotate_only && Is_Tagged_Type (gnat_entity))
-	    {
-	      unsigned int align
-		= MAX (TYPE_ALIGN (gnu_type), POINTER_SIZE) / BITS_PER_UNIT;
-	      Set_Alignment (gnat_entity, UI_From_Int (align));
-	      gnu_size = round_up (gnu_size, POINTER_SIZE);
-	      Set_Esize (gnat_entity, annotate_value (gnu_size));
-	    }
-	  /* Otherwise no adjustment is needed.  */
-	  else
-	    Set_Esize (gnat_entity, annotate_value (gnu_size));
-	}
-if (Unknown_RM_Size (gnat_entity) && TYPE_SIZE (gnu_type))
-	Set_RM_Size (gnat_entity, annotate_value (rm_size (gnu_type)));
 }
 /* If we haven't already, associate the ..._DECL node that we just made with
 the input GNAT entity node.  */
 if (!saved)
 }
 return false;
 }
+/* Return the inlining status of the GNAT subprogram SUBPROG.  */
+static enum inline_status_t
+inline_status_for_subprog (Entity_Id subprog)
+{
+if (Has_Pragma_No_Inline (subprog))
+return is_suppressed;
+if (Has_Pragma_Inline_Always (subprog))
+return is_required;
+if (Is_Inlined (subprog))
+{
+tree gnu_type;
+/* This is a kludge to work around a pass ordering issue: for small
+	 record types with many components, i.e. typically bit-fields, the
+	 initialization routine can contain many assignments that will be
+	 merged by the GIMPLE store merging pass.  But this pass runs very
+	 late in the pipeline, in particular after the inlining decisions
+	 are made, so the inlining heuristics cannot take its outcome into
+	 account.  Therefore, we optimistically override the heuristics for
+	 the initialization routine in this case.  */
+if (Is_Init_Proc (subprog)
+	  && flag_store_merging
+	  && Is_Record_Type (Etype (First_Formal (subprog)))
+	  && (gnu_type = gnat_to_gnu_type (Etype (First_Formal (subprog))))
+	  && !TYPE_IS_BY_REFERENCE_P (gnu_type)
+	  && tree_fits_uhwi_p (TYPE_SIZE (gnu_type))
+	  && compare_tree_int (TYPE_SIZE (gnu_type), MAX_FIXED_MODE_SIZE) <= 0)
+	return is_prescribed;
+return is_requested;
+}
+return is_default;
+}
 /* Finalize the processing of From_Limited_With incomplete types.  */
 void
 finalize_from_limited_with (void)
 {
 case E_Anonymous_Access_Protected_Subprogram_Type:
 if (Present (Equivalent_Type (gnat_entity)))
 	gnat_equiv = Equivalent_Type (gnat_entity);
 break;
+case E_Access_Subtype:
+gnat_equiv = Etype (gnat_entity);
+break;
+case E_Array_Subtype:
+if (!Is_Constrained (gnat_entity))
+	gnat_equiv = Etype (gnat_entity);
+break;
 case E_Class_Wide_Type:
 gnat_equiv = Root_Type (gnat_entity);
 break;
 case E_Protected_Type:
 gnat_to_gnu_component_type (Entity_Id gnat_array, bool definition,
 			    bool debug_info_p)
 {
 const Entity_Id gnat_type = Component_Type (gnat_array);
 tree gnu_type = gnat_to_gnu_type (gnat_type);
+bool has_packed_components = Is_Bit_Packed_Array (gnat_array);
 tree gnu_comp_size;
 unsigned int max_align;
 /* If an alignment is specified, use it as a cap on the component type
 so that it can be honored for the whole type.  But ignore it for the
 && Known_Alignment (gnat_array))
 max_align = validate_alignment (Alignment (gnat_array), gnat_array, 0);
 else
 max_align = 0;
-/* Try to get a smaller form of the component if needed.  */
+/* Try to get a packable form of the component if needed.  */
 if ((Is_Packed (gnat_array) || Has_Component_Size_Clause (gnat_array))
-&& !Is_Bit_Packed_Array (gnat_array)
 && !Has_Aliased_Components (gnat_array)
 && !Strict_Alignment (gnat_type)
+&& !has_packed_components
 && RECORD_OR_UNION_TYPE_P (gnu_type)
 && !TYPE_FAT_POINTER_P (gnu_type)
 && tree_fits_uhwi_p (TYPE_SIZE (gnu_type)))
-gnu_type = make_packable_type (gnu_type, false, max_align);
+{
+gnu_type = make_packable_type (gnu_type, false, max_align);
+has_packed_components = true;
+}
 /* Get and validate any specified Component_Size.  */
 gnu_comp_size
 = validate_size (Component_Size (gnat_array), gnu_type, gnat_array,
-		     Is_Bit_Packed_Array (gnat_array) ? TYPE_DECL : VAR_DECL,
+		     has_packed_components ? TYPE_DECL : VAR_DECL, true,
-		     true, Has_Component_Size_Clause (gnat_array));
+		     Has_Component_Size_Clause (gnat_array), NULL, NULL);
 /* If the component type is a RECORD_TYPE that has a self-referential size,
 then use the maximum size for the component size.  */
 if (!gnu_comp_size
 && TREE_CODE (gnu_type) == RECORD_TYPE
 	  create_type_decl (TYPE_NAME (gnu_type), gnu_type, true, debug_info_p,
 			    gnat_array);
 	}
 }
+/* Now check if the type of the component allows atomic access.  */
 if (Has_Atomic_Components (gnat_array) || Is_Atomic_Or_VFA (gnat_type))
 check_ok_for_atomic_type (gnu_type, gnat_array, true);
 /* If the component type is a padded type made for a non-bit-packed array
 of scalars with reverse storage order, we need to propagate the reverse
 bool in_param = (Ekind (gnat_param) == E_In_Parameter);
 /* The parameter can be indirectly modified if its address is taken.  */
 bool ro_param = in_param && !Address_Taken (gnat_param);
 bool by_return = false, by_component_ptr = false;
 bool by_ref = false;
+bool forced_by_ref = false;
 bool restricted_aliasing_p = false;
 location_t saved_location = input_location;
 tree gnu_param;
 /* Make sure to use the proper SLOC for vector ABI warnings.  */
 }
 /* Or else, see if a Mechanism was supplied that forced this parameter
 to be passed one way or another.  */
 else if (mech == Default || mech == By_Copy || mech == By_Reference)
-;
+forced_by_ref
+= (mech == By_Reference
+	 && !foreign
+	 && !TYPE_IS_BY_REFERENCE_P (gnu_param_type)
+	 && !Is_Aliased (gnat_param));
 /* Positive mechanism means by copy for sufficiently small parameters.  */
 else if (mech > 0)
 {
 if (TREE_CODE (gnu_param_type) == UNCONSTRAINED_ARRAY_TYPE
 return gnu_param_type;
 gnu_param = create_param_decl (gnu_param_name, gnu_param_type);
 TREE_READONLY (gnu_param) = ro_param || by_ref || by_component_ptr;
 DECL_BY_REF_P (gnu_param) = by_ref;
+DECL_FORCED_BY_REF_P (gnu_param) = forced_by_ref;
 DECL_BY_COMPONENT_PTR_P (gnu_param) = by_component_ptr;
 DECL_POINTS_TO_READONLY_P (gnu_param)
 = (ro_param && (by_ref || by_component_ptr));
 DECL_CAN_NEVER_BE_NULL_P (gnu_param) = Can_Never_Be_Null (gnat_param);
 DECL_RESTRICTED_ALIASING_P (gnu_param) = restricted_aliasing_p;
 }
 return gnu_type;
 }
+/* Return true if TYPE contains only integral data, recursively if need be.  */
+static bool
+type_contains_only_integral_data (tree type)
+{
+switch (TREE_CODE (type))
+{
+case RECORD_TYPE:
+case UNION_TYPE:
+case QUAL_UNION_TYPE:
+for (tree field = TYPE_FIELDS (type); field; field = DECL_CHAIN (field))
+	if (!type_contains_only_integral_data (TREE_TYPE (field)))
+	  return false;
+return true;
+case ARRAY_TYPE:
+case COMPLEX_TYPE:
+return type_contains_only_integral_data (TREE_TYPE (type));
+default:
+return INTEGRAL_TYPE_P (type);
+}
+gcc_unreachable ();
+}
 /* Return a GCC tree for a subprogram type corresponding to GNAT_SUBPROG.
 DEFINITION is true if this is for a subprogram being defined.  DEBUG_INFO_P
 is true if we need to write debug information for other types that we may
 create in the process.  Also set PARAM_LIST to the list of parameters.
 If GNAT_SUBPROG is bound to a GCC builtin, return the DECL for the builtin
 an element of this list is a FIELD_DECL of the record and the TREE_VALUE
 is the PARM_DECL corresponding to that field.  This list will be saved in
 the TYPE_CI_CO_LIST field of the FUNCTION_TYPE node we create.  */
 tree gnu_cico_list = NULL_TREE;
 tree gnu_cico_return_type = NULL_TREE;
-/* Fields in return type of procedure with copy-in copy-out parameters.  */
+tree gnu_cico_field_list = NULL_TREE;
-tree gnu_field_list = NULL_TREE;
+bool gnu_cico_only_integral_type = true;
 /* The semantics of "pure" in Ada essentially matches that of "const"
 or "pure" in GCC.  In particular, both properties are orthogonal
 to the "nothrow" property if the EH circuitry is explicit in the
 internal representation of the middle-end.  If we are to completely
 hide the EH circuitry from it, we need to declare that calls to pure
 				         gnu_return_type,
 				         gnu_cico_return_type, NULL_TREE,
 				         NULL_TREE, 0, 0);
 		  Sloc_to_locus (Sloc (gnat_subprog),
 			         &DECL_SOURCE_LOCATION (gnu_field));
-		  gnu_field_list = gnu_field;
+		  gnu_cico_field_list = gnu_field;
 		  gnu_cico_list
 		    = tree_cons (gnu_field, void_type_node, NULL_TREE);
+		  if (!type_contains_only_integral_data (gnu_return_type))
+		    gnu_cico_only_integral_type = false;
 		}
 	      TYPE_NAME (gnu_cico_return_type) = get_identifier ("RETURN");
 	      /* Set a default alignment to speed up accesses.  But we should
 		 not increase the size of the structure too much, lest it does
 	    = create_field_decl (gnu_param_name, gnu_param_type,
 				 gnu_cico_return_type, NULL_TREE, NULL_TREE,
 				 0, 0);
 	  Sloc_to_locus (Sloc (gnat_param),
 			 &DECL_SOURCE_LOCATION (gnu_field));
-	  DECL_CHAIN (gnu_field) = gnu_field_list;
+	  DECL_CHAIN (gnu_field) = gnu_cico_field_list;
-	  gnu_field_list = gnu_field;
+	  gnu_cico_field_list = gnu_field;
 	  gnu_cico_list = tree_cons (gnu_field, gnu_param, gnu_cico_list);
+	  if (!type_contains_only_integral_data (gnu_param_type))
+	    gnu_cico_only_integral_type = false;
 	}
 }
 /* If the subprogram uses the copy-in copy-out mechanism, possibly adjust
 and finish up the return type.  */
 /* Do not finalize the return type if the subprogram is stubbed
 	 since structures are incomplete for the back-end.  */
 else if (Convention (gnat_subprog) != Convention_Stubbed)
 	{
-	  finish_record_type (gnu_cico_return_type, nreverse (gnu_field_list),
+	  finish_record_type (gnu_cico_return_type,
+			      nreverse (gnu_cico_field_list),
 			      0, false);
-	  /* Try to promote the mode of the return type if it is passed
+	  /* Try to promote the mode if the return type is fully returned
-	     in registers, again to speed up accesses.  */
+	     in integer registers, again to speed up accesses.  */
 	  if (TYPE_MODE (gnu_cico_return_type) == BLKmode
+	      && gnu_cico_only_integral_type
 	      && !targetm.calls.return_in_memory (gnu_cico_return_type,
 						  NULL_TREE))
 	    {
 	      unsigned int size
 		= TREE_INT_CST_LOW (TYPE_SIZE (gnu_cico_return_type));
 		    = bitsize_int (GET_MODE_BITSIZE (mode));
 		  TYPE_SIZE_UNIT (gnu_cico_return_type)
 		    = size_int (GET_MODE_SIZE (mode));
 		}
 	    }
+	  /* But demote the mode if the return type is partly returned in FP
+	     registers to avoid creating problematic paradoxical subregs.
+	     Note that we need to cater to historical 32-bit architectures
+	     that incorrectly use the mode to select the return mechanism.  */
+	  else if (INTEGRAL_MODE_P (TYPE_MODE (gnu_cico_return_type))
+		   && !gnu_cico_only_integral_type
+		   && BITS_PER_WORD >= 64
+		   && !targetm.calls.return_in_memory (gnu_cico_return_type,
+						       NULL_TREE))
+	    SET_TYPE_MODE (gnu_cico_return_type, BLKmode);
 	  if (debug_info_p)
 	    rest_of_record_type_compilation (gnu_cico_return_type);
 	}
 static void
 set_nonaliased_component_on_array_type (tree type)
 {
 TYPE_NONALIASED_COMPONENT (type) = 1;
-TYPE_NONALIASED_COMPONENT (TYPE_CANONICAL (type)) = 1;
+if (TYPE_CANONICAL (type))
+TYPE_NONALIASED_COMPONENT (TYPE_CANONICAL (type)) = 1;
 }
 /* Set TYPE_REVERSE_STORAGE_ORDER on an array type built by means of
 build_nonshared_array_type.  */
 static void
 set_reverse_storage_order_on_array_type (tree type)
 {
 TYPE_REVERSE_STORAGE_ORDER (type) = 1;
-TYPE_REVERSE_STORAGE_ORDER (TYPE_CANONICAL (type)) = 1;
+if (TYPE_CANONICAL (type))
+TYPE_REVERSE_STORAGE_ORDER (TYPE_CANONICAL (type)) = 1;
 }
 /* Return true if DISCR1 and DISCR2 represent the same discriminant.  */
 static bool
 GNAT_TYPE, has a non-aliased component in the back-end sense.  */
 static bool
 array_type_has_nonaliased_component (tree gnu_type, Entity_Id gnat_type)
 {
-/* If the array type is not the innermost dimension of the GNAT type,
-then it has a non-aliased component.  */
-if (TREE_CODE (TREE_TYPE (gnu_type)) == ARRAY_TYPE
-&& TYPE_MULTI_ARRAY_P (TREE_TYPE (gnu_type)))
-return true;
 /* If the array type has an aliased component in the front-end sense,
 then it also has an aliased component in the back-end sense.  */
 if (Has_Aliased_Components (gnat_type))
 return false;
 /* If this is a derived type, then it has a non-aliased component if
 and only if its parent type also has one.  */
 if (Is_Derived_Type (gnat_type))
 {
 tree gnu_parent_type = gnat_to_gnu_type (Etype (gnat_type));
-int index;
 if (TREE_CODE (gnu_parent_type) == UNCONSTRAINED_ARRAY_TYPE)
 	gnu_parent_type
 	  = TREE_TYPE (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_parent_type))));
-for (index = Number_Dimensions (gnat_type) - 1; index > 0; index--)
-	gnu_parent_type = TREE_TYPE (gnu_parent_type);
 return TYPE_NONALIASED_COMPONENT (gnu_parent_type);
 }
+/* For a multi-dimensional array type, find the component type.  */
+while (TREE_CODE (TREE_TYPE (gnu_type)) == ARRAY_TYPE
+	 && TYPE_MULTI_ARRAY_P (TREE_TYPE (gnu_type)))
+gnu_type = TREE_TYPE (gnu_type);
 /* Consider that an array of pointers has an aliased component, which is
 sort of logical and helps with Taft Amendment types in LTO mode.  */
 if (POINTER_TYPE_P (TREE_TYPE (gnu_type)))
 return false;
 && !get_variant_part (TREE_TYPE (gnu_expr)))
 return false;
 /* In all the other cases, convert the expression to the object's type.  */
 return true;
+}
+/* Add the contribution of [MIN, MAX] to the current number of elements N_ELEM
+of an array type and return the result, or NULL_TREE if it overflowed.  */
+static tree
+update_n_elem (tree n_elem, tree min, tree max)
+{
+/* First deal with the empty case.  */
+if (TREE_CODE (min) == INTEGER_CST
+&& TREE_CODE (max) == INTEGER_CST
+&& tree_int_cst_lt (max, min))
+return size_zero_node;
+min = convert (sizetype, min);
+max = convert (sizetype, max);
+/* Compute the number of elements in this dimension.  */
+tree this_n_elem
+= size_binop (PLUS_EXPR, size_one_node, size_binop (MINUS_EXPR, max, min));
+if (TREE_CODE (this_n_elem) == INTEGER_CST && TREE_OVERFLOW (this_n_elem))
+return NULL_TREE;
+/* Multiply the current number of elements by the result.  */
+n_elem = size_binop (MULT_EXPR, n_elem, this_n_elem);
+if (TREE_CODE (n_elem) == INTEGER_CST && TREE_OVERFLOW (n_elem))
+return NULL_TREE;
+return n_elem;
 }
 /* Given GNAT_ENTITY, elaborate all expressions that are required to
 be elaborated at the point of its definition, but do nothing else.  */
 /* Prepend to ATTR_LIST an entry for an attribute provided by GNAT_PRAGMA.  */
 static void
 prepend_one_attribute_pragma (struct attrib **attr_list, Node_Id gnat_pragma)
 {
-const Node_Id gnat_arg = Pragma_Argument_Associations (gnat_pragma);
+const Node_Id gnat_arg = First (Pragma_Argument_Associations (gnat_pragma));
-tree gnu_arg0 = NULL_TREE, gnu_arg1 = NULL_TREE;
+Node_Id gnat_next_arg = Next (gnat_arg);
+tree gnu_arg1 = NULL_TREE, gnu_arg_list = NULL_TREE;
 enum attrib_type etype;
 /* Map the pragma at hand.  Skip if this isn't one we know how to handle.  */
 switch (Get_Pragma_Id (Chars (Pragma_Identifier (gnat_pragma))))
 {
+case Pragma_Linker_Alias:
+etype = ATTR_LINK_ALIAS;
+break;
+case Pragma_Linker_Constructor:
+etype = ATTR_LINK_CONSTRUCTOR;
+break;
+case Pragma_Linker_Destructor:
+etype = ATTR_LINK_DESTRUCTOR;
+break;
+case Pragma_Linker_Section:
+etype = ATTR_LINK_SECTION;
+break;
 case Pragma_Machine_Attribute:
 etype = ATTR_MACHINE_ATTRIBUTE;
 break;
-case Pragma_Linker_Alias:
+case Pragma_Thread_Local_Storage:
-etype = ATTR_LINK_ALIAS;
+etype = ATTR_THREAD_LOCAL_STORAGE;
-break;
-case Pragma_Linker_Section:
-etype = ATTR_LINK_SECTION;
-break;
-case Pragma_Linker_Constructor:
-etype = ATTR_LINK_CONSTRUCTOR;
-break;
-case Pragma_Linker_Destructor:
-etype = ATTR_LINK_DESTRUCTOR;
 break;
 case Pragma_Weak_External:
 etype = ATTR_WEAK_EXTERNAL;
 break;
-case Pragma_Thread_Local_Storage:
-etype = ATTR_THREAD_LOCAL_STORAGE;
-break;
 default:
 return;
 }
 /* See what arguments we have and turn them into GCC trees for attribute
-handlers.  These expect identifier for strings.  We handle at most two
+handlers.  The first one is always expected to be a string meant to be
-arguments and static expressions only.  */
+turned into an identifier.  The next ones are all static expressions,
-if (Present (gnat_arg) && Present (First (gnat_arg)))
+among which strings meant to be turned into an identifier, except for
+a couple of specific attributes that require raw strings.  */
+if (Present (gnat_next_arg))
 {
-Node_Id gnat_arg0 = Next (First (gnat_arg));
+gnu_arg1 = gnat_to_gnu (Expression (gnat_next_arg));
-Node_Id gnat_arg1 = Empty;
+gcc_assert (TREE_CODE (gnu_arg1) == STRING_CST);
-if (Present (gnat_arg0)
+const char *const p = TREE_STRING_POINTER (gnu_arg1);
-	  && Is_OK_Static_Expression (Expression (gnat_arg0)))
+const bool string_args
+	= strcmp (p, "target") == 0 || strcmp (p, "target_clones") == 0;
+gnu_arg1 = get_identifier (p);
+if (IDENTIFIER_LENGTH (gnu_arg1) == 0)
+	return;
+gnat_next_arg = Next (gnat_next_arg);
+while (Present (gnat_next_arg))
 	{
-	  gnu_arg0 = gnat_to_gnu (Expression (gnat_arg0));
+	  tree gnu_arg = gnat_to_gnu (Expression (gnat_next_arg));
+	  if (TREE_CODE (gnu_arg) == STRING_CST && !string_args)
-	  if (TREE_CODE (gnu_arg0) == STRING_CST)
+	    gnu_arg = get_identifier (TREE_STRING_POINTER (gnu_arg));
-	    {
+	  gnu_arg_list
-	      gnu_arg0 = get_identifier (TREE_STRING_POINTER (gnu_arg0));
+	    = chainon (gnu_arg_list, build_tree_list (NULL_TREE, gnu_arg));
-	      if (IDENTIFIER_LENGTH (gnu_arg0) == 0)
+	  gnat_next_arg = Next (gnat_next_arg);
-		return;
-	    }
-	  gnat_arg1 = Next (gnat_arg0);
-	}
-if (Present (gnat_arg1)
-	  && Is_OK_Static_Expression (Expression (gnat_arg1)))
-	{
-	  gnu_arg1 = gnat_to_gnu (Expression (gnat_arg1));
-	  if (TREE_CODE (gnu_arg1) == STRING_CST)
-	   gnu_arg1 = get_identifier (TREE_STRING_POINTER (gnu_arg1));
 	}
 }
-/* Prepend to the list.  Make a list of the argument we might have, as GCC
+prepend_one_attribute (attr_list, etype, gnu_arg1, gnu_arg_list,
-expects it.  */
+			 Present (Next (gnat_arg))
-prepend_one_attribute (attr_list, etype, gnu_arg0,
+			 ? Expression (Next (gnat_arg)) : gnat_pragma);
-			 gnu_arg1
-			 ? build_tree_list (NULL_TREE, gnu_arg1) : NULL_TREE,
-			 Present (Next (First (gnat_arg)))
-			 ? Expression (Next (First (gnat_arg))) : gnat_pragma);
 }
 /* Prepend to ATTR_LIST the list of attributes for GNAT_ENTITY, if any.  */
 static void
 && TYPE_IS_FAT_POINTER_P (TREE_TYPE (TREE_OPERAND (ref, 0))))
 return build3 (COMPONENT_REF, TREE_TYPE (ref),
 		   elaborate_reference_1 (TREE_OPERAND (ref, 0), data),
 		   TREE_OPERAND (ref, 1), NULL_TREE);
+/* If this is the displacement of a pointer, elaborate the pointer and then
+displace the result.  The actual purpose here is to drop the location on
+the expression, which may be problematic if replicated on references.  */
+if (TREE_CODE (ref) == POINTER_PLUS_EXPR
+&& TREE_CODE (TREE_OPERAND (ref, 1)) == INTEGER_CST)
+return build2 (POINTER_PLUS_EXPR, TREE_TYPE (ref),
+		   elaborate_reference_1 (TREE_OPERAND (ref, 0), data),
+		   TREE_OPERAND (ref, 1));
 sprintf (suffix, "EXP%d", ++er->n);
 return
 elaborate_expression_1 (ref, er->entity, suffix, er->definition, false);
 }
 			     build_binary_op (GE_EXPR, boolean_type_node,
 					      gnu_operand, gnu_low, true),
 			     build_binary_op (LE_EXPR, boolean_type_node,
 					      gnu_operand, gnu_high, true),
 			     true);
+else if (gnu_low == boolean_true_node
+	       && TREE_TYPE (gnu_operand) == boolean_type_node)
+	gnu_test = gnu_operand;
 else if (gnu_low)
 	gnu_test
 	  = build_binary_op (EQ_EXPR, boolean_type_node, gnu_operand, gnu_low,
 			     true);
 else
 type FIELD_TYPE to be placed in RECORD_TYPE.  Return the result.  */
 static int
 adjust_packed (tree field_type, tree record_type, int packed)
 {
-/* If the field contains an item of variable size, we cannot pack it
+/* If the field contains an array with self-referential size, we'd better
-because we cannot create temporaries of non-fixed size in case
+not pack it because this would misalign it and, therefore, cause large
-we need to take the address of the field.  See addressable_p and
+temporaries to be created in case we need to take the address of the
-the notes on the addressability issues for further details.  */
+field.  See addressable_p and the notes on the addressability issues
-if (type_has_variable_size (field_type))
+for further details.  */
+if (AGGREGATE_TYPE_P (field_type)
+&& aggregate_type_contains_array_p (field_type, true))
 return 0;
 /* In the other cases, we can honor the packing.  */
 if (packed)
 return packed;
 static tree
 gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed,
 		   bool definition, bool debug_info_p)
 {
+const Node_Id gnat_clause = Component_Clause (gnat_field);
 const Entity_Id gnat_record_type = Underlying_Type (Scope (gnat_field));
 const Entity_Id gnat_field_type = Etype (gnat_field);
+tree gnu_field_type = gnat_to_gnu_type (gnat_field_type);
+tree gnu_field_id = get_entity_name (gnat_field);
 const bool is_atomic
 = (Is_Atomic_Or_VFA (gnat_field) || Is_Atomic_Or_VFA (gnat_field_type));
 const bool is_aliased = Is_Aliased (gnat_field);
 const bool is_independent
 = (Is_Independent (gnat_field) || Is_Independent (gnat_field_type));
 const bool is_volatile
 = (Treat_As_Volatile (gnat_field) || Treat_As_Volatile (gnat_field_type));
+const bool is_by_ref = TYPE_IS_BY_REFERENCE_P (gnu_field_type);
 const bool is_strict_alignment = Strict_Alignment (gnat_field_type);
 /* We used to consider that volatile fields also require strict alignment,
 but that was an interpolation and would cause us to reject a pragma
 volatile on a packed record type containing boolean components, while
 there is no basis to do so in the RM.  In such cases, the writes will
 involve load-modify-store sequences, but that's OK for volatile.  The
 only constraint is the implementation advice whereby only the bits of
 the components should be accessed if they both start and end on byte
-boundaries, but that should be guaranteed by the GCC memory model.  */
+boundaries, but that should be guaranteed by the GCC memory model.
-const bool needs_strict_alignment
+Note that we have some redundancies (is_atomic => is_independent,
-= (is_atomic || is_aliased || is_independent || is_strict_alignment);
+is_aliased => is_independent and is_by_ref => is_strict_alignment)
-tree gnu_field_type = gnat_to_gnu_type (gnat_field_type);
+so the following formula is sufficient.  */
-tree gnu_field_id = get_entity_name (gnat_field);
+const bool needs_strict_alignment = (is_independent || is_strict_alignment);
+const char *field_s, *size_s;
 tree gnu_field, gnu_size, gnu_pos;
+bool is_bitfield;
-/* If this field requires strict alignment, we cannot pack it because
-it would very likely be under-aligned in the record.  */
+/* The qualifier to be used in messages.  */
+if (is_atomic)
+field_s = "atomic&";
+else if (is_aliased)
+field_s = "aliased&";
+else if (is_independent)
+field_s = "independent&";
+else if (is_by_ref)
+field_s = "& with by-reference type";
+else if (is_strict_alignment)
+field_s = "& with aliased part";
+else
+field_s = "&";
+/* The message to be used for incompatible size.  */
+if (is_atomic || is_aliased)
+size_s = "size for %s must be ^";
+else if (field_s)
+size_s = "size for %s too small{, minimum allowed is ^}";
+/* If a field requires strict alignment, we cannot pack it (RM 13.2(7)).  */
 if (needs_strict_alignment)
 packed = 0;
 else
 packed = adjust_packed (gnu_field_type, gnu_record_type, packed);
 /* If a size is specified, use it.  Otherwise, if the record type is packed,
 use the official RM size.  See "Handling of Type'Size Values" in Einfo
 for further details.  */
-if (Known_Esize (gnat_field))
+if (Present (gnat_clause) || Known_Esize (gnat_field))
-gnu_size = validate_size (Esize (gnat_field), gnu_field_type,
+gnu_size = validate_size (Esize (gnat_field), gnu_field_type, gnat_field,
-			      gnat_field, FIELD_DECL, false, true);
+			      FIELD_DECL, false, true, size_s, field_s);
 else if (packed == 1)
-gnu_size = validate_size (RM_Size (gnat_field_type), gnu_field_type,
+{
-			      gnat_field, FIELD_DECL, false, true);
+gnu_size = rm_size (gnu_field_type);
+if (TREE_CODE (gnu_size) != INTEGER_CST)
+	gnu_size = NULL_TREE;
+}
 else
 gnu_size = NULL_TREE;
-/* If we have a specified size that is smaller than that of the field's type,
+/* Likewise for the position.  */
-or a position is specified, and the field's type is a record that doesn't
+if (Present (gnat_clause))
-require strict alignment, see if we can get either an integral mode form
+{
-of the type or a smaller form.  If we can, show a size was specified for
+gnu_pos = UI_To_gnu (Component_Bit_Offset (gnat_field), bitsizetype);
-the field if there wasn't one already, so we know to make this a bitfield
+is_bitfield = !value_factor_p (gnu_pos, BITS_PER_UNIT);
-and avoid making things wider.
+}
+/* If the record has rep clauses and this is the tag field, make a rep
+clause for it as well.  */
+else if (Has_Specified_Layout (gnat_record_type)
+	   && Chars (gnat_field) == Name_uTag)
+{
+gnu_pos = bitsize_zero_node;
+gnu_size = TYPE_SIZE (gnu_field_type);
+is_bitfield = false;
+}
+else
+{
+gnu_pos = NULL_TREE;
+is_bitfield = false;
+}
+/* If the field's type is a fixed-size record that does not require strict
+alignment, and the record is packed or we have a position specified for
+the field that makes it a bitfield or we have a specified size that is
+smaller than that of the field's type, then see if we can get either an
+integral mode form of the field's type or a smaller form.  If we can,
+consider that a size was specified for the field if there wasn't one
+already, so we know to make it a bitfield and avoid making things wider.
 Changing to an integral mode form is useful when the record is packed as
 we can then place the field at a non-byte-aligned position and so achieve
 tighter packing.  This is in addition required if the field shares a byte
 with another field and the front-end lets the back-end handle the access
 if (!needs_strict_alignment
 && RECORD_OR_UNION_TYPE_P (gnu_field_type)
 && !TYPE_FAT_POINTER_P (gnu_field_type)
 && tree_fits_uhwi_p (TYPE_SIZE (gnu_field_type))
 && (packed == 1
+	  || is_bitfield
 	  || (gnu_size
-	      && (tree_int_cst_lt (gnu_size, TYPE_SIZE (gnu_field_type))
+	      && tree_int_cst_lt (gnu_size, TYPE_SIZE (gnu_field_type)))))
-		  || (Present (Component_Clause (gnat_field))
-		      && !(UI_To_Int (Component_Bit_Offset (gnat_field))
-			   % BITS_PER_UNIT == 0
-			   && value_factor_p (gnu_size, BITS_PER_UNIT)))))))
 {
-tree gnu_packable_type = make_packable_type (gnu_field_type, true);
+tree gnu_packable_type
+	= make_packable_type (gnu_field_type, true, is_bitfield ? 1 : 0);
 if (gnu_packable_type != gnu_field_type)
 	{
 	  gnu_field_type = gnu_packable_type;
 	  if (!gnu_size)
 	    gnu_size = rm_size (gnu_field_type);
 	}
 }
+/* Now check if the type of the field allows atomic access.  */
 if (Is_Atomic_Or_VFA (gnat_field))
 {
 const unsigned int align
 	= promote_object_alignment (gnu_field_type, gnat_field);
 if (align > 0)
 	  = maybe_pad_type (gnu_field_type, NULL_TREE, align, gnat_field,
 			    false, false, definition, true);
 check_ok_for_atomic_type (gnu_field_type, gnat_field, false);
 }
-if (Present (Component_Clause (gnat_field)))
+/* If a position is specified, check that it is valid.  */
+if (gnu_pos)
 {
-Node_Id gnat_clause = Component_Clause (gnat_field);
 Entity_Id gnat_parent = Parent_Subtype (gnat_record_type);
-gnu_pos = UI_To_gnu (Component_Bit_Offset (gnat_field), bitsizetype);
-gnu_size = validate_size (Esize (gnat_field), gnu_field_type,
-				gnat_field, FIELD_DECL, false, true);
 /* Ensure the position does not overlap with the parent subtype, if there
 	 is one.  This test is omitted if the parent of the tagged type has a
 	 full rep clause since, in this case, component clauses are allowed to
 	 overlay the space allocated for the parent type and the front-end has
 	  tree gnu_parent = gnat_to_gnu_type (gnat_parent);
 	  if (TREE_CODE (TYPE_SIZE (gnu_parent)) == INTEGER_CST
 	      && tree_int_cst_lt (gnu_pos, TYPE_SIZE (gnu_parent)))
 	    post_error_ne_tree
-	      ("offset of& must be beyond parent{, minimum allowed is ^}",
+	      ("position for& must be beyond parent{, minimum allowed is ^}",
 	       Position (gnat_clause), gnat_field, TYPE_SIZE_UNIT (gnu_parent));
 	}
 /* If this field needs strict alignment, make sure that the record is
 	 sufficiently aligned and that the position and size are consistent
 	  if (TYPE_ALIGN (gnu_record_type)
 	      && TYPE_ALIGN (gnu_record_type) < type_align)
 	    SET_TYPE_ALIGN (gnu_record_type, type_align);
+	  /* If the position is not a multiple of the storage unit, then error
+	     out and reset the position.  */
+	  if (!integer_zerop (size_binop (TRUNC_MOD_EXPR, gnu_pos,
+					  bitsize_unit_node)))
+	    {
+	      char s[128];
+	      snprintf (s, sizeof (s), "position for %s must be "
+			"multiple of Storage_Unit", field_s);
+	      post_error_ne (s, First_Bit (gnat_clause), gnat_field);
+	      gnu_pos = NULL_TREE;
+	    }
 	  /* If the position is not a multiple of the alignment of the type,
 	     then error out and reset the position.  */
-	  if (!integer_zerop (size_binop (TRUNC_MOD_EXPR, gnu_pos,
+	  else if (type_align > BITS_PER_UNIT
-					  bitsize_int (type_align))))
+		   && !integer_zerop (size_binop (TRUNC_MOD_EXPR, gnu_pos,
+						  bitsize_int (type_align))))
 	    {
-	      const char *s;
+	      char s[128];
+snprintf (s, sizeof (s), "position for %s must be multiple of ^",
-	      if (is_atomic)
+			field_s);
-		s = "position of atomic field& must be multiple of ^ bits";
-	      else if (is_aliased)
-		s = "position of aliased field& must be multiple of ^ bits";
-	      else if (is_independent)
-		s = "position of independent field& must be multiple of ^ bits";
-	      else if (is_strict_alignment)
-		s = "position of & with aliased or tagged part must be"
-		    " multiple of ^ bits";
-	      else
-		gcc_unreachable ();
 	      post_error_ne_num (s, First_Bit (gnat_clause), gnat_field,
-				 type_align);
+				 type_align / BITS_PER_UNIT);
+	      post_error_ne_num ("\\because alignment of its type& is ^",
+				 First_Bit (gnat_clause), Etype (gnat_field),
+				 type_align / BITS_PER_UNIT);
 	      gnu_pos = NULL_TREE;
 	    }
 	  if (gnu_size)
 	    {
-	      tree gnu_type_size = TYPE_SIZE (gnu_field_type);
+	      tree type_size = TYPE_SIZE (gnu_field_type);
-	      const int cmp = tree_int_cst_compare (gnu_size, gnu_type_size);
+	      int cmp;
+	      /* If the size is not a multiple of the storage unit, then error
+		 out and reset the size.  */
+	      if (!integer_zerop (size_binop (TRUNC_MOD_EXPR, gnu_size,
+					      bitsize_unit_node)))
+		{
+		  char s[128];
+		  snprintf (s, sizeof (s), "size for %s must be "
+			    "multiple of Storage_Unit", field_s);
+		  post_error_ne (s, Last_Bit (gnat_clause), gnat_field);
+		  gnu_size = NULL_TREE;
+		}
 	      /* If the size is lower than that of the type, or greater for
 		 atomic and aliased, then error out and reset the size.  */
-	      if (cmp < 0 || (cmp > 0 && (is_atomic || is_aliased)))
+	      else if ((cmp = tree_int_cst_compare (gnu_size, type_size)) < 0
+		       || (cmp > 0 && (is_atomic || is_aliased)))
 		{
-		  const char *s;
+		  char s[128];
+		  snprintf (s, sizeof (s), size_s, field_s);
-		  if (is_atomic)
-		    s = "size of atomic field& must be ^ bits";
-		  else if (is_aliased)
-		    s = "size of aliased field& must be ^ bits";
-		  else if (is_independent)
-		    s = "size of independent field& must be at least ^ bits";
-		  else if (is_strict_alignment)
-		    s = "size of & with aliased or tagged part must be"
-			" at least ^ bits";
-		  else
-		    gcc_unreachable ();
 		  post_error_ne_tree (s, Last_Bit (gnat_clause), gnat_field,
-				      gnu_type_size);
+				      type_size);
-		  gnu_size = NULL_TREE;
-		}
-	      /* Likewise if the size is not a multiple of a byte,  */
-	      else if (!integer_zerop (size_binop (TRUNC_MOD_EXPR, gnu_size,
-						   bitsize_unit_node)))
-		{
-		  const char *s;
-		  if (is_independent)
-		    s = "size of independent field& must be multiple of"
-			" Storage_Unit";
-		  else if (is_strict_alignment)
-		    s = "size of & with aliased or tagged part must be"
-			" multiple of Storage_Unit";
-		  else
-		    gcc_unreachable ();
-		  post_error_ne (s, Last_Bit (gnat_clause), gnat_field);
 		  gnu_size = NULL_TREE;
 		}
 	    }
 	}
 }
-/* If the record has rep clauses and this is the tag field, make a rep
-clause for it as well.  */
-else if (Has_Specified_Layout (gnat_record_type)
-	   && Chars (gnat_field) == Name_uTag)
-{
-gnu_pos = bitsize_zero_node;
-gnu_size = TYPE_SIZE (gnu_field_type);
-}
 else
 {
-gnu_pos = NULL_TREE;
 /* If we are packing the record and the field is BLKmode, round the
 	 size up to a byte boundary.  */
 if (packed && TYPE_MODE (gnu_field_type) == BLKmode && gnu_size)
 	gnu_size = round_up (gnu_size, BITS_PER_UNIT);
 }
 if (!needs_strict_alignment
 	  && TYPE_IS_PADDING_P (gnu_field_type)
 	  && INTEGRAL_TYPE_P (TREE_TYPE (TYPE_FIELDS (gnu_field_type))))
 	gnu_field_type = TREE_TYPE (TYPE_FIELDS (gnu_field_type));
+orig_field_type = gnu_field_type;
 gnu_field_type
 	= make_type_from_size (gnu_field_type, gnu_size,
 			       Has_Biased_Representation (gnat_field));
+/* If the type has been extended, we may need to cap the alignment.  */
+if (!needs_strict_alignment
+	  && gnu_field_type != orig_field_type
+	  && tree_int_cst_lt (TYPE_SIZE (orig_field_type), gnu_size))
+	packed = adjust_packed (gnu_field_type, gnu_record_type, packed);
 orig_field_type = gnu_field_type;
 gnu_field_type = maybe_pad_type (gnu_field_type, gnu_size, 0, gnat_field,
 				       false, false, definition, true);
 			 gnu_size, gnu_pos, packed, is_aliased);
 Sloc_to_locus (Sloc (gnat_field), &DECL_SOURCE_LOCATION (gnu_field));
 DECL_ALIASED_P (gnu_field) = is_aliased;
 TREE_SIDE_EFFECTS (gnu_field) = TREE_THIS_VOLATILE (gnu_field) = is_volatile;
+/* If this is a discriminant, then we treat it specially: first, we set its
+index number for the back-annotation; second, we record whether it cannot
+be changed once it has been set for the computation of loop invariants;
+third, we make it addressable in order for the optimizer to more easily
+see that it cannot be modified by assignments to the other fields of the
+record (see create_field_decl for a more detailed explanation), which is
+crucial to hoist the offset and size computations of dynamic fields.  */
 if (Ekind (gnat_field) == E_Discriminant)
 {
+DECL_DISCRIMINANT_NUMBER (gnu_field)
+	= UI_To_gnu (Discriminant_Number (gnat_field), sizetype);
 DECL_INVARIANT_P (gnu_field)
 	= No (Discriminant_Default_Value (gnat_field));
-DECL_DISCRIMINANT_NUMBER (gnu_field)
+DECL_NONADDRESSABLE_P (gnu_field) = 0;
-	= UI_To_gnu (Discriminant_Number (gnat_field), sizetype);
 }
 return gnu_field;
 }
 Present (component_decl);
 component_decl = Next_Non_Pragma (component_decl))
 {
 Entity_Id gnat_field = Defining_Entity (component_decl);
-if (Is_Aliased (gnat_field))
+if (Is_Independent (gnat_field) || Is_Independent (Etype (gnat_field)))
 	return true;
 if (Strict_Alignment (Etype (gnat_field)))
 	return true;
 }
 return false;
 }
-/* Return true if TYPE is a type with variable size or a padding type with a
-field of variable size or a record that has a field with such a type.  */
-static bool
-type_has_variable_size (tree type)
-{
-tree field;
-if (!TREE_CONSTANT (TYPE_SIZE (type)))
-return true;
-if (TYPE_IS_PADDING_P (type)
-&& !TREE_CONSTANT (DECL_SIZE (TYPE_FIELDS (type))))
-return true;
-if (!RECORD_OR_UNION_TYPE_P (type))
-return false;
-for (field = TYPE_FIELDS (type); field; field = DECL_CHAIN (field))
-if (type_has_variable_size (TREE_TYPE (field)))
-return true;
-return false;
-}
 /* Return true if FIELD is an artificial field.  */
 static bool
 field_is_artificial (tree field)
 {
 const bool needs_xv_encodings
 = debug_info && gnat_encodings != DWARF_GNAT_ENCODINGS_MINIMAL;
 bool all_rep_and_size = all_rep && TYPE_SIZE (gnu_record_type);
 bool variants_have_rep = all_rep;
 bool layout_with_rep = false;
+bool has_non_packed_fixed_size_field = false;
 bool has_self_field = false;
 bool has_aliased_after_self_field = false;
 Entity_Id gnat_component_decl, gnat_variant_part;
 tree gnu_field, gnu_next, gnu_last;
 tree gnu_variant_part = NULL_TREE;
 		/* And record information for the final layout.  */
 		if (field_has_self_size (gnu_field))
 		  has_self_field = true;
 		else if (has_self_field && DECL_ALIASED_P (gnu_field))
 		  has_aliased_after_self_field = true;
+		else if (!DECL_FIELD_OFFSET (gnu_field)
+			 && !DECL_PACKED (gnu_field)
+			 && !field_has_variable_size (gnu_field))
+		  has_non_packed_fixed_size_field = true;
 	      }
 	  }
 	save_gnu_tree (gnat_field, gnu_field, false);
 }
 tree gnu_discr = gnat_to_gnu (gnat_discr);
 tree gnu_name = TYPE_IDENTIFIER (gnu_record_type);
 tree gnu_var_name
 	= concat_name (get_identifier (Get_Name_String (Chars (gnat_discr))),
 		       "XVN");
-tree gnu_union_type, gnu_union_name;
+tree gnu_union_name
+	= concat_name (gnu_name, IDENTIFIER_POINTER (gnu_var_name));
+tree gnu_union_type;
 tree this_first_free_pos, gnu_variant_list = NULL_TREE;
 bool union_field_needs_strict_alignment = false;
 auto_vec <vinfo_t, 16> variant_types;
 vinfo_t *gnu_variant;
 unsigned int variants_align = 0;
 unsigned int i;
-gnu_union_name
-	= concat_name (gnu_name, IDENTIFIER_POINTER (gnu_var_name));
 /* Reuse the enclosing union if this is an Unchecked_Union whose fields
 	 are all in the variant part, to match the layout of C unions.  There
 	 is an associated check below.  */
 if (TREE_CODE (gnu_record_type) == UNION_TYPE)
 with self-referential size, variable size and fixed size not a multiple
 of a byte, so that they don't cause the regular fields to be either at
 self-referential/variable offset or misaligned.  Note, in the latter
 case, that this can only happen in packed record types so the alignment
 is effectively capped to the byte for the whole record.  But we don't
-do it for non-packed record types if pragma Optimize_Alignment (Space)
+do it for packed record types if not all fixed-size fiels can be packed
-is specified because this can prevent alignment gaps from being filled.
+and for non-packed record types if pragma Optimize_Alignment (Space) is
+specified, because this can prevent alignment gaps from being filled.
 Optionally, if the layout warning is enabled, keep track of the above 4
 different kinds of fields and issue a warning if some of them would be
 (or are being) reordered by the reordering mechanism.
 ??? If we reorder fields, the debugging information will be affected and
 the debugger print fields in a different order from the source code.  */
 const bool do_reorder
 = (Convention (gnat_record_type) == Convention_Ada
 && !No_Reordering (gnat_record_type)
-&& (!Optimize_Alignment_Space (gnat_record_type)
+&& !(Is_Packed (gnat_record_type)
-	   || Is_Packed (gnat_record_type))
+	    ? has_non_packed_fixed_size_field
-&& !debug__debug_flag_dot_r);
+	    : Optimize_Alignment_Space (gnat_record_type))
+&& !Debug_Flag_Dot_R);
 const bool w_reorder
 = (Convention (gnat_record_type) == Convention_Ada
 && Warn_On_Questionable_Layout
 && !(No_Reordering (gnat_record_type) && GNAT_Mode));
 const bool in_variant = (p_gnu_rep_list != NULL);
 	  continue;
 	}
 if (DECL_SIZE (gnu_field) && integer_zerop (DECL_SIZE (gnu_field)))
 	{
+	  DECL_SIZE_UNIT (gnu_field) = size_zero_node;
 	  DECL_FIELD_OFFSET (gnu_field) = size_zero_node;
 	  SET_DECL_OFFSET_ALIGN (gnu_field, BIGGEST_ALIGNMENT);
 	  DECL_FIELD_BIT_OFFSET (gnu_field) = bitsize_zero_node;
 	  if (DECL_ALIASED_P (gnu_field))
 	    SET_TYPE_ALIGN (gnu_record_type,
 if (layout_with_rep)
 	gnu_field_list = gnu_rep_list;
 else
 	{
+	  TYPE_NAME (gnu_rep_type)
+	    = create_concat_name (gnat_record_type, "REP");
 	  TYPE_REVERSE_STORAGE_ORDER (gnu_rep_type)
 	    = TYPE_REVERSE_STORAGE_ORDER (gnu_record_type);
 	  finish_record_type (gnu_rep_type, gnu_rep_list, 1, debug_info);
 	  /* If FIRST_FREE_POS is nonzero, we need to ensure that the fields
 	}
 }
 /* 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);
 TYPE_ARTIFICIAL (gnu_record_type) = artificial;
 case GT_EXPR:		tcode = Gt_Expr; break;
 case GE_EXPR:		tcode = Ge_Expr; break;
 case EQ_EXPR:		tcode = Eq_Expr; break;
 case NE_EXPR:		tcode = Ne_Expr; break;
+case PLUS_EXPR:
+/* Turn addition of negative constant into subtraction.  */
+if (TREE_CODE (TREE_OPERAND (gnu_size, 1)) == INTEGER_CST
+	  && tree_int_cst_sign_bit (TREE_OPERAND (gnu_size, 1)))
+	{
+	  tcode = Minus_Expr;
+	  wide_int wop1 = -wi::to_wide (TREE_OPERAND (gnu_size, 1));
+	  ops[1] = annotate_value (wide_int_to_tree (sizetype, wop1));
+	  break;
+	}
+/* ... fall through ... */
 case MULT_EXPR:
-case PLUS_EXPR:
 tcode = (TREE_CODE (gnu_size) == MULT_EXPR ? Mult_Expr : Plus_Expr);
 /* Fold conversions from bytes to bits into inner operations.  */
 if (TREE_CODE (TREE_OPERAND (gnu_size, 1)) == INTEGER_CST
 	  && CONVERT_EXPR_P (TREE_OPERAND (gnu_size, 0)))
 	{
 	  tree inner_op = TREE_OPERAND (TREE_OPERAND (gnu_size, 0), 0);
 	  if (TREE_CODE (inner_op) == TREE_CODE (gnu_size)
 	      && TREE_CODE (TREE_OPERAND (inner_op, 1)) == INTEGER_CST)
 	    {
+	      ops[0] = annotate_value (TREE_OPERAND (inner_op, 0));
 	      tree inner_op_op1 = TREE_OPERAND (inner_op, 1);
 	      tree gnu_size_op1 = TREE_OPERAND (gnu_size, 1);
 	      widest_int op1;
 	      if (TREE_CODE (gnu_size) == MULT_EXPR)
 		op1 = (wi::to_widest (inner_op_op1)
 		       * wi::to_widest (gnu_size_op1));
 	      else
-		op1 = (wi::to_widest (inner_op_op1)
+		{
-		       + wi::to_widest (gnu_size_op1));
+		  op1 = (wi::to_widest (inner_op_op1)
-	      ops[1] = UI_From_gnu (wide_int_to_tree (sizetype, op1));
+			 + wi::to_widest (gnu_size_op1));
-	      ops[0] = annotate_value (TREE_OPERAND (inner_op, 0));
+		  if (wi::zext (op1, TYPE_PRECISION (sizetype)) == 0)
+		    return ops[0];
+		}
+	      ops[1] = annotate_value (wide_int_to_tree (sizetype, op1));
 	    }
 	}
 break;
 case BIT_AND_EXPR:
 tcode = Bit_And_Expr;
 /* For negative values in sizetype, build NEGATE_EXPR of the opposite.
-	 Such values appear in expressions with aligning patterns.  Note that,
+	 Such values can appear in expressions with aligning patterns.  */
-	 since sizetype is unsigned, we have to jump through some hoops.   */
 if (TREE_CODE (TREE_OPERAND (gnu_size, 1)) == INTEGER_CST)
 	{
-	  tree op1 = TREE_OPERAND (gnu_size, 1);
+	  wide_int wop1 = -wi::to_wide (TREE_OPERAND (gnu_size, 1));
-	  wide_int signed_op1 = wi::sext (wi::to_wide (op1),
+	  tree op1 = wide_int_to_tree (sizetype, wop1);
-					  TYPE_PRECISION (sizetype));
+	  ops[1] = annotate_value (build1 (NEGATE_EXPR, sizetype, op1));
-	  if (wi::neg_p (signed_op1))
-	    {
-	      op1 = wide_int_to_tree (sizetype, wi::neg (signed_op1));
-	      ops[1] = annotate_value (build1 (NEGATE_EXPR, sizetype, op1));
-	    }
 	}
 break;
 case CALL_EXPR:
 /* In regular mode, inline back only if symbolic annotation is requested
 	 in order to avoid memory explosion on big discriminated record types.
 	 But not in ASIS mode, as symbolic annotation is required for DDA.  */
-if (List_Representation_Info == 3 || type_annotate_only)
+if (List_Representation_Info >= 3 || type_annotate_only)
 	{
 	  tree t = maybe_inline_call_in_expr (gnu_size);
 	  return t ? annotate_value (t) : No_Uint;
 	}
 else
 }
 return gnu_list;
 }
+/* If SIZE has overflowed, return the maximum valid size, which is the upper
+bound of the signed sizetype in bits; otherwise return SIZE unmodified.  */
+static tree
+maybe_saturate_size (tree size)
+{
+if (TREE_CODE (size) == INTEGER_CST && TREE_OVERFLOW (size))
+size = size_binop (MULT_EXPR,
+		       fold_convert (bitsizetype, TYPE_MAX_VALUE (ssizetype)),
+		       build_int_cst (bitsizetype, BITS_PER_UNIT));
+return size;
+}
 /* UINT_SIZE is a Uint giving the specified size for an object of GNU_TYPE
 corresponding to GNAT_OBJECT.  If the size is valid, return an INTEGER_CST
 corresponding to its value.  Otherwise, return NULL_TREE.  KIND is set to
 VAR_DECL if we are specifying the size of an object, TYPE_DECL for the
 size of a type, and FIELD_DECL for the size of a field.  COMPONENT_P is
 true if we are being called to process the Component_Size of GNAT_OBJECT;
 this is used only for error messages.  ZERO_OK is true if a size of zero
 is permitted; if ZERO_OK is false, it means that a size of zero should be
-treated as an unspecified size.  */
+treated as an unspecified size.  S1 and S2 are used for error messages.  */
 static tree
 validate_size (Uint uint_size, tree gnu_type, Entity_Id gnat_object,
-	       enum tree_code kind, bool component_p, bool zero_ok)
+	       enum tree_code kind, bool component_p, bool zero_ok,
+	       const char *s1, const char *s2)
 {
 Node_Id gnat_error_node;
-tree type_size, size;
+tree old_size, size;
 /* Return 0 if no size was specified.  */
 if (uint_size == No_Uint)
 return NULL_TREE;
 || Ekind (gnat_object) == E_Discriminant)
 && Present (Component_Clause (gnat_object)))
 gnat_error_node = Last_Bit (Component_Clause (gnat_object));
 else if (Present (Size_Clause (gnat_object)))
 gnat_error_node = Expression (Size_Clause (gnat_object));
+else if (Has_Object_Size_Clause (gnat_object))
+gnat_error_node = Expression (Object_Size_Clause (gnat_object));
 else
 gnat_error_node = gnat_object;
 /* Get the size as an INTEGER_CST.  Issue an error if a size was specified
 but cannot be represented in bitsizetype.  */
 /* The size of objects is always a multiple of a byte.  */
 if (kind == VAR_DECL
 && !integer_zerop (size_binop (TRUNC_MOD_EXPR, size, bitsize_unit_node)))
 {
 if (component_p)
-	post_error_ne ("component size for& is not a multiple of Storage_Unit",
+	post_error_ne ("component size for& must be multiple of Storage_Unit",
 		       gnat_error_node, gnat_object);
 else
-	post_error_ne ("size for& is not a multiple of Storage_Unit",
+	post_error_ne ("size for& must be multiple of Storage_Unit",
 		       gnat_error_node, gnat_object);
 return NULL_TREE;
 }
 /* If this is an integral type or a packed array type, the front-end has
 template to the specified size.  */
 if (TREE_CODE (gnu_type) == RECORD_TYPE
 && TYPE_CONTAINS_TEMPLATE_P (gnu_type))
 size = size_binop (PLUS_EXPR, DECL_SIZE (TYPE_FIELDS (gnu_type)), size);
-if (kind == VAR_DECL
+old_size = (kind == VAR_DECL ? TYPE_SIZE (gnu_type) : rm_size (gnu_type));
-/* If a type needs strict alignment, a component of this type in
-	 a packed record cannot be packed and thus uses the type size.  */
+/* If the old size is self-referential, get the maximum size.  */
-|| (kind == TYPE_DECL && Strict_Alignment (gnat_object)))
+if (CONTAINS_PLACEHOLDER_P (old_size))
-type_size = TYPE_SIZE (gnu_type);
+old_size = max_size (old_size, true);
-else
-type_size = rm_size (gnu_type);
-/* Modify the size of a discriminated type to be the maximum size.  */
-if (type_size && CONTAINS_PLACEHOLDER_P (type_size))
-type_size = max_size (type_size, true);
 /* If this is an access type or a fat pointer, the minimum size is that given
 by the smallest integral mode that's valid for pointers.  */
 if (TREE_CODE (gnu_type) == POINTER_TYPE || TYPE_IS_FAT_POINTER_P (gnu_type))
 {
 scalar_int_mode p_mode = NARROWEST_INT_MODE;
 while (!targetm.valid_pointer_mode (p_mode))
 	p_mode = GET_MODE_WIDER_MODE (p_mode).require ();
-type_size = bitsize_int (GET_MODE_BITSIZE (p_mode));
+old_size = bitsize_int (GET_MODE_BITSIZE (p_mode));
 }
 /* Issue an error either if the default size of the object isn't a constant
 or if the new size is smaller than it.  */
-if (TREE_CODE (type_size) != INTEGER_CST
+if (TREE_CODE (old_size) != INTEGER_CST
-|| TREE_OVERFLOW (type_size)
+|| TREE_OVERFLOW (old_size)
-|| tree_int_cst_lt (size, type_size))
+|| tree_int_cst_lt (size, old_size))
 {
-if (component_p)
+char buf[128];
-	post_error_ne_tree
+const char *s;
-	  ("component size for& too small{, minimum allowed is ^}",
-	   gnat_error_node, gnat_object, type_size);
+if (kind == FIELD_DECL)
+	{
+	  snprintf (buf, sizeof (buf), s1, s2);
+	  s = buf;
+	}
+else if (component_p)
+	s = "component size for& too small{, minimum allowed is ^}";
 else
-	post_error_ne_tree
+	s = "size for& too small{, minimum allowed is ^}";
-	  ("size for& too small{, minimum allowed is ^}",
+post_error_ne_tree (s, gnat_error_node, gnat_object, old_size);
-	   gnat_error_node, gnat_object, type_size);
 return NULL_TREE;
 }
 return size;
 }
 Node_Id gnat_attr_node;
 tree old_size, size;
 /* Do nothing if no size was specified.  */
 if (uint_size == No_Uint)
-return;
-/* Ignore a negative size since that corresponds to our back-annotation.  */
-if (UI_Lt (uint_size, Uint_0))
 return;
 /* Only issue an error if a Value_Size clause was explicitly given.
 Otherwise, we'd be duplicating an error on the Size clause.  */
 gnat_attr_node
 /* If we've exhausted both lists simultaneously, we're done.  */
 if (!ada_type && !btin_type)
 	break;
-/* If one list is shorter than the other, they fail to match.  */
+/* If the internal builtin uses a variable list, accept anything.  */
-if (!ada_type || !btin_type)
+if (!btin_type)
-	return false;
+	break;
 /* If we're done with the Ada args and not with the internal builtin
 	 args, or the other way around, complain.  */
 if (ada_type == void_type_node
 	  && btin_type != void_type_node)
 	  {
 	    gnu_size = DECL_SIZE (gnu_old_field);
 	    if (RECORD_OR_UNION_TYPE_P (gnu_field_type)
 		&& !TYPE_FAT_POINTER_P (gnu_field_type)
 		&& tree_fits_uhwi_p (TYPE_SIZE (gnu_field_type)))
-	      gnu_field_type = make_packable_type (gnu_field_type, true);
+	      gnu_field_type = make_packable_type (gnu_field_type, true, 0);
 	  }
 	else
 	  gnu_size = TYPE_SIZE (gnu_field_type);
 {
 /* For integral types, we store the RM size explicitly.  */
 if (INTEGRAL_TYPE_P (gnu_type) && TYPE_RM_SIZE (gnu_type))
 return TYPE_RM_SIZE (gnu_type);
-/* Return the RM size of the actual data plus the size of the template.  */
+/* If the type contains a template, return the padded size of the template
+plus the RM size of the actual data.  */
 if (TREE_CODE (gnu_type) == RECORD_TYPE
 && TYPE_CONTAINS_TEMPLATE_P (gnu_type))
 return
 size_binop (PLUS_EXPR,
-		  rm_size (TREE_TYPE (DECL_CHAIN (TYPE_FIELDS (gnu_type)))),
+		  bit_position (DECL_CHAIN (TYPE_FIELDS (gnu_type))),
-		  DECL_SIZE (TYPE_FIELDS (gnu_type)));
+		  rm_size (TREE_TYPE (DECL_CHAIN (TYPE_FIELDS (gnu_type)))));
 /* For record or union types, we store the size explicitly.  */
 if (RECORD_OR_UNION_TYPE_P (gnu_type)
 && !TYPE_FAT_POINTER_P (gnu_type)
 && TYPE_ADA_SIZE (gnu_type))
 strcat (new_name, "___");
 strcat (new_name, suffix);
 return get_identifier_with_length (new_name, len);
 }
-/* Initialize data structures of the decl.c module.  */
+/* Initialize the data structures of the decl.c module.  */
 void
 init_gnat_decl (void)
 {
 /* Initialize the cache of annotated values.  */
 /* Initialize the association of dummy types with subprograms.  */
 dummy_to_subprog_map = hash_table<dummy_type_hasher>::create_ggc (512);
 }
-/* Destroy data structures of the decl.c module.  */
+/* Destroy the data structures of the decl.c module.  */
 void
 destroy_gnat_decl (void)
 {
 /* Destroy the cache of annotated values.  */

Mercurial > hg > CbC > CbC_gcc

comparison gcc/ada/gcc-interface/decl.c @ 145:1830386684a0