gigi.h (create_index_type): Adjust head comment.

* gcc-interface/gigi.h (create_index_type): Adjust head comment.
	* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Signed_Integer_Subtype>:
	Use front-end predicates to compute signedness and precision.
	<E_String_Literal_Subtype>: Fold range type.
	Make sure to set longest_float_type_node to a scalar type.
	(elaborate_entity): Use consistent Constraint_Error spelling.
	(substitute_in_type) <INTEGER_TYPE>: Always copy the type.
	* gcc-interface/misc.c (gnat_print_type) <INTEGER_TYPE>: Use brief
	output for the modulus, if any.
	<ENUMERAL_TYPE>: Likewise for the RM size.
	* gcc-interface/trans.c (gnat_to_gnu): Use consistent Constraint_Error
	spelling.
	* gcc-interface/utils.c (finish_record_type): Really test the alignment
	of BLKmode bit-fields to compute their addressability.
	(create_index_type): Adjust comments.
	(create_param_decl): Create the biased subtype manually.
	* gcc-interface/utils2.c (build_component_ref): Use consistent
	Constraint_Error spelling.

From-SVN: r146644

gcc/ada/ChangeLog

@@ -1,3 +1,24 @@
+2009-04-23  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gcc-interface/gigi.h (create_index_type): Adjust head comment.
+	* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Signed_Integer_Subtype>:
+	Use front-end predicates to compute signedness and precision.
+	<E_String_Literal_Subtype>: Fold range type.
+	Make sure to set longest_float_type_node to a scalar type.
+	(elaborate_entity): Use consistent Constraint_Error spelling.
+	(substitute_in_type) <INTEGER_TYPE>: Always copy the type.
+	* gcc-interface/misc.c (gnat_print_type) <INTEGER_TYPE>: Use brief
+	output for the modulus, if any.
+	<ENUMERAL_TYPE>: Likewise for the RM size.
+	* gcc-interface/trans.c (gnat_to_gnu): Use consistent Constraint_Error
+	spelling.
+	* gcc-interface/utils.c (finish_record_type): Really test the alignment
+	of BLKmode bit-fields to compute their addressability.
+	(create_index_type): Adjust comments.
+	(create_param_decl): Create the biased subtype manually.
+	* gcc-interface/utils2.c (build_component_ref): Use consistent
+	Constraint_Error spelling.
+
 2009-04-23  Eric Botcazou  <ebotcazou@adacore.com>
 
 	* gcc-interface/cuintp.c: Clean up include directives.

gcc/ada/gcc-interface/decl.c

@@ -1521,7 +1521,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
       /* For integral subtypes, we make a new INTEGER_TYPE.  Note that we do
 	 not want to call build_range_type since we would like each subtype
 	 node to be distinct.  ??? Historically this was in preparation for
-	 when memory aliasing is implemented.  But that's obsolete now given
+	 when memory aliasing is implemented, but that's obsolete now given
 	 the call to relate_alias_sets below.
 
 	 The TREE_TYPE field of the INTEGER_TYPE points to the base type;
@@ -1542,12 +1542,19 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
       gnu_type = make_node (INTEGER_TYPE);
       TREE_TYPE (gnu_type) = get_unpadded_type (Etype (gnat_entity));
 
+      /* This should be an unsigned type if the base type is unsigned or
+	 if the lower bound is constant and non-negative or if the type
+	 is biased.  */
+      TYPE_UNSIGNED (gnu_type) = (Is_Unsigned_Type (Etype (gnat_entity))
+				  || Is_Unsigned_Type (gnat_entity)
+				  || Has_Biased_Representation (gnat_entity));
+
       /* Set the precision to the Esize except for bit-packed arrays and
 	 subtypes of Standard.Boolean.  */
       if (Is_Packed_Array_Type (gnat_entity)
 	  && Is_Bit_Packed_Array (Original_Array_Type (gnat_entity)))
 	esize = UI_To_Int (RM_Size (gnat_entity));
-      else if (TREE_CODE (TREE_TYPE (gnu_type)) == BOOLEAN_TYPE)
+      else if (Is_Boolean_Type (gnat_entity))
 	esize = 1;
 
       TYPE_PRECISION (gnu_type) = esize;
