diff mbox series

[Ada] Fix run time inefficiency with dynamic discriminated record types

Message ID 2670958.OxIvtm4W9Q@polaris
State New
Headers show
Series [Ada] Fix run time inefficiency with dynamic discriminated record types | expand

Commit Message

Eric Botcazou Jan. 27, 2019, 7:14 p.m. UTC
This isn't really a regression but a long standing issue related to the run 
time performance of a class of dynamic discriminated record types.  For them, 
the size and offset calculations contain artificial MIN expressions that are 
introduced to compute maximum sizes at compile time but nevertheless end up in 
the generated code.  Moreover, in some cases, these calculations cannot be 
hoisted out of loops because of fake aliasing conflicts for the discriminant.

The attached patch is aimed at addressing both issues.  We have been using it 
for some time now and is IMO worth having in GCC 9 despite the small risk.

Tested on x86_64-suse-linux, applied on the mainline.


2019-01-27  Eric Botcazou  <ebotcazou@adacore.com>

	* repinfo.adb (List_Component_Layout): Remove superfluous space for
	zero-sized field.
	* gcc-interface/ada-tree.h (TYPE_IS_EXTRA_SUBTYPE_P): New macro.
	* gcc-interface/gigi.h (create_extra_subtype): Declare.
	* gcc-interface/decl.c (TYPE_ARRAY_SIZE_LIMIT): Likewise.
	(update_n_elem): New function.
	(gnat_to_gnu_entity): Use create_extra_subtype to create extra subtypes
	instead of doing it manually.
	<E_Array_Type>: Use update_n_elem to compute the maximum size.  Use the
 	index type instead of base type for the bounds.  Set TYPE_ARRAY_MAX_SIZE
	of the array to the maximum size.
	<E_Array_Subtype>: Create an extra subtype using the index type of the
	base array type for self-referential bounds.  Use update_n_elem to
	compute the maximum size. Set TYPE_ARRAY_MAX_SIZE of the array to the
	maximum size.
	(gnat_to_gnu_field): Clear DECL_NONADDRESSABLE_P on discriminants.
	* gcc-interface/misc.c (gnat_get_alias_set): Return the alias set of
	the base type for an extra subtype.
	(gnat_type_max_size): Remove obsolete code.
	* gcc-interface/trans.c (Attribute_to_gnu): Minor tweak.
	(can_be_lower_p): Deal with pathological types.
	* gcc-interface/utils.c (create_extra_subtype): New function.
	(create_field_decl): Minor tweak.
	(max_size) <tcc_reference>: Compute a better value by using the extra
 	subtypes on the self-referential bounds.
	<tcc_binary>: Rewrite.  Deal with "negative value" in unsigned types.
	<tcc_expression>: Likewise.
	* gcc-interface/utils2.c (compare_arrays): Retrieve the original bounds
	of the arrays upfront.  Swap only if the second length is not constant.
	Use comparisons on the original bounds consistently for the null tests.
	(build_binary_op): Use TYPE_IS_EXTRA_SUBTYPE_P macro.
	(build_allocator): Minor tweak.
diff mbox series

Patch

Index: gcc-interface/ada-tree.h
===================================================================
--- gcc-interface/ada-tree.h	(revision 268309)
+++ gcc-interface/ada-tree.h	(working copy)
@@ -111,6 +111,9 @@  do {							 \
    front-end.  */
 #define TYPE_EXTRA_SUBTYPE_P(NODE) TYPE_LANG_FLAG_2 (INTEGER_TYPE_CHECK (NODE))
 
+#define TYPE_IS_EXTRA_SUBTYPE_P(NODE) \
+  (TREE_CODE (NODE) == INTEGER_TYPE && TYPE_EXTRA_SUBTYPE_P (NODE))
+
 /* Nonzero for an aggregate type if this is a by-reference type.  We also
    set this on an ENUMERAL_TYPE that is dummy.  */
 #define TYPE_BY_REFERENCE_P(NODE)				       \
Index: gcc-interface/decl.c
===================================================================
--- gcc-interface/decl.c	(revision 268314)
+++ gcc-interface/decl.c	(working copy)
@@ -85,6 +85,12 @@ 
 #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;
@@ -216,6 +222,7 @@  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,
@@ -1760,12 +1767,10 @@  gnat_to_gnu_entity (Entity_Id gnat_entit
 	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;
+	    gnu_type
+	      = create_extra_subtype (gnu_type, TYPE_MIN_VALUE (gnu_type),
+				      gnu_high);
 	  }
       }
       goto discrete_type;
