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
This commit is contained in:
Eric Botcazou
Eric Botcazou
parent
8713b7e4f5
commit
c1abd261d9
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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,
|
||||
TYPE_MIN_VALUE (gnu_range_type)),
|
||||
convert (sizetype,
|
||||
TYPE_MAX_VALUE (gnu_range_type)),
|
||||
gnu_range_type, gnat_entity);
|
||||
= create_index_type (convert (sizetype, gnu_lower_bound),
|
||||
convert (sizetype, gnu_upper_bound),
|
||||
build_range_type (gnu_string_index_type,
|
||||
gnu_lower_bound,
|
||||
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
|
||||
the bounds since they refer to the type. These bounds are always static.
|
||||
For enumeration types, also write debugging information and declare the
|
||||
enumeration literal table, if needed. */
|
||||
/* If this is an enumeration or floating-point type, we were not able to set
|
||||
the bounds since they refer to the type. These are always static. */
|
||||
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
|
||||
is needed until the front stops generating bogus conversions
|
||||
on bounds of real types. */
|
||||
|
||||
/* ??? Tests to avoid Constraint_Error in static expressions
|
||||
are needed until after the front stops generating bogus
|
||||
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));
|
||||
|
|
|
|||
|
|
@ -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
|
||||
TYPE_INDEX_TYPE is INDEX. GNAT_NODE is used for the position of
|
||||
the decl. */
|
||||
/* 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 the associated TYPE_DECL. */
|
||||
extern tree create_index_type (tree min, tree max, tree index,
|
||||
Node_Id gnat_node);
|
||||
|
||||
|
|
|
|||
|
|
@ -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:
|
||||
|
|
|
|||
|
|
@ -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. */
|
||||
else if (TREE_CODE (gnu_result) == INTEGER_CST
|
||||
&& TREE_OVERFLOW (gnu_result))
|
||||
/* If the result is a constant that overflowed, raise Constraint_Error. */
|
||||
if (TREE_CODE (gnu_result) == INTEGER_CST && 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,
|
||||
|
|
|
|||
|
|
@ -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
|
||||
is technically not addressable. Except that it can actually be
|
||||
addressed if the field is BLKmode and happens to be properly
|
||||
aligned. */
|
||||
DECL_NONADDRESSABLE_P (field)
|
||||
|= DECL_BIT_FIELD (field) && DECL_MODE (field) != BLKmode;
|
||||
/* If we still have DECL_BIT_FIELD set at this point, we know that the
|
||||
field is technically not addressable. Except that it can actually
|
||||
be addressed if it is BLKmode and happens to be properly aligned. */
|
||||
if (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
|
||||
TYPE_INDEX_TYPE is INDEX. GNAT_NODE is used for the position of
|
||||
the decl. */
|
||||
/* 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 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
|
||||
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 this type has the TYPE_INDEX_TYPE we want, return it. */
|
||||
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
|
||||
= copy_type (build_range_type (integer_type_node,
|
||||
TYPE_MIN_VALUE (param_type),
|
||||
TYPE_MAX_VALUE (param_type)));
|
||||
tree subtype = make_node (INTEGER_TYPE);
|
||||
TREE_TYPE (subtype) = integer_type_node;
|
||||
TYPE_BIASED_REPRESENTATION_P (subtype) = 1;
|
||||
|
||||
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;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
raise constraint error. Otherwise, we can't find the type to return, so
|
||||
abort. */
|
||||
/* If FIELD was specified, assume this is an invalid user field so raise
|
||||
Constraint_Error. Otherwise, we have no type to return so abort. */
|
||||
gcc_assert (field);
|
||||
return build1 (NULL_EXPR, TREE_TYPE (field),
|
||||
build_call_raise (CE_Discriminant_Check_Failed, Empty,
|
||||
|
|
|
|||
Loading…
Reference in New Issue