@@ -1577,13 +1584,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
       TYPE_BIASED_REPRESENTATION_P (gnu_type)
 	= Has_Biased_Representation (gnat_entity);
 
-      /* This should be an unsigned type if the base type is unsigned or
-	 if the lower bound is constant and non-negative (as computed by
-	 layout_type) or if the type is biased.  */
-      TYPE_UNSIGNED (gnu_type) = (TYPE_UNSIGNED (TREE_TYPE (gnu_type))
-				  || TYPE_BIASED_REPRESENTATION_P (gnu_type)
-				  || Is_Unsigned_Type (gnat_entity));
-
       layout_type (gnu_type);
 
       /* Inherit our alias set from what we're a subtype of.  Subtypes
@@ -2592,15 +2592,13 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	  = build_binary_op (PLUS_EXPR, gnu_string_index_type,
 			     gnu_lower_bound,
 			     convert (gnu_string_index_type, gnu_length));
-	tree gnu_range_type
-	  = build_range_type (gnu_string_index_type,
-			      gnu_lower_bound, gnu_upper_bound);
 	tree gnu_index_type
-	  = create_index_type (convert (sizetype,
+	  = create_index_type (convert (sizetype, gnu_lower_bound),
-					TYPE_MIN_VALUE (gnu_range_type)),
+			       convert (sizetype, gnu_upper_bound),
-			       convert (sizetype,
+			       build_range_type (gnu_string_index_type,
-					TYPE_MAX_VALUE (gnu_range_type)),
+						 gnu_lower_bound,
-			       gnu_range_type, gnat_entity);
+						 gnu_upper_bound),
+			       gnat_entity);
 
 	gnu_type
 	  = build_array_type (gnat_to_gnu_type (Component_Type (gnat_entity)),
@@ -4653,10 +4651,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
   if (!saved)
     save_gnu_tree (gnat_entity, gnu_decl, false);
 
-  /* If this is an enumeral or floating-point type, we were not able to set
+  /* If this is an enumeration or floating-point type, we were not able to set
-     the bounds since they refer to the type.  These bounds are always static.
+     the bounds since they refer to the type.  These are always static.  */
-     For enumeration types, also write debugging information and declare the
-     enumeration literal table, if needed.  */
   if ((kind == E_Enumeration_Type && Present (First_Literal (gnat_entity)))
       || (kind == E_Floating_Point_Type && !Vax_Float (gnat_entity)))
     {
@@ -4670,14 +4666,15 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
       /* If this is a floating point type and we haven't set a floating
 	 point type yet, use this in the evaluation of the bounds.  */
       if (!longest_float_type_node && kind == E_Floating_Point_Type)
-	longest_float_type_node = gnu_type;
+	longest_float_type_node = gnu_scalar_type;
 
       TYPE_MIN_VALUE (gnu_scalar_type)
 	= gnat_to_gnu (Type_Low_Bound (gnat_entity));
       TYPE_MAX_VALUE (gnu_scalar_type)
 	= gnat_to_gnu (Type_High_Bound (gnat_entity));
 
-      if (TREE_CODE (gnu_scalar_type) == ENUMERAL_TYPE)
+      /* For enumeration types, write full debugging information.  */
+      if (kind == E_Enumeration_Type)
 	{
 	  /* Since this has both a typedef and a tag, avoid outputting
 	     the name twice.  */
@@ -5171,10 +5168,9 @@ elaborate_entity (Entity_Id gnat_entity)
 	Node_Id gnat_lb = Type_Low_Bound (gnat_entity);
 	Node_Id gnat_hb = Type_High_Bound (gnat_entity);
 
-	/* ??? Tests for avoiding static constraint error expression
+	/* ??? Tests to avoid Constraint_Error in static expressions
-	   is needed until the front stops generating bogus conversions
+	   are needed until after the front stops generating bogus
-	   on bounds of real types.  */
+	   conversions on bounds of real types.  */
-
 	if (!Raises_Constraint_Error (gnat_lb))
 	  elaborate_expression (gnat_lb, gnat_entity, get_identifier ("L"),
 				1, 0, Needs_Debug_Info (gnat_entity));
@@ -7597,7 +7593,9 @@ substitute_in_type (tree t, tree f, tree r)
 	  if (low == TYPE_MIN_VALUE (t) && high == TYPE_MAX_VALUE (t))
 	    return t;
 
-	  new = build_range_type (TREE_TYPE (t), low, high);
+	  new = copy_type (t);
+	  TYPE_MIN_VALUE (new) = low;
+	  TYPE_MAX_VALUE (new) = high;
 	  if (TYPE_INDEX_TYPE (t))
 	    SET_TYPE_INDEX_TYPE
 	      (new, substitute_in_type (TYPE_INDEX_TYPE (t), f, r));

gcc/ada/gcc-interface/gigi.h

@@ -141,7 +141,7 @@ extern tree choices_to_gnu (tree operand, Node_Id choices);
    nothing has changed.  */
 extern tree substitute_in_type (tree t, tree f, tree r);
 
-/* Return the "RM size" of GNU_TYPE.  This is the actual number of bits
+/* Return the RM size of GNU_TYPE.  This is the actual number of bits
    needed to represent the object.  */
 extern tree rm_size (tree gnu_type);
 
@@ -542,9 +542,9 @@ extern tree create_subprog_type (tree return_type, tree param_decl_list,
 /* Return a copy of TYPE, but safe to modify in any way.  */
 extern tree copy_type (tree type);
 
-/* Return an INTEGER_TYPE of SIZETYPE with range MIN to MAX and whose
+/* Return a subtype of sizetype with range MIN to MAX and whose
-   TYPE_INDEX_TYPE is INDEX.  GNAT_NODE is used for the position of
+   TYPE_INDEX_TYPE is INDEX.  GNAT_NODE is used for the position
-   the decl.  */
+   of the associated TYPE_DECL.  */
 extern tree create_index_type (tree min, tree max, tree index,
 			       Node_Id gnat_node);
 

gcc/ada/gcc-interface/misc.c

@@ -497,7 +497,7 @@ gnat_print_type (FILE *file, tree node, int indent)
 
     case INTEGER_TYPE:
       if (TYPE_MODULAR_P (node))
-	print_node (file, "modulus", TYPE_MODULUS (node), indent + 4);
+	print_node_brief (file, "modulus", TYPE_MODULUS (node), indent + 4);
       else if (TYPE_HAS_ACTUAL_BOUNDS_P (node))
 	print_node (file, "actual bounds", TYPE_ACTUAL_BOUNDS (node),
 		    indent + 4);
@@ -510,7 +510,7 @@ gnat_print_type (FILE *file, tree node, int indent)
 
     case ENUMERAL_TYPE:
     case BOOLEAN_TYPE:
-      print_node (file, "RM size", TYPE_RM_SIZE (node), indent + 4);
+      print_node_brief (file, "RM size", TYPE_RM_SIZE (node), indent + 4);
       break;
 
     case ARRAY_TYPE:

gcc/ada/gcc-interface/trans.c

@@ -5299,12 +5299,10 @@ gnat_to_gnu (Node_Id gnat_node)
   if (TREE_CODE (gnu_result_type) == VOID_TYPE)
     return gnu_result;
 
-  /* If the result is a constant that overflows, raise constraint error.  */
+  /* If the result is a constant that overflowed, raise Constraint_Error.  */
-  else if (TREE_CODE (gnu_result) == INTEGER_CST
+  if (TREE_CODE (gnu_result) == INTEGER_CST && TREE_OVERFLOW (gnu_result))
-      && TREE_OVERFLOW (gnu_result))
     {
       post_error ("Constraint_Error will be raised at run-time?", gnat_node);
-
       gnu_result
 	= build1 (NULL_EXPR, gnu_result_type,
 		  build_call_raise (CE_Overflow_Check_Failed, gnat_node,

gcc/ada/gcc-interface/utils.c

@@ -664,12 +664,13 @@ finish_record_type (tree record_type, tree fieldlist, int rep_level,
 	    DECL_BIT_FIELD (field) = 0;
 	}
 
-      /* If we still have DECL_BIT_FIELD set at this point, we know the field
+      /* If we still have DECL_BIT_FIELD set at this point, we know that the
-	 is technically not addressable.  Except that it can actually be
+	 field is technically not addressable.  Except that it can actually
-	 addressed if the field is BLKmode and happens to be properly
+	 be addressed if it is BLKmode and happens to be properly aligned.  */
-	 aligned.  */
+      if (DECL_BIT_FIELD (field)
-      DECL_NONADDRESSABLE_P (field)
+	  && !(DECL_MODE (field) == BLKmode
-	|= DECL_BIT_FIELD (field) && DECL_MODE (field) != BLKmode;
+	       && value_factor_p (pos, BITS_PER_UNIT)))
+	DECL_NONADDRESSABLE_P (field) = 1;
 
       /* A type must be as aligned as its most aligned field that is not
 	 a bit-field.  But this is already enforced by layout_type.  */
@@ -1160,9 +1161,9 @@ copy_type (tree type)
   return new;
 }
 
-/* Return an INTEGER_TYPE of SIZETYPE with range MIN to MAX and whose
+/* Return a subtype of sizetype with range MIN to MAX and whose
-   TYPE_INDEX_TYPE is INDEX.  GNAT_NODE is used for the position of
+   TYPE_INDEX_TYPE is INDEX.  GNAT_NODE is used for the position
-   the decl.  */
+   of the associated TYPE_DECL.  */
 
 tree
 create_index_type (tree min, tree max, tree index, Node_Id gnat_node)
@@ -1170,18 +1171,18 @@ create_index_type (tree min, tree max, tree index, Node_Id gnat_node)
   /* First build a type for the desired range.  */
   tree type = build_index_2_type (min, max);
 
-  /* If this type has the TYPE_INDEX_TYPE we want, return it.  Otherwise, if it
+  /* If this type has the TYPE_INDEX_TYPE we want, return it.  */
-     doesn't have TYPE_INDEX_TYPE set, set it to INDEX.  If TYPE_INDEX_TYPE
-     is set, but not to INDEX, make a copy of this type with the requested
-     index type.  Note that we have no way of sharing these types, but that's
-     only a small hole.  */
   if (TYPE_INDEX_TYPE (type) == index)
     return type;
-  else if (TYPE_INDEX_TYPE (type))
+
+  /* Otherwise, if TYPE_INDEX_TYPE is set, make a copy.  Note that we have
+     no way of sharing these types, but that's only a small hole.  */
+  if (TYPE_INDEX_TYPE (type))
     type = copy_type (type);
 
   SET_TYPE_INDEX_TYPE (type, index);
   create_type_decl (NULL_TREE, type, NULL, true, false, gnat_node);
+
   return type;
 }
 
@@ -1570,12 +1571,17 @@ create_param_decl (tree param_name, tree param_type, bool readonly)
       if (TREE_CODE (param_type) == INTEGER_TYPE
 	  && TYPE_BIASED_REPRESENTATION_P (param_type))
 	{
-	  param_type
+	  tree subtype = make_node (INTEGER_TYPE);
-	    = copy_type (build_range_type (integer_type_node,
+	  TREE_TYPE (subtype) = integer_type_node;
-					   TYPE_MIN_VALUE (param_type),
+	  TYPE_BIASED_REPRESENTATION_P (subtype) = 1;
-					   TYPE_MAX_VALUE (param_type)));
 
-	  TYPE_BIASED_REPRESENTATION_P (param_type) = 1;
+	  TYPE_UNSIGNED (subtype) = 1;
+	  TYPE_PRECISION (subtype) = TYPE_PRECISION (integer_type_node);
+	  TYPE_MIN_VALUE (subtype) = TYPE_MIN_VALUE (param_type);
+	  TYPE_MAX_VALUE (subtype) = TYPE_MAX_VALUE (param_type);
+	  layout_type (subtype);
+
+	  param_type = subtype;
 	}
       else
 	param_type = integer_type_node;

gcc/ada/gcc-interface/utils2.c

@@ -1825,9 +1825,8 @@ build_component_ref (tree record_variable, tree component,
   if (ref)
     return ref;
 
-  /* If FIELD was specified, assume this is an invalid user field so
+  /* If FIELD was specified, assume this is an invalid user field so raise
-     raise constraint error.  Otherwise, we can't find the type to return, so
+     Constraint_Error.  Otherwise, we have no type to return so abort.  */
-     abort.  */
   gcc_assert (field);
   return build1 (NULL_EXPR, TREE_TYPE (field),
 		 build_call_raise (CE_Discriminant_Check_Failed, Empty,