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;
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");
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);
= 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;
-
- /* Make the FIELD_DECLs for the minimum and maximum of this
- type and then make extractions of that field from the
+ 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 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);
- 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_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_min_field));
+ &DECL_SOURCE_LOCATION (gnu_low_field));
+
+ field_name[0] = 'U';
+ 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_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,
+ gnu_temp_fields[index] = chainon (gnu_low_field, gnu_high_field);
+
+ /* 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);
- TREE_READONLY (gnu_min) = TREE_READONLY (gnu_max) = 1;
+ 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 ranges, but using
- the Ada subtype. Then we convert to sizetype. */
+ /* 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,
- size_binop (PLUS_EXPR, size_one_node,
- size_binop (MINUS_EXPR, gnu_base_max,
- gnu_base_min)));
+
+ /* 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_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);
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]);
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
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_UNIT (tem));
+ {
+ 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),
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;
-
- /* 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. */
+ int index;
- 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 prec = TYPE_RM_SIZE (gnu_index_type);
+ const bool wider_p
+ = (compare_tree_int (prec, TYPE_PRECISION (sizetype)) > 0
+ || (compare_tree_int (prec, TYPE_PRECISION (sizetype)) == 0
+ && TYPE_UNSIGNED (gnu_index_type)
+ != TYPE_UNSIGNED (sizetype)));
+ 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)
- > 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_OVERFLOW
- (fold_build2 (MINUS_EXPR, gnu_index_subtype,
- TYPE_MAX_VALUE (gnu_index_subtype),
- TYPE_MIN_VALUE (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))
{
- 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_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))
+ /* Similarly, if one of the values overflows in sizetype and the
+ range is null, use 1..0 for the sizetype bounds. */
+ else if (wider_p
&& 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)))
+ && tree_int_cst_lt (gnu_orig_max, gnu_orig_min))
{
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))
+ /* 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 (wider_p
+ && TREE_CODE (gnu_min) == INTEGER_CST
+ && TREE_CODE (gnu_max) == INTEGER_CST
+ && TREE_OVERFLOW (gnu_min) && TREE_OVERFLOW (gnu_max)
+ && !TREE_OVERFLOW
+ (convert (sizetype,
+ fold_build2 (MINUS_EXPR, gnu_index_type,
+ gnu_orig_max,
+ gnu_orig_min))))
{
- gnu_min = size_one_node;
- gnu_max = size_zero_node;
+ TREE_OVERFLOW (gnu_min) = 0;
+ TREE_OVERFLOW (gnu_max) = 0;
gnu_high = gnu_max;
}
"superflat" case. There are three ways to do this. If
we can prove that the array can never be superflat, we
can just use the high bound of the index subtype. If we
- can prove that the low bound minus one can't overflow,
- we can do this as MAX (hb, lb - 1). Otherwise, we have
- to use the expression hb >= lb ? hb : lb - 1. */
+ can prove that the low bound minus one and the high bound
+ can't overflow, we can do this as MAX (hb, lb - 1). But,
+ otherwise, we have to use (hb >= lb) ? hb : lb - 1. Note
+ that the comparison must be done in the original index
+ type, to avoid any overflow during the conversion. */
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
- overflowed. */
- else if (TYPE_UNSIGNED (gnu_base_subtype)
- || TREE_CODE (gnu_high) == INTEGER_CST)
+ /* If the index type is not wider and gnu_high is a constant
+ that hasn't overflowed, we can use the maximum. */
+ else if (!wider_p && TREE_CODE (gnu_high) == INTEGER_CST)
gnu_high = size_binop (MAX_EXPR, gnu_max, gnu_high);
else
= build_cond_expr (sizetype,
build_binary_op (GE_EXPR,
integer_type_node,
- gnu_max, gnu_min),
+ gnu_orig_max,
+ gnu_orig_min),
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 (!CONTAINS_PLACEHOLDER_P (gnu_min)
+ || !(TREE_CODE (gnu_base_min) == INTEGER_CST
+ && !TREE_OVERFLOW (gnu_base_min)))
+ gnu_base_min = gnu_min;
+
+ if (!CONTAINS_PLACEHOLDER_P (gnu_max)
+ || !(TREE_CODE (gnu_base_max) == INTEGER_CST
+ && !TREE_OVERFLOW (gnu_base_max)))
+ gnu_base_max = gnu_max;
+
+ if ((TREE_CODE (gnu_base_min) == INTEGER_CST
+ && TREE_OVERFLOW (gnu_base_min))
+ || operand_equal_p (gnu_base_min, gnu_base_base_min, 0)
+ || (TREE_CODE (gnu_base_max) == INTEGER_CST
+ && TREE_OVERFLOW (gnu_base_max))
+ || operand_equal_p (gnu_base_max, gnu_base_base_max, 0))
+ 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,
+ gnu_base_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);
+ }
+ }
- 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)
- || !(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)
- || !(TREE_CODE (gnu_base_max) == INTEGER_CST
- && !TREE_OVERFLOW (gnu_base_max)))
- gnu_base_max = gnu_max;
-
- if ((TREE_CODE (gnu_base_min) == INTEGER_CST
- && TREE_OVERFLOW (gnu_base_min))
- || operand_equal_p (gnu_base_min, gnu_base_base_min, 0)
- || (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
- = size_binop (MAX_EXPR,
- size_binop (PLUS_EXPR, size_one_node,
- 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
- = 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)
- > TYPE_PRECISION (sizetype)))
+ /* 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)
+ || compare_tree_int (prec, TYPE_PRECISION (sizetype)) > 0)
need_index_type_struct = true;
}
&& !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,
| TYPE_QUAL_VOLATILE));
}
- 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));
+ /* 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;
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;
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)
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));
OSDN Git Service
