This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Ada] Fix unexpected allocation change with size clause
- From: Eric Botcazou <ebotcazou at adacore dot com>
- To: gcc-patches at gcc dot gnu dot org
- Date: Mon, 11 Jun 2012 11:09:11 +0200
- Subject: [Ada] Fix unexpected allocation change with size clause
The attached packages declare two big objects of the same size, but for the
first package the object is allocated statically whereas, for the second one,
the object is allocated dynamically because of the size clause.
The discrepancy stems from a bit vs byte confusion in a specific place in gigi.
Tested on i586-suse-linux, applied on the mainline.
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>
* gnat.dg/specs/array1.ads: New test.
* gnat.dg/specs/array2.ads: Likewise.
* gnat.dg/array22.adb: Likewise.
--
Eric Botcazou
-- { 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;
-- { 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;
-- { 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;
Index: gcc-interface/utils.c
===================================================================
--- gcc-interface/utils.c (revision 188379)
+++ gcc-interface/utils.c (working copy)
@@ -3601,7 +3601,7 @@ build_vms_descriptor (tree type, Mechani
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,
Index: gcc-interface/decl.c
===================================================================
--- gcc-interface/decl.c (revision 188379)
+++ gcc-interface/decl.c (working copy)
@@ -1283,10 +1283,14 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
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_entit
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_entit
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_entit
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_entit
/* 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_entit
/* 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_entit
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_entit
/* 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
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
(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
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
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
/* 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
}
}
- 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 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_varia
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_varia
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_varia
}
/* 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_ty
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));
Index: gcc-interface/utils2.c
===================================================================
--- gcc-interface/utils2.c (revision 188377)
+++ gcc-interface/utils2.c (working copy)
@@ -2287,7 +2287,7 @@ build_allocator (tree type, tree init, t
/* 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, t
/* 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,