@@ -2052,7 +2057,7 @@  gnat_to_gnu_entity (Entity_Id gnat_entit
 	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;
@@ -2165,17 +2170,27 @@  gnat_to_gnu_entity (Entity_Id gnat_entit
 	  {
 	    char field_name[16];
 	    tree gnu_index_type = get_unpadded_type (Etype (gnat_index));
-	    tree gnu_index_base_type
-	      = maybe_character_type (get_base_type (gnu_index_type));
-	    tree gnu_lb_field, gnu_hb_field, gnu_orig_min, gnu_orig_max;
+	    tree gnu_orig_min = TYPE_MIN_VALUE (gnu_index_type);
+	    tree gnu_orig_max = TYPE_MAX_VALUE (gnu_index_type);
+	    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),
@@ -2183,7 +2198,7 @@  gnat_to_gnu_entity (Entity_Id gnat_entit
 
 	    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),
@@ -2193,10 +2208,10 @@  gnat_to_gnu_entity (Entity_Id gnat_entit
 
 	    /* 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;
@@ -2222,25 +2237,6 @@  gnat_to_gnu_entity (Entity_Id gnat_entit
 						      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);
 	  }
@@ -2262,17 +2258,10 @@  gnat_to_gnu_entity (Entity_Id gnat_entit
 	  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_unit = size_binop (MULT_EXPR, gnu_max_size,
-					    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;
+	  gnu_max_size
+	    = size_binop (MULT_EXPR, gnu_max_size, TYPE_SIZE_UNIT (comp_type));
 
 	/* Now build the array type.  */
         tem = comp_type;
@@ -2329,14 +2318,8 @@  gnat_to_gnu_entity (Entity_Id gnat_entit
 	if (gnu_max_size
 	    && TREE_CODE (gnu_max_size) == INTEGER_CST
 	    && !TREE_OVERFLOW (gnu_max_size)
-	    && TREE_CODE (gnu_max_size_unit) == INTEGER_CST
-	    && !TREE_OVERFLOW (gnu_max_size_unit))
-	  {
-	    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));
-	  }
+	    && compare_tree_int (gnu_max_size, TYPE_ARRAY_SIZE_LIMIT) <= 0)
+	  TYPE_ARRAY_MAX_SIZE (tem) = gnu_max_size;
 
 	create_type_decl (create_concat_name (gnat_entity, "XUA"), tem,
 			  artificial_p, debug_info_p, gnat_entity);
@@ -2400,7 +2383,7 @@  gnat_to_gnu_entity (Entity_Id gnat_entit
 	  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;
 
@@ -2416,27 +2399,83 @@  gnat_to_gnu_entity (Entity_Id gnat_entit
 	       gnat_base_index = Next_Index (gnat_base_index))
 	    {
 	      tree gnu_index_type = get_unpadded_type (Etype (gnat_index));
-	      tree gnu_index_base_type
-		= maybe_character_type (get_base_type (gnu_index_type));
-	      tree gnu_orig_min
-		= 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_orig_min = TYPE_MIN_VALUE (gnu_index_type);
+	      tree gnu_orig_max = TYPE_MAX_VALUE (gnu_index_type);
+	      tree gnu_index_base_type = get_base_type (gnu_index_type);
 	      tree gnu_base_index_type
 		= get_unpadded_type (Etype (gnat_base_index));
-	      tree gnu_base_index_base_type
-	        = maybe_character_type (get_base_type (gnu_base_index_type));
-	      tree gnu_base_orig_min
-		= convert (gnu_base_index_base_type,
-			   TYPE_MIN_VALUE (gnu_base_index_type));
-	      tree gnu_base_orig_max
-	        = convert (gnu_base_index_base_type,
-			   TYPE_MAX_VALUE (gnu_base_index_type));
-	      tree gnu_high;
+	      tree gnu_base_orig_min = TYPE_MIN_VALUE (gnu_base_index_type);
+	      tree gnu_base_orig_max = TYPE_MAX_VALUE (gnu_base_index_type);
+	      tree gnu_min, gnu_max, gnu_high;
+
+	      /* We try to define subtypes for discriminants used as bounds
+		 that are more restrictive than those declared by using the
+		 bounds of the index type of the base array type.  This will
+		 make it possible to calculate the maximum size of the record
+		 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
@@ -2470,7 +2509,8 @@  gnat_to_gnu_entity (Entity_Id gnat_entit
 		       && 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))))
 		{
@@ -2512,12 +2552,9 @@  gnat_to_gnu_entity (Entity_Id gnat_entit
 		}
 
 	      /* Finally we use (hb >= lb) ? hb : lb - 1 for the upper bound
-		 in all the other cases.  Note that, here as well as above,
-		 the condition used in the comparison must be equivalent to
-		 the condition (length != 0).  This is relied upon in order
-		 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.  */
+		 in all the other cases.  Note that 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,
@@ -2538,65 +2575,6 @@  gnat_to_gnu_entity (Entity_Id gnat_entit
 		= 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
@@ -2646,17 +2624,10 @@  gnat_to_gnu_entity (Entity_Id gnat_entit
 		}
 	    }
 
-	  /* 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_unit = size_binop (MULT_EXPR, gnu_max_size,
-					      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;
+	    gnu_max_size
+	      = size_binop (MULT_EXPR, gnu_max_size, TYPE_SIZE_UNIT (gnu_type));
 
 	  /* Now build the array type.  */
 	  for (index = ndim - 1; index >= 0; index --)
@@ -2776,21 +2747,12 @@  gnat_to_gnu_entity (Entity_Id gnat_entit
 	    = (Is_Packed (gnat_entity)
 	       || Is_Packed_Array_Impl_Type (gnat_entity));
 
-	  /* If the size is self-referential and the maximum size doesn't
-	     overflow, use it.  */
-	  if (CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_type))
-	      && gnu_max_size
-	      && !(TREE_CODE (gnu_max_size) == INTEGER_CST
-		   && TREE_OVERFLOW (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));
-	    }
+	  /* 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)
+	      && compare_tree_int (gnu_max_size, TYPE_ARRAY_SIZE_LIMIT) <= 0)
+	    TYPE_ARRAY_MAX_SIZE (gnu_type) = gnu_max_size;
 
 	  /* Set our alias set to that of our base type.  This gives all
 	     array subtypes the same alias set.  */
@@ -2850,17 +2812,10 @@  gnat_to_gnu_entity (Entity_Id gnat_entit
 			 TYPE_MODULUS for modular types so we make an extra
 			 subtype if necessary.  */
 		      if (TYPE_MODULAR_P (gnu_inner))
-			{
-			  tree gnu_subtype
-			    = make_unsigned_type (TYPE_PRECISION (gnu_inner));
-			  TREE_TYPE (gnu_subtype) = 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;
-			}
+			gnu_inner
+			  = create_extra_subtype (gnu_inner,
+						  TYPE_MIN_VALUE (gnu_inner),
+						  TYPE_MAX_VALUE (gnu_inner));
 
 		      TYPE_HAS_ACTUAL_BOUNDS_P (gnu_inner) = 1;
 
@@ -3259,7 +3214,7 @@  gnat_to_gnu_entity (Entity_Id gnat_entit
 		&& !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),
@@ -3270,20 +3225,10 @@  gnat_to_gnu_entity (Entity_Id gnat_entit
 		gcc_assert (TREE_TYPE (TREE_OPERAND (gnu_ref, 0)) == gnu_type);
 
 		if (gnu_discr_type != TREE_TYPE (gnu_ref))
-		  {
-		    const unsigned prec = TYPE_PRECISION (TREE_TYPE (gnu_ref));
-		    tree gnu_subtype
-		      = TYPE_UNSIGNED (TREE_TYPE (gnu_ref))
-		        ? 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;
-		  }
+		  TREE_TYPE (gnu_ref)
+		    = create_extra_subtype (TREE_TYPE (gnu_ref),
+					    TYPE_MIN_VALUE (gnu_discr_type),
+					    TYPE_MAX_VALUE (gnu_discr_type));
 	      }
 
 	/* If this is a derived type with discriminants and these discriminants
@@ -6399,6 +6344,37 @@  initial_value_needs_conversion (tree gnu
   /* 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.  */
@@ -7222,12 +7198,20 @@  gnat_to_gnu_field (Entity_Id gnat_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_INVARIANT_P (gnu_field)
-	= No (Discriminant_Default_Value (gnat_field));
       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_NONADDRESSABLE_P (gnu_field) = 0;
     }
 
   return gnu_field;
Index: gcc-interface/gigi.h
===================================================================
--- gcc-interface/gigi.h	(revision 268309)
+++ gcc-interface/gigi.h	(working copy)
@@ -637,6 +637,9 @@  extern tree create_index_type (tree min,
    sizetype is used.  */
 extern tree create_range_type (tree type, tree min, tree max);
 
+/* Return an extra subtype of TYPE with range MIN to MAX.  */
+extern tree create_extra_subtype (tree type, tree min, tree max);
+
 /* Return a TYPE_DECL node suitable for the TYPE_STUB_DECL field of TYPE.
    NAME gives the name of the type to be used in the declaration.  */
 extern tree create_type_stub_decl (tree name, tree type);
Index: gcc-interface/misc.c
===================================================================
--- gcc-interface/misc.c	(revision 268309)
+++ gcc-interface/misc.c	(working copy)
@@ -727,6 +727,10 @@  gnat_get_alias_set (tree type)
   if (TYPE_IS_PADDING_P (type))
     return get_alias_set (TREE_TYPE (TYPE_FIELDS (type)));
 
+  /* If this is an extra subtype, use the base type.  */
+  else if (TYPE_IS_EXTRA_SUBTYPE_P (type))
+    return get_alias_set (get_base_type (type));
+
   /* If the type is an unconstrained array, use the type of the
      self-referential array we make.  */
   else if (TREE_CODE (type) == UNCONSTRAINED_ARRAY_TYPE)
@@ -753,59 +757,22 @@  gnat_type_max_size (const_tree gnu_type)
      elaborated and possibly replaced by a VAR_DECL.  */
   tree max_size_unit = max_size (TYPE_SIZE_UNIT (gnu_type), true);
 
-  /* If we don't have a constant, try to look at attributes which should have
-     stayed untouched.  */
-  if (!tree_fits_uhwi_p (max_size_unit))
+  /* If we don't have a constant, see what we can get from TYPE_ADA_SIZE,
+     which should stay untouched.  */
+  if (!tree_fits_uhwi_p (max_size_unit)
+      && RECORD_OR_UNION_TYPE_P (gnu_type)
+      && !TYPE_FAT_POINTER_P (gnu_type)
+      && TYPE_ADA_SIZE (gnu_type))
     {
-      /* For record types, see what we can get from TYPE_ADA_SIZE.  */
-      if (RECORD_OR_UNION_TYPE_P (gnu_type)
-	  && !TYPE_FAT_POINTER_P (gnu_type)
-	  && TYPE_ADA_SIZE (gnu_type))
-	{
-	  tree max_ada_size = max_size (TYPE_ADA_SIZE (gnu_type), true);
-
-	  /* If we have succeeded in finding a constant, round it up to the
-	     type's alignment and return the result in units.  */
-	  if (tree_fits_uhwi_p (max_ada_size))
-	    max_size_unit
-	      = size_binop (CEIL_DIV_EXPR,
-			    round_up (max_ada_size, TYPE_ALIGN (gnu_type)),
-			    bitsize_unit_node);
-	}
-
-      /* For array types, see what we can get from TYPE_INDEX_TYPE.  */
-      else if (TREE_CODE (gnu_type) == ARRAY_TYPE
-	       && TYPE_INDEX_TYPE (TYPE_DOMAIN (gnu_type))
-	       && tree_fits_uhwi_p (TYPE_SIZE_UNIT (TREE_TYPE (gnu_type))))
-	{
-	  tree lb = TYPE_MIN_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (gnu_type)));
-	  tree hb = TYPE_MAX_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (gnu_type)));
-	  if (TREE_CODE (lb) != INTEGER_CST
-	      && TYPE_RM_SIZE (TREE_TYPE (lb))
-	      && compare_tree_int (TYPE_RM_SIZE (TREE_TYPE (lb)), 16) <= 0)
-	    lb = TYPE_MIN_VALUE (TREE_TYPE (lb));
-	  if (TREE_CODE (hb) != INTEGER_CST
-	      && TYPE_RM_SIZE (TREE_TYPE (hb))
-	      && compare_tree_int (TYPE_RM_SIZE (TREE_TYPE (hb)), 16) <= 0)
-	    hb = TYPE_MAX_VALUE (TREE_TYPE (hb));
-	  if (TREE_CODE (lb) == INTEGER_CST && TREE_CODE (hb) == INTEGER_CST)
-	    {
-	      tree ctype = get_base_type (TREE_TYPE (lb));
-	      lb = fold_convert (ctype, lb);
-	      hb = fold_convert (ctype, hb);
-	      if (tree_int_cst_le (lb, hb))
-		{
-		  tree length
-		    = fold_build2 (PLUS_EXPR, ctype,
-				   fold_build2 (MINUS_EXPR, ctype, hb, lb),
-				   build_int_cst (ctype, 1));
-		  max_size_unit
-		    = fold_build2 (MULT_EXPR, sizetype,
-				   fold_convert (sizetype, length),
-				   TYPE_SIZE_UNIT (TREE_TYPE (gnu_type)));
-		}
-	    }
-	}
+      tree max_ada_size = max_size (TYPE_ADA_SIZE (gnu_type), true);
+
+      /* If we have succeeded in finding a constant, round it up to the
+	 type's alignment and return the result in units.  */
+      if (tree_fits_uhwi_p (max_ada_size))
+	max_size_unit
+	  = size_binop (CEIL_DIV_EXPR,
+			round_up (max_ada_size, TYPE_ALIGN (gnu_type)),
+			bitsize_unit_node);
     }
 
   return max_size_unit;
