From 7194767cdf77212e8c736f41b426e3f636f52ca3 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Tue, 26 May 2015 19:18:15 +0000 Subject: [PATCH] gigi.h (gnat_stabilize_reference): Adjust prototype. * gcc-interface/gigi.h (gnat_stabilize_reference): Adjust prototype. * gcc-interface/decl.c (gnat_to_gnu_entity): Do not rely on const_flag to detect constant renamings. Be prepared for specific pattern of renamed object based on function calls. Create a constant object for the renaming of a NULL_EXPR or of a CONSTRUCTOR. Adjust calls to gnat_stabilize_reference and tidy up. Remove redundant tests. (elaborate_expression_1): Remove obsolete test and tidy up. * gcc-interface/trans.c (Call_to_gnu): Do not stabilize In/Out or Out parameters passed by reference. (gnat_to_gnu) : Remove redundant protection again side-effects. Use gnat_protect_expr instead of gnat_stabilize_reference for general protection against side-effects. * gcc-interface/utils2.c (gnat_stable_expr_p): New predicate. (gnat_save_expr): Invoke it. (gnat_protect_expr): Likewise. (gnat_stabilize_reference_1): Likewise. Remove useless propagation of TREE_THIS_NOTRAP. (gnat_stabilize_reference): Remove parameter and adjust throughout. Delete ADDR_EXDR, COMPOUND_EXPR and CONSTRUCTOR cases. Restrict CALL_EXPR case to atomic loads and tweak ERROR_MARK case. From-SVN: r223708 --- gcc/ada/ChangeLog | 24 ++++ gcc/ada/gcc-interface/decl.c | 195 ++++++++++++--------------------- gcc/ada/gcc-interface/gigi.h | 5 +- gcc/ada/gcc-interface/trans.c | 21 +--- gcc/ada/gcc-interface/utils2.c | 121 ++++++++------------ 5 files changed, 148 insertions(+), 218 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index f30ae12eb28..951d64cff97 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,27 @@ +2015-05-26 Eric Botcazou + + * gcc-interface/gigi.h (gnat_stabilize_reference): Adjust prototype. + * gcc-interface/decl.c (gnat_to_gnu_entity): Do not rely on const_flag + to detect constant renamings. Be prepared for specific pattern of + renamed object based on function calls. Create a constant object + for the renaming of a NULL_EXPR or of a CONSTRUCTOR. Adjust calls + to gnat_stabilize_reference and tidy up. Remove redundant tests. + (elaborate_expression_1): Remove obsolete test and tidy up. + * gcc-interface/trans.c (Call_to_gnu): Do not stabilize In/Out or Out + parameters passed by reference. + (gnat_to_gnu) : Remove redundant protection again + side-effects. + Use gnat_protect_expr instead of gnat_stabilize_reference for general + protection against side-effects. + * gcc-interface/utils2.c (gnat_stable_expr_p): New predicate. + (gnat_save_expr): Invoke it. + (gnat_protect_expr): Likewise. + (gnat_stabilize_reference_1): Likewise. Remove useless propagation + of TREE_THIS_NOTRAP. + (gnat_stabilize_reference): Remove parameter and adjust throughout. + Delete ADDR_EXDR, COMPOUND_EXPR and CONSTRUCTOR cases. + Restrict CALL_EXPR case to atomic loads and tweak ERROR_MARK case. + 2015-05-26 Ed Schonberg * sinfo.ads: Minor reformatting. diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 2d803fa5eb8..0a1f58aaa95 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -955,13 +955,12 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) } /* If this is a renaming, avoid as much as possible to create a new - object. However, in several cases, creating it is required. - This processing needs to be applied to the raw expression so - as to make it more likely to rename the underlying object. */ + object. However, in some cases, creating it is required because + renaming can be applied to objects that are not names in Ada. + This processing needs to be applied to the raw expression so as + to make it more likely to rename the underlying object. */ if (Present (Renamed_Object (gnat_entity))) { - bool create_normal_object = false; - /* If the renamed object had padding, strip off the reference to the inner object and reset our type. */ if ((TREE_CODE (gnu_expr) == COMPONENT_REF @@ -981,96 +980,76 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) && CONTAINS_PLACEHOLDER_P (TYPE_SIZE (gnu_type))) gnu_type = TREE_TYPE (gnu_expr); - /* Case 1: If this is a constant renaming stemming from a function - call, treat it as a normal object whose initial value is what is - being renamed. RM 3.3 says that the result of evaluating a - function call is a constant object. Treat constant literals - the same way. As a consequence, it can be the inner object of - a constant renaming. In this case, the renaming must be fully - instantiated, i.e. it cannot be a mere reference to (part of) an - existing object. */ - if (const_flag) - { - tree inner_object = gnu_expr; - while (handled_component_p (inner_object)) - inner_object = TREE_OPERAND (inner_object, 0); - if (TREE_CODE (inner_object) == CALL_EXPR - || CONSTANT_CLASS_P (inner_object)) - create_normal_object = true; - } + /* Case 1: if this is a constant renaming stemming from a function + call, treat it as a normal object whose initial value is what + is being renamed. RM 3.3 says that the result of evaluating a + function call is a constant object. Therefore, it can be the + inner object of a constant renaming and the renaming must be + fully instantiated, i.e. it cannot be a reference to (part of) + an existing object. And treat null expressions, constructors + and literals the same way. */ + tree inner = gnu_expr; + while (handled_component_p (inner) || CONVERT_EXPR_P (inner)) + inner = TREE_OPERAND (inner, 0); + /* Expand_Dispatching_Call can prepend a comparison of the tags + before the call to "=". */ + if (TREE_CODE (inner) == TRUTH_ANDIF_EXPR) + inner = TREE_OPERAND (inner, 1); + if (TREE_CODE (inner) == CALL_EXPR + || TREE_CODE (inner) == NULL_EXPR + || TREE_CODE (inner) == CONSTRUCTOR + || CONSTANT_CLASS_P (inner)) + ; - /* Otherwise, see if we can proceed with a stabilized version of - the renamed entity or if we need to make a new object. */ - if (!create_normal_object) + /* Case 2: if the renaming entity need not be materialized, use + the stabilized renamed expression for the renaming. At the + global level, we can do this only if we know no SAVE_EXPRs + need be made, because otherwise the expression would be tied + to a specific elaboration routine. */ + else if (!Materialize_Entity (gnat_entity) + && (!global_bindings_p () + || (staticp (gnu_expr) + && !TREE_SIDE_EFFECTS (gnu_expr)))) { - tree maybe_stable_expr = NULL_TREE; - bool stable = false; - - /* Case 2: If the renaming entity need not be materialized and - the renamed expression is something we can stabilize, use - that for the renaming. At the global level, we can only do - this if we know no SAVE_EXPRs need be made, because the - expression we return might be used in arbitrary conditional - branches so we must force the evaluation of the SAVE_EXPRs - immediately and this requires a proper function context. - Note that an external constant is at the global level. */ - if (!Materialize_Entity (gnat_entity) - && (!((!definition && kind == E_Constant) - || global_bindings_p ()) - || (staticp (gnu_expr) - && !TREE_SIDE_EFFECTS (gnu_expr)))) - { - maybe_stable_expr - = gnat_stabilize_reference (gnu_expr, true, &stable); + gnu_decl = gnat_stabilize_reference (gnu_expr, true); - if (stable) - { - /* ??? No DECL_EXPR is created so we need to mark - the expression manually lest it is shared. */ - if ((!definition && kind == E_Constant) - || global_bindings_p ()) - MARK_VISITED (maybe_stable_expr); - gnu_decl = maybe_stable_expr; - save_gnu_tree (gnat_entity, gnu_decl, true); - saved = true; - annotate_object (gnat_entity, gnu_type, NULL_TREE, - false); - /* This assertion will fail if the renamed object - isn't aligned enough as to make it possible to - honor the alignment set on the renaming. */ - if (align) - { - unsigned int renamed_align - = DECL_P (gnu_decl) - ? DECL_ALIGN (gnu_decl) - : TYPE_ALIGN (TREE_TYPE (gnu_decl)); - gcc_assert (renamed_align >= align); - } - break; - } + /* ??? No DECL_EXPR is created so we need to mark + the expression manually lest it is shared. */ + if (global_bindings_p ()) + MARK_VISITED (gnu_decl); - /* The stabilization failed. Keep maybe_stable_expr - untouched here to let the pointer case below know - about that failure. */ + /* This assertion will fail if the renamed object isn't + aligned enough as to make it possible to honor the + alignment set on the renaming. */ + if (align) + { + unsigned int ralign = DECL_P (gnu_decl) + ? DECL_ALIGN (gnu_decl) + : TYPE_ALIGN (TREE_TYPE (gnu_decl)); + gcc_assert (ralign >= align); } - /* Case 3: Make this into a constant pointer to the object we - are to rename and attach the object to the pointer if it is - something we can stabilize. + save_gnu_tree (gnat_entity, gnu_decl, true); + saved = true; + annotate_object (gnat_entity, gnu_type, NULL_TREE, false); + break; + } - From the proper scope, attached objects will be referenced - directly instead of indirectly via the pointer to avoid - subtle aliasing problems with non-addressable entities. - They have to be stable because we must not evaluate the - variables in the expression every time the renaming is used. - The pointer is called a "renaming" pointer in this case. + /* Case 3: otherwise, make a constant pointer to the object we + are to rename and attach the object to the pointer after it + is stabilized. - In the rare cases where we cannot stabilize the renamed - object, we just make a "bare" pointer and the renamed - object will always be accessed indirectly through it. + From the proper scope, attached objects will be referenced + directly instead of indirectly via the pointer to avoid + subtle aliasing problems with non-addressable entities. + They have to be stable because we must not evaluate the + variables in the expression every time the renaming is used. + The pointer is called a "renaming" pointer in this case. - Note that we need to preserve the volatility of the renamed - object through the indirection. */ + Note that we need to preserve the volatility of the renamed + object through the indirection. */ + else + { if (TREE_THIS_VOLATILE (gnu_expr) && !TYPE_VOLATILE (gnu_type)) gnu_type = change_qualified_type (gnu_type, TYPE_QUAL_VOLATILE); @@ -1078,15 +1057,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) inner_const_flag = TREE_READONLY (gnu_expr); const_flag = true; - /* If the previous attempt at stabilizing failed, there is - no point in trying again and we reuse the result without - attaching it to the pointer. In this case it will only - be used as the initializing expression of the pointer and - thus needs no special treatment with regard to multiple - evaluations. - - Otherwise, try to stabilize and attach the expression to - the pointer if the stabilization succeeds. + /* Stabilize and attach the expression to the pointer. Note that this might introduce SAVE_EXPRs and we don't check whether we are at the global level or not. This @@ -1100,21 +1071,14 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) non-global case or the elaboration code for the global case, and will be attached to the elaboration procedure in the latter case. */ - if (!maybe_stable_expr) - { - maybe_stable_expr - = gnat_stabilize_reference (gnu_expr, true, &stable); - - if (stable) - renamed_obj = maybe_stable_expr; - } + renamed_obj = gnat_stabilize_reference (gnu_expr, true); if (type_annotate_only - && TREE_CODE (maybe_stable_expr) == ERROR_MARK) + && TREE_CODE (renamed_obj) == ERROR_MARK) gnu_expr = NULL_TREE; else gnu_expr - = build_unary_op (ADDR_EXPR, gnu_type, maybe_stable_expr); + = build_unary_op (ADDR_EXPR, gnu_type, renamed_obj); gnu_size = NULL_TREE; used_by_ref = true; @@ -1519,13 +1483,12 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) /* If this is a renaming pointer, attach the renamed object to it and register it if we are at the global level and the renamed object - is a non-constant reference. Note that an external constant is at - the global level. */ + is a non-constant reference. */ if (renamed_obj) { SET_DECL_RENAMED_OBJECT (gnu_decl, renamed_obj); - if (((!definition && kind == E_Constant) || global_bindings_p ()) + if (global_bindings_p () && !gnat_constant_reference_p (renamed_obj)) { DECL_GLOBAL_NONCONSTANT_RENAMING_P (gnu_decl) = 1; @@ -6197,16 +6160,6 @@ elaborate_expression_1 (tree gnu_expr, Entity_Id gnat_entity, const char *s, const bool expr_global_p = expr_public_p || global_bindings_p (); bool expr_variable_p, use_variable; - /* In most cases, we won't see a naked FIELD_DECL because a discriminant - reference will have been replaced with a COMPONENT_REF when the type - is being elaborated. However, there are some cases involving child - types where we will. So convert it to a COMPONENT_REF. We hope it - will be at the highest level of the expression in these cases. */ - if (TREE_CODE (gnu_expr) == FIELD_DECL) - gnu_expr = build3 (COMPONENT_REF, TREE_TYPE (gnu_expr), - build0 (PLACEHOLDER_EXPR, DECL_CONTEXT (gnu_expr)), - gnu_expr, NULL_TREE); - /* If GNU_EXPR contains a placeholder, just return it. We rely on the fact that an expression cannot contain both a discriminant and a variable. */ if (CONTAINS_PLACEHOLDER_P (gnu_expr)) @@ -6217,14 +6170,12 @@ elaborate_expression_1 (tree gnu_expr, Entity_Id gnat_entity, const char *s, containing the definition is elaborated. If this entity is defined at top level, replace the expression by the variable; otherwise use a SAVE_EXPR if this is necessary. */ - if (CONSTANT_CLASS_P (gnu_expr)) + if (TREE_CONSTANT (gnu_expr)) expr_variable_p = false; else { /* Skip any conversions and simple constant arithmetics to see if the - expression is based on a read-only variable. - ??? This really should remain read-only, but we have to think about - the typing of the tree here. */ + expression is based on a read-only variable. */ tree inner = remove_conversions (gnu_expr, true); inner = skip_simple_constant_arithmetic (inner); diff --git a/gcc/ada/gcc-interface/gigi.h b/gcc/ada/gcc-interface/gigi.h index f817fbc9785..2a964d2139e 100644 --- a/gcc/ada/gcc-interface/gigi.h +++ b/gcc/ada/gcc-interface/gigi.h @@ -965,9 +965,8 @@ 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); + force evaluation of everything. */ +extern tree gnat_stabilize_reference (tree ref, bool force); /* This is equivalent to get_inner_reference in expr.c but it returns the ultimate containing object only if the reference (lvalue) is constant, diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index 2cb830461e8..a506c633d9d 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -4241,11 +4241,11 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target, /* If it's possible we may need to use this expression twice, make sure that any side-effects are handled via SAVE_EXPRs; likewise if we need - to force side-effects before the call. - ??? 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, NULL); + to force side-effects before the call. */ + if (Ekind (gnat_formal) != E_In_Parameter + && !is_by_ref_formal_parm + && TREE_CODE (gnu_name) != NULL_EXPR) + gnu_name = gnat_stabilize_reference (gnu_name, true); /* 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 @@ -6099,14 +6099,6 @@ gnat_to_gnu (Node_Id gnat_node) { gnu_field = gnat_to_gnu_field_decl (gnat_field); - /* If there are discriminants, the prefix might be evaluated more - than once, which is a problem if it has side-effects. */ - if (Has_Discriminants (Is_Access_Type (Etype (Prefix (gnat_node))) - ? Designated_Type (Etype - (Prefix (gnat_node))) - : Etype (Prefix (gnat_node)))) - gnu_prefix = gnat_stabilize_reference (gnu_prefix, false, NULL); - gnu_result = build_component_ref (gnu_prefix, NULL_TREE, gnu_field, (Nkind (Parent (gnat_node)) @@ -7313,7 +7305,6 @@ gnat_to_gnu (Node_Id gnat_node) gets inserted there as well. This ensures that the type elaboration code is issued past the actions computing values on which it might depend. */ - start_stmt_group (); add_stmt_list (Actions (gnat_node)); gnu_expr = gnat_to_gnu (Expression (gnat_node)); @@ -7498,7 +7489,7 @@ gnat_to_gnu (Node_Id gnat_node) && TYPE_IS_PADDING_P (TREE_TYPE (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, NULL); + gnu_result = gnat_protect_expr (gnu_result); /* Now convert the result to the result type, unless we are in one of the following cases: diff --git a/gcc/ada/gcc-interface/utils2.c b/gcc/ada/gcc-interface/utils2.c index 157a18bf297..7f7a30d172b 100644 --- a/gcc/ada/gcc-interface/utils2.c +++ b/gcc/ada/gcc-interface/utils2.c @@ -2563,6 +2563,17 @@ gnat_mark_addressable (tree t) } } +/* Return true if EXP is a stable expression for the purpose of the functions + below and, therefore, can be returned unmodified by them. We accept things + that are actual constants or that have already been handled. */ + +static bool +gnat_stable_expr_p (tree exp) +{ + enum tree_code code = TREE_CODE (exp); + return TREE_CONSTANT (exp) || code == NULL_EXPR || code == SAVE_EXPR; +} + /* 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. */ @@ -2572,7 +2583,7 @@ 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) + if (gnat_stable_expr_p (exp)) return exp; if (code == UNCONSTRAINED_ARRAY_REF) @@ -2603,7 +2614,7 @@ 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) + if (gnat_stable_expr_p (exp)) return exp; /* If EXP has no side effects, we theoretically don't need to do anything. @@ -2669,11 +2680,7 @@ gnat_stabilize_reference_1 (tree e, bool force) 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) + if (gnat_stable_expr_p (e)) return e; switch (TREE_CODE_CLASS (code)) @@ -2722,36 +2729,24 @@ gnat_stabilize_reference_1 (tree e, bool force) 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); - if (code == INDIRECT_REF - || code == UNCONSTRAINED_ARRAY_REF - || code == ARRAY_REF - || code == ARRAY_RANGE_REF) - TREE_THIS_NOTRAP (result) = TREE_THIS_NOTRAP (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. */ + force evaluation of everything. */ tree -gnat_stabilize_reference (tree ref, bool force, bool *success) +gnat_stabilize_reference (tree ref, bool force) { 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: @@ -2761,15 +2756,13 @@ gnat_stabilize_reference (tree ref, bool force, bool *success) /* 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)); + gnat_stabilize_reference (TREE_OPERAND (ref, 0), force)); break; case INDIRECT_REF: @@ -2781,79 +2774,51 @@ gnat_stabilize_reference (tree ref, bool force, bool *success) case COMPONENT_REF: result = build3 (COMPONENT_REF, type, - gnat_stabilize_reference (TREE_OPERAND (ref, 0), force, - success), + gnat_stabilize_reference (TREE_OPERAND (ref, 0), force), 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 (TREE_OPERAND (ref, 0), force), TREE_OPERAND (ref, 1), TREE_OPERAND (ref, 2)); 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); + result + = build4 (code, type, + gnat_stabilize_reference (TREE_OPERAND (ref, 0), force), + gnat_stabilize_reference_1 (TREE_OPERAND (ref, 1), force), + TREE_OPERAND (ref, 2), TREE_OPERAND (ref, 3)); break; case CALL_EXPR: - if (call_is_atomic_load (ref)) - result - = build_call_expr (TREE_OPERAND (CALL_EXPR_FN (ref), 0), 2, - gnat_stabilize_reference (CALL_EXPR_ARG (ref, 0), - force, success), - CALL_EXPR_ARG (ref, 1)); - else - result = gnat_stabilize_reference_1 (ref, force); - break; - - case COMPOUND_EXPR: - result = build2 (COMPOUND_EXPR, type, - gnat_stabilize_reference (TREE_OPERAND (ref, 0), force, - success), - gnat_stabilize_reference (TREE_OPERAND (ref, 1), force, - success)); - break; + { + /* This can only be an atomic load. */ + gcc_assert (call_is_atomic_load (ref)); + + /* An atomic load is an INDIRECT_REF of its first argument. */ + tree t = CALL_EXPR_ARG (ref, 0); + if (TREE_CODE (t) == NOP_EXPR) + t = TREE_OPERAND (t, 0); + if (TREE_CODE (t) == ADDR_EXPR) + t = build1 (ADDR_EXPR, TREE_TYPE (t), + gnat_stabilize_reference (TREE_OPERAND (t, 0), force)); + else + t = gnat_stabilize_reference_1 (t, force); + t = fold_convert (TREE_TYPE (CALL_EXPR_ARG (ref, 0)), t); - case CONSTRUCTOR: - /* Constructors with 1 element are used extensively to formally - convert objects to special wrapping types. */ - if (TREE_CODE (type) == RECORD_TYPE - && vec_safe_length (CONSTRUCTOR_ELTS (ref)) == 1) - { - tree index = (*CONSTRUCTOR_ELTS (ref))[0].index; - tree value = (*CONSTRUCTOR_ELTS (ref))[0].value; - result - = build_constructor_single (type, index, - gnat_stabilize_reference_1 (value, - force)); - } - else - { - if (success) - *success = false; - return ref; - } + result = build_call_expr (TREE_OPERAND (CALL_EXPR_FN (ref), 0), 2, + t, CALL_EXPR_ARG (ref, 1)); + } break; case ERROR_MARK: - ref = error_mark_node; - - /* ... fall through to failure ... */ + return error_mark_node; - /* 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; + gcc_unreachable (); } /* TREE_THIS_VOLATILE and TREE_SIDE_EFFECTS set on the initial expression -- 2.30.2