diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/ChangeLog | 15 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/decl.c | 116 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/utils.c | 2 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/utils2.c | 4 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 6 | ||||
| -rw-r--r-- | gcc/testsuite/gnat.dg/array22.adb | 21 | ||||
| -rw-r--r-- | gcc/testsuite/gnat.dg/specs/array1.ads | 10 | ||||
| -rw-r--r-- | gcc/testsuite/gnat.dg/specs/array2.ads | 12 |
8 files changed, 121 insertions, 65 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index de1d479..0b6ab7b 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,20 @@ 2012-06-11 Eric Botcazou <ebotcazou@adacore.com> + * 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. + +2012-06-11 Eric Botcazou <ebotcazou@adacore.com> + * gcc-interface/trans.c (Identifier_to_gnu): Test Is_Elementary_Type instead of Is_Scalar_Type for a constant with an address clause. Do not return the underlying constant for a constant used by reference diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index ce2f94a..b27707c 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 db909d9..62a4b31 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 931d5bb..c7dfe98 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, diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index b8c9c7b..bab2378 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,5 +1,11 @@ 2012-06-11 Eric Botcazou <ebotcazou@adacore.com> + * gnat.dg/specs/array1.ads: New test. + * gnat.dg/specs/array2.ads: Likewise. + * gnat.dg/array22.adb: Likewise. + +2012-06-11 Eric Botcazou <ebotcazou@adacore.com> + * gnat.dg/constant4.adb: New test. * gnat.dg/constant4_pkg.ads: New helper. diff --git a/gcc/testsuite/gnat.dg/array22.adb b/gcc/testsuite/gnat.dg/array22.adb new file mode 100644 index 0000000..c172593 --- /dev/null +++ b/gcc/testsuite/gnat.dg/array22.adb @@ -0,0 +1,21 @@ +-- { dg-do compile } + +with System; use System; + +procedure Array22 is + + type Integer_Address is mod Memory_Size; + + type Memory is array (Integer_Address range <>) of Character; + + type Chunk (First, Last : Integer_Address) is record + Mem : Memory (First .. Last); + end record; + + C : Chunk (1, 8); + for C'Alignment use 8; + pragma Unreferenced (C); + +begin + null; +end; diff --git a/gcc/testsuite/gnat.dg/specs/array1.ads b/gcc/testsuite/gnat.dg/specs/array1.ads new file mode 100644 index 0000000..1964f74 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/array1.ads @@ -0,0 +1,10 @@ +-- { dg-do compile } + +pragma Restrictions (No_Elaboration_Code); + +package Array1 is + + type Arr is array (Positive range <>) of Boolean; + A : Arr (1 .. 2 ** 29); + +end Array1; diff --git a/gcc/testsuite/gnat.dg/specs/array2.ads b/gcc/testsuite/gnat.dg/specs/array2.ads new file mode 100644 index 0000000..73d4ea5 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/array2.ads @@ -0,0 +1,12 @@ +-- { dg-do compile } +-- { dg-options "-gnatws" } + +pragma Restrictions (No_Elaboration_Code); + +package Array2 is + + type Arr is array (Positive range <>) of Boolean; + A : Arr (1 .. 2 ** 2); + for A'Size use 16#1000_0000_0#; + +end Array2; |