Index: gcc-interface/trans.c
===================================================================
--- gcc-interface/trans.c	(revision 268309)
+++ gcc-interface/trans.c	(working copy)
@@ -2374,15 +2374,12 @@  Attribute_to_gnu (Node_Id gnat_node, tre
       else
 	gnu_result = rm_size (gnu_type);
 
-      /* Deal with a self-referential size by returning the maximum size for
-	 a type and by qualifying the size with the object otherwise.  */
-      if (CONTAINS_PLACEHOLDER_P (gnu_result))
-	{
-	  if (TREE_CODE (gnu_prefix) == TYPE_DECL)
-	    gnu_result = max_size (gnu_result, true);
-	  else
-	    gnu_result = substitute_placeholder_in_expr (gnu_result, gnu_expr);
-	}
+      /* Deal with a self-referential size by qualifying the size with the
+	 object or returning the maximum size for a type.  */
+      if (TREE_CODE (gnu_prefix) != TYPE_DECL)
+	gnu_result = SUBSTITUTE_PLACEHOLDER_IN_EXPR (gnu_result, gnu_expr);
+      else if (CONTAINS_PLACEHOLDER_P (gnu_result))
+	gnu_result = max_size (gnu_result, true);
 
       /* If the type contains a template, subtract the padded size of the
 	 template, except for 'Max_Size_In_Storage_Elements because we need
@@ -3227,13 +3224,25 @@  static bool
 can_be_lower_p (tree val1, tree val2)
 {
   if (TREE_CODE (val1) == NOP_EXPR)
-    val1 = TYPE_MIN_VALUE (TREE_TYPE (TREE_OPERAND (val1, 0)));
+    {
+      tree type = TREE_TYPE (TREE_OPERAND (val1, 0));
+      if (can_be_lower_p (TYPE_MAX_VALUE (type), TYPE_MIN_VALUE (type)))
+	return true;
+
+      val1 = TYPE_MIN_VALUE (type);
+    }
 
   if (TREE_CODE (val1) != INTEGER_CST)
     return true;
 
   if (TREE_CODE (val2) == NOP_EXPR)
-    val2 = TYPE_MAX_VALUE (TREE_TYPE (TREE_OPERAND (val2, 0)));
+    {
+      tree type = TREE_TYPE (TREE_OPERAND (val2, 0));
+      if (can_be_lower_p (TYPE_MAX_VALUE (type), TYPE_MIN_VALUE (type)))
+	return true;
+
+      val2 = TYPE_MAX_VALUE (type);
+    }
 
   if (TREE_CODE (val2) != INTEGER_CST)
     return true;
Index: gcc-interface/utils.c
===================================================================
--- gcc-interface/utils.c	(revision 268309)
+++ gcc-interface/utils.c	(working copy)
@@ -2260,7 +2260,7 @@  merge_sizes (tree last_size, tree first_
 						       1, has_rep));
 
   /* We don't need any NON_VALUE_EXPRs and they can confuse us (especially
-     when fed through substitute_in_expr) into thinking that a constant
+     when fed through SUBSTITUTE_IN_EXPR) into thinking that a constant
      size is not constant.  */
   while (TREE_CODE (new_size) == NON_LVALUE_EXPR)
     new_size = TREE_OPERAND (new_size, 0);
@@ -2429,6 +2429,24 @@  create_range_type (tree type, tree min,
   return range_type;
 }
 
+/* Return an extra subtype of TYPE with range MIN to MAX.  */
+
+tree
+create_extra_subtype (tree type, tree min, tree max)
+{
+  const bool uns = TYPE_UNSIGNED (type);
+  const unsigned prec = TYPE_PRECISION (type);
+  tree subtype = uns ? make_unsigned_type (prec) : make_signed_type (prec);
+
+  TREE_TYPE (subtype) = type;
+  TYPE_EXTRA_SUBTYPE_P (subtype) = 1;
+
+  SET_TYPE_RM_MIN_VALUE (subtype, min);
+  SET_TYPE_RM_MAX_VALUE (subtype, max);
+
+  return subtype;
+}
+
 /* Return a TYPE_DECL node suitable for the TYPE_STUB_DECL field of TYPE.
    NAME gives the name of the type to be used in the declaration.  */
 
@@ -2811,8 +2829,8 @@  create_field_decl (tree name, tree type,
 
       layout_decl (field_decl, known_align);
       SET_DECL_OFFSET_ALIGN (field_decl,
-			     tree_fits_uhwi_p (pos) ? BIGGEST_ALIGNMENT
-			     : BITS_PER_UNIT);
+			     tree_fits_uhwi_p (pos)
+			     ? BIGGEST_ALIGNMENT : BITS_PER_UNIT);
       pos_from_bit (&DECL_FIELD_OFFSET (field_decl),
 		    &DECL_FIELD_BIT_OFFSET (field_decl),
 		    DECL_OFFSET_ALIGN (field_decl), pos);
@@ -2829,6 +2847,15 @@  create_field_decl (tree name, tree type,
   if (!addressable && !type_for_nonaliased_component_p (type))
     addressable = 1;
 
+  /* Note that there is a trade-off in making a field nonaddressable because
+     this will cause type-based alias analysis to use the same alias set for
+     accesses to the field as for accesses to the whole record: while doing
+     so will make it more likely to disambiguate accesses to other objects
+     and accesses to the field, it will make it less likely to disambiguate
+     accesses to the other fields of the record and accesses to the field.
+     If the record is fully static, then the trade-off is irrelevant since
+     the fields of the record can always be disambiguated by their offsets
+     but, if the record is dynamic, then it can become problematic.  */
   DECL_NONADDRESSABLE_P (field_decl) = !addressable;
 
   return field_decl;
@@ -3658,11 +3685,27 @@  max_size (tree exp, bool max_p)
 	 modify.  Otherwise, we treat it like a variable.  */
       if (CONTAINS_PLACEHOLDER_P (exp))
 	{
-	  tree val_type = TREE_TYPE (TREE_OPERAND (exp, 1));
-	  tree val = (max_p ? TYPE_MAX_VALUE (type) : TYPE_MIN_VALUE (type));
-	  return
-	    convert (type,
-		     max_size (convert (get_base_type (val_type), val), true));
+	  tree base_type = get_base_type (TREE_TYPE (TREE_OPERAND (exp, 1)));
+	  tree val
+	    = fold_convert (base_type,
+			    max_p
+			    ? TYPE_MAX_VALUE (type) : TYPE_MIN_VALUE (type));
+
+	  /* Walk down the extra subtypes to get more restrictive bounds.  */
+	  while (TYPE_IS_EXTRA_SUBTYPE_P (type))
+	    {
+	      type = TREE_TYPE (type);
+	      if (max_p)
+		val = fold_build2 (MIN_EXPR, base_type, val,
+				   fold_convert (base_type,
+						 TYPE_MAX_VALUE (type)));
+	      else
+		val = fold_build2 (MAX_EXPR, base_type, val,
+				   fold_convert (base_type,
+						 TYPE_MIN_VALUE (type)));
+	    }
+
+	  return fold_convert (type, max_size (val, max_p));
 	}
 
       return exp;
@@ -3683,49 +3726,57 @@  max_size (tree exp, bool max_p)
       return fold_build1 (code, type, op0);
 
     case tcc_binary:
-      {
-	tree lhs = max_size (TREE_OPERAND (exp, 0), max_p);
-	tree rhs = max_size (TREE_OPERAND (exp, 1),
-			     code == MINUS_EXPR ? !max_p : max_p);
-
-	/* Special-case wanting the maximum value of a MIN_EXPR.
-	   In that case, if one side overflows, return the other.  */
-	if (max_p && code == MIN_EXPR)
-	  {
-	    if (TREE_CODE (rhs) == INTEGER_CST && TREE_OVERFLOW (rhs))
-	      return lhs;
+      op0 = TREE_OPERAND (exp, 0);
+      op1 = TREE_OPERAND (exp, 1);
 
-	    if (TREE_CODE (lhs) == INTEGER_CST && TREE_OVERFLOW (lhs))
-	      return rhs;
-	  }
+      /* If we have a multiply-add with a "negative" value in an unsigned
+	 type, do a multiply-subtract with the negated value, in order to
+	 avoid creating a spurious overflow below.  */
+      if (code == PLUS_EXPR
+	  && TREE_CODE (op0) == MULT_EXPR
+	  && TYPE_UNSIGNED (type)
+	  && TREE_CODE (TREE_OPERAND (op0, 1)) == INTEGER_CST
+	  && !TREE_OVERFLOW (TREE_OPERAND (op0, 1))
+	  && tree_int_cst_sign_bit (TREE_OPERAND (op0, 1)))
+	{
+	  tree tmp = op1;
+	  op1 = build2 (MULT_EXPR, type, TREE_OPERAND (op0, 0),
+			fold_build1 (NEGATE_EXPR, type,
+				    TREE_OPERAND (op0, 1)));
+	  op0 = tmp;
+	  code = MINUS_EXPR;
+	}
 
-	/* Likewise, handle a MINUS_EXPR or PLUS_EXPR with the LHS
-	   overflowing and the RHS a variable.  */
-	if ((code == MINUS_EXPR || code == PLUS_EXPR)
-	    && TREE_CODE (lhs) == INTEGER_CST
-	    && TREE_OVERFLOW (lhs)
-	    && TREE_CODE (rhs) != INTEGER_CST)
-	  return lhs;
-
-	/* If we are going to subtract a "negative" value in an unsigned type,
-	   do the operation as an addition of the negated value, in order to
-	   avoid creating a spurious overflow below.  */
-	if (code == MINUS_EXPR
-	    && TYPE_UNSIGNED (type)
-	    && TREE_CODE (rhs) == INTEGER_CST
-	    && !TREE_OVERFLOW (rhs)
-	    && tree_int_cst_sign_bit (rhs) != 0)
-	  {
-	    rhs = fold_build1 (NEGATE_EXPR, type, rhs);
-	    code = PLUS_EXPR;
-	  }
+      op0 = max_size (op0, max_p);
+      op1 = max_size (op1, code == MINUS_EXPR ? !max_p : max_p);
+
+      if ((code == MINUS_EXPR || code == PLUS_EXPR))
+	{
+	  /* If the op0 has overflowed and the op1 is a variable,
+	     propagate the overflow by returning the op0.  */
+	  if (TREE_CODE (op0) == INTEGER_CST
+	      && TREE_OVERFLOW (op0)
+	      && TREE_CODE (op1) != INTEGER_CST)
+	    return op0;
+
+	  /* If we have a "negative" value in an unsigned type, do the
+	     opposite operation on the negated value, in order to avoid
+	     creating a spurious overflow below.  */
+	  if (TYPE_UNSIGNED (type)
+	      && TREE_CODE (op1) == INTEGER_CST
+	      && !TREE_OVERFLOW (op1)
+	      && tree_int_cst_sign_bit (op1))
+	    {
+	      op1 = fold_build1 (NEGATE_EXPR, type, op1);
+	      code = (code == MINUS_EXPR ? PLUS_EXPR : MINUS_EXPR);
+	    }
+	}
 
-	if (lhs == TREE_OPERAND (exp, 0) && rhs == TREE_OPERAND (exp, 1))
-	  return exp;
+      if (op0 == TREE_OPERAND (exp, 0) && op1 == TREE_OPERAND (exp, 1))
+	return exp;
 
-	/* We need to detect overflows so we call size_binop here.  */
-	return size_binop (code, lhs, rhs);
-      }
+      /* We need to detect overflows so we call size_binop here.  */
+      return size_binop (code, op0, op1);
 
     case tcc_expression:
       switch (TREE_CODE_LENGTH (code))
@@ -3757,15 +3808,28 @@  max_size (tree exp, bool max_p)
 	case 3:
 	  if (code == COND_EXPR)
 	    {
+	      op0 = TREE_OPERAND (exp, 0);
 	      op1 = TREE_OPERAND (exp, 1);
 	      op2 = TREE_OPERAND (exp, 2);
 
 	      if (!op1 || !op2)
 		return exp;
 
-	      return
-		fold_build2 (max_p ? MAX_EXPR : MIN_EXPR, type,
-			     max_size (op1, max_p), max_size (op2, max_p));
+	      op1 = max_size (op1, max_p);
+	      op2 = max_size (op2, max_p);
+
+	      /* If we have the MAX of a "negative" value in an unsigned type
+		 and zero for a length expression, just return zero.  */
+	      if (max_p
+		  && TREE_CODE (op0) == LE_EXPR
+		  && TYPE_UNSIGNED (type)
+		  && TREE_CODE (op1) == INTEGER_CST
+		  && !TREE_OVERFLOW (op1)
+		  && tree_int_cst_sign_bit (op1)
+		  && integer_zerop (op2))
+		return op2;
+
+	      return fold_build2 (max_p ? MAX_EXPR : MIN_EXPR, type, op1, op2);
 	    }
 	  break;
 
Index: gcc-interface/utils2.c
===================================================================
--- gcc-interface/utils2.c	(revision 268309)
+++ gcc-interface/utils2.c	(working copy)
@@ -301,19 +301,31 @@  compare_arrays (location_t loc, tree res
      in order to suppress the comparison of the data at the end.  */
   while (TREE_CODE (t1) == ARRAY_TYPE && TREE_CODE (t2) == ARRAY_TYPE)
     {
-      tree lb1 = TYPE_MIN_VALUE (TYPE_DOMAIN (t1));
-      tree ub1 = TYPE_MAX_VALUE (TYPE_DOMAIN (t1));
-      tree lb2 = TYPE_MIN_VALUE (TYPE_DOMAIN (t2));
-      tree ub2 = TYPE_MAX_VALUE (TYPE_DOMAIN (t2));
-      tree length1 = size_binop (PLUS_EXPR, size_binop (MINUS_EXPR, ub1, lb1),
+      tree dom1 = TYPE_DOMAIN (t1);
+      tree dom2 = TYPE_DOMAIN (t2);
+      tree length1 = size_binop (PLUS_EXPR,
+				 size_binop (MINUS_EXPR,
+					     TYPE_MAX_VALUE (dom1),
+					     TYPE_MIN_VALUE (dom1)),
 				 size_one_node);
-      tree length2 = size_binop (PLUS_EXPR, size_binop (MINUS_EXPR, ub2, lb2),
+      tree length2 = size_binop (PLUS_EXPR,
+				 size_binop (MINUS_EXPR,
+					     TYPE_MAX_VALUE (dom2),
+					     TYPE_MIN_VALUE (dom2)),
 				 size_one_node);
+      tree ind1 = TYPE_INDEX_TYPE (dom1);
+      tree ind2 = TYPE_INDEX_TYPE (dom2);
+      tree base_type = maybe_character_type (get_base_type (ind1));
+      tree lb1 = convert (base_type, TYPE_MIN_VALUE (ind1));
+      tree ub1 = convert (base_type, TYPE_MAX_VALUE (ind1));
+      tree lb2 = convert (base_type, TYPE_MIN_VALUE (ind2));
+      tree ub2 = convert (base_type, TYPE_MAX_VALUE (ind2));
       tree comparison, this_a1_is_null, this_a2_is_null;
 
-      /* If the length of the first array is a constant, swap our operands
-	 unless the length of the second array is the constant zero.  */
-      if (TREE_CODE (length1) == INTEGER_CST && !integer_zerop (length2))
+      /* If the length of the first array is a constant and that of the second
+	 array is not, swap our operands to have the constant second.  */
+      if (TREE_CODE (length1) == INTEGER_CST
+	  && TREE_CODE (length2) != INTEGER_CST)
 	{
 	  tree tem;
 	  bool btem;
@@ -333,17 +345,12 @@  compare_arrays (location_t loc, tree res
 	 last < first holds.  */
       if (integer_zerop (length2))
 	{
-	  tree b = get_base_type (TYPE_INDEX_TYPE (TYPE_DOMAIN (t1)));
-
 	  length_zero_p = true;
 
-	  ub1
-	    = convert (b, TYPE_MAX_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (t1))));
-	  lb1
-	    = convert (b, TYPE_MIN_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (t1))));
+	  lb1 = SUBSTITUTE_PLACEHOLDER_IN_EXPR (lb1, a1);
+	  ub1 = SUBSTITUTE_PLACEHOLDER_IN_EXPR (ub1, a1);
 
 	  comparison = fold_build2_loc (loc, LT_EXPR, result_type, ub1, lb1);
-	  comparison = SUBSTITUTE_PLACEHOLDER_IN_EXPR (comparison, a1);
 	  if (EXPR_P (comparison))
 	    SET_EXPR_LOCATION (comparison, loc);
 
@@ -356,24 +363,17 @@  compare_arrays (location_t loc, tree res
 	 just use its length computed from the actual stored bounds.  */
       else if (TREE_CODE (length2) == INTEGER_CST)
 	{
-	  tree b = get_base_type (TYPE_INDEX_TYPE (TYPE_DOMAIN (t1)));
-
-	  ub1
-	    = convert (b, TYPE_MAX_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (t1))));
-	  lb1
-	    = convert (b, TYPE_MIN_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (t1))));
-	  /* Note that we know that UB2 and LB2 are constant and hence
+	  /* Note that we know that LB2 and UB2 are constant and hence
 	     cannot contain a PLACEHOLDER_EXPR.  */
-	  ub2
-	    = convert (b, TYPE_MAX_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (t2))));
-	  lb2
-	    = convert (b, TYPE_MIN_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (t2))));
+	  lb1 = SUBSTITUTE_PLACEHOLDER_IN_EXPR (lb1, a1);
+	  ub1 = SUBSTITUTE_PLACEHOLDER_IN_EXPR (ub1, a1);
 
 	  comparison
 	    = fold_build2_loc (loc, EQ_EXPR, result_type,
-			       build_binary_op (MINUS_EXPR, b, ub1, lb1),
-			       build_binary_op (MINUS_EXPR, b, ub2, lb2));
-	  comparison = SUBSTITUTE_PLACEHOLDER_IN_EXPR (comparison, a1);
+			       build_binary_op (MINUS_EXPR, base_type,
+						ub1, lb1),
+			       build_binary_op (MINUS_EXPR, base_type,
+						ub2, lb2));
 	  if (EXPR_P (comparison))
 	    SET_EXPR_LOCATION (comparison, loc);
 
