gigi.h (gigi_checking_assert): New macro.

* gcc-interface/gigi.h (gigi_checking_assert): New macro.
	* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Modular_Integer_Type>:
	Remove redundant test and adjust comments.  Minor tweaks.
	* gcc-interface/trans.c (Call_to_gnu): Do not generate range checks,
	instead assert that the Do_Range_Check flag is not set.  Adjust call
	to convert_with_check.
	(gnat_to_gnu): Likewise.
	(assoc_to_constructor): Likewise.
	(pos_to_constructor): Likewise.  Remove GNAT_COMPONENT_TYPE parameter.
	(emit_range_check): Delete.
	(convert_with_check): Remove RANGE_P parameter and adjust.  Do a single
	overflow check for modular types.

From-SVN: r275174
This commit is contained in:
Eric Botcazou 2019-08-30 13:50:34 +00:00 committed by Eric Botcazou
parent 3eefaaa9fe
commit 815b536832
4 changed files with 83 additions and 146 deletions

View File

@ -1,3 +1,18 @@
2019-08-30 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/gigi.h (gigi_checking_assert): New macro.
* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Modular_Integer_Type>:
Remove redundant test and adjust comments. Minor tweaks.
* gcc-interface/trans.c (Call_to_gnu): Do not generate range checks,
instead assert that the Do_Range_Check flag is not set. Adjust call
to convert_with_check.
(gnat_to_gnu): Likewise.
(assoc_to_constructor): Likewise.
(pos_to_constructor): Likewise. Remove GNAT_COMPONENT_TYPE parameter.
(emit_range_check): Delete.
(convert_with_check): Remove RANGE_P parameter and adjust. Do a single
overflow check for modular types.
2019-08-23 Jakub Jelinek <jakub@redhat.com>
PR middle-end/91283

View File

@ -447,13 +447,13 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
If we are not defining it, it must be a type or an entity that is defined
elsewhere or externally, otherwise we should have defined it already. */
gcc_assert (definition
|| type_annotate_only
|| is_type
|| kind == E_Discriminant
|| kind == E_Component
|| kind == E_Label
|| (kind == E_Constant && Present (Full_View (gnat_entity)))
|| Is_Public (gnat_entity));
|| Is_Public (gnat_entity)
|| type_annotate_only);
/* Get the name of the entity and set up the line number and filename of
the original definition for use in any decl we make. Make sure we do
@ -1758,34 +1758,29 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
case E_Modular_Integer_Type:
{
/* For modular types, make the unsigned type of the proper number
of bits and then set up the modulus, if required. */
tree gnu_modulus, gnu_high = NULL_TREE;
/* Packed Array Impl. Types are supposed to be subtypes only. */
gcc_assert (!Is_Packed_Array_Impl_Type (gnat_entity));
/* For modular types, make the unsigned type of the proper number
of bits and then set up the modulus, if required. */
gnu_type = make_unsigned_type (esize);
/* Get the modulus in this type. If it overflows, assume it is because
it is equal to 2**Esize. Note that there is no overflow checking
done on unsigned type, so we detect the overflow by looking for
a modulus of zero, which is otherwise invalid. */
gnu_modulus = UI_To_gnu (Modulus (gnat_entity), gnu_type);
/* Get the modulus in this type. If the modulus overflows, assume
that this is because it was equal to 2**Esize. Note that there
is no overflow checking done on unsigned types, so we detect the
overflow by looking for a modulus of zero, which is invalid. */
tree gnu_modulus = UI_To_gnu (Modulus (gnat_entity), gnu_type);
/* If the modulus is not 2**Esize, then this also means that the upper
bound of the type, i.e. modulus - 1, is not maximal, so we create an
extra subtype to carry it and set the modulus on the base type. */
if (!integer_zerop (gnu_modulus))
{
TYPE_NAME (gnu_type) = create_concat_name (gnat_entity, "UMT");
TYPE_MODULAR_P (gnu_type) = 1;
SET_TYPE_MODULUS (gnu_type, gnu_modulus);
gnu_high = fold_build2 (MINUS_EXPR, gnu_type, gnu_modulus,
build_int_cst (gnu_type, 1));
}
/* If the upper bound is not maximal, make an extra subtype. */
if (gnu_high
&& !tree_int_cst_equal (gnu_high, TYPE_MAX_VALUE (gnu_type)))
{
TYPE_NAME (gnu_type) = create_concat_name (gnat_entity, "UMT");
tree gnu_high = fold_build2 (MINUS_EXPR, gnu_type, gnu_modulus,
build_int_cst (gnu_type, 1));
gnu_type
= create_extra_subtype (gnu_type, TYPE_MIN_VALUE (gnu_type),
gnu_high);
@ -2987,8 +2982,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
|| Present (Record_Extension_Part (record_definition)))
record_definition = Record_Extension_Part (record_definition);
gcc_assert (type_annotate_only
|| Present (Parent_Subtype (gnat_entity)));
gcc_assert (Present (Parent_Subtype (gnat_entity))
|| type_annotate_only);
}
/* Make a node for the record. If we are not defining the record,

View File

@ -6,7 +6,7 @@
* *
* C Header File *
* *
* Copyright (C) 1992-2018, Free Software Foundation, Inc. *
* Copyright (C) 1992-2019, Free Software Foundation, Inc. *
* *
* GNAT is free software; you can redistribute it and/or modify it under *
* terms of the GNU General Public License as published by the Free Soft- *
@ -1054,6 +1054,12 @@ extern void enumerate_modes (void (*f) (const char *, int, int, int, int, int,
}
#endif
/* Use gigi_checking_assert to test invariants in code generation mode.
It's effective only if the compiler is configured with more checking
than the release mode and can be disabled by means of -fchecking. */
#define gigi_checking_assert(EXPR) \
gcc_checking_assert ((EXPR) || type_annotate_only)
/* If EXP's type is a VECTOR_TYPE, return EXP converted to the associated
TYPE_REPRESENTATIVE_ARRAY. */

