char field_name[16];
tree gnu_index_base_type
= get_unpadded_type (Base_Type (Etype (gnat_index)));
- tree gnu_lb_field, gnu_hb_field, gnu_orig_min, gnu_orig_max;
- tree gnu_min, gnu_max, gnu_high;
+ tree gnu_low_field, gnu_high_field, gnu_low, gnu_high, gnu_max;
/* 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_lb_field = create_field_decl (get_identifier (field_name),
- gnu_index_base_type,
- gnu_template_type, 0,
- NULL_TREE, NULL_TREE, 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_lb_field));
+ &DECL_SOURCE_LOCATION (gnu_low_field));
field_name[0] = 'U';
- gnu_hb_field = create_field_decl (get_identifier (field_name),
- gnu_index_base_type,
- gnu_template_type, 0,
- NULL_TREE, NULL_TREE, 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_hb_field));
+ &DECL_SOURCE_LOCATION (gnu_high_field));
- gnu_temp_fields[index] = chainon (gnu_lb_field, gnu_hb_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_orig_min = build3 (COMPONENT_REF, gnu_index_base_type,
- gnu_template_reference, gnu_lb_field,
- NULL_TREE);
- gnu_orig_max = build3 (COMPONENT_REF, gnu_index_base_type,
- gnu_template_reference, gnu_hb_field,
- NULL_TREE);
- TREE_READONLY (gnu_orig_min) = TREE_READONLY (gnu_orig_max) = 1;
-
- gnu_min = convert (sizetype, gnu_orig_min);
- gnu_max = convert (sizetype, gnu_orig_max);
-
- /* Compute the size of this dimension. See the E_Array_Subtype
- case below for the rationale. */
- gnu_high
- = build3 (COND_EXPR, sizetype,
- build2 (GE_EXPR, boolean_type_node,
- gnu_orig_max, gnu_orig_min),
- gnu_max,
- size_binop (MINUS_EXPR, gnu_min, size_one_node));
+ 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;
+
+ /* Compute the size of this dimension. */
+ gnu_max
+ = build3 (COND_EXPR, gnu_index_base_type,
+ build2 (GE_EXPR, boolean_type_node, gnu_high, gnu_low),
+ gnu_high,
+ build2 (MINUS_EXPR, gnu_index_base_type,
+ gnu_low, fold_convert (gnu_index_base_type,
+ integer_one_node)));
/* Make a range type with the new range in the Ada base type.
Then make an index type with the size range in sizetype. */
gnu_index_types[index]
- = create_index_type (gnu_min, gnu_high,
+ = create_index_type (convert (sizetype, gnu_low),
+ convert (sizetype, gnu_max),
create_range_type (gnu_index_base_type,
- gnu_orig_min,
- gnu_orig_max),
+ gnu_low, gnu_high),
gnat_entity);
/* Update the maximum size of the array in elements. */
gnat_base_index = Next_Index (gnat_base_index))
{
tree gnu_index_type = get_unpadded_type (Etype (gnat_index));
+ const int prec_comp
+ = compare_tree_int (rm_size (gnu_index_type),
+ TYPE_PRECISION (sizetype));
+ const bool subrange_p = (prec_comp < 0
+ && (TYPE_UNSIGNED (gnu_index_type)
+ || !TYPE_UNSIGNED (sizetype)))
+ || (prec_comp == 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);
= 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_high, gnu_low;
/* See if the base array type is already flat. If it is, we
are probably compiling an ACATS test but it will cause the
/* Similarly, if one of the values overflows in sizetype and the
range is null, use 1..0 for the sizetype bounds. */
- else if (TREE_CODE (gnu_min) == INTEGER_CST
+ else if (!subrange_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 (gnu_orig_max, gnu_orig_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 (TREE_CODE (gnu_min) == INTEGER_CST
+ else if (!subrange_p
+ && TREE_CODE (gnu_min) == INTEGER_CST
&& TREE_CODE (gnu_max) == INTEGER_CST
&& TREE_OVERFLOW (gnu_min) && TREE_OVERFLOW (gnu_max)
&& !TREE_OVERFLOW
deal with the "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 type. */
- else if ((Nkind (gnat_index) == N_Range
- && cannot_be_superflat_p (gnat_index))
- /* Packed Array Types are never superflat. */
- || Is_Packed_Array_Type (gnat_entity))
+ else if (Nkind (gnat_index) == N_Range
+ && cannot_be_superflat_p (gnat_index))
gnu_high = gnu_max;
- /* Otherwise, if the high bound is constant but the low bound is
- not, we use the expression (hb >= lb) ? lb : hb + 1 for the
- lower bound. Note that the comparison must be done in the
- original type to avoid any overflow during the conversion. */
- else if (TREE_CODE (gnu_max) == INTEGER_CST
- && TREE_CODE (gnu_min) != INTEGER_CST)
+ /* Otherwise, if we can prove that the low bound minus one and
+ the high bound cannot overflow, we can just use the expression
+ MAX (hb, lb - 1). Similarly, if we can prove that the high
+ bound plus one and the low bound cannot overflow, we can use
+ the high bound as-is and MIN (hb + 1, lb) for the low bound.
+ Otherwise, we have to fall back to the most general expression
+ (hb >= lb) ? hb : lb - 1. Note that the comparison must be
+ done in the original index type, to avoid any overflow during
+ the conversion. */
+ else
{
- gnu_high = gnu_max;
- gnu_min
- = build_cond_expr (sizetype,
- build_binary_op (GE_EXPR,
- boolean_type_node,
- gnu_orig_max,
- gnu_orig_min),
- gnu_min,
- size_binop (PLUS_EXPR, gnu_max,
- size_one_node));
+ gnu_high = size_binop (MINUS_EXPR, gnu_min, size_one_node);
+ gnu_low = size_binop (PLUS_EXPR, gnu_max, size_one_node);
+
+ /* If gnu_high is a constant that has overflowed, the low
+ bound is the smallest integer so cannot be the maximum.
+ If gnu_low is a constant that has overflowed, the high
+ bound is the highest integer so cannot be the minimum. */
+ if ((TREE_CODE (gnu_high) == INTEGER_CST
+ && TREE_OVERFLOW (gnu_high))
+ || (TREE_CODE (gnu_low) == INTEGER_CST
+ && TREE_OVERFLOW (gnu_low)))
+ gnu_high = gnu_max;
+
+ /* If the index type is a subrange and gnu_high a constant
+ that hasn't overflowed, we can use the maximum. */
+ else if (subrange_p && TREE_CODE (gnu_high) == INTEGER_CST)
+ gnu_high = size_binop (MAX_EXPR, gnu_max, gnu_high);
+
+ /* If the index type is a subrange and gnu_low a constant
+ that hasn't overflowed, we can use the minimum. */
+ else if (subrange_p && TREE_CODE (gnu_low) == INTEGER_CST)
+ {
+ gnu_high = gnu_max;
+ gnu_min = size_binop (MIN_EXPR, gnu_min, gnu_low);
+ }
+
+ else
+ gnu_high
+ = build_cond_expr (sizetype,
+ build_binary_op (GE_EXPR,
+ boolean_type_node,
+ gnu_orig_max,
+ gnu_orig_min),
+ gnu_max, gnu_high);
}
- /* Finally we use (hb >= lb) ? hb : lb - 1 for the upper bound
- in all the other cases. Note that, here as well as above,
- the condition used in the comparison must be equivalent to
- the condition (length != 0). This is relied upon in order
- to optimize array comparisons in compare_arrays. */
- else
- gnu_high
- = build_cond_expr (sizetype,
- build_binary_op (GE_EXPR,
- boolean_type_node,
- gnu_orig_max,
- gnu_orig_min),
- gnu_max,
- size_binop (MINUS_EXPR, gnu_min,
- size_one_node));
-
- /* Reuse the index type for the range type. Then make an index
- type with the size range in sizetype. */
gnu_index_types[index]
= create_index_type (gnu_min, gnu_high, gnu_index_type,
gnat_entity);
&& TREE_CODE (TREE_TYPE (gnu_index_type))
!= INTEGER_TYPE)
|| TYPE_BIASED_REPRESENTATION_P (gnu_index_type)
- || compare_tree_int (rm_size (gnu_index_type),
- TYPE_PRECISION (sizetype)) > 0)
+ || prec_comp > 0)
need_index_type_struct = true;
}
if (definition
&& TREE_CODE (gnu_size_unit) != INTEGER_CST
&& !CONTAINS_PLACEHOLDER_P (gnu_size_unit))
- TYPE_SIZE_UNIT (gnu_subtype_marker)
- = create_var_decl (create_concat_name (gnat_entity,
- "XVZ"),
- NULL_TREE, sizetype, gnu_size_unit,
- false, false, false, false, NULL,
- gnat_entity);
+ create_var_decl (create_concat_name (gnat_entity, "XVZ"),
+ NULL_TREE, sizetype, gnu_size_unit, false,
+ false, false, false, NULL, gnat_entity);
}
/* Now we can finalize it. */
add_parallel_type (TYPE_STUB_DECL (record), marker);
if (definition && size && TREE_CODE (size) != INTEGER_CST)
- TYPE_SIZE_UNIT (marker)
- = create_var_decl (concat_name (name, "XVZ"), NULL_TREE, sizetype,
- TYPE_SIZE_UNIT (record), false, false, false,
- false, NULL, gnat_entity);
+ create_var_decl (concat_name (name, "XVZ"), NULL_TREE, sizetype,
+ TYPE_SIZE_UNIT (record), false, false, false,
+ false, NULL, gnat_entity);
}
rest_of_record_type_compilation (record);
this is in bitsizetype. */
gnu_size = convert (bitsizetype, gnu_size);
- /* For a negative value, build NEGATE_EXPR of the opposite. Such values
- appear in expressions containing aligning patterns. Note that, since
- sizetype is sign-extended but nonetheless unsigned, we don't directly
- use tree_int_cst_sgn. */
- if (TREE_INT_CST_HIGH (gnu_size) < 0)
+ /* For a negative value, use NEGATE_EXPR of the opposite. Such values
+ appear in expressions containing aligning patterns. */
+ if (tree_int_cst_sgn (gnu_size) < 0)
{
tree op_size = fold_build1 (NEGATE_EXPR, bitsizetype, gnu_size);
return annotate_value (build1 (NEGATE_EXPR, bitsizetype, op_size));
if (uint_size == No_Uint)
return NULL_TREE;
- /* Ignore a negative size since that corresponds to our back-annotation. */
- if (UI_Lt (uint_size, Uint_0))
- return NULL_TREE;
-
/* Find the node to use for errors. */
if ((Ekind (gnat_object) == E_Component
|| Ekind (gnat_object) == E_Discriminant)
return NULL_TREE;
}
- /* Ignore a zero size if it is not permitted. */
- if (!zero_ok && integer_zerop (size))
+ /* Ignore a negative size since that corresponds to our back-annotation.
+ Also ignore a zero size if it is not permitted. */
+ if (tree_int_cst_sgn (size) < 0 || (integer_zerop (size) && !zero_ok))
return NULL_TREE;
/* The size of objects is always a multiple of a byte. */
if (uint_size == No_Uint)
return;
- /* Ignore a negative size since that corresponds to our back-annotation. */
- if (UI_Lt (uint_size, Uint_0))
- return;
-
/* Only issue an error if a Value_Size clause was explicitly given.
Otherwise, we'd be duplicating an error on the Size clause. */
gnat_attr_node
return;
}
- /* Ignore a zero size unless a Value_Size clause exists, or a size clause
- exists, or this is an integer type, in which case the front-end will
- have always set it. */
- if (No (gnat_attr_node)
- && integer_zerop (size)
- && !Has_Size_Clause (gnat_entity)
- && !Is_Discrete_Or_Fixed_Point_Type (gnat_entity))
+ /* Ignore a negative size since that corresponds to our back-annotation.
+ Also ignore a zero size unless a Value_Size clause exists, or a size
+ clause exists, or this is an integer type, in which case the front-end
+ will have always set it. */
+ if (tree_int_cst_sgn (size) < 0
+ || (integer_zerop (size)
+ && No (gnat_attr_node)
+ && !Has_Size_Clause (gnat_entity)
+ && !Is_Discrete_Or_Fixed_Point_Type (gnat_entity)))
return;
old_size = rm_size (gnu_type);
OSDN Git Service