@@ -391,26 +391,20 @@  compare_arrays (location_t loc, tree res
 
 	  comparison
 	    = fold_build2_loc (loc, EQ_EXPR, result_type, length1, length2);
+	  if (EXPR_P (comparison))
+	    SET_EXPR_LOCATION (comparison, loc);
 
-	  /* If the length expression is of the form (cond ? val : 0), assume
-	     that cond is equivalent to (length != 0).  That's guaranteed by
-	     construction of the array types in gnat_to_gnu_entity.  */
-	  if (TREE_CODE (length1) == COND_EXPR
-	      && integer_zerop (TREE_OPERAND (length1, 2)))
-	    this_a1_is_null
-	      = invert_truthvalue_loc (loc, TREE_OPERAND (length1, 0));
-	  else
-	    this_a1_is_null = fold_build2_loc (loc, EQ_EXPR, result_type,
-					       length1, size_zero_node);
+	  lb1 = SUBSTITUTE_PLACEHOLDER_IN_EXPR (lb1, a1);
+	  ub1 = SUBSTITUTE_PLACEHOLDER_IN_EXPR (ub1, a1);
 
-	  /* Likewise for the second array.  */
-	  if (TREE_CODE (length2) == COND_EXPR
-	      && integer_zerop (TREE_OPERAND (length2, 2)))
-	    this_a2_is_null
-	      = invert_truthvalue_loc (loc, TREE_OPERAND (length2, 0));
-	  else
-	    this_a2_is_null = fold_build2_loc (loc, EQ_EXPR, result_type,
-					       length2, size_zero_node);
+	  this_a1_is_null
+	    = fold_build2_loc (loc, LT_EXPR, result_type, ub1, lb1);
+
+	  lb2 = SUBSTITUTE_PLACEHOLDER_IN_EXPR (lb2, a2);
+	  ub2 = SUBSTITUTE_PLACEHOLDER_IN_EXPR (ub2, a2);
+
+	  this_a2_is_null
+	    = fold_build2_loc (loc, LT_EXPR, result_type, ub2, lb2);
 	}
 
       /* Append expressions for this dimension to the final expressions.  */
