uintp.h (UI_Lt): Declare.
* uintp.h (UI_Lt): Declare. * gcc-interface/decl.c (gnat_to_gnu_entity) <E_Array_Type>: Do the size computation in sizetype. <E_Array_Subtype>: Use unified handling for all index types. Do not generate MAX_EXPR-based expressions, only COND_EXPR-based ones. Add bypass for PATs. (annotate_value): Change test for negative values. (validate_size): Apply test for negative values on GNAT nodes. (set_rm_size): Likewise. * gcc-interface/misc.c (gnat_init): Set unsigned types for sizetypes. * gcc-interface/utils.c (rest_of_record_type_compilation): Change test for negative values. (max_size) <MINUS_EXPR>: Do not reassociate a COND_EXPR on the LHS. (builtin_type_for_size): Adjust definition of signed_size_type_node. * gcc-interface/utils2.c (compare_arrays): Optimize comparison of lengths against zero. From-SVN: r158466
This commit is contained in:
Eric Botcazou
Eric Botcazou
parent
1b78f5757a
commit
728936bb92
|
|
@ -1,3 +1,22 @@
|
|||
2010-04-17 Eric Botcazou <ebotcazou@adacore.com>
|
||||
|
||||
* uintp.h (UI_Lt): Declare.
|
||||
* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Array_Type>: Do the size
|
||||
computation in sizetype.
|
||||
<E_Array_Subtype>: Use unified handling for all index types. Do not
|
||||
generate MAX_EXPR-based expressions, only COND_EXPR-based ones. Add
|
||||
bypass for PATs.
|
||||
(annotate_value): Change test for negative values.
|
||||
(validate_size): Apply test for negative values on GNAT nodes.
|
||||
(set_rm_size): Likewise.
|
||||
* gcc-interface/misc.c (gnat_init): Set unsigned types for sizetypes.
|
||||
* gcc-interface/utils.c (rest_of_record_type_compilation): Change test
|
||||
for negative values.
|
||||
(max_size) <MINUS_EXPR>: Do not reassociate a COND_EXPR on the LHS.
|
||||
(builtin_type_for_size): Adjust definition of signed_size_type_node.
|
||||
* gcc-interface/utils2.c (compare_arrays): Optimize comparison of
|
||||
lengths against zero.
|
||||
|
||||
2010-04-17 Eric Botcazou <ebotcazou@adacore.com>
|
||||
|
||||
* back-end.adb (Call_Back_End): Pass Standard_Character to gigi.
|
||||
|
|
|
|||
|
|
@ -2112,15 +2112,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
|
|||
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);
|
||||
|
|
@ -2129,7 +2120,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
|
|||
= 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, gnu_low;
|
||||
tree gnu_high;
|
||||
|
||||
/* See if the base array type is already flat. If it is, we
|
||||
are probably compiling an ACATS test but it will cause the
|
||||
|
|
@ -2145,8 +2136,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
|
|||
|
||||
/* Similarly, if one of the values overflows in sizetype and the
|
||||
range is null, use 1..0 for the sizetype bounds. */
|
||||
else if (!subrange_p
|
||||
&& TREE_CODE (gnu_min) == INTEGER_CST
|
||||
else if (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))
|
||||
|
|
@ -2159,8 +2149,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
|
|||
/* 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 (!subrange_p
|
||||
&& TREE_CODE (gnu_min) == INTEGER_CST
|
||||
else if (TREE_CODE (gnu_min) == INTEGER_CST
|
||||
&& TREE_CODE (gnu_max) == INTEGER_CST
|
||||
&& TREE_OVERFLOW (gnu_min) && TREE_OVERFLOW (gnu_max)
|
||||
&& !TREE_OVERFLOW
|
||||
|
|
@ -2179,57 +2168,47 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
|
|||
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))
|
||||
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))
|
||||
gnu_high = gnu_max;
|
||||
|
||||
/* 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
|
||||
/* 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)
|
||||
{
|
||||
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);
|
||||
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));
|
||||
}
|
||||
|
||||
/* 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));
|
||||
|
||||
gnu_index_types[index]
|
||||
= create_index_type (gnu_min, gnu_high, gnu_index_type,
|
||||
gnat_entity);
|
||||
|
|
@ -2299,7 +2278,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
|
|||
&& TREE_CODE (TREE_TYPE (gnu_index_type))
|
||||
!= INTEGER_TYPE)
|
||||
|| TYPE_BIASED_REPRESENTATION_P (gnu_index_type)
|
||||
|| prec_comp > 0)
|
||||
|| compare_tree_int (rm_size (gnu_index_type),
|
||||
TYPE_PRECISION (sizetype)) > 0)
|
||||
need_index_type_struct = true;
|
||||
}
|
||||
|
||||
|
|
@ -7128,9 +7108,11 @@ annotate_value (tree gnu_size)
|
|||
this is in bitsizetype. */
|
||||
gnu_size = convert (bitsizetype, gnu_size);
|
||||
|
||||
/* 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)
|
||||
/* 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)
|
||||
{
|
||||
tree op_size = fold_build1 (NEGATE_EXPR, bitsizetype, gnu_size);
|
||||
return annotate_value (build1 (NEGATE_EXPR, bitsizetype, op_size));
|
||||
|
|
@ -7498,6 +7480,10 @@ validate_size (Uint uint_size, tree gnu_type, Entity_Id gnat_object,
|
|||
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)
|
||||
|
|
@ -7522,9 +7508,8 @@ validate_size (Uint uint_size, tree gnu_type, Entity_Id gnat_object,
|
|||
return NULL_TREE;
|
||||
}
|
||||
|
||||
/* 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))
|
||||
/* Ignore a zero size if it is not permitted. */
|
||||
if (!zero_ok && integer_zerop (size))
|
||||
return NULL_TREE;
|
||||
|
||||
/* The size of objects is always a multiple of a byte. */
|
||||
|
|
@ -7611,6 +7596,10 @@ set_rm_size (Uint uint_size, tree gnu_type, Entity_Id gnat_entity)
|
|||
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
|
||||
|
|
@ -7627,15 +7616,13 @@ set_rm_size (Uint uint_size, tree gnu_type, Entity_Id gnat_entity)
|
|||
return;
|
||||
}
|
||||
|
||||
/* 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)))
|
||||
/* 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))
|
||||
return;
|
||||
|
||||
old_size = rm_size (gnu_type);
|
||||
|
|
|
|||
|
|
@ -391,13 +391,16 @@ gnat_init (void)
|
|||
/* Do little here, most of the standard declarations are set up after the
|
||||
front-end has been run. Use the same `char' as C, this doesn't really
|
||||
matter since we'll use the explicit `unsigned char' for Character. */
|
||||
build_common_tree_nodes (flag_signed_char, true);
|
||||
build_common_tree_nodes (flag_signed_char, false);
|
||||
|
||||
/* In Ada, we use a signed type for SIZETYPE. Use the signed type
|
||||
corresponding to the width of Pmode. In most cases when ptr_mode
|
||||
and Pmode differ, C will use the width of ptr_mode for SIZETYPE.
|
||||
But we get far better code using the width of Pmode. */
|
||||
size_type_node = gnat_type_for_mode (Pmode, 0);
|
||||
/* In Ada, we use the unsigned type corresponding to the width of Pmode as
|
||||
SIZETYPE. In most cases when ptr_mode and Pmode differ, C will use the
|
||||
width of ptr_mode for SIZETYPE, but we get better code using the width
|
||||
of Pmode. Note that, although we manipulate negative offsets for some
|
||||
internal constructs and rely on compile time overflow detection in size
|
||||
computations, using unsigned types for SIZETYPEs is fine since they are
|
||||
treated specially by the middle-end, in particular sign-extended. */
|
||||
size_type_node = gnat_type_for_mode (Pmode, 1);
|
||||
set_sizetype (size_type_node);
|
||||
TYPE_NAME (sizetype) = get_identifier ("size_type");
|
||||
|
||||
|
|
|
|||
|
|
@ -839,11 +839,13 @@ rest_of_record_type_compilation (tree record_type)
|
|||
align = tree_low_cst (TREE_OPERAND (curpos, 1), 1);
|
||||
|
||||
/* An offset which is a bitwise AND with a negative power of 2
|
||||
means an alignment corresponding to this power of 2. */
|
||||
means an alignment corresponding to this power of 2. Note
|
||||
that, as sizetype is sign-extended but nonetheless unsigned,
|
||||
we don't directly use tree_int_cst_sgn. */
|
||||
offset = remove_conversions (offset, true);
|
||||
if (TREE_CODE (offset) == BIT_AND_EXPR
|
||||
&& host_integerp (TREE_OPERAND (offset, 1), 0)
|
||||
&& tree_int_cst_sgn (TREE_OPERAND (offset, 1)) < 0)
|
||||
&& TREE_INT_CST_HIGH (TREE_OPERAND (offset, 1)) < 0)
|
||||
{
|
||||
unsigned int pow
|
||||
= - tree_low_cst (TREE_OPERAND (offset, 1), 0);
|
||||
|
|
@ -2175,22 +2177,6 @@ max_size (tree exp, bool max_p)
|
|||
if (code == COMPOUND_EXPR)
|
||||
return max_size (TREE_OPERAND (exp, 1), max_p);
|
||||
|
||||
/* Calculate "(A ? B : C) - D" as "A ? B - D : C - D" which
|
||||
may provide a tighter bound on max_size. */
|
||||
if (code == MINUS_EXPR
|
||||
&& TREE_CODE (TREE_OPERAND (exp, 0)) == COND_EXPR)
|
||||
{
|
||||
tree lhs = fold_build2 (MINUS_EXPR, type,
|
||||
TREE_OPERAND (TREE_OPERAND (exp, 0), 1),
|
||||
TREE_OPERAND (exp, 1));
|
||||
tree rhs = fold_build2 (MINUS_EXPR, type,
|
||||
TREE_OPERAND (TREE_OPERAND (exp, 0), 2),
|
||||
TREE_OPERAND (exp, 1));
|
||||
return fold_build2 (max_p ? MAX_EXPR : MIN_EXPR, type,
|
||||
max_size (lhs, max_p),
|
||||
max_size (rhs, max_p));
|
||||
}
|
||||
|
||||
{
|
||||
tree lhs = max_size (TREE_OPERAND (exp, 0), max_p);
|
||||
tree rhs = max_size (TREE_OPERAND (exp, 1),
|
||||
|
|
@ -4707,7 +4693,7 @@ builtin_type_for_size (int size, bool unsignedp)
|
|||
static void
|
||||
install_builtin_elementary_types (void)
|
||||
{
|
||||
signed_size_type_node = size_type_node;
|
||||
signed_size_type_node = gnat_signed_type (size_type_node);
|
||||
pid_type_node = integer_type_node;
|
||||
void_list_node = build_void_list_node ();
|
||||
|
||||
|
|
|
|||
|
|
@ -351,14 +351,26 @@ compare_arrays (tree result_type, tree a1, tree a2)
|
|||
if (EXPR_P (comparison))
|
||||
SET_EXPR_LOCATION (comparison, input_location);
|
||||
|
||||
this_a1_is_null = build_binary_op (EQ_EXPR, result_type, length1,
|
||||
size_zero_node);
|
||||
if (EXPR_P (this_a1_is_null))
|
||||
/* If the length expression is of the form (cond ? val : 0), assume
|
||||
that cond is equivalent to (length != 0). That's guaranteed by
|
||||
construction of the array types in gnat_to_gnu_entity. */
|
||||
if (TREE_CODE (length1) == COND_EXPR
|
||||
&& integer_zerop (TREE_OPERAND (length1, 2)))
|
||||
this_a1_is_null = invert_truthvalue (TREE_OPERAND (length1, 0));
|
||||
else
|
||||
this_a1_is_null = build_binary_op (EQ_EXPR, result_type, length1,
|
||||
size_zero_node);
|
||||
if (EXPR_P (this_a1_is_null))
|
||||
SET_EXPR_LOCATION (this_a1_is_null, input_location);
|
||||
|
||||
this_a2_is_null = build_binary_op (EQ_EXPR, result_type, length2,
|
||||
size_zero_node);
|
||||
if (EXPR_P (this_a2_is_null))
|
||||
/* Likewise for the second array. */
|
||||
if (TREE_CODE (length2) == COND_EXPR
|
||||
&& integer_zerop (TREE_OPERAND (length2, 2)))
|
||||
this_a2_is_null = invert_truthvalue (TREE_OPERAND (length2, 0));
|
||||
else
|
||||
this_a2_is_null = build_binary_op (EQ_EXPR, result_type, length2,
|
||||
size_zero_node);
|
||||
if (EXPR_P (this_a2_is_null))
|
||||
SET_EXPR_LOCATION (this_a2_is_null, input_location);
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -75,6 +75,10 @@ typedef struct {const int *Array; Vector_Template *Bounds; }
|
|||
#define Vector_To_Uint uintp__vector_to_uint
|
||||
extern Uint Vector_To_Uint (Int_Vector, Boolean);
|
||||
|
||||
/* Compare integer values for less than. */
|
||||
#define UI_Lt uintp__ui_lt
|
||||
extern Boolean UI_Lt (Uint, Uint);
|
||||
|
||||
/* Universal integers are represented by the Uint type which is an index into
|
||||
the Uints_Ptr table containing Uint_Entry values. A Uint_Entry contains an
|
||||
index and length for getting the "digits" of the universal integer from the
|
||||
|
|
|
|||
|
|
@ -1,3 +1,9 @@
|
|||
2010-04-17 Eric Botcazou <ebotcazou@adacore.com>
|
||||
|
||||
* gnat.dg/sizetype.adb: Rename into...
|
||||
* gnat.dg/sizetype1.adb: ...this.
|
||||
* gnat.dg/sizetype2.adb: New test.
|
||||
|
||||
2010-04-16 Richard Guenther <rguenther@suse.de>
|
||||
|
||||
PR tree-optimization/43572
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
|
||||
with Interfaces.C; use Interfaces.C;
|
||||
|
||||
procedure Sizetype is
|
||||
procedure Sizetype1 is
|
||||
|
||||
TC_String : String(1..8) := "abcdefgh";
|
||||
TC_No_nul : constant char_array := To_C(TC_String, False);
|
||||
|
|
@ -0,0 +1,27 @@
|
|||
-- { dg-do run }
|
||||
|
||||
procedure Sizetype2 is
|
||||
|
||||
function Ident_Int (X : Integer) return Integer is
|
||||
begin
|
||||
return X;
|
||||
end;
|
||||
|
||||
type A is array (Integer range <>) of Boolean;
|
||||
subtype T1 is A (Ident_Int (- 6) .. Ident_Int (Integer'Last - 4));
|
||||
subtype T2 is A (- 6 .. Ident_Int (Integer'Last - 4));
|
||||
subtype T3 is A (Ident_Int (- 6) .. Integer'Last - 4);
|
||||
|
||||
begin
|
||||
if T1'Size /= 17179869200 then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
if T2'Size /= 17179869200 then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
if T3'Size /= 17179869200 then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
end;
|
||||
Loading…
Reference in New Issue