gigi.h (maybe_variable): Delete.

* gcc-interface/gigi.h (maybe_variable): Delete.
	(protect_multiple_eval): Likewise.
	(maybe_stabilize_reference): Likewise.
	(gnat_save_expr): Declare.
	(gnat_protect_expr): Likewise.
	(gnat_stabilize_reference): Likewise.
	* gcc-interface/decl.c (gnat_to_gnu_entity) <object>: Use
	gnat_stabilize_reference.
	(maybe_variable): Delete.
	(elaborate_expression_1): Use gnat_save_expr.
	* gcc-interface/trans.c (Attribute_to_gnu): Use gnat_protect_expr.
	(call_to_gnu): Pass NULL to gnat_stabilize_reference.
	(gnat_to_gnu) <N_Object_Declaration>: Use gnat_save_expr.
	<N_Slice>: Use gnat_protect_exp.
	<N_Selected_Component>: Pass NULL to gnat_stabilize_reference.
	<N_In>: Use gnat_protect_expr.
	Pass NULL to gnat_stabilize_reference.
	(build_unary_op_trapv): Use gnat_protect_expr.
	(build_binary_op_trapv): Likewise.
	(emit_range_check): Likewise.
	(emit_index_check): Likewise.
	(convert_with_check): Likewise.
	(protect_multiple_eval): Move to utils2.c file.
	(maybe_stabilize_reference): Merge into...
	(gnat_stabilize_reference): ...this.  Move to utils2.c file.
	(gnat_stabilize_reference_1): Likewise.
	* gcc-interface/utils.c (convert_to_fat_pointer): Use gnat_protect_expr
	instead of protect_multiple_eval.
	* gcc-interface/utils2.c (compare_arrays): Likewise.
	(nonbinary_modular_operation): Likewise.
	(maybe_wrap_malloc): Likewise.
	(build_allocator): Likewise.
	(gnat_save_expr): New function.
	(gnat_protect_expr): Rename from protect_multiple_eval.  Early return
	in common cases.  Propagate TREE_READONLY onto dereferences.
	(gnat_stabilize_reference_1): Move from trans.c file.
	(gnat_stabilize_reference): Likewise.

From-SVN: r158159
This commit is contained in:
Eric Botcazou 2010-04-09 10:49:46 +00:00 committed by Eric Botcazou
parent 3f2060fd38
commit 7d7a1fe859
6 changed files with 374 additions and 326 deletions

View File

@ -1,3 +1,43 @@
2010-04-09 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/gigi.h (maybe_variable): Delete.
(protect_multiple_eval): Likewise.
(maybe_stabilize_reference): Likewise.
(gnat_save_expr): Declare.
(gnat_protect_expr): Likewise.
(gnat_stabilize_reference): Likewise.
* gcc-interface/decl.c (gnat_to_gnu_entity) <object>: Use
gnat_stabilize_reference.
(maybe_variable): Delete.
(elaborate_expression_1): Use gnat_save_expr.
* gcc-interface/trans.c (Attribute_to_gnu): Use gnat_protect_expr.
(call_to_gnu): Pass NULL to gnat_stabilize_reference.
(gnat_to_gnu) <N_Object_Declaration>: Use gnat_save_expr.
<N_Slice>: Use gnat_protect_exp.
<N_Selected_Component>: Pass NULL to gnat_stabilize_reference.
<N_In>: Use gnat_protect_expr.
Pass NULL to gnat_stabilize_reference.
(build_unary_op_trapv): Use gnat_protect_expr.
(build_binary_op_trapv): Likewise.
(emit_range_check): Likewise.
(emit_index_check): Likewise.
(convert_with_check): Likewise.
(protect_multiple_eval): Move to utils2.c file.
(maybe_stabilize_reference): Merge into...
(gnat_stabilize_reference): ...this. Move to utils2.c file.
(gnat_stabilize_reference_1): Likewise.
* gcc-interface/utils.c (convert_to_fat_pointer): Use gnat_protect_expr
instead of protect_multiple_eval.
* gcc-interface/utils2.c (compare_arrays): Likewise.
(nonbinary_modular_operation): Likewise.
(maybe_wrap_malloc): Likewise.
(build_allocator): Likewise.
(gnat_save_expr): New function.
(gnat_protect_expr): Rename from protect_multiple_eval. Early return
in common cases. Propagate TREE_READONLY onto dereferences.
(gnat_stabilize_reference_1): Move from trans.c file.
(gnat_stabilize_reference): Likewise.
2010-04-09 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/gigi.h (gnat_mark_addressable): Rename parameter.

View File