@@ -861,9 +855,7 @@  build_binary_op (enum tree_code op_code,
       && TYPE_JUSTIFIED_MODULAR_P (operation_type))
     operation_type = TREE_TYPE (TYPE_FIELDS (operation_type));
 
-  if (operation_type
-      && TREE_CODE (operation_type) == INTEGER_TYPE
-      && TYPE_EXTRA_SUBTYPE_P (operation_type))
+  if (operation_type && TYPE_IS_EXTRA_SUBTYPE_P (operation_type))
     operation_type = get_base_type (operation_type);
 
   modulus = (operation_type
@@ -2431,16 +2423,13 @@  build_allocator (tree type, tree init, t
     size = TYPE_SIZE_UNIT (TREE_TYPE (init));
 
   /* If the size is still self-referential, reference the initializing
-     expression, if it is present.  If not, this must have been a
-     call to allocate a library-level object, in which case we use
-     the maximum size.  */
-  if (CONTAINS_PLACEHOLDER_P (size))
-    {
-      if (!ignore_init_type && init)
-	size = substitute_placeholder_in_expr (size, init);
-      else
-	size = max_size (size, true);
-    }
+     expression, if it is present.  If not, this must have been a call
+     to allocate a library-level object, in which case we just use the
+     maximum size.  */
+  if (!ignore_init_type && init)
+    size = SUBSTITUTE_PLACEHOLDER_IN_EXPR (size, init);
+  else if (CONTAINS_PLACEHOLDER_P (size))
+    size = max_size (size, true);
 
   /* If the size overflows, pass -1 so Storage_Error will be raised.  */
   if (TREE_CODE (size) == INTEGER_CST && !valid_constant_size_p (size))