summaryrefslogtreecommitdiff
path: root/gcc/ada
diff options
context:
space:
mode:
authorebotcazou <ebotcazou@138bc75d-0d04-0410-961f-82ee72b054a4>2009-05-15 09:11:40 +0000
committerebotcazou <ebotcazou@138bc75d-0d04-0410-961f-82ee72b054a4>2009-05-15 09:11:40 +0000
commita9538d681b63fb9ff2291c3fde1ddd1ab389576c (patch)
treefaaa7bb6c0694f3f9cf8d8dbe54a58161ef0489f /gcc/ada
parent7739b9657f038bd8dce5417ab9af6b5abf9e47a7 (diff)
downloadgcc-a9538d681b63fb9ff2291c3fde1ddd1ab389576c.tar.gz
* dbxout.c (dbxout_range_type): Add LOW and HIGH parameters. Use them
for bounds. (print_int_cst_bounds_in_octal_p): Likewise. (dbxout_type): Adjust calls to above functions. Be prepared to deal with subtypes. * dwarf2out.c (base_type_die): Likewise. (is_subrange_type): Delete. (subrange_type_die): Add LOW and HIGH parameters. Use them for bounds. (modified_type_die): Call subrange_type_for_debug_p on subtypes. * fold-const.c (fold_truth_not_expr) <CONVERT_EXPR>: Do not strip it if the destination type is boolean. (build_range_check): Do not special-case subtypes. (fold_sign_changed_comparison): Likewise. (fold_unary): Likewise. * langhooks-def.h (LANG_HOOKS_GET_SUBRANGE_BOUNDS): Define. (LANG_HOOKS_FOR_TYPES_INITIALIZER): Add LANG_HOOKS_GET_SUBRANGE_BOUNDS. * langhooks.h (lang_hooks_for_types): Add get_subrange_bounds. * tree.c (subrange_type_for_debug_p): New predicate based on the former is_subrange_type. * tree.h (subrange_type_for_debug_p): Declare. * tree-chrec.c (avoid_arithmetics_in_type_p): Delete. (convert_affine_scev): Remove call to above function. (chrec_convert_aggressive): Likewise. * tree-ssa.c (useless_type_conversion_p_1): Do not specifically return false for conversions involving subtypes. * tree-vrp.c (vrp_val_max): Do not special-case subtypes. (vrp_val_min): Likewise. (needs_overflow_infinity): Likewise. (extract_range_from_unary_expr): Likewise. ada/ * gcc-interface/ada-tree.h (TYPE_GCC_MIN_VALUE, TYPE_GCC_MAX_VALUE): New macros. (TYPE_RM_VALUES): Likewise. (TYPE_RM_SIZE): Rewrite in terms of TYPE_RM_VALUES. (SET_TYPE_RM_SIZE): New macro. (TYPE_RM_MIN_VALUE, TYPE_RM_MAX_VALUE): Likewise. (SET_TYPE_RM_SIZE, SET_TYPE_RM_MAX_VALUE): Likewise. (TYPE_MIN_VALUE, TYPE_MAX_VALUE): Redefine. * gcc-interface/gigi.h (create_range_type): Declare. * gcc-interface/decl.c (gnat_to_gnu_entity) <E_Modular_Integer_Type> Use SET_TYPE_RM_MAX_VALUE to set the upper bound on the UMT type. <E_Signed_Integer_Subtype>: Build a regular integer type first and then set the RM bounds. Use SET_TYPE_RM_SIZE to set the RM size. <E_Floating_Point_Subtype>: Build a regular floating-point type first and then set the RM bounds. <E_Array_Type>: Use create_range_type instead of build_range_type. <E_Array_Subtype>: Build a regular integer type first and then set the RM bounds for the extra subtype. <E_String_Literal_Subtype>: Use create_range_type instead of build_range_type. <all>: Set the RM bounds for enumeration types and the GCC bounds for floating-point types. (set_rm_size): Use SET_TYPE_RM_SIZE to set the RM size. (make_type_from_size) <INTEGER_TYPE>: Use SET_TYPE_RM_{MIN,MAX}_VALUE to set the bounds. Use SET_TYPE_RM_SIZE to set the RM size. (substitute_in_type) <INTEGER_TYPE>: Deal with GCC bounds for domain types and with RM bounds for subtypes. * gcc-interface/misc.c (LANG_HOOKS_GET_SUBRANGE_BOUNDS): Define. (gnat_print_type) <REAL_TYPE>: New case. <ENUMERAL_TYPE>: Fall through to above case. (gnat_get_subrange_bounds): New function. * gcc-interface/trans.c (add_decl_expr): Mark the trees rooted as TYPE_RM_MIN_VALUE and TYPE_RM_MAX_VALUE, if any. * gcc-interface/utils.c (gnat_init_decl_processing): Use precision 8 for booleans. Adjust and use SET_TYPE_RM_SIZE to set the RM size. (create_range_type): New function. (create_param_decl): Build a regular integer type first and then set the RM bounds for the extra subtype. (unchecked_convert): Remove kludge for 'Valid. * gcc-interface/utils2.c (build_binary_op) <ARRAY_RANGE_REF>: Convert the index to sizetype instead of TYPE_DOMAIN. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@147563 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/ada')
-rw-r--r--gcc/ada/ChangeLog44
-rw-r--r--gcc/ada/gcc-interface/ada-tree.h82
-rw-r--r--gcc/ada/gcc-interface/decl.c200
-rw-r--r--gcc/ada/gcc-interface/gigi.h4
-rw-r--r--gcc/ada/gcc-interface/misc.c21
-rw-r--r--gcc/ada/gcc-interface/trans.c33
-rw-r--r--gcc/ada/gcc-interface/utils.c115
-rw-r--r--gcc/ada/gcc-interface/utils2.c7
8 files changed, 339 insertions, 167 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 99806dda7fd..0548b21cbcf 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,47 @@
+2009-05-15 Eric Botcazou <ebotcazou@adacore.com>
+
+ * gcc-interface/ada-tree.h (TYPE_GCC_MIN_VALUE, TYPE_GCC_MAX_VALUE):
+ New macros.
+ (TYPE_RM_VALUES): Likewise.
+ (TYPE_RM_SIZE): Rewrite in terms of TYPE_RM_VALUES.
+ (SET_TYPE_RM_SIZE): New macro.
+ (TYPE_RM_MIN_VALUE, TYPE_RM_MAX_VALUE): Likewise.
+ (SET_TYPE_RM_SIZE, SET_TYPE_RM_MAX_VALUE): Likewise.
+ (TYPE_MIN_VALUE, TYPE_MAX_VALUE): Redefine.
+ * gcc-interface/gigi.h (create_range_type): Declare.
+ * gcc-interface/decl.c (gnat_to_gnu_entity) <E_Modular_Integer_Type>
+ Use SET_TYPE_RM_MAX_VALUE to set the upper bound on the UMT type.
+ <E_Signed_Integer_Subtype>: Build a regular integer type first and
+ then set the RM bounds. Use SET_TYPE_RM_SIZE to set the RM size.
+ <E_Floating_Point_Subtype>: Build a regular floating-point type first
+ and then set the RM bounds.
+ <E_Array_Type>: Use create_range_type instead of build_range_type.
+ <E_Array_Subtype>: Build a regular integer type first and then set
+ the RM bounds for the extra subtype.
+ <E_String_Literal_Subtype>: Use create_range_type instead of
+ build_range_type.
+ <all>: Set the RM bounds for enumeration types and the GCC bounds for
+ floating-point types.
+ (set_rm_size): Use SET_TYPE_RM_SIZE to set the RM size.
+ (make_type_from_size) <INTEGER_TYPE>: Use SET_TYPE_RM_{MIN,MAX}_VALUE
+ to set the bounds. Use SET_TYPE_RM_SIZE to set the RM size.
+ (substitute_in_type) <INTEGER_TYPE>: Deal with GCC bounds for domain
+ types and with RM bounds for subtypes.
+ * gcc-interface/misc.c (LANG_HOOKS_GET_SUBRANGE_BOUNDS): Define.
+ (gnat_print_type) <REAL_TYPE>: New case.
+ <ENUMERAL_TYPE>: Fall through to above case.
+ (gnat_get_subrange_bounds): New function.
+ * gcc-interface/trans.c (add_decl_expr): Mark the trees rooted as
+ TYPE_RM_MIN_VALUE and TYPE_RM_MAX_VALUE, if any.
+ * gcc-interface/utils.c (gnat_init_decl_processing): Use precision 8
+ for booleans. Adjust and use SET_TYPE_RM_SIZE to set the RM size.
+ (create_range_type): New function.
+ (create_param_decl): Build a regular integer type first and then set
+ the RM bounds for the extra subtype.
+ (unchecked_convert): Remove kludge for 'Valid.
+ * gcc-interface/utils2.c (build_binary_op) <ARRAY_RANGE_REF>: Convert
+ the index to sizetype instead of TYPE_DOMAIN.
+
2009-05-14 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/decl.c (elaborate_expression_1): Remove GNAT_EXPR
diff --git a/gcc/ada/gcc-interface/ada-tree.h b/gcc/ada/gcc-interface/ada-tree.h
index 19c9fa51f2b..38bc8620815 100644
--- a/gcc/ada/gcc-interface/ada-tree.h
+++ b/gcc/ada/gcc-interface/ada-tree.h
@@ -167,9 +167,87 @@ struct GTY(()) lang_decl { tree t; };
mechanism refer to the routine gnat_to_gnu_entity. */
#define TYPE_CI_CO_LIST(NODE) TYPE_LANG_SLOT_1 (FUNCTION_TYPE_CHECK (NODE))
-/* For integral types, this is the RM size of the type. */
+/* For numerical types, this is the GCC lower bound of the type. The GCC
+ type system is based on the invariant that an object X of a given type
+ cannot hold at run time a value smaller than its lower bound; otherwise
+ the behavior is undefined. The optimizer takes advantage of this and
+ considers that the assertion X >= LB is always true. */
+#define TYPE_GCC_MIN_VALUE(NODE) (NUMERICAL_TYPE_CHECK (NODE)->type.minval)
+
+/* For numerical types, this is the GCC upper bound of the type. The GCC
+ type system is based on the invariant that an object X of a given type
+ cannot hold at run time a value larger than its upper bound; otherwise
+ the behavior is undefined. The optimizer takes advantage of this and
+ considers that the assertion X <= UB is always true. */
+#define TYPE_GCC_MAX_VALUE(NODE) (NUMERICAL_TYPE_CHECK (NODE)->type.maxval)
+
+/* For numerical types, this holds various RM-defined values. */
+#define TYPE_RM_VALUES(NODE) TYPE_LANG_SLOT_1 (NUMERICAL_TYPE_CHECK (NODE))
+
+/* For numerical types, this is the RM size of the type, aka its precision.
+ There is a discrepancy between what is called precision here (and more
+ generally throughout gigi) and what is called precision in the GCC type
+ system: in the former case it's TYPE_RM_SIZE whereas it's TYPE_PRECISION
+ in the latter case. They are not identical because of the need to support
+ invalid values.
+
+ These values can be outside the range of values allowed by the RM size
+ but they must nevertheless be valid in the GCC type system, otherwise
+ the optimizer can pretend that they simply don't exist. Therefore they
+ must be within the range of values allowed by the precision in the GCC
+ sense, hence TYPE_PRECISION be set to the Esize, not the RM size. */
#define TYPE_RM_SIZE(NODE) \
- TYPE_LANG_SLOT_1 (TREE_CHECK3 (NODE, ENUMERAL_TYPE, BOOLEAN_TYPE, INTEGER_TYPE))
+ (TYPE_RM_VALUES (NODE) ? TREE_VEC_ELT (TYPE_RM_VALUES (NODE), 0) : NULL_TREE)
+#define SET_TYPE_RM_SIZE(NODE, X) \
+ TREE_VEC_ELT ((TYPE_RM_VALUES (NODE) \
+ = (TYPE_RM_VALUES (NODE) \
+ ? TYPE_RM_VALUES (NODE) : make_tree_vec (3))), 0) = (X)
+
+/* For numerical types, this is the RM lower bound of the type. There is
+ again a discrepancy between this lower bound and the GCC lower bound,
+ again because of the need to support invalid values.
+
+ These values can be outside the range of values allowed by the RM lower
+ bound but they must nevertheless be valid in the GCC type system, otherwise
+ the optimizer can pretend that they simply don't exist. Therefore they
+ must be within the range of values allowed by the lower bound in the GCC
+ sense, hence the GCC lower bound be set to that of the base type. */
+#define TYPE_RM_MIN_VALUE(NODE) \
+ (TYPE_RM_VALUES (NODE) ? TREE_VEC_ELT (TYPE_RM_VALUES (NODE), 1) : NULL_TREE)
+#define SET_TYPE_RM_MIN_VALUE(NODE, X) \
+ TREE_VEC_ELT ((TYPE_RM_VALUES (NODE) \
+ = (TYPE_RM_VALUES (NODE) \
+ ? TYPE_RM_VALUES (NODE) : make_tree_vec (3))), 1) = (X)
+
+/* For numerical types, this is the RM upper bound of the type. There is
+ again a discrepancy between this upper bound and the GCC upper bound,
+ again because of the need to support invalid values.
+
+ These values can be outside the range of values allowed by the RM upper
+ bound but they must nevertheless be valid in the GCC type system, otherwise
+ the optimizer can pretend that they simply don't exist. Therefore they
+ must be within the range of values allowed by the upper bound in the GCC
+ sense, hence the GCC upper bound be set to that of the base type. */
+#define TYPE_RM_MAX_VALUE(NODE) \
+ (TYPE_RM_VALUES (NODE) ? TREE_VEC_ELT (TYPE_RM_VALUES (NODE), 2) : NULL_TREE)
+#define SET_TYPE_RM_MAX_VALUE(NODE, X) \
+ TREE_VEC_ELT ((TYPE_RM_VALUES (NODE) \
+ = (TYPE_RM_VALUES (NODE) \
+ ? TYPE_RM_VALUES (NODE) : make_tree_vec (3))), 2) = (X)
+
+/* For numerical types, this is the lower bound of the type, i.e. the RM lower
+ bound for language-defined types and the GCC lower bound for others. */
+#undef TYPE_MIN_VALUE
+#define TYPE_MIN_VALUE(NODE) \
+ (TYPE_RM_MIN_VALUE (NODE) \
+ ? TYPE_RM_MIN_VALUE (NODE) : TYPE_GCC_MIN_VALUE (NODE))
+
+/* For numerical types, this is the upper bound of the type, i.e. the RM upper
+ bound for language-defined types and the GCC upper bound for others. */
+#undef TYPE_MAX_VALUE
+#define TYPE_MAX_VALUE(NODE) \
+ (TYPE_RM_MAX_VALUE (NODE) \
+ ? TYPE_RM_MAX_VALUE (NODE) : TYPE_GCC_MAX_VALUE (NODE))
/* In an UNCONSTRAINED_ARRAY_TYPE, points to the record containing both
the template and object.
diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c
index 6feadbdece0..46215daf4c9 100644
--- a/gcc/ada/gcc-interface/decl.c
+++ b/gcc/ada/gcc-interface/decl.c
@@ -1503,7 +1503,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
&& !tree_int_cst_equal (gnu_high, TYPE_MAX_VALUE (gnu_type)))
{
tree gnu_subtype = make_unsigned_type (esize);
- TYPE_MAX_VALUE (gnu_subtype) = gnu_high;
+ 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");
@@ -1519,7 +1519,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
case E_Decimal_Fixed_Point_Subtype:
/* 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
+ not want to call create_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
the call to relate_alias_sets below.
@@ -1539,39 +1539,37 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
|| !Compile_Time_Known_Value (Type_High_Bound (gnat_entity))))
gnat_to_gnu_entity (Ancestor_Subtype (gnat_entity), gnu_expr, 0);
- 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. */
+ /* Set the precision to the Esize except for bit-packed arrays. */
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 (Is_Boolean_Type (gnat_entity))
- esize = 1;
-
- TYPE_PRECISION (gnu_type) = esize;
- TYPE_MIN_VALUE (gnu_type)
- = convert (TREE_TYPE (gnu_type),
- elaborate_expression (Type_Low_Bound (gnat_entity),
- gnat_entity, get_identifier ("L"),
- definition, true,
- Needs_Debug_Info (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. */
+ if (Is_Unsigned_Type (Etype (gnat_entity))
+ || Is_Unsigned_Type (gnat_entity)
+ || Has_Biased_Representation (gnat_entity))
+ gnu_type = make_unsigned_type (esize);
+ else
+ gnu_type = make_signed_type (esize);
+ TREE_TYPE (gnu_type) = get_unpadded_type (Etype (gnat_entity));
- TYPE_MAX_VALUE (gnu_type)
- = convert (TREE_TYPE (gnu_type),
- elaborate_expression (Type_High_Bound (gnat_entity),
- gnat_entity, get_identifier ("U"),
- definition, true,
- Needs_Debug_Info (gnat_entity)));
+ SET_TYPE_RM_MIN_VALUE
+ (gnu_type,
+ convert (TREE_TYPE (gnu_type),
+ elaborate_expression (Type_Low_Bound (gnat_entity),
+ gnat_entity, get_identifier ("L"),
+ definition, true,
+ Needs_Debug_Info (gnat_entity))));
+
+ SET_TYPE_RM_MAX_VALUE
+ (gnu_type,
+ convert (TREE_TYPE (gnu_type),
+ elaborate_expression (Type_High_Bound (gnat_entity),
+ gnat_entity, get_identifier ("U"),
+ definition, true,
+ Needs_Debug_Info (gnat_entity))));
/* One of the above calls might have caused us to be elaborated,
so don't blow up if so. */
@@ -1584,8 +1582,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);
- layout_type (gnu_type);
-
/* Attach the TYPE_STUB_DECL in case we have a parallel type. */
TYPE_STUB_DECL (gnu_type)
= create_type_stub_decl (gnu_entity_name, gnu_type);
@@ -1616,8 +1612,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
tree gnu_field_type, gnu_field;
/* Set the RM size before wrapping up the type. */
- TYPE_RM_SIZE (gnu_type)
- = UI_To_gnu (RM_Size (gnat_entity), bitsizetype);
+ SET_TYPE_RM_SIZE (gnu_type,
+ UI_To_gnu (RM_Size (gnat_entity), bitsizetype));
TYPE_PACKED_ARRAY_TYPE_P (gnu_type) = 1;
gnu_field_type = gnu_type;
@@ -1669,8 +1665,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
tree gnu_field_type, gnu_field;
/* Set the RM size before wrapping up the type. */
- TYPE_RM_SIZE (gnu_type)
- = UI_To_gnu (RM_Size (gnat_entity), bitsizetype);
+ SET_TYPE_RM_SIZE (gnu_type,
+ UI_To_gnu (RM_Size (gnat_entity), bitsizetype));
gnu_field_type = gnu_type;
gnu_type = make_node (RECORD_TYPE);
@@ -1741,20 +1737,27 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
gnu_type = make_node (REAL_TYPE);
TREE_TYPE (gnu_type) = get_unpadded_type (Etype (gnat_entity));
TYPE_PRECISION (gnu_type) = fp_size_to_prec (esize);
+ TYPE_GCC_MIN_VALUE (gnu_type)
+ = TYPE_GCC_MIN_VALUE (TREE_TYPE (gnu_type));
+ TYPE_GCC_MAX_VALUE (gnu_type)
+ = TYPE_GCC_MAX_VALUE (TREE_TYPE (gnu_type));
+ layout_type (gnu_type);
- TYPE_MIN_VALUE (gnu_type)
- = convert (TREE_TYPE (gnu_type),
- elaborate_expression (Type_Low_Bound (gnat_entity),
- gnat_entity, get_identifier ("L"),
- definition, true,
- Needs_Debug_Info (gnat_entity)));
-
- TYPE_MAX_VALUE (gnu_type)
- = convert (TREE_TYPE (gnu_type),
- elaborate_expression (Type_High_Bound (gnat_entity),
- gnat_entity, get_identifier ("U"),
- definition, true,
- Needs_Debug_Info (gnat_entity)));
+ SET_TYPE_RM_MIN_VALUE
+ (gnu_type,
+ convert (TREE_TYPE (gnu_type),
+ elaborate_expression (Type_Low_Bound (gnat_entity),
+ gnat_entity, get_identifier ("L"),
+ definition, true,
+ Needs_Debug_Info (gnat_entity))));
+
+ SET_TYPE_RM_MAX_VALUE
+ (gnu_type,
+ convert (TREE_TYPE (gnu_type),
+ elaborate_expression (Type_High_Bound (gnat_entity),
+ gnat_entity, get_identifier ("U"),
+ definition, true,
+ Needs_Debug_Info (gnat_entity))));
/* One of the above calls might have caused us to be elaborated,
so don't blow up if so. */
@@ -1764,8 +1767,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
break;
}
- layout_type (gnu_type);
-
/* Inherit our alias set from what we're a subtype of, as for
integer subtypes. */
relate_alias_sets (gnu_type, TREE_TYPE (gnu_type), ALIAS_SET_COPY);
@@ -1899,8 +1900,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
gnu_index_types[index]
= create_index_type (convert (sizetype, gnu_min),
convert (sizetype, gnu_max),
- build_range_type (gnu_ind_subtype,
- gnu_min, gnu_max),
+ create_range_type (gnu_ind_subtype,
+ gnu_min, gnu_max),
gnat_entity);
/* Update the maximum size of the array, in elements. */
gnu_max_size
@@ -2585,19 +2586,14 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
subtype if necessary. */
if (TYPE_MODULAR_P (gnu_inner_type))
{
- tree gnu_subtype = make_node (INTEGER_TYPE);
+ tree gnu_subtype
+ = make_unsigned_type (TYPE_PRECISION (gnu_inner_type));
TREE_TYPE (gnu_subtype) = gnu_inner_type;
TYPE_EXTRA_SUBTYPE_P (gnu_subtype) = 1;
-
- TYPE_UNSIGNED (gnu_subtype) = 1;
- TYPE_PRECISION (gnu_subtype)
- = TYPE_PRECISION (gnu_inner_type);
- TYPE_MIN_VALUE (gnu_subtype)
- = TYPE_MIN_VALUE (gnu_inner_type);
- TYPE_MAX_VALUE (gnu_subtype)
- = TYPE_MAX_VALUE (gnu_inner_type);
- layout_type (gnu_subtype);
-
+ SET_TYPE_RM_MIN_VALUE (gnu_subtype,
+ TYPE_MIN_VALUE (gnu_inner_type));
+ SET_TYPE_RM_MAX_VALUE (gnu_subtype,
+ TYPE_MAX_VALUE (gnu_inner_type));
gnu_inner_type = gnu_subtype;
}
@@ -2665,9 +2661,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
tree gnu_index_type
= 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),
+ create_range_type (gnu_string_index_type,
+ gnu_lower_bound,
+ gnu_upper_bound),
gnat_entity);
gnu_type
@@ -4743,6 +4739,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
|| (kind == E_Floating_Point_Type && !Vax_Float (gnat_entity)))
{
tree gnu_scalar_type = gnu_type;
+ tree gnu_low_bound, gnu_high_bound;
/* If this is a padded type, we need to use the underlying type. */
if (TREE_CODE (gnu_scalar_type) == RECORD_TYPE
@@ -4754,19 +4751,27 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
if (!longest_float_type_node && kind == E_Floating_Point_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));
+ gnu_low_bound = gnat_to_gnu (Type_Low_Bound (gnat_entity));
+ gnu_high_bound = gnat_to_gnu (Type_High_Bound (gnat_entity));
- /* 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. */
+ /* Enumeration types have specific RM bounds. */
+ SET_TYPE_RM_MIN_VALUE (gnu_scalar_type, gnu_low_bound);
+ SET_TYPE_RM_MAX_VALUE (gnu_scalar_type, gnu_high_bound);
+
+ /* Write full debugging information. Since this has both a
+ typedef and a tag, avoid outputting the name twice. */
DECL_ARTIFICIAL (gnu_decl) = 1;
rest_of_type_decl_compilation (gnu_decl);
}
+
+ else
+ {
+ /* Floating-point types don't have specific RM bounds. */
+ TYPE_GCC_MIN_VALUE (gnu_scalar_type) = gnu_low_bound;
+ TYPE_GCC_MAX_VALUE (gnu_scalar_type) = gnu_high_bound;
+ }
}
/* If we deferred processing of incomplete types, re-enable it. If there
@@ -7391,7 +7396,7 @@ set_rm_size (Uint uint_size, tree gnu_type, Entity_Id gnat_entity)
&& Is_Discrete_Or_Fixed_Point_Type (gnat_entity))
|| (TREE_CODE (gnu_type) == ENUMERAL_TYPE
|| TREE_CODE (gnu_type) == BOOLEAN_TYPE))
- TYPE_RM_SIZE (gnu_type) = size;
+ SET_TYPE_RM_SIZE (gnu_type, size);
/* ...or the Ada size for record and union types. */
else if ((TREE_CODE (gnu_type) == RECORD_TYPE
@@ -7443,10 +7448,12 @@ make_type_from_size (tree type, tree size_tree, bool for_biased)
else
new_type = make_signed_type (size);
TREE_TYPE (new_type) = TREE_TYPE (type) ? TREE_TYPE (type) : type;
- TYPE_MIN_VALUE (new_type)
- = convert (TREE_TYPE (new_type), TYPE_MIN_VALUE (type));
- TYPE_MAX_VALUE (new_type)
- = convert (TREE_TYPE (new_type), TYPE_MAX_VALUE (type));
+ SET_TYPE_RM_MIN_VALUE (new_type,
+ convert (TREE_TYPE (new_type),
+ TYPE_MIN_VALUE (type)));
+ SET_TYPE_RM_MAX_VALUE (new_type,
+ convert (TREE_TYPE (new_type),
+ TYPE_MAX_VALUE (type)));
/* Propagate the name to avoid creating a fake subrange type. */
if (TYPE_NAME (type))
{
@@ -7456,7 +7463,7 @@ make_type_from_size (tree type, tree size_tree, bool for_biased)
TYPE_NAME (new_type) = TYPE_NAME (type);
}
TYPE_BIASED_REPRESENTATION_P (new_type) = biased_p;
- TYPE_RM_SIZE (new_type) = bitsize_int (size);
+ SET_TYPE_RM_SIZE (new_type, bitsize_int (size));
return new_type;
case RECORD_TYPE:
@@ -7703,18 +7710,20 @@ substitute_in_type (tree t, tree f, tree r)
case ENUMERAL_TYPE:
case BOOLEAN_TYPE:
case REAL_TYPE:
- if (CONTAINS_PLACEHOLDER_P (TYPE_MIN_VALUE (t))
- || CONTAINS_PLACEHOLDER_P (TYPE_MAX_VALUE (t)))
+
+ /* First the domain types of arrays. */
+ if (CONTAINS_PLACEHOLDER_P (TYPE_GCC_MIN_VALUE (t))
+ || CONTAINS_PLACEHOLDER_P (TYPE_GCC_MAX_VALUE (t)))
{
- tree low = SUBSTITUTE_IN_EXPR (TYPE_MIN_VALUE (t), f, r);
- tree high = SUBSTITUTE_IN_EXPR (TYPE_MAX_VALUE (t), f, r);
+ tree low = SUBSTITUTE_IN_EXPR (TYPE_GCC_MIN_VALUE (t), f, r);
+ tree high = SUBSTITUTE_IN_EXPR (TYPE_GCC_MAX_VALUE (t), f, r);
- if (low == TYPE_MIN_VALUE (t) && high == TYPE_MAX_VALUE (t))
+ if (low == TYPE_GCC_MIN_VALUE (t) && high == TYPE_GCC_MAX_VALUE (t))
return t;
new = copy_type (t);
- TYPE_MIN_VALUE (new) = low;
- TYPE_MAX_VALUE (new) = high;
+ TYPE_GCC_MIN_VALUE (new) = low;
+ TYPE_GCC_MAX_VALUE (new) = high;
if (TREE_CODE (t) == INTEGER_TYPE && TYPE_INDEX_TYPE (t))
SET_TYPE_INDEX_TYPE
@@ -7723,6 +7732,23 @@ substitute_in_type (tree t, tree f, tree r)
return new;
}
+ /* Then the subtypes. */
+ if (CONTAINS_PLACEHOLDER_P (TYPE_RM_MIN_VALUE (t))
+ || CONTAINS_PLACEHOLDER_P (TYPE_RM_MAX_VALUE (t)))
+ {
+ tree low = SUBSTITUTE_IN_EXPR (TYPE_RM_MIN_VALUE (t), f, r);
+ tree high = SUBSTITUTE_IN_EXPR (TYPE_RM_MAX_VALUE (t), f, r);
+
+ if (low == TYPE_RM_MIN_VALUE (t) && high == TYPE_RM_MAX_VALUE (t))
+ return t;
+
+ new = copy_type (t);
+ SET_TYPE_RM_MIN_VALUE (new, low);
+ SET_TYPE_RM_MAX_VALUE (new, high);
+
+ return new;
+ }
+
return t;
case COMPLEX_TYPE:
diff --git a/gcc/ada/gcc-interface/gigi.h b/gcc/ada/gcc-interface/gigi.h
index 8ccb39c4b0a..4d19b42e491 100644
--- a/gcc/ada/gcc-interface/gigi.h
+++ b/gcc/ada/gcc-interface/gigi.h
@@ -558,6 +558,10 @@ extern tree copy_type (tree type);
extern tree create_index_type (tree min, tree max, tree index,
Node_Id gnat_node);
+/* Return a subtype of TYPE with range MIN to MAX. If TYPE is NULL,
+ sizetype is used. */
+extern tree create_range_type (tree type, tree min, tree max);
+
/* Return a TYPE_DECL node suitable for the TYPE_STUB_DECL field of a type.
TYPE_NAME gives the name of the type and TYPE is a ..._TYPE node giving
its data type. */
diff --git a/gcc/ada/gcc-interface/misc.c b/gcc/ada/gcc-interface/misc.c
index 5ccf13469b1..bd6b51af118 100644
--- a/gcc/ada/gcc-interface/misc.c
+++ b/gcc/ada/gcc-interface/misc.c
@@ -78,6 +78,7 @@ static int gnat_eh_type_covers (tree, tree);
static void gnat_parse_file (int);
static void internal_error_function (const char *, va_list *);
static tree gnat_type_max_size (const_tree);
+static void gnat_get_subrange_bounds (const_tree, tree *, tree *);
/* Definitions for our language-specific hooks. */
@@ -125,6 +126,8 @@ static tree gnat_type_max_size (const_tree);
#define LANG_HOOKS_TYPE_FOR_SIZE gnat_type_for_size
#undef LANG_HOOKS_TYPES_COMPATIBLE_P
#define LANG_HOOKS_TYPES_COMPATIBLE_P gnat_types_compatible_p
+#undef LANG_HOOKS_GET_SUBRANGE_BOUNDS
+#define LANG_HOOKS_GET_SUBRANGE_BOUNDS gnat_get_subrange_bounds
#undef LANG_HOOKS_ATTRIBUTE_TABLE
#define LANG_HOOKS_ATTRIBUTE_TABLE gnat_internal_attribute_table
#undef LANG_HOOKS_BUILTIN_FUNCTION
@@ -513,6 +516,12 @@ gnat_print_type (FILE *file, tree node, int indent)
case ENUMERAL_TYPE:
case BOOLEAN_TYPE:
print_node_brief (file, "RM size", TYPE_RM_SIZE (node), indent + 4);
+
+ /* ... fall through ... */
+
+ case REAL_TYPE:
+ print_node_brief (file, "RM min", TYPE_RM_MIN_VALUE (node), indent + 4);
+ print_node_brief (file, "RM max", TYPE_RM_MAX_VALUE (node), indent + 4);
break;
case ARRAY_TYPE:
@@ -644,6 +653,18 @@ gnat_type_max_size (const_tree gnu_type)
return max_unitsize;
}
+/* GNU_TYPE is a subtype of an integral type. Set LOWVAL to the low bound
+ and HIGHVAL to the high bound, respectively. */
+
+static void
+gnat_get_subrange_bounds (const_tree gnu_type, tree *lowval, tree *highval)
+{
+ tree min = TYPE_MIN_VALUE (gnu_type);
+ tree max = TYPE_MAX_VALUE (gnu_type);
+ *lowval = TREE_CONSTANT (min) ? min : TYPE_GCC_MIN_VALUE (gnu_type);
+ *highval = TREE_CONSTANT (max) ? max : TYPE_GCC_MAX_VALUE (gnu_type);
+}
+
/* GNU_TYPE is a type. Determine if it should be passed by reference by
default. */
diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c
index ee65c81503a..2c471f1561f 100644
--- a/gcc/ada/gcc-interface/trans.c
+++ b/gcc/ada/gcc-interface/trans.c
@@ -5562,6 +5562,7 @@ add_decl_expr (tree gnu_decl, Entity_Id gnat_entity)
Note that walk_tree knows how to deal with TYPE_DECL, but neither
VAR_DECL nor CONST_DECL. This appears to be somewhat arbitrary. */
mark_visited (&gnu_stmt);
+
if (TREE_CODE (gnu_decl) == VAR_DECL
|| TREE_CODE (gnu_decl) == CONST_DECL)
{
@@ -5569,13 +5570,31 @@ add_decl_expr (tree gnu_decl, Entity_Id gnat_entity)
mark_visited (&DECL_SIZE_UNIT (gnu_decl));
mark_visited (&DECL_INITIAL (gnu_decl));
}
- /* In any case, we have to deal with our own TYPE_ADA_SIZE field. */
- if (TREE_CODE (gnu_decl) == TYPE_DECL
- && (TREE_CODE (type) == RECORD_TYPE
- || TREE_CODE (type) == UNION_TYPE
- || TREE_CODE (type) == QUAL_UNION_TYPE)
- && (t = TYPE_ADA_SIZE (type)))
- mark_visited (&t);
+
+ /* In any case, we have to deal with our own fields. */
+ else if (TREE_CODE (gnu_decl) == TYPE_DECL)
+ switch (TREE_CODE (type))
+ {
+ case RECORD_TYPE:
+ case UNION_TYPE:
+ case QUAL_UNION_TYPE:
+ if ((t = TYPE_ADA_SIZE (type)))
+ mark_visited (&t);
+ break;
+
+ case INTEGER_TYPE:
+ case ENUMERAL_TYPE:
+ case BOOLEAN_TYPE:
+ case REAL_TYPE:
+ if ((t = TYPE_RM_MIN_VALUE (type)))
+ mark_visited (&t);
+ if ((t = TYPE_RM_MAX_VALUE (type)))
+ mark_visited (&t);
+ break;
+
+ default:
+ break;
+ }
}
else
add_stmt_with_node (gnu_stmt, gnat_entity);
diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c
index e3cf9756ea3..6dbd1e700e1 100644
--- a/gcc/ada/gcc-interface/utils.c
+++ b/gcc/ada/gcc-interface/utils.c
@@ -530,12 +530,14 @@ gnat_init_decl_processing (void)
set_sizetype (size_type_node);
/* In Ada, we use an unsigned 8-bit type for the default boolean type. */
- boolean_type_node = make_node (BOOLEAN_TYPE);
- TYPE_PRECISION (boolean_type_node) = 1;
- fixup_unsigned_type (boolean_type_node);
- TYPE_RM_SIZE (boolean_type_node) = bitsize_int (1);
+ boolean_type_node = make_unsigned_type (8);
+ TREE_SET_CODE (boolean_type_node, BOOLEAN_TYPE);
+ SET_TYPE_RM_MAX_VALUE (boolean_type_node,
+ build_int_cst (boolean_type_node, 1));
+ SET_TYPE_RM_SIZE (boolean_type_node, bitsize_int (1));
build_common_tree_nodes_2 (0);
+ boolean_true_node = TYPE_MAX_VALUE (boolean_type_node);
ptr_void_type_node = build_pointer_type (void_type_node);
}
@@ -1195,6 +1197,42 @@ create_index_type (tree min, tree max, tree index, Node_Id gnat_node)
return type;
}
+
+/* Return a subtype of TYPE with range MIN to MAX. If TYPE is NULL,
+ sizetype is used. */
+
+tree
+create_range_type (tree type, tree min, tree max)
+{
+ tree range_type;
+
+ if (type == NULL_TREE)
+ type = sizetype;
+
+ /* First build a type with the base range. */
+ range_type
+ = build_range_type (type, TYPE_MIN_VALUE (type), TYPE_MAX_VALUE (type));
+
+ min = convert (type, min);
+ max = convert (type, max);
+
+ /* If this type has the TYPE_RM_{MIN,MAX}_VALUE we want, return it. */
+ if (TYPE_RM_MIN_VALUE (range_type)
+ && TYPE_RM_MAX_VALUE (range_type)
+ && operand_equal_p (TYPE_RM_MIN_VALUE (range_type), min, 0)
+ && operand_equal_p (TYPE_RM_MAX_VALUE (range_type), max, 0))
+ return range_type;
+
+ /* Otherwise, if TYPE_RM_{MIN,MAX}_VALUE is set, make a copy. */
+ if (TYPE_RM_MIN_VALUE (range_type) || TYPE_RM_MAX_VALUE (range_type))
+ range_type = copy_type (range_type);
+
+ /* Then set the actual range. */
+ SET_TYPE_RM_MIN_VALUE (range_type, min);
+ SET_TYPE_RM_MAX_VALUE (range_type, max);
+
+ return range_type;
+}
/* Return a TYPE_DECL node suitable for the TYPE_STUB_DECL field of a type.
TYPE_NAME gives the name of the type and TYPE is a ..._TYPE node giving
@@ -1581,16 +1619,12 @@ create_param_decl (tree param_name, tree param_type, bool readonly)
if (TREE_CODE (param_type) == INTEGER_TYPE
&& TYPE_BIASED_REPRESENTATION_P (param_type))
{
- tree subtype = make_node (INTEGER_TYPE);
+ tree subtype
+ = make_unsigned_type (TYPE_PRECISION (integer_type_node));
TREE_TYPE (subtype) = integer_type_node;
TYPE_BIASED_REPRESENTATION_P (subtype) = 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);
-
+ SET_TYPE_RM_MIN_VALUE (subtype, TYPE_MIN_VALUE (param_type));
+ SET_TYPE_RM_MAX_VALUE (subtype, TYPE_MAX_VALUE (param_type));
param_type = subtype;
}
else
@@ -4288,8 +4322,7 @@ maybe_unconstrained_array (tree exp)
}
/* Return true if EXPR is an expression that can be folded as an operand
- of a VIEW_CONVERT_EXPR. See the head comment of unchecked_convert for
- the rationale. */
+ of a VIEW_CONVERT_EXPR. See ada-tree.h for a complete rationale. */
static bool
can_fold_for_view_convert_p (tree expr)
@@ -4337,22 +4370,7 @@ can_fold_for_view_convert_p (tree expr)
we expect the 8 bits at Vbits'Address to always contain Value, while
their original location depends on the endianness, at Value'Address
- on a little-endian architecture but not on a big-endian one.
-
- ??? There is a problematic discrepancy between what is called precision
- here (and more generally throughout gigi) for integral types and what is
- called precision in the middle-end. In the former case it's the RM size
- as given by TYPE_RM_SIZE (or rm_size) whereas it's TYPE_PRECISION in the
- latter case, the hitch being that they are not equal when they matter,
- that is when the number of value bits is not equal to the type's size:
- TYPE_RM_SIZE does give the number of value bits but TYPE_PRECISION is set
- to the size. The sole exception are BOOLEAN_TYPEs for which both are 1.
-
- The consequence is that gigi must duplicate code bridging the gap between
- the type's size and its precision that exists for TYPE_PRECISION in the
- middle-end, because the latter knows nothing about TYPE_RM_SIZE, and be
- wary of transformations applied in the middle-end based on TYPE_PRECISION
- because this value doesn't reflect the actual precision for Ada. */
+ on a little-endian architecture but not on a big-endian one. */
tree
unchecked_convert (tree type, tree expr, bool notrunc_p)
@@ -4397,43 +4415,6 @@ unchecked_convert (tree type, tree expr, bool notrunc_p)
expr = convert (rtype, expr);
expr = build1 (NOP_EXPR, type, expr);
}
-
- /* We have another special case: if we are unchecked converting either
- a subtype or a type with limited range into a base type, we need to
- ensure that VRP doesn't propagate range information because this
- conversion may be done precisely to validate that the object is
- within the range it is supposed to have. */
- else if (TREE_CODE (expr) != INTEGER_CST
- && TREE_CODE (type) == INTEGER_TYPE && !TREE_TYPE (type)
- && ((TREE_CODE (etype) == INTEGER_TYPE && TREE_TYPE (etype))
- || TREE_CODE (etype) == ENUMERAL_TYPE
- || TREE_CODE (etype) == BOOLEAN_TYPE))
- {
- /* The optimization barrier is a VIEW_CONVERT_EXPR node; moreover,
- in order not to be deemed an useless type conversion, it must
- be from subtype to base type.
-
- Therefore we first do the bulk of the conversion to a subtype of
- the final type. And this conversion must itself not be deemed
- useless if the source type is not a subtype because, otherwise,
- the final VIEW_CONVERT_EXPR will be deemed so as well. That's
- why we toggle the unsigned flag in this conversion, which is
- harmless since the final conversion is only a reinterpretation
- of the bit pattern.
-
- ??? This may raise addressability and/or aliasing issues because
- VIEW_CONVERT_EXPR gets gimplified as an lvalue, thus causing the
- address of its operand to be taken if it is deemed addressable
- and not already in GIMPLE form. */
- tree rtype
- = gnat_type_for_mode (TYPE_MODE (type), !TYPE_UNSIGNED (etype));
- rtype = copy_type (rtype);
- TYPE_MAIN_VARIANT (rtype) = rtype;
- TREE_TYPE (rtype) = type;
- expr = convert (rtype, expr);
- expr = build1 (VIEW_CONVERT_EXPR, type, expr);
- }
-
else
expr = convert (type, expr);
}
diff --git a/gcc/ada/gcc-interface/utils2.c b/gcc/ada/gcc-interface/utils2.c
index e5001ab7d42..3fe85853879 100644
--- a/gcc/ada/gcc-interface/utils2.c
+++ b/gcc/ada/gcc-interface/utils2.c
@@ -802,11 +802,10 @@ build_binary_op (enum tree_code op_code, tree result_type,
left_type = TREE_TYPE (left_operand);
}
- /* Then convert the right operand to its base type. This will
- prevent unneeded signedness conversions when sizetype is wider than
- integer. */
+ /* Then convert the right operand to its base type. This will prevent
+ unneeded sign conversions when sizetype is wider than integer. */
right_operand = convert (right_base_type, right_operand);
- right_operand = convert (TYPE_DOMAIN (left_type), right_operand);
+ right_operand = convert (sizetype, right_operand);
if (!TREE_CONSTANT (right_operand)
|| !TREE_CONSTANT (TYPE_MIN_VALUE (right_type)))