@ -897,7 +897,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
&& !TREE_SIDE_EFFECTS (gnu_expr))))
{
maybe_stable_expr
= maybe_stabilize_reference (gnu_expr, true, &stable);
= gnat_stabilize_reference (gnu_expr, true, &stable);
if (stable)
{
@ -973,7 +973,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
else
{
maybe_stable_expr
= maybe_stabilize_reference (gnu_expr, true, &stable);
= gnat_stabilize_reference (gnu_expr, true, &stable);
if (stable)
renamed_obj = maybe_stable_expr;
@ -5727,29 +5727,6 @@ prepend_attributes (Entity_Id gnat_entity, struct attrib ** attr_list)
}
}
/* Called when we need to protect a variable object using a SAVE_EXPR. */
tree
maybe_variable (tree gnu_operand)
{
if (TREE_CONSTANT (gnu_operand)
|| TREE_READONLY (gnu_operand)
|| TREE_CODE (gnu_operand) == SAVE_EXPR
|| TREE_CODE (gnu_operand) == NULL_EXPR)
return gnu_operand;
if (TREE_CODE (gnu_operand) == UNCONSTRAINED_ARRAY_REF)
{
tree gnu_result
= build1 (UNCONSTRAINED_ARRAY_REF, TREE_TYPE (gnu_operand),
variable_size (TREE_OPERAND (gnu_operand, 0)));
TREE_READONLY (gnu_result) = TYPE_READONLY (TREE_TYPE (gnu_operand));
return gnu_result;
}
return variable_size (gnu_operand);
}
/* Given a GNAT tree GNAT_EXPR, for an expression which is a value within a
type definition (either a bound or a discriminant value) for GNAT_ENTITY,
return the GCC tree to use for that expression. GNU_NAME is the suffix
@ -5852,7 +5829,7 @@ elaborate_expression_1 (tree gnu_expr, Entity_Id gnat_entity, tree gnu_name,
if (expr_global && expr_variable)
return gnu_decl;
return expr_variable ? maybe_variable (gnu_expr) : gnu_expr;
return expr_variable ? gnat_save_expr (gnu_expr) : gnu_expr;
}
/* Create a record type that contains a SIZE bytes long field of TYPE with a

View File

@ -112,9 +112,6 @@ extern void mark_out_of_scope (Entity_Id gnat_entity);
/* Get the unpadded version of a GNAT type. */
extern tree get_unpadded_type (Entity_Id gnat_entity);
/* Called when we need to protect a variable object using a save_expr. */
extern tree maybe_variable (tree gnu_operand);
/* Create a record type that contains a SIZE bytes long field of TYPE with a
starting bit position so that it is aligned to ALIGN bits, and leaving at
least ROOM bytes free before the field. BASE_ALIGN is the alignment the
@ -256,9 +253,6 @@ extern void post_error_ne_tree (const char *msg, Node_Id node, Entity_Id ent,
extern void post_error_ne_tree_2 (const char *msg, Node_Id node, Entity_Id ent,
tree t, int num);
/* Protect EXP from multiple evaluation. This may make a SAVE_EXPR. */
extern tree protect_multiple_eval (tree exp);
/* Return a label to branch to for the exception type in KIND or NULL_TREE
if none. */
extern tree get_exception_label (char kind);
@ -267,12 +261,6 @@ extern tree get_exception_label (char kind);
called. */
extern Node_Id error_gnat_node;
/* This is equivalent to stabilize_reference in tree.c, but we know how to
handle our own nodes and we take extra arguments. FORCE says whether to
force evaluation of everything. We set SUCCESS to true unless we walk
through something we don't know how to stabilize. */
extern tree maybe_stabilize_reference (tree ref, bool force, bool *success);
/* Highest number in the front-end node table. */
extern int max_gnat_nodes;
@ -875,6 +863,21 @@ extern tree fill_vms_descriptor (tree expr, Entity_Id gnat_formal,
should not be allocated in a register. Returns true if successful. */
extern bool gnat_mark_addressable (tree t);
/* Save EXP for later use or reuse. This is equivalent to save_expr in tree.c
but we know how to handle our own nodes. */
extern tree gnat_save_expr (tree exp);
/* Protect EXP for immediate reuse. This is a variant of gnat_save_expr that
is optimized under the assumption that EXP's value doesn't change before
its subsequent reuse(s) except through its potential reevaluation. */
extern tree gnat_protect_expr (tree exp);
/* This is equivalent to stabilize_reference in tree.c but we know how to
handle our own nodes and we take extra arguments. FORCE says whether to
force evaluation of everything. We set SUCCESS to true unless we walk
through something we don't know how to stabilize. */
extern tree gnat_stabilize_reference (tree ref, bool force, bool *success);
/* Implementation of the builtin_function langhook. */
extern tree gnat_builtin_function (tree decl);

View File

@ -214,8 +214,6 @@ static tree assoc_to_constructor (Entity_Id, Node_Id, tree);
static tree extract_values (tree, tree);
static tree pos_to_constructor (Node_Id, tree, Entity_Id);
static tree maybe_implicit_deref (tree);
static tree gnat_stabilize_reference (tree, bool);
static tree gnat_stabilize_reference_1 (tree, bool);
static void set_expr_location_from_node (tree, Node_Id);
static int lvalue_required_p (Node_Id, tree, bool, bool);
@ -1128,7 +1126,7 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute)
if (Do_Range_Check (First (Expressions (gnat_node))))
{
gnu_expr = protect_multiple_eval (gnu_expr);
gnu_expr = gnat_protect_expr (gnu_expr);
gnu_expr
= emit_check
(build_binary_op (EQ_EXPR, integer_type_node,
@ -2492,7 +2490,7 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
??? This is more conservative than we need since we don't need to do
this for pass-by-ref with no conversion. */
if (Ekind (gnat_formal) != E_In_Parameter)
gnu_name = gnat_stabilize_reference (gnu_name, true);
gnu_name = gnat_stabilize_reference (gnu_name, true, NULL);
/* If we are passing a non-addressable parameter by reference, pass the
address of a copy. In the Out or In Out case, set up to copy back
@ -2555,10 +2553,9 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
gnu_name_type)))
gnu_name = convert (gnu_name_type, gnu_name);
/* Make a SAVE_EXPR to both properly account for potential side
effects and handle the creation of a temporary. Special code
in gnat_gimplify_expr ensures that the same temporary is used
as the object and copied back after the call if needed. */
/* Make a SAVE_EXPR to force the creation of a temporary. Special
code in gnat_gimplify_expr ensures that the same temporary is
used as the object and copied back after the call if needed. */
gnu_name = build1 (SAVE_EXPR, TREE_TYPE (gnu_name), gnu_name);
TREE_SIDE_EFFECTS (gnu_name) = 1;
@ -3722,7 +3719,7 @@ gnat_to_gnu (Node_Id gnat_node)
gnu_expr, false, Is_Public (gnat_temp),
false, false, NULL, gnat_temp);
else
gnu_expr = maybe_variable (gnu_expr);
gnu_expr = gnat_save_expr (gnu_expr);
save_gnu_tree (gnat_node, gnu_expr, true);
}
@ -3886,8 +3883,8 @@ gnat_to_gnu (Node_Id gnat_node)
(TYPE_MAX_VALUE (gnu_base_index_type), gnu_result);
tree gnu_expr_l, gnu_expr_h, gnu_expr_type;
gnu_min_expr = protect_multiple_eval (gnu_min_expr);
gnu_max_expr = protect_multiple_eval (gnu_max_expr);
gnu_min_expr = gnat_protect_expr (gnu_min_expr);
gnu_max_expr = gnat_protect_expr (gnu_max_expr);
/* Derive a good type to convert everything to. */
gnu_expr_type = get_base_type (gnu_index_type);
@ -3989,7 +3986,7 @@ gnat_to_gnu (Node_Id gnat_node)
? Designated_Type (Etype
(Prefix (gnat_node)))
: Etype (Prefix (gnat_node))))
gnu_prefix = gnat_stabilize_reference (gnu_prefix, false);
gnu_prefix = gnat_stabilize_reference (gnu_prefix, false, NULL);
gnu_result
= build_component_ref (gnu_prefix, NULL_TREE, gnu_field,
@ -4177,7 +4174,7 @@ gnat_to_gnu (Node_Id gnat_node)
else
{
tree t1, t2;
gnu_obj = protect_multiple_eval (gnu_obj);
gnu_obj = gnat_protect_expr (gnu_obj);
t1 = build_binary_op (GE_EXPR, gnu_result_type, gnu_obj, gnu_low);
if (EXPR_P (t1))
set_expr_location_from_node (t1, gnat_node);
@ -5293,7 +5290,7 @@ gnat_to_gnu (Node_Id gnat_node)
if (TREE_SIDE_EFFECTS (gnu_result)
&& (TREE_CODE (gnu_result_type) == UNCONSTRAINED_ARRAY_TYPE
|| CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_result_type))))
gnu_result = gnat_stabilize_reference (gnu_result, false);
gnu_result = gnat_stabilize_reference (gnu_result, false, NULL);
/* Now convert the result to the result type, unless we are in one of the
following cases:
@ -6272,7 +6269,7 @@ build_unary_op_trapv (enum tree_code code, tree gnu_type, tree operand,
{
gcc_assert (code == NEGATE_EXPR || code == ABS_EXPR);
operand = protect_multiple_eval (operand);
operand = gnat_protect_expr (operand);
return emit_check (build_binary_op (EQ_EXPR, integer_type_node,
operand, TYPE_MIN_VALUE (gnu_type)),
@ -6291,8 +6288,8 @@ static tree
build_binary_op_trapv (enum tree_code code, tree gnu_type, tree left,
tree right, Node_Id gnat_node)
{
tree lhs = protect_multiple_eval (left);
tree rhs = protect_multiple_eval (right);
tree lhs = gnat_protect_expr (left);
tree rhs = gnat_protect_expr (right);
tree type_max = TYPE_MAX_VALUE (gnu_type);
tree type_min = TYPE_MIN_VALUE (gnu_type);
tree gnu_expr;
@ -6488,7 +6485,7 @@ emit_range_check (tree gnu_expr, Entity_Id gnat_range_type, Node_Id gnat_node)
return gnu_expr;
/* Checked expressions must be evaluated only once. */
gnu_expr = protect_multiple_eval (gnu_expr);
gnu_expr = gnat_protect_expr (gnu_expr);
/* There's no good type to use here, so we might as well use
integer_type_node. Note that the form of the check is
@ -6528,7 +6525,7 @@ emit_index_check (tree gnu_array_object, tree gnu_expr, tree gnu_low,
tree gnu_expr_check;
/* Checked expressions must be evaluated only once. */
gnu_expr = protect_multiple_eval (gnu_expr);
gnu_expr = gnat_protect_expr (gnu_expr);
/* Must do this computation in the base type in case the expression's
type is an unsigned subtypes. */
@ -6619,7 +6616,7 @@ convert_with_check (Entity_Id gnat_type, tree gnu_expr, bool overflowp,
&& !(FLOAT_TYPE_P (gnu_base_type) && INTEGRAL_TYPE_P (gnu_in_basetype)))
{
/* Ensure GNU_EXPR only gets evaluated once. */
tree gnu_input = protect_multiple_eval (gnu_result);
tree gnu_input = gnat_protect_expr (gnu_result);
tree gnu_cond = integer_zero_node;
tree gnu_in_lb = TYPE_MIN_VALUE (gnu_in_basetype);
tree gnu_in_ub = TYPE_MAX_VALUE (gnu_in_basetype);
@ -6728,7 +6725,7 @@ convert_with_check (Entity_Id gnat_type, tree gnu_expr, bool overflowp,
conversion of the input to the calc_type (if necessary). */
gnu_zero = convert (gnu_in_basetype, integer_zero_node);
gnu_result = protect_multiple_eval (gnu_result);
gnu_result = gnat_protect_expr (gnu_result);
gnu_conv = convert (calc_type, gnu_result);
gnu_comp
= fold_build2 (GE_EXPR, integer_type_node, gnu_result, gnu_zero);
@ -7191,265 +7188,6 @@ maybe_implicit_deref (tree exp)
return exp;
}
/* Protect EXP from multiple evaluation. This may make a SAVE_EXPR. */
tree
protect_multiple_eval (tree exp)
{
tree type = TREE_TYPE (exp);
enum tree_code code = TREE_CODE (exp);
/* If EXP has no side effects, we theoritically don't need to do anything.
However, we may be recursively passed more and more complex expressions
involving checks which will be reused multiple times and eventually be
unshared for gimplification; in order to avoid a complexity explosion
at that point, we protect any expressions more complex than a simple
arithmetic expression. */
if (!TREE_SIDE_EFFECTS (exp)
&& (CONSTANT_CLASS_P (exp)
|| !EXPRESSION_CLASS_P (skip_simple_arithmetic (exp))))
return exp;
/* If this is a conversion, protect what's inside the conversion.
Similarly, if we're indirectly referencing something, we only
need to protect the address since the data itself can't change
in these situations. */
if (code == NON_LVALUE_EXPR
|| CONVERT_EXPR_CODE_P (code)
|| code == VIEW_CONVERT_EXPR
|| code == INDIRECT_REF
|| code == UNCONSTRAINED_ARRAY_REF)
return build1 (code, type, protect_multiple_eval (TREE_OPERAND (exp, 0)));
/* If this is a COMPONENT_REF of a fat pointer, save the entire fat pointer.
This may be more efficient, but will also allow us to more easily find
the match for the PLACEHOLDER_EXPR. */
if (code == COMPONENT_REF
&& TYPE_IS_FAT_POINTER_P (TREE_TYPE (TREE_OPERAND (exp, 0))))
return build3 (code, type, protect_multiple_eval (TREE_OPERAND (exp, 0)),
TREE_OPERAND (exp, 1), TREE_OPERAND (exp, 2));
/* If this is a fat pointer or something that can be placed in a register,
just make a SAVE_EXPR. Likewise for a CALL_EXPR as large objects are
returned via invisible reference in most ABIs so the temporary will
directly be filled by the callee. */
if (TYPE_IS_FAT_POINTER_P (type)
|| TYPE_MODE (type) != BLKmode
|| code == CALL_EXPR)
return save_expr (exp);
/* Otherwise reference, protect the address and dereference. */
return
build_unary_op (INDIRECT_REF, type,
save_expr (build_unary_op (ADDR_EXPR,
build_reference_type (type),
exp)));
}
/* This is equivalent to stabilize_reference in tree.c, but we know how to
handle our own nodes and we take extra arguments. FORCE says whether to
force evaluation of everything. We set SUCCESS to true unless we walk
through something we don't know how to stabilize. */
tree
maybe_stabilize_reference (tree ref, bool force, bool *success)
{
tree type = TREE_TYPE (ref);
enum tree_code code = TREE_CODE (ref);
tree result;
/* Assume we'll success unless proven otherwise. */
*success = true;
switch (code)
{
case CONST_DECL:
case VAR_DECL:
case PARM_DECL:
case RESULT_DECL:
/* No action is needed in this case. */
return ref;
case ADDR_EXPR:
CASE_CONVERT:
case FLOAT_EXPR:
case FIX_TRUNC_EXPR:
case VIEW_CONVERT_EXPR:
result
= build1 (code, type,
maybe_stabilize_reference (TREE_OPERAND (ref, 0), force,
success));
break;
case INDIRECT_REF:
case UNCONSTRAINED_ARRAY_REF:
result = build1 (code, type,
gnat_stabilize_reference_1 (TREE_OPERAND (ref, 0),
force));
break;
case COMPONENT_REF:
result = build3 (COMPONENT_REF, type,
maybe_stabilize_reference (TREE_OPERAND (ref, 0), force,
success),
TREE_OPERAND (ref, 1), NULL_TREE);
break;
case BIT_FIELD_REF:
result = build3 (BIT_FIELD_REF, type,
maybe_stabilize_reference (TREE_OPERAND (ref, 0), force,
success),
gnat_stabilize_reference_1 (TREE_OPERAND (ref, 1),
force),
gnat_stabilize_reference_1 (TREE_OPERAND (ref, 2),
force));
break;
case ARRAY_REF:
case ARRAY_RANGE_REF:
result = build4 (code, type,
maybe_stabilize_reference (TREE_OPERAND (ref, 0), force,
success),
gnat_stabilize_reference_1 (TREE_OPERAND (ref, 1),
force),
NULL_TREE, NULL_TREE);
break;
case CALL_EXPR:
case COMPOUND_EXPR:
result = gnat_stabilize_reference_1 (ref, force);
break;
case CONSTRUCTOR:
/* Constructors with 1 element are used extensively to formally
convert objects to special wrapping types. */
if (TREE_CODE (type) == RECORD_TYPE
&& VEC_length (constructor_elt, CONSTRUCTOR_ELTS (ref)) == 1)
{
tree index
= VEC_index (constructor_elt, CONSTRUCTOR_ELTS (ref), 0)->index;
tree value
= VEC_index (constructor_elt, CONSTRUCTOR_ELTS (ref), 0)->value;
result
= build_constructor_single (type, index,
gnat_stabilize_reference_1 (value,
force));
}
else
{
*success = false;
return ref;
}
break;
case ERROR_MARK:
ref = error_mark_node;
/* ... fall through to failure ... */
/* If arg isn't a kind of lvalue we recognize, make no change.
Caller should recognize the error for an invalid lvalue. */
default:
*success = false;
return ref;
}
/* TREE_THIS_VOLATILE and TREE_SIDE_EFFECTS set on the initial expression
may not be sustained across some paths, such as the way via build1 for
INDIRECT_REF. We reset those flags here in the general case, which is
consistent with the GCC version of this routine.
Special care should be taken regarding TREE_SIDE_EFFECTS, because some
paths introduce side-effects where there was none initially (e.g. if a
SAVE_EXPR is built) and we also want to keep track of that. */
TREE_READONLY (result) = TREE_READONLY (ref);
TREE_SIDE_EFFECTS (result) |= TREE_SIDE_EFFECTS (ref);
TREE_THIS_VOLATILE (result) = TREE_THIS_VOLATILE (ref);
return result;
}
/* Wrapper around maybe_stabilize_reference, for common uses without lvalue
restrictions and without the need to examine the success indication. */
static tree
gnat_stabilize_reference (tree ref, bool force)
{
bool dummy;
return maybe_stabilize_reference (ref, force, &dummy);
}
/* Similar to stabilize_reference_1 in tree.c, but supports an extra
arg to force a SAVE_EXPR for everything. */
static tree
gnat_stabilize_reference_1 (tree e, bool force)
{
enum tree_code code = TREE_CODE (e);
tree type = TREE_TYPE (e);
tree result;
/* We cannot ignore const expressions because it might be a reference
to a const array but whose index contains side-effects. But we can
ignore things that are actual constant or that already have been
handled by this function. */
if (TREE_CONSTANT (e) || code == SAVE_EXPR)
return e;
switch (TREE_CODE_CLASS (code))
{
case tcc_exceptional:
case tcc_declaration:
case tcc_comparison:
case tcc_expression:
case tcc_reference:
case tcc_vl_exp:
/* If this is a COMPONENT_REF of a fat pointer, save the entire
fat pointer. This may be more efficient, but will also allow
us to more easily find the match for the PLACEHOLDER_EXPR. */
if (code == COMPONENT_REF
&& TYPE_IS_FAT_POINTER_P (TREE_TYPE (TREE_OPERAND (e, 0))))
result
= build3 (code, type,
gnat_stabilize_reference_1 (TREE_OPERAND (e, 0), force),
TREE_OPERAND (e, 1), TREE_OPERAND (e, 2));
/* If the expression has side-effects, then encase it in a SAVE_EXPR
so that it will only be evaluated once. */
/* The tcc_reference and tcc_comparison classes could be handled as
below, but it is generally faster to only evaluate them once. */
else if (TREE_SIDE_EFFECTS (e) || force)
return save_expr (e);
else
return e;
break;
case tcc_binary:
/* Recursively stabilize each operand. */
result
= build2 (code, type,
gnat_stabilize_reference_1 (TREE_OPERAND (e, 0), force),
gnat_stabilize_reference_1 (TREE_OPERAND (e, 1), force));
break;
case tcc_unary:
/* Recursively stabilize each operand. */
result
= build1 (code, type,
gnat_stabilize_reference_1 (TREE_OPERAND (e, 0), force));
break;
default:
gcc_unreachable ();
}
/* See similar handling in maybe_stabilize_reference. */
TREE_READONLY (result) = TREE_READONLY (e);
TREE_SIDE_EFFECTS (result) |= TREE_SIDE_EFFECTS (e);
TREE_THIS_VOLATILE (result) = TREE_THIS_VOLATILE (e);
return result;
}
/* Convert SLOC into LOCUS. Return true if SLOC corresponds to a source code
location and false if it doesn't. In the former case, set the Gigi global
variable REF_FILENAME to the simple debug file name as given by sinput. */

View File

@ -3587,7 +3587,7 @@ convert_to_fat_pointer (tree type, tree expr)
{
tree fields = TYPE_FIELDS (TREE_TYPE (etype));
expr = protect_multiple_eval (expr);
expr = gnat_protect_expr (expr);
if (TREE_CODE (expr) == ADDR_EXPR)
expr = TREE_OPERAND (expr, 0);
else

View File

@ -254,10 +254,10 @@ compare_arrays (tree result_type, tree a1, tree a2)
/* If either operand has side-effects, they have to be evaluated only once
in spite of the multiple references to the operand in the comparison. */
if (a1_side_effects_p)
a1 = protect_multiple_eval (a1);
a1 = gnat_protect_expr (a1);
if (a2_side_effects_p)
a2 = protect_multiple_eval (a2);
a2 = gnat_protect_expr (a2);
/* Process each dimension separately and compare the lengths. If any
dimension has a size known to be zero, set SIZE_ZERO_P to 1 to
@ -471,7 +471,7 @@ nonbinary_modular_operation (enum tree_code op_code, tree type, tree lhs,
/* For subtraction, add the modulus back if we are negative. */
else if (op_code == MINUS_EXPR)
{
result = protect_multiple_eval (result);
result = gnat_protect_expr (result);
result = fold_build3 (COND_EXPR, op_type,
fold_build2 (LT_EXPR, integer_type_node, result,
convert (op_type, integer_zero_node)),
@ -482,7 +482,7 @@ nonbinary_modular_operation (enum tree_code op_code, tree type, tree lhs,
/* For the other operations, subtract the modulus if we are >= it. */
else
{
result = protect_multiple_eval (result);
result = gnat_protect_expr (result);
result = fold_build3 (COND_EXPR, op_type,
fold_build2 (GE_EXPR, integer_type_node,
result, modulus),
@ -1800,7 +1800,7 @@ maybe_wrap_malloc (tree data_size, tree data_type, Node_Id gnat_node)
{
/* Latch malloc's return value and get a pointer to the aligning field
first. */
tree storage_ptr = protect_multiple_eval (malloc_ptr);
tree storage_ptr = gnat_protect_expr (malloc_ptr);
tree aligning_record_addr
= convert (build_pointer_type (aligning_type), storage_ptr);
@ -1961,7 +1961,7 @@ build_allocator (tree type, tree init, tree result_type, Entity_Id gnat_proc,
storage = build_call_alloc_dealloc (NULL_TREE, size, storage_type,
gnat_proc, gnat_pool, gnat_node);
storage = convert (storage_ptr_type, protect_multiple_eval (storage));
storage = convert (storage_ptr_type, gnat_protect_expr (storage));
if (TYPE_IS_PADDING_P (type))
{
@ -2039,7 +2039,7 @@ build_allocator (tree type, tree init, tree result_type, Entity_Id gnat_proc,
and return the address with a COMPOUND_EXPR. */
if (init)
{
result = protect_multiple_eval (result);
result = gnat_protect_expr (result);
result
= build2 (COMPOUND_EXPR, TREE_TYPE (result),
build_binary_op
@ -2147,3 +2147,293 @@ gnat_mark_addressable (tree t)
return true;
}
}
/* Save EXP for later use or reuse. This is equivalent to save_expr in tree.c
but we know how to handle our own nodes. */
tree
gnat_save_expr (tree exp)
{
tree type = TREE_TYPE (exp);
enum tree_code code = TREE_CODE (exp);
if (TREE_CONSTANT (exp) || code == SAVE_EXPR || code == NULL_EXPR)
return exp;
if (code == UNCONSTRAINED_ARRAY_REF)
{
tree t = build1 (code, type, gnat_save_expr (TREE_OPERAND (exp, 0)));
TREE_READONLY (t) = TYPE_READONLY (type);
return t;
}
/* If this is a COMPONENT_REF of a fat pointer, save the entire fat pointer.
This may be more efficient, but will also allow us to more easily find
the match for the PLACEHOLDER_EXPR. */
if (code == COMPONENT_REF
&& TYPE_IS_FAT_POINTER_P (TREE_TYPE (TREE_OPERAND (exp, 0))))
return build3 (code, type, gnat_save_expr (TREE_OPERAND (exp, 0)),
TREE_OPERAND (exp, 1), TREE_OPERAND (exp, 2));
return save_expr (exp);
}
/* Protect EXP for immediate reuse. This is a variant of gnat_save_expr that
is optimized under the assumption that EXP's value doesn't change before
its subsequent reuse(s) except through its potential reevaluation. */
tree
gnat_protect_expr (tree exp)
{
tree type = TREE_TYPE (exp);
enum tree_code code = TREE_CODE (exp);
if (TREE_CONSTANT (exp) || code == SAVE_EXPR || code == NULL_EXPR)
return exp;
/* If EXP has no side effects, we theoritically don't need to do anything.
However, we may be recursively passed more and more complex expressions
involving checks which will be reused multiple times and eventually be
unshared for gimplification; in order to avoid a complexity explosion
at that point, we protect any expressions more complex than a simple
arithmetic expression. */
if (!TREE_SIDE_EFFECTS (exp)
&& !EXPRESSION_CLASS_P (skip_simple_arithmetic (exp)))
return exp;
/* If this is a conversion, protect what's inside the conversion. */
if (code == NON_LVALUE_EXPR
|| CONVERT_EXPR_CODE_P (code)
|| code == VIEW_CONVERT_EXPR)
return build1 (code, type, gnat_protect_expr (TREE_OPERAND (exp, 0)));
/* If we're indirectly referencing something, we only need to protect the
address since the data itself can't change in these situations. */
if (code == INDIRECT_REF || code == UNCONSTRAINED_ARRAY_REF)
{
tree t = build1 (code, type, gnat_protect_expr (TREE_OPERAND (exp, 0)));
TREE_READONLY (t) = TYPE_READONLY (type);
return t;
}
/* If this is a COMPONENT_REF of a fat pointer, save the entire fat pointer.
This may be more efficient, but will also allow us to more easily find
the match for the PLACEHOLDER_EXPR. */
if (code == COMPONENT_REF
&& TYPE_IS_FAT_POINTER_P (TREE_TYPE (TREE_OPERAND (exp, 0))))
return build3 (code, type, gnat_protect_expr (TREE_OPERAND (exp, 0)),
TREE_OPERAND (exp, 1), TREE_OPERAND (exp, 2));
/* If this is a fat pointer or something that can be placed in a register,
just make a SAVE_EXPR. Likewise for a CALL_EXPR as large objects are
returned via invisible reference in most ABIs so the temporary will
directly be filled by the callee. */
if (TYPE_IS_FAT_POINTER_P (type)
|| TYPE_MODE (type) != BLKmode
|| code == CALL_EXPR)
return save_expr (exp);
/* Otherwise reference, protect the address and dereference. */
return
build_unary_op (INDIRECT_REF, type,
save_expr (build_unary_op (ADDR_EXPR,
build_reference_type (type),
exp)));
}
/* This is equivalent to stabilize_reference_1 in tree.c but we take an extra
argument to force evaluation of everything. */
static tree
gnat_stabilize_reference_1 (tree e, bool force)
{
enum tree_code code = TREE_CODE (e);
tree type = TREE_TYPE (e);
tree result;
/* We cannot ignore const expressions because it might be a reference
to a const array but whose index contains side-effects. But we can
ignore things that are actual constant or that already have been
handled by this function. */
if (TREE_CONSTANT (e) || code == SAVE_EXPR)
return e;
switch (TREE_CODE_CLASS (code))
{
case tcc_exceptional:
case tcc_declaration:
case tcc_comparison:
case tcc_expression:
case tcc_reference:
case tcc_vl_exp:
/* If this is a COMPONENT_REF of a fat pointer, save the entire
fat pointer. This may be more efficient, but will also allow
us to more easily find the match for the PLACEHOLDER_EXPR. */
if (code == COMPONENT_REF
&& TYPE_IS_FAT_POINTER_P (TREE_TYPE (TREE_OPERAND (e, 0))))
result
= build3 (code, type,
gnat_stabilize_reference_1 (TREE_OPERAND (e, 0), force),
TREE_OPERAND (e, 1), TREE_OPERAND (e, 2));
/* If the expression has side-effects, then encase it in a SAVE_EXPR
so that it will only be evaluated once. */
/* The tcc_reference and tcc_comparison classes could be handled as
below, but it is generally faster to only evaluate them once. */
else if (TREE_SIDE_EFFECTS (e) || force)
return save_expr (e);
else
return e;
break;
case tcc_binary:
/* Recursively stabilize each operand. */
result
= build2 (code, type,
gnat_stabilize_reference_1 (TREE_OPERAND (e, 0), force),
gnat_stabilize_reference_1 (TREE_OPERAND (e, 1), force));
break;
case tcc_unary:
/* Recursively stabilize each operand. */
result
= build1 (code, type,
gnat_stabilize_reference_1 (TREE_OPERAND (e, 0), force));
break;
default:
gcc_unreachable ();
}
/* See similar handling in gnat_stabilize_reference. */
TREE_READONLY (result) = TREE_READONLY (e);
TREE_SIDE_EFFECTS (result) |= TREE_SIDE_EFFECTS (e);
TREE_THIS_VOLATILE (result) = TREE_THIS_VOLATILE (e);
return result;
}
/* This is equivalent to stabilize_reference in tree.c but we know how to
handle our own nodes and we take extra arguments. FORCE says whether to
force evaluation of everything. We set SUCCESS to true unless we walk
through something we don't know how to stabilize. */
tree
gnat_stabilize_reference (tree ref, bool force, bool *success)
{
tree type = TREE_TYPE (ref);
enum tree_code code = TREE_CODE (ref);
tree result;
/* Assume we'll success unless proven otherwise. */
if (success)
*success = true;
switch (code)
{
case CONST_DECL:
case VAR_DECL:
case PARM_DECL:
case RESULT_DECL:
/* No action is needed in this case. */
return ref;
case ADDR_EXPR:
CASE_CONVERT:
case FLOAT_EXPR:
case FIX_TRUNC_EXPR:
case VIEW_CONVERT_EXPR:
result
= build1 (code, type,
gnat_stabilize_reference (TREE_OPERAND (ref, 0), force,
success));
break;
case INDIRECT_REF:
case UNCONSTRAINED_ARRAY_REF:
result = build1 (code, type,
gnat_stabilize_reference_1 (TREE_OPERAND (ref, 0),
force));
break;
case COMPONENT_REF:
result = build3 (COMPONENT_REF, type,
gnat_stabilize_reference (TREE_OPERAND (ref, 0), force,
success),
TREE_OPERAND (ref, 1), NULL_TREE);
break;
case BIT_FIELD_REF:
result = build3 (BIT_FIELD_REF, type,
gnat_stabilize_reference (TREE_OPERAND (ref, 0), force,
success),
gnat_stabilize_reference_1 (TREE_OPERAND (ref, 1),
force),
gnat_stabilize_reference_1 (TREE_OPERAND (ref, 2),
force));
break;
case ARRAY_REF:
case ARRAY_RANGE_REF:
result = build4 (code, type,
gnat_stabilize_reference (TREE_OPERAND (ref, 0), force,
success),
gnat_stabilize_reference_1 (TREE_OPERAND (ref, 1),
force),
NULL_TREE, NULL_TREE);
break;
case CALL_EXPR:
case COMPOUND_EXPR:
result = gnat_stabilize_reference_1 (ref, force);
break;
case CONSTRUCTOR:
/* Constructors with 1 element are used extensively to formally
convert objects to special wrapping types. */
if (TREE_CODE (type) == RECORD_TYPE
&& VEC_length (constructor_elt, CONSTRUCTOR_ELTS (ref)) == 1)
{
tree index
= VEC_index (constructor_elt, CONSTRUCTOR_ELTS (ref), 0)->index;
tree value
= VEC_index (constructor_elt, CONSTRUCTOR_ELTS (ref), 0)->value;
result
= build_constructor_single (type, index,
gnat_stabilize_reference_1 (value,
force));
}
else
{
if (success)
*success = false;
return ref;
}
break;
case ERROR_MARK:
ref = error_mark_node;
/* ... fall through to failure ... */
/* If arg isn't a kind of lvalue we recognize, make no change.
Caller should recognize the error for an invalid lvalue. */
default:
if (success)
*success = false;
return ref;
}
/* TREE_THIS_VOLATILE and TREE_SIDE_EFFECTS set on the initial expression
may not be sustained across some paths, such as the way via build1 for
INDIRECT_REF. We reset those flags here in the general case, which is
consistent with the GCC version of this routine.
Special care should be taken regarding TREE_SIDE_EFFECTS, because some
paths introduce side-effects where there was none initially (e.g. if a
SAVE_EXPR is built) and we also want to keep track of that. */
TREE_READONLY (result) = TREE_READONLY (ref);
TREE_SIDE_EFFECTS (result) |= TREE_SIDE_EFFECTS (ref);
TREE_THIS_VOLATILE (result) = TREE_THIS_VOLATILE (ref);
return result;
}