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

decl.c (gnat_to_gnu_entity): Pass correct arguments to create_field_decl.

Browse Source 
* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Array_Type>: Pass
	correct arguments to create_field_decl.  Remove redundant iteration.
	Rewrite computation of the maximum size.
	<E_Array_Subtype>: Reorder and simplify handling of special cases.
	Rewrite computation of the maximum size.  Use consistent naming.
	* gcc-interface/trans.c (Attribute_to_gnu) <Attr_Length>: Swap
	comparison order for consistency.  Use generic integer node to
	build the operator and fold the result.

From-SVN: r148962
This commit is contained in:
Eric Botcazou 2009-06-26 08:05:31 +00:00 committed by Eric Botcazou
parent b3c54c8f55
commit 4e6602a879
3 changed files with 282 additions and 267 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
gcc/ada/ChangeLog
View File

@ -1,3 +1,14 @@
2009-06-26 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Array_Type>: Pass
correct arguments to create_field_decl. Remove redundant iteration.
Rewrite computation of the maximum size.
<E_Array_Subtype>: Reorder and simplify handling of special cases.
Rewrite computation of the maximum size. Use consistent naming.
* gcc-interface/trans.c (Attribute_to_gnu) <Attr_Length>: Swap
comparison order for consistency. Use generic integer node to
build the operator and fold the result.
2009-06-25 Vincent Celier <celier@adacore.com>
* vms_data.ads: Minor comment change

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