View File

@ -231,14 +231,13 @@ static enum gimplify_status gnat_gimplify_stmt (tree *);
static void elaborate_all_entities (Node_Id);
static void process_freeze_entity (Node_Id);
static void process_decls (List_Id, List_Id, Node_Id, bool, bool);
static tree emit_range_check (tree, Node_Id, Node_Id);
static tree emit_check (tree, tree, int, Node_Id);
static tree build_unary_op_trapv (enum tree_code, tree, tree, Node_Id);
static tree build_binary_op_trapv (enum tree_code, tree, tree, tree, Node_Id);
static tree convert_with_check (Entity_Id, tree, bool, bool, bool, Node_Id);
static tree convert_with_check (Entity_Id, tree, bool, bool, Node_Id);
static bool addressable_p (tree, tree);
static tree assoc_to_constructor (Entity_Id, Node_Id, tree);
static tree pos_to_constructor (Node_Id, tree, Entity_Id);
static tree pos_to_constructor (Node_Id, tree);
static void validate_unchecked_conversion (Node_Id);
static Node_Id adjust_for_implicit_deref (Node_Id);
static tree maybe_implicit_deref (tree);
@ -5407,11 +5406,7 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target,
else
gnu_actual = convert (gnu_actual_type, gnu_actual);
/* Make sure that the actual is in range of the formal's type. */
if (Ekind (gnat_formal) != E_Out_Parameter
&& Do_Range_Check (gnat_actual))
gnu_actual
= emit_range_check (gnu_actual, gnat_formal_type, gnat_actual);
gigi_checking_assert (!Do_Range_Check (gnat_actual));
/* First see if the parameter is passed by reference. */
if (is_true_formal_parm && DECL_BY_REF_P (gnu_formal))
@ -5655,12 +5650,15 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target,
conversion node and not from the inner Expression. */
if (Nkind (gnat_actual) == N_Type_Conversion)
{
const Node_Id gnat_expr = Expression (gnat_actual);
gigi_checking_assert (!Do_Range_Check (gnat_expr));
gnu_result
= convert_with_check
(Etype (Expression (gnat_actual)), gnu_result,
Do_Overflow_Check (gnat_actual),
Do_Range_Check (Expression (gnat_actual)),
Float_Truncate (gnat_actual), gnat_actual);
= convert_with_check (Etype (gnat_expr), gnu_result,
Do_Overflow_Check (gnat_actual),
Float_Truncate (gnat_actual),
gnat_actual);
if (!Is_Composite_Type (Underlying_Type (Etype (gnat_formal))))
gnu_actual = convert (TREE_TYPE (gnu_result), gnu_actual);
@ -5676,10 +5674,7 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target,
No_Truncation (gnat_actual));
else
{
if (Do_Range_Check (gnat_actual))
gnu_result
= emit_range_check (gnu_result, Etype (gnat_actual),
gnat_actual);
gigi_checking_assert (!Do_Range_Check (gnat_actual));
if (!(!TREE_CONSTANT (TYPE_SIZE (TREE_TYPE (gnu_actual)))
&& TREE_CONSTANT (TYPE_SIZE (TREE_TYPE (gnu_result)))))
@ -5736,11 +5731,7 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target,
Node_Id gnat_parent = Parent (gnat_node);
enum tree_code op_code;
/* If range check is needed, emit code to generate it. */
if (Do_Range_Check (gnat_node))
gnu_call
= emit_range_check (gnu_call, Etype (Name (gnat_parent)),
gnat_parent);
gigi_checking_assert (!Do_Range_Check (gnat_node));
/* ??? If the return type has variable size, then force the return
slot optimization as we would not be able to create a temporary.
@ -7043,10 +7034,9 @@ gnat_to_gnu (Node_Id gnat_node)
&& (!type_annotate_only
|| Compile_Time_Known_Value (Expression (gnat_node))))
{
gigi_checking_assert (!Do_Range_Check (Expression (gnat_node)));
gnu_expr = gnat_to_gnu (Expression (gnat_node));
if (Do_Range_Check (Expression (gnat_node)))
gnu_expr
= emit_range_check (gnu_expr, Etype (gnat_temp), gnat_node);
if (type_annotate_only && TREE_CODE (gnu_expr) == ERROR_MARK)
gnu_expr = NULL_TREE;
@ -7396,8 +7386,7 @@ gnat_to_gnu (Node_Id gnat_node)
gnu_aggr_type);
else if (TREE_CODE (gnu_aggr_type) == ARRAY_TYPE)
gnu_result = pos_to_constructor (First (Expressions (gnat_node)),
gnu_aggr_type,
Component_Type (Etype (gnat_node)));
gnu_aggr_type);
else if (TREE_CODE (gnu_aggr_type) == COMPLEX_TYPE)
gnu_result
= build_binary_op
@ -7436,10 +7425,11 @@ gnat_to_gnu (Node_Id gnat_node)
if (kind == N_Qualified_Expression && Is_Tagged_Type (Etype (gnat_node)))
used_types_insert (gnu_result_type);
gigi_checking_assert (!Do_Range_Check (Expression (gnat_node)));
gnu_result
= convert_with_check (Etype (gnat_node), gnu_expr,
Do_Overflow_Check (gnat_node),
Do_Range_Check (Expression (gnat_node)),
kind == N_Type_Conversion
&& Float_Truncate (gnat_node), gnat_node);
break;
@ -7749,10 +7739,9 @@ gnat_to_gnu (Node_Id gnat_node)
gnat_temp = Expression (gnat_node);
/* The Expression operand can either be an N_Identifier or
Expanded_Name, which must represent a type, or a
N_Qualified_Expression, which contains both the object type and an
initial value for the object. */
/* The expression can be either an N_Identifier or an Expanded_Name,
which must represent a type, or a N_Qualified_Expression, which
contains both the type and an initial value for the object. */
if (Nkind (gnat_temp) == N_Identifier
|| Nkind (gnat_temp) == N_Expanded_Name)
gnu_type = gnat_to_gnu_type (Entity (gnat_temp));
@ -7765,9 +7754,8 @@ gnat_to_gnu (Node_Id gnat_node)
gnu_init = gnat_to_gnu (Expression (gnat_temp));
gnu_init = maybe_unconstrained_array (gnu_init);
if (Do_Range_Check (Expression (gnat_temp)))
gnu_init
= emit_range_check (gnu_init, gnat_desig_type, gnat_temp);
gigi_checking_assert (!Do_Range_Check (Expression (gnat_temp)));
if (Is_Elementary_Type (gnat_desig_type)
|| Is_Constrained (gnat_desig_type))
@ -7873,10 +7861,7 @@ gnat_to_gnu (Node_Id gnat_node)
else
gnu_rhs = maybe_unconstrained_array (gnat_to_gnu (gnat_expr));
/* If range check is needed, emit code to generate it. */
if (Do_Range_Check (gnat_expr))
gnu_rhs = emit_range_check (gnu_rhs, Etype (Name (gnat_node)),
gnat_node);
gigi_checking_assert (!Do_Range_Check (gnat_expr));
/* If an outer atomic access is required on the LHS, build the load-
modify-store sequence. */
@ -10086,58 +10071,6 @@ build_binary_op_trapv (enum tree_code code, tree gnu_type, tree left,
return emit_check (check, gnu_expr, CE_Overflow_Check_Failed, gnat_node);
}
/* Emit code for a range check. GNU_EXPR is the expression to be checked,
GNAT_RANGE_TYPE the gnat type or subtype containing the bounds against
which we have to check. GNAT_NODE is the GNAT node conveying the source
location for which the error should be signaled. */
static tree
emit_range_check (tree gnu_expr, Entity_Id gnat_range_type, Node_Id gnat_node)
{
tree gnu_range_type = get_unpadded_type (gnat_range_type);
tree gnu_compare_type = get_base_type (TREE_TYPE (gnu_expr));
/* If GNU_EXPR has GNAT_RANGE_TYPE as its base type, no check is needed.
This can for example happen when translating 'Val or 'Value. */
if (gnu_compare_type == gnu_range_type)
return gnu_expr;
/* Range checks can only be applied to types with ranges. */
gcc_assert (INTEGRAL_TYPE_P (gnu_range_type)
|| SCALAR_FLOAT_TYPE_P (gnu_range_type));
/* If GNU_EXPR has an integral type that is narrower than GNU_RANGE_TYPE,
we can't do anything since we might be truncating the bounds. No
check is needed in this case. */
if (INTEGRAL_TYPE_P (TREE_TYPE (gnu_expr))
&& (TYPE_PRECISION (gnu_compare_type)
< TYPE_PRECISION (get_base_type (gnu_range_type))))
return gnu_expr;
/* Checked expressions must be evaluated only once. */
gnu_expr = gnat_protect_expr (gnu_expr);
/* Note that the form of the check is
(not (expr >= lo)) or (not (expr <= hi))
the reason for this slightly convoluted form is that NaNs
are not considered to be in range in the float case. */
return emit_check
(build_binary_op (TRUTH_ORIF_EXPR, boolean_type_node,
invert_truthvalue
(build_binary_op (GE_EXPR, boolean_type_node,
convert (gnu_compare_type, gnu_expr),
convert (gnu_compare_type,
TYPE_MIN_VALUE
(gnu_range_type)))),
invert_truthvalue
(build_binary_op (LE_EXPR, boolean_type_node,
convert (gnu_compare_type, gnu_expr),
convert (gnu_compare_type,
TYPE_MAX_VALUE
(gnu_range_type))))),
gnu_expr, CE_Range_Check_Failed, gnat_node);
}
/* GNU_COND contains the condition corresponding to an index, overflow or
range check of value GNU_EXPR. Build a COND_EXPR that returns GNU_EXPR
if GNU_COND is false and raises a CONSTRAINT_ERROR if GNU_COND is true.
@ -10169,14 +10102,13 @@ emit_check (tree gnu_cond, tree gnu_expr, int reason, Node_Id gnat_node)
}
/* Return an expression that converts GNU_EXPR to GNAT_TYPE, doing overflow
checks if OVERFLOW_P is true and range checks if RANGE_P is true.
If TRUNCATE_P true, do a float-to-integer conversion with truncation,
otherwise round. GNAT_NODE is the GNAT node conveying the source location
for which the error should be signaled. */
checks if OVERFLOW_P is true. If TRUNCATE_P is true, do a fp-to-integer
conversion with truncation, otherwise round. GNAT_NODE is the GNAT node
conveying the source location for which the error should be signaled. */
static tree
convert_with_check (Entity_Id gnat_type, tree gnu_expr, bool overflow_p,
bool range_p, bool truncate_p, Node_Id gnat_node)
bool truncate_p, Node_Id gnat_node)
{
tree gnu_type = get_unpadded_type (gnat_type);
tree gnu_base_type = get_base_type (gnu_type);
@ -10187,8 +10119,7 @@ convert_with_check (Entity_Id gnat_type, tree gnu_expr, bool overflow_p,
/* If we are not doing any checks, the output is an integral type and the
input is not a floating-point type, just do the conversion. This is
required for packed array types and is simpler in all cases anyway. */
if (!range_p
&& !overflow_p
if (!overflow_p
&& INTEGRAL_TYPE_P (gnu_base_type)
&& !FLOAT_TYPE_P (gnu_in_base_type))
return convert (gnu_type, gnu_expr);
@ -10221,7 +10152,13 @@ convert_with_check (Entity_Id gnat_type, tree gnu_expr, bool overflow_p,
tree gnu_in_lb = TYPE_MIN_VALUE (gnu_in_base_type);
tree gnu_in_ub = TYPE_MAX_VALUE (gnu_in_base_type);
tree gnu_out_lb = TYPE_MIN_VALUE (gnu_base_type);
tree gnu_out_ub = TYPE_MAX_VALUE (gnu_base_type);
tree gnu_out_ub
= (TREE_CODE (gnu_base_type) == INTEGER_TYPE
&& TYPE_MODULAR_P (gnu_base_type))
? fold_build2 (MINUS_EXPR, gnu_base_type,
TYPE_MODULUS (gnu_base_type),
build_int_cst (gnu_base_type, 1))
: TYPE_MAX_VALUE (gnu_base_type);
/* Convert the lower bounds to signed types, so we're sure we're
comparing them properly. Likewise, convert the upper bounds
@ -10346,14 +10283,6 @@ convert_with_check (Entity_Id gnat_type, tree gnu_expr, bool overflow_p,
else
gnu_result = convert (gnu_base_type, gnu_result);
/* Finally, do the range check if requested. Note that if the result type
is a modular type, the range check is actually an overflow check. */
if (range_p
|| (overflow_p
&& TREE_CODE (gnu_base_type) == INTEGER_TYPE
&& TYPE_MODULAR_P (gnu_base_type)))
gnu_result = emit_range_check (gnu_result, gnat_type, gnat_node);
return convert (gnu_type, gnu_result);
}
@ -10682,7 +10611,8 @@ assoc_to_constructor (Entity_Id gnat_entity, Node_Id gnat_assoc, tree gnu_type)
for (; Present (gnat_assoc); gnat_assoc = Next (gnat_assoc))
{
Node_Id gnat_field = First (Choices (gnat_assoc));
const Node_Id gnat_field = First (Choices (gnat_assoc));
const Node_Id gnat_expr = Expression (gnat_assoc);
tree gnu_field = gnat_to_gnu_field_decl (Entity (gnat_field));
tree gnu_expr = gnat_to_gnu (Expression (gnat_assoc));
@ -10702,11 +10632,9 @@ assoc_to_constructor (Entity_Id gnat_entity, Node_Id gnat_assoc, tree gnu_type)
&& Is_Unchecked_Union (gnat_entity))
continue;
/* Before assigning a value in an aggregate make sure range checks
are done if required. Then convert to the type of the field. */
if (Do_Range_Check (Expression (gnat_assoc)))
gnu_expr = emit_range_check (gnu_expr, Etype (gnat_field), Empty);
gigi_checking_assert (!Do_Range_Check (gnat_expr));
/* Convert to the type of the field. */
gnu_expr = convert (TREE_TYPE (gnu_field), gnu_expr);
/* Add the field and expression to the list. */
@ -10727,13 +10655,10 @@ assoc_to_constructor (Entity_Id gnat_entity, Node_Id gnat_assoc, tree gnu_type)
/* Build a possibly nested constructor for array aggregates. GNAT_EXPR is
the first element of an array aggregate. It may itself be an aggregate.
GNU_ARRAY_TYPE is the GCC type corresponding to the array aggregate.
GNAT_COMPONENT_TYPE is the type of the array component; it is needed
for range checking. */
GNU_ARRAY_TYPE is the GCC type corresponding to the array aggregate. */
static tree
pos_to_constructor (Node_Id gnat_expr, tree gnu_array_type,
Entity_Id gnat_component_type)
pos_to_constructor (Node_Id gnat_expr, tree gnu_array_type)
{
tree gnu_index = TYPE_MIN_VALUE (TYPE_DOMAIN (gnu_array_type));
vec<constructor_elt, va_gc> *gnu_expr_vec = NULL;
@ -10749,8 +10674,7 @@ pos_to_constructor (Node_Id gnat_expr, tree gnu_array_type,
&& TREE_CODE (TREE_TYPE (gnu_array_type)) == ARRAY_TYPE
&& TYPE_MULTI_ARRAY_P (TREE_TYPE (gnu_array_type)))
gnu_expr = pos_to_constructor (First (Expressions (gnat_expr)),
TREE_TYPE (gnu_array_type),
gnat_component_type);
TREE_TYPE (gnu_array_type));
else
{
/* If the expression is a conversion to an unconstrained array type,
@ -10762,10 +10686,7 @@ pos_to_constructor (Node_Id gnat_expr, tree gnu_array_type,
else
gnu_expr = gnat_to_gnu (gnat_expr);
/* Before assigning the element to the array, make sure it is
in range. */
if (Do_Range_Check (gnat_expr))
gnu_expr = emit_range_check (gnu_expr, gnat_component_type, Empty);
gigi_checking_assert (!Do_Range_Check (gnat_expr));
}
CONSTRUCTOR_APPEND_ELT (gnu_expr_vec, gnu_index,