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.
* gcc-interface/decl.c (maybe_variable): Do not set TREE_STATIC on _REF
node. Use the type of the operand to set TREE_READONLY.
&& !TREE_SIDE_EFFECTS (gnu_expr))))
{
maybe_stable_expr
- = maybe_stabilize_reference (gnu_expr, true, &stable);
+ = gnat_stabilize_reference (gnu_expr, true, &stable);
if (stable)
{
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;
}
}
\f
-/* 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);
-}
-\f
/* 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
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;
}
\f
/* Create a record type that contains a SIZE bytes long field of TYPE with a
/* 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
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);
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;
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);
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);
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,
??? 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
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;
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);
}
(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);
? 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,
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);
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:
{
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)),
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;
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
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. */
&& !(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);
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);
return exp;
}
\f
-/* 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)));
-}
-\f
-/* 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;
-}
-\f
/* 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. */
{
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
/* 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
/* 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)),
/* 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),
{
/* 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);
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))
{
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
return true;
}
}
+\f
+/* 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;
+}
OSDN Git Service