@ -1795,14 +1795,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
case E_String_Type:
case E_Array_Type:
{
Entity_Id gnat_ind_subtype;
Entity_Id gnat_ind_base_subtype;
int ndim = Number_Dimensions (gnat_entity);
int first_dim
= (Convention (gnat_entity) == Convention_Fortran) ? ndim - 1 : 0;
int next_dim
= (Convention (gnat_entity) == Convention_Fortran) ? - 1 : 1;
int index;
Entity_Id gnat_index;
const bool convention_fortran_p
= (Convention (gnat_entity) == Convention_Fortran);
const int ndim = Number_Dimensions (gnat_entity);
tree gnu_template_fields = NULL_TREE;
tree gnu_template_type = make_node (RECORD_TYPE);
tree gnu_template_reference;
@ -1812,6 +1808,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
tree *gnu_temp_fields = (tree *) alloca (ndim * sizeof (tree));
tree gnu_max_size = size_one_node, gnu_max_size_unit;
tree gnu_comp_size, tem;
int index;
TYPE_NAME (gnu_template_type)
= create_concat_name (gnat_entity, "XUB");
@ -1832,10 +1829,12 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
tem = chainon (chainon (NULL_TREE,
create_field_decl (get_identifier ("P_ARRAY"),
ptr_void_type_node,
gnu_fat_type, 0, 0, 0, 0)),
gnu_fat_type, 0,
NULL_TREE, NULL_TREE, 0)),
create_field_decl (get_identifier ("P_BOUNDS"),
gnu_ptr_template,
gnu_fat_type, 0, 0, 0, 0));
gnu_fat_type, 0,
NULL_TREE, NULL_TREE, 0));
/* Make sure we can put this into a register. */
TYPE_ALIGN (gnu_fat_type) = MIN (BIGGEST_ALIGNMENT, 2 * POINTER_SIZE);
@ -1855,69 +1854,81 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
= build_unary_op (INDIRECT_REF, gnu_template_type, tem);
TREE_READONLY (gnu_template_reference) = 1;
/* Now create the GCC type for each index and add the fields for
that index to the template. */
for (index = first_dim, gnat_ind_subtype = First_Index (gnat_entity),
gnat_ind_base_subtype
= First_Index (Implementation_Base_Type (gnat_entity));
index < ndim && index >= 0;
index += next_dim,
gnat_ind_subtype = Next_Index (gnat_ind_subtype),
gnat_ind_base_subtype = Next_Index (gnat_ind_base_subtype))
/* Now create the GCC type for each index and add the fields for that
index to the template. */
for (index = (convention_fortran_p ? ndim - 1 : 0),
gnat_index = First_Index (gnat_entity);
0 <= index && index < ndim;
index += (convention_fortran_p ? - 1 : 1),
gnat_index = Next_Index (gnat_index))
{
char field_name[10];
tree gnu_ind_subtype
= get_unpadded_type (Base_Type (Etype (gnat_ind_subtype)));
tree gnu_base_subtype
= get_unpadded_type (Etype (gnat_ind_base_subtype));
tree gnu_base_min
= convert (sizetype, TYPE_MIN_VALUE (gnu_base_subtype));
tree gnu_base_max
= convert (sizetype, TYPE_MAX_VALUE (gnu_base_subtype));
tree gnu_min_field, gnu_max_field, gnu_min, gnu_max;
char field_name[16];
tree gnu_index_base_type
= get_unpadded_type (Base_Type (Etype (gnat_index)));
tree gnu_low_field, gnu_high_field, gnu_low, gnu_high;
/* Make the FIELD_DECLs for the minimum and maximum of this
type and then make extractions of that field from the
/* Make the FIELD_DECLs for the low and high bounds of this
type and then make extractions of these fields from the
template. */
sprintf (field_name, "LB%d", index);
gnu_min_field = create_field_decl (get_identifier (field_name),
gnu_ind_subtype,
gnu_template_type, 0, 0, 0, 0);
gnu_low_field = create_field_decl (get_identifier (field_name),
gnu_index_base_type,
gnu_template_type, 0,
NULL_TREE, NULL_TREE, 0);
Sloc_to_locus (Sloc (gnat_entity),
&DECL_SOURCE_LOCATION (gnu_low_field));
field_name[0] = 'U';
gnu_max_field = create_field_decl (get_identifier (field_name),
gnu_ind_subtype,
gnu_template_type, 0, 0, 0, 0);
gnu_high_field = create_field_decl (get_identifier (field_name),
gnu_index_base_type,
gnu_template_type, 0,
NULL_TREE, NULL_TREE, 0);
Sloc_to_locus (Sloc (gnat_entity),
&DECL_SOURCE_LOCATION (gnu_min_field));
Sloc_to_locus (Sloc (gnat_entity),
&DECL_SOURCE_LOCATION (gnu_max_field));
gnu_temp_fields[index] = chainon (gnu_min_field, gnu_max_field);
&DECL_SOURCE_LOCATION (gnu_high_field));
/* We can't use build_component_ref here since the template
type isn't complete yet. */
gnu_min = build3 (COMPONENT_REF, gnu_ind_subtype,
gnu_template_reference, gnu_min_field,
NULL_TREE);
gnu_max = build3 (COMPONENT_REF, gnu_ind_subtype,
gnu_template_reference, gnu_max_field,
NULL_TREE);
TREE_READONLY (gnu_min) = TREE_READONLY (gnu_max) = 1;
gnu_temp_fields[index] = chainon (gnu_low_field, gnu_high_field);
/* Make a range type with the new ranges, but using
the Ada subtype. Then we convert to sizetype. */
/* We can't use build_component_ref here since the template type
isn't complete yet. */
gnu_low = build3 (COMPONENT_REF, gnu_index_base_type,
gnu_template_reference, gnu_low_field,
NULL_TREE);
gnu_high = build3 (COMPONENT_REF, gnu_index_base_type,
gnu_template_reference, gnu_high_field,
NULL_TREE);
TREE_READONLY (gnu_low) = TREE_READONLY (gnu_high) = 1;
/* Make a range type with the new range in the Ada base type.
Then make an index type with the new range in sizetype. */
gnu_index_types[index]
= create_index_type (convert (sizetype, gnu_min),
convert (sizetype, gnu_max),
create_range_type (gnu_ind_subtype,
gnu_min, gnu_max),
= create_index_type (convert (sizetype, gnu_low),
convert (sizetype, gnu_high),
create_range_type (gnu_index_base_type,
gnu_low, gnu_high),
gnat_entity);
/* Update the maximum size of the array, in elements. */
gnu_max_size
= size_binop (MULT_EXPR, gnu_max_size,
/* Update the maximum size of the array in elements. */
if (gnu_max_size)
{
tree gnu_index_type = get_unpadded_type (Etype (gnat_index));
tree gnu_min
= convert (sizetype, TYPE_MIN_VALUE (gnu_index_type));
tree gnu_max
= convert (sizetype, TYPE_MAX_VALUE (gnu_index_type));
tree gnu_this_max
= size_binop (MAX_EXPR,
size_binop (PLUS_EXPR, size_one_node,
size_binop (MINUS_EXPR, gnu_base_max,
gnu_base_min)));
size_binop (MINUS_EXPR,
gnu_max, gnu_min)),
size_zero_node);
if (TREE_CODE (gnu_this_max) == INTEGER_CST
&& TREE_OVERFLOW (gnu_this_max))
gnu_max_size = NULL_TREE;
else
gnu_max_size
= size_binop (MULT_EXPR, gnu_max_size, gnu_this_max);
}
TYPE_NAME (gnu_index_types[index])
= create_concat_name (gnat_entity, field_name);
@ -2006,15 +2017,19 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
if (Unknown_Component_Size (gnat_entity))
Set_Component_Size (gnat_entity, annotate_value (TYPE_SIZE (tem)));
gnu_max_size_unit = size_binop (MAX_EXPR, size_zero_node,
size_binop (MULT_EXPR, gnu_max_size,
TYPE_SIZE_UNIT (tem)));
gnu_max_size = size_binop (MAX_EXPR, bitsize_zero_node,
size_binop (MULT_EXPR,
convert (bitsizetype,
gnu_max_size),
TYPE_SIZE (tem)));
/* Compute the maximum size of the array in units and bits. */
if (gnu_max_size)
{
gnu_max_size_unit = size_binop (MULT_EXPR, gnu_max_size,
TYPE_SIZE_UNIT (tem));
gnu_max_size = size_binop (MULT_EXPR,
convert (bitsizetype, gnu_max_size),
TYPE_SIZE (tem));
}
else
gnu_max_size_unit = NULL_TREE;
/* Now build the array type. */
for (index = ndim - 1; index >= 0; index--)
{
tem = build_array_type (tem, gnu_index_types[index]);
@ -2036,8 +2051,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
TYPE_USER_ALIGN (tem) = 1;
}
TYPE_CONVENTION_FORTRAN_P (tem)
= (Convention (gnat_entity) == Convention_Fortran);
TYPE_CONVENTION_FORTRAN_P (tem) = convention_fortran_p;
TREE_TYPE (TYPE_FIELDS (gnu_fat_type)) = build_pointer_type (tem);
/* The result type is an UNCONSTRAINED_ARRAY_TYPE that indicates the
@ -2049,15 +2063,17 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
SET_TYPE_UNCONSTRAINED_ARRAY (gnu_fat_type, gnu_type);
/* If the maximum size doesn't overflow, use it. */
if (TREE_CODE (gnu_max_size) == INTEGER_CST
&& !TREE_OVERFLOW (gnu_max_size))
TYPE_SIZE (tem)
= size_binop (MIN_EXPR, gnu_max_size, TYPE_SIZE (tem));
if (TREE_CODE (gnu_max_size_unit) == INTEGER_CST
if (gnu_max_size
&& TREE_CODE (gnu_max_size) == INTEGER_CST
&& !TREE_OVERFLOW (gnu_max_size)
&& TREE_CODE (gnu_max_size_unit) == INTEGER_CST
&& !TREE_OVERFLOW (gnu_max_size_unit))
TYPE_SIZE_UNIT (tem)
= size_binop (MIN_EXPR, gnu_max_size_unit,
{
TYPE_SIZE (tem) = size_binop (MIN_EXPR, gnu_max_size,
TYPE_SIZE (tem));
TYPE_SIZE_UNIT (tem) = size_binop (MIN_EXPR, gnu_max_size_unit,
TYPE_SIZE_UNIT (tem));
}
create_type_decl (create_concat_name (gnat_entity, "XUA"),
tem, NULL, !Comes_From_Source (gnat_entity),
@ -2089,123 +2105,100 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
case E_Array_Subtype:
/* This is the actual data type for array variables. Multidimensional
arrays are implemented in the gnu tree as arrays of arrays. Note
that for the moment arrays which have sparse enumeration subtypes as
index components create sparse arrays, which is obviously space
inefficient but so much easier to code for now.
arrays are implemented as arrays of arrays. Note that arrays which
have sparse enumeration subtypes as index components create sparse
arrays, which is obviously space inefficient but so much easier to
code for now.
Also note that the subtype never refers to the unconstrained
array type, which is somewhat at variance with Ada semantics.
Also note that the subtype never refers to the unconstrained array
type, which is somewhat at variance with Ada semantics.
First check to see if this is simply a renaming of the array
type. If so, the result is the array type. */
First check to see if this is simply a renaming of the array type.
If so, the result is the array type. */
gnu_type = gnat_to_gnu_type (Etype (gnat_entity));
if (!Is_Constrained (gnat_entity))
break;
else
{
Entity_Id gnat_ind_subtype;
Entity_Id gnat_ind_base_subtype;
int dim = Number_Dimensions (gnat_entity);
int first_dim
= (Convention (gnat_entity) == Convention_Fortran) ? dim - 1 : 0;
int next_dim
= (Convention (gnat_entity) == Convention_Fortran) ? -1 : 1;
int index;
Entity_Id gnat_index, gnat_base_index;
const bool convention_fortran_p
= (Convention (gnat_entity) == Convention_Fortran);
const int ndim = Number_Dimensions (gnat_entity);
tree gnu_base_type = gnu_type;
tree *gnu_index_type = (tree *) alloca (dim * sizeof (tree));
tree *gnu_index_types = (tree *) alloca (ndim * sizeof (tree));
tree gnu_max_size = size_one_node, gnu_max_size_unit;
bool need_index_type_struct = false;
bool max_overflow = false;
int index;
/* First create the gnu types for each index. Create types for
debugging information to point to the index types if the
are not integer types, have variable bounds, or are
wider than sizetype. */
for (index = first_dim, gnat_ind_subtype = First_Index (gnat_entity),
gnat_ind_base_subtype
/* First create the GCC type for each index and find out whether
special types are needed for debugging information. */
for (index = (convention_fortran_p ? ndim - 1 : 0),
gnat_index = First_Index (gnat_entity),
gnat_base_index
= First_Index (Implementation_Base_Type (gnat_entity));
index < dim && index >= 0;
index += next_dim,
gnat_ind_subtype = Next_Index (gnat_ind_subtype),
gnat_ind_base_subtype = Next_Index (gnat_ind_base_subtype))
0 <= index && index < ndim;
index += (convention_fortran_p ? - 1 : 1),
gnat_index = Next_Index (gnat_index),
gnat_base_index = Next_Index (gnat_base_index))
{
tree gnu_index_subtype
= get_unpadded_type (Etype (gnat_ind_subtype));
tree gnu_min
= convert (sizetype, TYPE_MIN_VALUE (gnu_index_subtype));
tree gnu_max
= convert (sizetype, TYPE_MAX_VALUE (gnu_index_subtype));
tree gnu_base_subtype
= get_unpadded_type (Etype (gnat_ind_base_subtype));
tree gnu_base_min
= convert (sizetype, TYPE_MIN_VALUE (gnu_base_subtype));
tree gnu_base_max
= convert (sizetype, TYPE_MAX_VALUE (gnu_base_subtype));
tree gnu_base_type = get_base_type (gnu_base_subtype);
tree gnu_base_base_min
= convert (sizetype, TYPE_MIN_VALUE (gnu_base_type));
tree gnu_base_base_max
= convert (sizetype, TYPE_MAX_VALUE (gnu_base_type));
tree gnu_index_type = get_unpadded_type (Etype (gnat_index));
tree gnu_orig_min = TYPE_MIN_VALUE (gnu_index_type);
tree gnu_orig_max = TYPE_MAX_VALUE (gnu_index_type);
tree gnu_min = convert (sizetype, gnu_orig_min);
tree gnu_max = convert (sizetype, gnu_orig_max);
tree gnu_base_index_type
= get_unpadded_type (Etype (gnat_base_index));
tree gnu_base_orig_min = TYPE_MIN_VALUE (gnu_base_index_type);
tree gnu_base_orig_max = TYPE_MAX_VALUE (gnu_base_index_type);
tree gnu_high;
tree gnu_this_max;
/* If the minimum and maximum values both overflow in
SIZETYPE, but the difference in the original type
does not overflow in SIZETYPE, ignore the overflow
indications. */
if ((TYPE_PRECISION (gnu_index_subtype)
/* See if the base array type is already flat. If it is, we
are probably compiling an ACATS test but it will cause the
code below to malfunction if we don't handle it specially. */
if (TREE_CODE (gnu_base_orig_min) == INTEGER_CST
&& TREE_CODE (gnu_base_orig_max) == INTEGER_CST
&& tree_int_cst_lt (gnu_base_orig_max, gnu_base_orig_min))
{
gnu_min = size_one_node;
gnu_max = size_zero_node;
gnu_high = gnu_max;
}
/* Similarly, if one of the values overflows in sizetype and the
range is null, use 1..0 for the sizetype bounds. */
else if ((TYPE_PRECISION (gnu_index_type)
> TYPE_PRECISION (sizetype)
|| TYPE_UNSIGNED (gnu_index_subtype)
|| TYPE_UNSIGNED (gnu_index_type)
!= TYPE_UNSIGNED (sizetype))
&& TREE_CODE (gnu_min) == INTEGER_CST
&& TREE_CODE (gnu_max) == INTEGER_CST
&& (TREE_OVERFLOW (gnu_min) || TREE_OVERFLOW (gnu_max))
&& tree_int_cst_lt (gnu_orig_max, gnu_orig_min))
{
gnu_min = size_one_node;
gnu_max = size_zero_node;
gnu_high = gnu_max;
}
/* If the minimum and maximum values both overflow in sizetype,
but the difference in the original type does not overflow in
sizetype, ignore the overflow indication. */
else if ((TYPE_PRECISION (gnu_index_type)
> TYPE_PRECISION (sizetype)
|| TYPE_UNSIGNED (gnu_index_type)
!= TYPE_UNSIGNED (sizetype))
&& TREE_CODE (gnu_min) == INTEGER_CST
&& TREE_CODE (gnu_max) == INTEGER_CST
&& TREE_OVERFLOW (gnu_min) && TREE_OVERFLOW (gnu_max)
&& !TREE_OVERFLOW
(fold_build2 (MINUS_EXPR, gnu_index_subtype,
TYPE_MAX_VALUE (gnu_index_subtype),
TYPE_MIN_VALUE (gnu_index_subtype))))
(convert (sizetype,
fold_build2 (MINUS_EXPR, gnu_index_type,
gnu_orig_max,
gnu_orig_min))))
{
TREE_OVERFLOW (gnu_min) = 0;
TREE_OVERFLOW (gnu_max) = 0;
if (tree_int_cst_lt (gnu_max, gnu_min))
{
gnu_min = size_one_node;
gnu_max = size_zero_node;
}
gnu_high = gnu_max;
}
/* Similarly, if the range is null, use bounds of 1..0 for
the sizetype bounds. */
else if ((TYPE_PRECISION (gnu_index_subtype)
> TYPE_PRECISION (sizetype)
|| TYPE_UNSIGNED (gnu_index_subtype)
!= TYPE_UNSIGNED (sizetype))
&& TREE_CODE (gnu_min) == INTEGER_CST
&& TREE_CODE (gnu_max) == INTEGER_CST
&& (TREE_OVERFLOW (gnu_min) || TREE_OVERFLOW (gnu_max))
&& tree_int_cst_lt (TYPE_MAX_VALUE (gnu_index_subtype),
TYPE_MIN_VALUE (gnu_index_subtype)))
{
gnu_min = size_one_node;
gnu_max = size_zero_node;
gnu_high = gnu_max;
}
/* See if the base array type is already flat. If it is, we
are probably compiling an ACATS test, but it will cause the
code below to malfunction if we don't handle it specially. */
else if (TREE_CODE (gnu_base_min) == INTEGER_CST
&& TREE_CODE (gnu_base_max) == INTEGER_CST
&& !TREE_OVERFLOW (gnu_base_min)
&& !TREE_OVERFLOW (gnu_base_max)
&& tree_int_cst_lt (gnu_base_max, gnu_base_min))
{
gnu_min = size_one_node;
gnu_max = size_zero_node;
gnu_high = gnu_max;
}
@ -2221,16 +2214,17 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
to use the expression hb >= lb ? hb : lb - 1. */
gnu_high = size_binop (MINUS_EXPR, gnu_min, size_one_node);
/* If gnu_high is now an integer which overflowed, the array
/* If gnu_high is a constant that has overflowed, the array
cannot be superflat. */
if (TREE_CODE (gnu_high) == INTEGER_CST
&& TREE_OVERFLOW (gnu_high))
gnu_high = gnu_max;
/* gnu_high cannot overflow if the subtype is unsigned since
sizetype is signed, or if it is now a constant that hasn't
/* gnu_high cannot overflow if the subtype is unsigned and
sizetype is signed, or if it is a constant that hasn't
overflowed. */
else if (TYPE_UNSIGNED (gnu_base_subtype)
else if ((TYPE_UNSIGNED (gnu_index_type)
&& !TYPE_UNSIGNED (sizetype))
|| TREE_CODE (gnu_high) == INTEGER_CST)
gnu_high = size_binop (MAX_EXPR, gnu_max, gnu_high);
@ -2243,29 +2237,35 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
gnu_max, gnu_high);
}
gnu_index_type[index]
= create_index_type (gnu_min, gnu_high, gnu_index_subtype,
gnu_index_types[index]
= create_index_type (gnu_min, gnu_high, gnu_index_type,
gnat_entity);
/* Also compute the maximum size of the array. Here we
/* Update the maximum size of the array in elements. Here we
see if any constraint on the index type of the base type
can be used in the case of self-referential bound on
the index type of the subtype. We look for a non-"infinite"
can be used in the case of self-referential bound on the
index type of the subtype. We look for a non-"infinite"
and non-self-referential bound from any type involved and
handle each bound separately. */
if (gnu_max_size)
{
tree gnu_base_min = convert (sizetype, gnu_base_orig_min);
tree gnu_base_max = convert (sizetype, gnu_base_orig_max);
tree gnu_base_index_base_type
= get_base_type (gnu_base_index_type);
tree gnu_base_base_min
= convert (sizetype,
TYPE_MIN_VALUE (gnu_base_index_base_type));
tree gnu_base_base_max
= convert (sizetype,
TYPE_MAX_VALUE (gnu_base_index_base_type));
if ((TREE_CODE (gnu_min) == INTEGER_CST
&& !TREE_OVERFLOW (gnu_min)
&& !operand_equal_p (gnu_min, gnu_base_base_min, 0))
|| !CONTAINS_PLACEHOLDER_P (gnu_min)
if (!CONTAINS_PLACEHOLDER_P (gnu_min)
|| !(TREE_CODE (gnu_base_min) == INTEGER_CST
&& !TREE_OVERFLOW (gnu_base_min)))
gnu_base_min = gnu_min;
if ((TREE_CODE (gnu_max) == INTEGER_CST
&& !TREE_OVERFLOW (gnu_max)
&& !operand_equal_p (gnu_max, gnu_base_base_max, 0))
|| !CONTAINS_PLACEHOLDER_P (gnu_max)
if (!CONTAINS_PLACEHOLDER_P (gnu_max)
|| !(TREE_CODE (gnu_base_max) == INTEGER_CST
&& !TREE_OVERFLOW (gnu_base_max)))
gnu_base_max = gnu_max;
@ -2276,34 +2276,37 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
|| (TREE_CODE (gnu_base_max) == INTEGER_CST
&& TREE_OVERFLOW (gnu_base_max))
|| operand_equal_p (gnu_base_max, gnu_base_base_max, 0))
max_overflow = true;
gnu_base_min = size_binop (MAX_EXPR, gnu_base_min, gnu_min);
gnu_base_max = size_binop (MIN_EXPR, gnu_base_max, gnu_max);
gnu_this_max
gnu_max_size = NULL_TREE;
else
{
tree gnu_this_max
= size_binop (MAX_EXPR,
size_binop (PLUS_EXPR, size_one_node,
size_binop (MINUS_EXPR, gnu_base_max,
size_binop (MINUS_EXPR,
gnu_base_max,
gnu_base_min)),
size_zero_node);
if (TREE_CODE (gnu_this_max) == INTEGER_CST
&& TREE_OVERFLOW (gnu_this_max))
max_overflow = true;
gnu_max_size = NULL_TREE;
else
gnu_max_size
= size_binop (MULT_EXPR, gnu_max_size, gnu_this_max);
}
}
if (!integer_onep (TYPE_MIN_VALUE (gnu_index_subtype))
|| (TREE_CODE (TYPE_MAX_VALUE (gnu_index_subtype))
!= INTEGER_CST)
|| TREE_CODE (gnu_index_subtype) != INTEGER_TYPE
|| (TREE_TYPE (gnu_index_subtype)
&& (TREE_CODE (TREE_TYPE (gnu_index_subtype))
!= INTEGER_TYPE))
|| TYPE_BIASED_REPRESENTATION_P (gnu_index_subtype)
|| (TYPE_PRECISION (gnu_index_subtype)
/* We need special types for debugging information to point to
the index types if they have variable bounds, are not integer
types, are biased or are wider than sizetype. */
if (!integer_onep (gnu_orig_min)
|| TREE_CODE (gnu_orig_max) != INTEGER_CST
|| TREE_CODE (gnu_index_type) != INTEGER_TYPE
|| (TREE_TYPE (gnu_index_type)
&& TREE_CODE (TREE_TYPE (gnu_index_type))
!= INTEGER_TYPE)
|| TYPE_BIASED_REPRESENTATION_P (gnu_index_type)
|| (TYPE_PRECISION (gnu_index_type)
> TYPE_PRECISION (sizetype)))
need_index_type_struct = true;
}
@ -2316,7 +2319,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
&& !Is_Bit_Packed_Array (Original_Array_Type (gnat_entity)))
{
gnu_type = gnat_to_gnu_type (Original_Array_Type (gnat_entity));
for (index = dim - 1; index >= 0; index--)
for (index = ndim - 1; index >= 0; index--)
gnu_type = TREE_TYPE (gnu_type);
/* One of the above calls might have caused us to be elaborated,
@ -2409,15 +2412,22 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
| TYPE_QUAL_VOLATILE));
}
/* Compute the maximum size of the array in units and bits. */
if (gnu_max_size)
{
gnu_max_size_unit = size_binop (MULT_EXPR, gnu_max_size,
TYPE_SIZE_UNIT (gnu_type));
gnu_max_size = size_binop (MULT_EXPR,
convert (bitsizetype, gnu_max_size),
TYPE_SIZE (gnu_type));
}
else
gnu_max_size_unit = NULL_TREE;
for (index = dim - 1; index >= 0; index --)
/* Now build the array type. */
for (index = ndim - 1; index >= 0; index --)
{
gnu_type = build_array_type (gnu_type, gnu_index_type[index]);
gnu_type = build_array_type (gnu_type, gnu_index_types[index]);
TYPE_MULTI_ARRAY_P (gnu_type) = (index > 0);
if (array_type_has_nonaliased_component (gnat_entity, gnu_type))
TYPE_NONALIASED_COMPONENT (gnu_type) = 1;
@ -2427,10 +2437,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
TYPE_STUB_DECL (gnu_type)
= create_type_stub_decl (gnu_entity_name, gnu_type);
/* If we are at file level and this is a multi-dimensional array, we
need to make a variable corresponding to the stride of the
/* If we are at file level and this is a multi-dimensional array,
we need to make a variable corresponding to the stride of the
inner dimensions. */
if (global_bindings_p () && dim > 1)
if (global_bindings_p () && ndim > 1)
{
tree gnu_str_name = get_identifier ("ST");
tree gnu_arr_type;
@ -2483,9 +2493,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
TYPE_NAME (gnu_bound_rec)
= create_concat_name (gnat_entity, "XA");
for (index = dim - 1; index >= 0; index--)
for (index = ndim - 1; index >= 0; index--)
{
tree gnu_index = TYPE_INDEX_TYPE (gnu_index_type[index]);
tree gnu_index = TYPE_INDEX_TYPE (gnu_index_types[index]);
tree gnu_index_name = TYPE_NAME (gnu_index);
if (TREE_CODE (gnu_index_name) == TYPE_DECL)
@ -2513,20 +2523,19 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
gnat_to_gnu_type
(Original_Array_Type (gnat_entity)));
TYPE_CONVENTION_FORTRAN_P (gnu_type)
= (Convention (gnat_entity) == Convention_Fortran);
TYPE_CONVENTION_FORTRAN_P (gnu_type) = convention_fortran_p;
TYPE_PACKED_ARRAY_TYPE_P (gnu_type)
= (Is_Packed_Array_Type (gnat_entity)
&& Is_Bit_Packed_Array (Original_Array_Type (gnat_entity)));
/* If our size depends on a placeholder and the maximum size doesn't
/* If the size is self-referential and the maximum size doesn't
overflow, use it. */
if (CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_type))
&& gnu_max_size
&& !(TREE_CODE (gnu_max_size) == INTEGER_CST
&& TREE_OVERFLOW (gnu_max_size))
&& !(TREE_CODE (gnu_max_size_unit) == INTEGER_CST
&& TREE_OVERFLOW (gnu_max_size_unit))
&& !max_overflow)
&& TREE_OVERFLOW (gnu_max_size_unit)))
{
TYPE_SIZE (gnu_type) = size_binop (MIN_EXPR, gnu_max_size,
TYPE_SIZE (gnu_type));

49
gcc/ada/gcc-interface/trans.c
View File

@ -1552,43 +1552,38 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute)
/* We used to compute the length as max (hb - lb + 1, 0),
which could overflow for some cases of empty arrays, e.g.
when lb == index_type'first. We now compute the length as
(hb < lb) ? 0 : hb - lb + 1, which would only overflow in
(hb >= lb) ? hb - lb + 1 : 0, which would only overflow in
much rarer cases, for extremely large arrays we expect
never to encounter in practice. In addition, the former
computation required the use of potentially constraining
signed arithmetic while the latter doesn't. Note that the
comparison must be done in the original index base type,
otherwise the conversion of either bound to gnu_compute_type
may overflow. */
tree gnu_compute_type = get_base_type (gnu_result_type);
tree index_type
= TYPE_INDEX_TYPE (TYPE_DOMAIN (gnu_type));
tree lb
= convert (gnu_compute_type, TYPE_MIN_VALUE (index_type));
tree hb
= convert (gnu_compute_type, TYPE_MAX_VALUE (index_type));
signed arithmetic while the latter doesn't. Note that
the comparison must be done in the original index type,
to avoid any overflow during the conversion. */
tree comp_type = get_base_type (gnu_result_type);
tree index_type = TYPE_INDEX_TYPE (TYPE_DOMAIN (gnu_type));
tree lb = TYPE_MIN_VALUE (index_type);
tree hb = TYPE_MAX_VALUE (index_type);
gnu_result
= build3
(COND_EXPR, gnu_compute_type,
build_binary_op (LT_EXPR, get_base_type (index_type),
TYPE_MAX_VALUE (index_type),
TYPE_MIN_VALUE (index_type)),
convert (gnu_compute_type, integer_zero_node),
build_binary_op
(PLUS_EXPR, gnu_compute_type,
build_binary_op (MINUS_EXPR, gnu_compute_type, hb, lb),
convert (gnu_compute_type, integer_one_node)));
= build_binary_op (PLUS_EXPR, comp_type,
build_binary_op (MINUS_EXPR,
comp_type,
convert (comp_type, hb),
convert (comp_type, lb)),
convert (comp_type, integer_one_node));
gnu_result
= build_cond_expr (comp_type,
build_binary_op (GE_EXPR,
integer_type_node,
hb, lb),
gnu_result,
convert (comp_type, integer_zero_node));
}
}
/* If this has a PLACEHOLDER_EXPR, qualify it by the object we are
handling. Note that these attributes could not have been used on
an unconstrained array type. */
gnu_result = SUBSTITUTE_PLACEHOLDER_IN_EXPR (gnu_result,
gnu_prefix);
gnu_result = SUBSTITUTE_PLACEHOLDER_IN_EXPR (gnu_result, gnu_prefix);
/* Cache the expression we have just computed. Since we want to do it
at runtime, we force the use of a SAVE_EXPR and let the gimplifier