* gcc-interface/decl.c (gnat_to_gnu_entity) <object>: Convert GNU_SIZE

	to units before invoking allocatable_size_p on it.
	Remove orphaned comment.  Do not use ssize_int.
	<E_Record_Subtype>: Traverse list in original order.  Minor tweak.
	(allocatable_size_p): Adjust and simplify.
	(build_subst_list): Use consistent terminology throughout.
	(build_variant_list): Likewise.  Traverse list in original order.
	(create_field_decl_from): Likewise.
	(copy_and_substitute_in_size): Likewise.
	(create_variant_part_from): Add comment about field list order.
	* gcc-interface/utils.c (build_vms_descriptor): Do not use ssize_int.
	* gcc-interface/utils2.c (build_allocator): Likewise.


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

3 files changed, 57 insertions, 65 deletions

diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c
index ce2f94a2538..b27707c5593 100644
--- a/gcc/ada/gcc-interface/decl.c
+++ b/gcc/ada/gcc-interface/decl.c
@@ -1283,10 +1283,14 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 				 global_bindings_p ()
 				 || !definition
 				 || static_p)
-	    || (gnu_size && !allocatable_size_p (gnu_size,
-						 global_bindings_p ()
-						 || !definition
-						 || static_p)))
+	    || (gnu_size
+		&& !allocatable_size_p (convert (sizetype,
+						 size_binop
+						 (CEIL_DIV_EXPR, gnu_size,
+						  bitsize_unit_node)),
+					global_bindings_p ()
+					|| !definition
+					|| static_p)))
 	  {
 	    gnu_type = build_reference_type (gnu_type);
 	    gnu_size = NULL_TREE;
@@ -2204,8 +2208,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 			    debug_info_p);
 	TYPE_READONLY (gnu_template_type) = 1;
 
-	/* Now build the array type.  */
-
 	/* If Component_Size is not already specified, annotate it with the
 	   size of the component.  */
 	if (Unknown_Component_Size (gnat_entity))
@@ -2810,12 +2812,14 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	tree gnu_lower_bound
 	  = convert (gnu_string_index_type,
 		     gnat_to_gnu (String_Literal_Low_Bound (gnat_entity)));
