OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

decl.c (gnat_to_gnu_entity): Convert GNU_SIZE to units before invoking allocatable_size_p on it. 

* 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.

From-SVN: r188382
This commit is contained in:
Eric Botcazou 2012-06-11 09:14:20 +00:00 committed by Eric Botcazou
parent e4270465dd
commit f54ee9801d
8 changed files with 121 additions and 65 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
gcc/ada/ChangeLog
View File

@ -1,3 +1,18 @@
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

116
gcc/ada/gcc-interface/decl.c
View File

@ -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;
/* 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);
/* 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;
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));

2
gcc/ada/gcc-interface/utils.c
View File

@ -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,

4
gcc/ada/gcc-interface/utils2.c
View File

@ -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,

6
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,9 @@
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.

21
gcc/testsuite/gnat.dg/array22.adb Normal file
View File

@ -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;

10
gcc/testsuite/gnat.dg/specs/array1.ads Normal file
View File

@ -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;

12
gcc/testsuite/gnat.dg/specs/array2.ads Normal file
View File

@ -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;