-/* Protect EXP from multiple evaluation. This may make a SAVE_EXPR. */
-
-tree
-protect_multiple_eval (tree exp)
-{
- tree type = TREE_TYPE (exp);
-
- /* If this has no side effects, we don't need to do anything. */
- if (!TREE_SIDE_EFFECTS (exp))
- return exp;
-
- /* If it is a conversion, protect what's inside the conversion.
- Similarly, if we're indirectly referencing something, we only
- actually need to protect the address since the data itself can't
- change in these situations. */
- else if (TREE_CODE (exp) == NON_LVALUE_EXPR
- || CONVERT_EXPR_P (exp)
- || TREE_CODE (exp) == VIEW_CONVERT_EXPR
- || TREE_CODE (exp) == INDIRECT_REF
- || TREE_CODE (exp) == UNCONSTRAINED_ARRAY_REF)
- return build1 (TREE_CODE (exp), type,
- protect_multiple_eval (TREE_OPERAND (exp, 0)));
-
- /* If EXP is a fat pointer or something that can be placed into a register,
- just make a SAVE_EXPR. */
- if (TYPE_FAT_POINTER_P (type) || TYPE_MODE (type) != BLKmode)
- return save_expr (exp);
-
- /* Otherwise, dereference, protect the address, and re-reference. */
- else
- 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 COMPOUND_EXPR:
- result = gnat_stabilize_reference_1 (ref, force);
- break;
-
- case CALL_EXPR:
- /* This generates better code than the scheme in protect_multiple_eval
- because large objects will be returned via invisible reference in
- most ABIs so the temporary will directly be filled by the callee. */
- 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_READONLY (result) = TREE_READONLY (ref);
-
- /* TREE_THIS_VOLATILE and TREE_SIDE_EFFECTS attached to the initial
- expression may not be sustained across some paths, such as the way via
- build1 for INDIRECT_REF. We re-populate those flags here for 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. calls
- to save_expr), and we also want to keep track of that. */
-
- TREE_THIS_VOLATILE (result) = TREE_THIS_VOLATILE (ref);
- TREE_SIDE_EFFECTS (result) |= TREE_SIDE_EFFECTS (ref);
-
- return result;
-}
-
-/* Wrapper around maybe_stabilize_reference, for common uses without
- lvalue restrictions and without 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_type:
- case tcc_declaration:
- case tcc_comparison:
- case tcc_statement:
- 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_FAT_POINTER_P (TREE_TYPE (TREE_OPERAND (e, 0))))
- result = build3 (COMPONENT_REF, type,
- gnat_stabilize_reference_1 (TREE_OPERAND (e, 0),
- force),
- TREE_OPERAND (e, 1), TREE_OPERAND (e, 2));
- else if (TREE_SIDE_EFFECTS (e) || force)
- return save_expr (e);
- else
- return e;
- break;
-
- case tcc_constant:
- /* Constants need no processing. In fact, we should never reach
- here. */
- return e;
-
- 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 ();
- }
-
- TREE_READONLY (result) = TREE_READONLY (e);
-
- TREE_THIS_VOLATILE (result) = TREE_THIS_VOLATILE (e);
- TREE_SIDE_EFFECTS (result) |= TREE_SIDE_EFFECTS (e);
- return result;
-}
-\f