-	int length = UI_To_Int (String_Literal_Length (gnat_entity));
-	tree gnu_length = ssize_int (length - 1);
+	tree gnu_length
+	  = UI_To_gnu (String_Literal_Length (gnat_entity),
+		       gnu_string_index_type);
 	tree gnu_upper_bound
 	  = build_binary_op (PLUS_EXPR, gnu_string_index_type,
 			     gnu_lower_bound,
-			     convert (gnu_string_index_type, gnu_length));
+			     int_const_binop (MINUS_EXPR, gnu_length,
+					      integer_one_node));
 	tree gnu_index_type
 	  = create_index_type (convert (sizetype, gnu_lower_bound),
 			       convert (sizetype, gnu_upper_bound),
@@ -3298,7 +3302,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	      if (gnu_variant_part)
 		{
 		  variant_desc *v;
-		  unsigned ix;
+		  unsigned int i;
 
 		  gnu_variant_list
 		    = build_variant_list (TREE_TYPE (gnu_variant_part),
@@ -3307,8 +3311,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 		  /* If all the qualifiers are unconditionally true, the
 		     innermost variant is statically selected.  */
 		  selected_variant = true;
-		  FOR_EACH_VEC_ELT_REVERSE (variant_desc, gnu_variant_list,
-					    ix, v)
+		  FOR_EACH_VEC_ELT (variant_desc, gnu_variant_list, i, v)
 		    if (!integer_onep (v->qual))
 		      {
 			selected_variant = false;
@@ -3317,8 +3320,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 
 		  /* Otherwise, create the new variants.  */
 		  if (!selected_variant)
-		    FOR_EACH_VEC_ELT_REVERSE (variant_desc, gnu_variant_list,
-					      ix, v)
+		    FOR_EACH_VEC_ELT (variant_desc, gnu_variant_list, i, v)
 		      {
 			tree old_variant = v->type;
 			tree new_variant = make_node (RECORD_TYPE);
@@ -3420,11 +3422,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 		    else
 		      {
 			variant_desc *v;
-			unsigned ix;
+			unsigned int i;
 
 			t = NULL_TREE;
-			FOR_EACH_VEC_ELT_REVERSE (variant_desc,
-						  gnu_variant_list, ix, v)
+			FOR_EACH_VEC_ELT (variant_desc, gnu_variant_list, i, v)
 			  if (v->type == gnu_context)
 			    {
 			      t = v->type;
@@ -3510,8 +3511,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 
 	      /* Do not emit debug info for the type yet since we're going to
 		 modify it below.  */
-	      gnu_field_list = nreverse (gnu_field_list);
-	      finish_record_type (gnu_type, gnu_field_list, 2, false);
+	      finish_record_type (gnu_type, nreverse (gnu_field_list), 2,
+				  false);
 
 	      /* See the E_Record_Type case for the rationale.  */
 	      if (Is_By_Reference_Type (gnat_entity))
@@ -5933,30 +5934,21 @@ elaborate_entity (Entity_Id gnat_entity)
     }
 }
 
-/* Return true if the size represented by GNU_SIZE can be handled by an
-   allocation.  If STATIC_P is true, consider only what can be done with a
+/* Return true if the size in units represented by GNU_SIZE can be handled by
+   an allocation.  If STATIC_P is true, consider only what can be done with a
    static allocation.  */
 
 static bool
 allocatable_size_p (tree gnu_size, bool static_p)
 {
-  HOST_WIDE_INT our_size;
-
-  /* If this is not a static allocation, the only case we want to forbid
-     is an overflowing size.  That will be converted into a raise a
-     Storage_Error.  */
-  if (!static_p)
-    return !(TREE_CODE (gnu_size) == INTEGER_CST
-	     && TREE_OVERFLOW (gnu_size));
-
-  /* Otherwise, we need to deal with both variable sizes and constant
-     sizes that won't fit in a host int.  We use int instead of HOST_WIDE_INT
-     since assemblers may not like very large sizes.  */
-  if (!host_integerp (gnu_size, 1))
-    return false;
+  /* We can allocate a fixed size if it hasn't overflowed and can be handled
+     (efficiently) on the host.  */
+  if (TREE_CODE (gnu_size) == INTEGER_CST)
+    return !TREE_OVERFLOW (gnu_size) && host_integerp (gnu_size, 1);
 
-  our_size = tree_low_cst (gnu_size, 1);
-  return (int) our_size == our_size;
+  /* We can allocate a variable size if this isn't a static allocation.  */
+  else
+    return !static_p;
 }
 
 /* Prepend to ATTR_LIST an entry for an attribute with provided TYPE,
@@ -7502,16 +7494,16 @@ build_position_list (tree gnu_type, bool do_not_flatten_variant, tree gnu_pos,
   return gnu_list;
 }
 
-/* Return a VEC describing the substitutions needed to reflect the
+/* Return a list describing the substitutions needed to reflect the
    discriminant substitutions from GNAT_TYPE to GNAT_SUBTYPE.  They can
-   be in any order.  The values in an element of the VEC are in the form
+   be in any order.  The values in an element of the list are in the form
    of operands to SUBSTITUTE_IN_EXPR.  DEFINITION is true if this is for
    a definition of GNAT_SUBTYPE.  */
 
 static VEC(subst_pair,heap) *
 build_subst_list (Entity_Id gnat_subtype, Entity_Id gnat_type, bool definition)
 {
-  VEC(subst_pair,heap) *gnu_vec = NULL;
+  VEC(subst_pair,heap) *gnu_list = NULL;
   Entity_Id gnat_discrim;
   Node_Id gnat_value;
 
@@ -7529,23 +7521,22 @@ build_subst_list (Entity_Id gnat_subtype, Entity_Id gnat_type, bool definition)
 				    (Node (gnat_value), gnat_subtype,
 				     get_entity_name (gnat_discrim),
 				     definition, true, false));
-	subst_pair *s = VEC_safe_push (subst_pair, heap, gnu_vec, NULL);
+	subst_pair *s = VEC_safe_push (subst_pair, heap, gnu_list, NULL);
 	s->discriminant = gnu_field;
 	s->replacement = replacement;
       }
 
-  return gnu_vec;
+  return gnu_list;
 }
 
-/* Scan all fields in QUAL_UNION_TYPE and return a VEC describing the
+/* Scan all fields in QUAL_UNION_TYPE and return a list describing the
    variants of QUAL_UNION_TYPE that are still relevant after applying
-   the substitutions described in SUBST_LIST.  VARIANT_LIST is a
-   pre-existing VEC onto which newly created entries should be
-   pushed.  */
+   the substitutions described in SUBST_LIST.  GNU_LIST is a pre-existing
+   list to be prepended to the newly created entries.  */
 
 static VEC(variant_desc,heap) *
 build_variant_list (tree qual_union_type, VEC(subst_pair,heap) *subst_list,
-		    VEC(variant_desc,heap) *variant_list)
+		    VEC(variant_desc,heap) *gnu_list)
 {
   tree gnu_field;
 
@@ -7554,10 +7545,10 @@ build_variant_list (tree qual_union_type, VEC(subst_pair,heap) *subst_list,
        gnu_field = DECL_CHAIN (gnu_field))
     {
       tree qual = DECL_QUALIFIER (gnu_field);
-      unsigned ix;
+      unsigned int i;
       subst_pair *s;
 
-      FOR_EACH_VEC_ELT_REVERSE (subst_pair, subst_list, ix, s)
+      FOR_EACH_VEC_ELT (subst_pair, subst_list, i, s)
 	qual = SUBSTITUTE_IN_EXPR (qual, s->discriminant, s->replacement);
 
       /* If the new qualifier is not unconditionally false, its variant may
@@ -7567,7 +7558,7 @@ build_variant_list (tree qual_union_type, VEC(subst_pair,heap) *subst_list,
 	  variant_desc *v;
 	  tree variant_type = TREE_TYPE (gnu_field), variant_subpart;
 
-	  v = VEC_safe_push (variant_desc, heap, variant_list, NULL);
+	  v = VEC_safe_push (variant_desc, heap, gnu_list, NULL);
 	  v->type = variant_type;
 	  v->field = gnu_field;
 	  v->qual = qual;
@@ -7576,8 +7567,8 @@ build_variant_list (tree qual_union_type, VEC(subst_pair,heap) *subst_list,
 	  /* Recurse on the variant subpart of the variant, if any.  */
 	  variant_subpart = get_variant_part (variant_type);
 	  if (variant_subpart)
-	    variant_list = build_variant_list (TREE_TYPE (variant_subpart),
-					       subst_list, variant_list);
+	    gnu_list = build_variant_list (TREE_TYPE (variant_subpart),
+					   subst_list, gnu_list);
 
 	  /* If the new qualifier is unconditionally true, the subsequent
 	     variants cannot be accessed.  */
@@ -7586,7 +7577,7 @@ build_variant_list (tree qual_union_type, VEC(subst_pair,heap) *subst_list,
 	}
     }
 
-  return variant_list;
+  return gnu_list;
 }
 
 /* UINT_SIZE is a Uint giving the specified size for an object of GNU_TYPE
@@ -8135,11 +8126,11 @@ create_field_decl_from (tree old_field, tree field_type, tree record_type,
   tree pos = TREE_VEC_ELT (t, 0), bitpos = TREE_VEC_ELT (t, 2);
   unsigned int offset_align = tree_low_cst (TREE_VEC_ELT (t, 1), 1);
   tree new_pos, new_field;
-  unsigned ix;
+  unsigned int i;
   subst_pair *s;
 
   if (CONTAINS_PLACEHOLDER_P (pos))
-    FOR_EACH_VEC_ELT_REVERSE (subst_pair, subst_list, ix, s)
+    FOR_EACH_VEC_ELT (subst_pair, subst_list, i, s)
       pos = SUBSTITUTE_IN_EXPR (pos, s->discriminant, s->replacement);
 
   /* If the position is now a constant, we can set it as the position of the
@@ -8243,7 +8234,7 @@ create_variant_part_from (tree old_variant_part,
   tree new_union_type, new_variant_part;
   tree union_field_list = NULL_TREE;
   variant_desc *v;
-  unsigned ix;
+  unsigned int i;
 
   /* First create the type of the variant part from that of the old one.  */
   new_union_type = make_node (QUAL_UNION_TYPE);
@@ -8273,7 +8264,7 @@ create_variant_part_from (tree old_variant_part,
     copy_and_substitute_in_size (new_union_type, old_union_type, subst_list);
 
   /* Now finish up the new variants and populate the union type.  */
-  FOR_EACH_VEC_ELT_REVERSE (variant_desc, variant_list, ix, v)
+  FOR_EACH_VEC_ELT_REVERSE (variant_desc, variant_list, i, v)
     {
       tree old_field = v->field, new_field;
       tree old_variant, old_variant_subpart, new_variant, field_list;
@@ -8317,7 +8308,8 @@ create_variant_part_from (tree old_variant_part,
     }
 
   /* Finish up the union type and create the variant part.  No need for debug
-     info thanks to the XVS type.  */
+     info thanks to the XVS type.  Note that we don't reverse the field list
+     because VARIANT_LIST has been traversed in reverse order.  */
   finish_record_type (new_union_type, union_field_list, 2, false);
   compute_record_mode (new_union_type);
   create_type_decl (TYPE_NAME (new_union_type), new_union_type, NULL,
@@ -8356,7 +8348,7 @@ static void
 copy_and_substitute_in_size (tree new_type, tree old_type,
 			     VEC(subst_pair,heap) *subst_list)
 {
-  unsigned ix;
+  unsigned int i;
   subst_pair *s;
 
   TYPE_SIZE (new_type) = TYPE_SIZE (old_type);
@@ -8366,19 +8358,19 @@ copy_and_substitute_in_size (tree new_type, tree old_type,
   relate_alias_sets (new_type, old_type, ALIAS_SET_COPY);
 
   if (CONTAINS_PLACEHOLDER_P (TYPE_SIZE (new_type)))
-    FOR_EACH_VEC_ELT_REVERSE (subst_pair, subst_list, ix, s)
+    FOR_EACH_VEC_ELT (subst_pair, subst_list, i, s)
       TYPE_SIZE (new_type)
 	= SUBSTITUTE_IN_EXPR (TYPE_SIZE (new_type),
 			      s->discriminant, s->replacement);
 
   if (CONTAINS_PLACEHOLDER_P (TYPE_SIZE_UNIT (new_type)))
-    FOR_EACH_VEC_ELT_REVERSE (subst_pair, subst_list, ix, s)
+    FOR_EACH_VEC_ELT (subst_pair, subst_list, i, s)
       TYPE_SIZE_UNIT (new_type)
 	= SUBSTITUTE_IN_EXPR (TYPE_SIZE_UNIT (new_type),
 			      s->discriminant, s->replacement);
 
   if (CONTAINS_PLACEHOLDER_P (TYPE_ADA_SIZE (new_type)))
-    FOR_EACH_VEC_ELT_REVERSE (subst_pair, subst_list, ix, s)
+    FOR_EACH_VEC_ELT (subst_pair, subst_list, i, s)
       SET_TYPE_ADA_SIZE
 	(new_type, SUBSTITUTE_IN_EXPR (TYPE_ADA_SIZE (new_type),
 				       s->discriminant, s->replacement));
diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c
index db909d93377..62a4b319dfb 100644
--- a/gcc/ada/gcc-interface/utils.c
+++ b/gcc/ada/gcc-interface/utils.c
@@ -3601,7 +3601,7 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
 			     record_type, size_int (klass), field_list);
   field_list
     = make_descriptor_field ("MBMO", gnat_type_for_size (32, 1),
-			     record_type, ssize_int (-1), field_list);
+			     record_type, size_int (-1), field_list);
   field_list
     = make_descriptor_field ("LENGTH", gnat_type_for_size (64, 1),
 			     record_type,
diff --git a/gcc/ada/gcc-interface/utils2.c b/gcc/ada/gcc-interface/utils2.c
index 931d5bb312a..c7dfe98fce2 100644
--- a/gcc/ada/gcc-interface/utils2.c
+++ b/gcc/ada/gcc-interface/utils2.c
@@ -2287,7 +2287,7 @@ build_allocator (tree type, tree init, tree result_type, Entity_Id gnat_proc,
 
       /* If the size overflows, pass -1 so Storage_Error will be raised.  */
       if (TREE_CODE (size) == INTEGER_CST && TREE_OVERFLOW (size))
-	size = ssize_int (-1);
+	size = size_int (-1);
 
       storage = build_call_alloc_dealloc (NULL_TREE, size, storage_type,
 					  gnat_proc, gnat_pool, gnat_node);
@@ -2345,7 +2345,7 @@ build_allocator (tree type, tree init, tree result_type, Entity_Id gnat_proc,
 
   /* If the size overflows, pass -1 so Storage_Error will be raised.  */
   if (TREE_CODE (size) == INTEGER_CST && TREE_OVERFLOW (size))
-    size = ssize_int (-1);
+    size = size_int (-1);
 
   storage = convert (result_type,
 		     build_call_alloc_dealloc (NULL_TREE, size, type,