+/* Protect EXP from multiple evaluation. This may make a SAVE_EXPR. */
+
+tree
+protect_multiple_eval (tree exp)
+{
+ tree type = TREE_TYPE (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 (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 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
+ || TREE_CODE (exp) == 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_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_IS_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