diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/ChangeLog | 19 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/decl.c | 143 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/trans.c | 150 | ||||
| -rw-r--r-- | gcc/ada/gcc-interface/utils.c | 8 |
4 files changed, 198 insertions, 122 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 7f66b56..090f121 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,4 +1,23 @@ 2014-04-15 Eric Botcazou <ebotcazou@adacore.com> + Pierre-Marie de Rodat <derodat@adacore.com> + + * gcc-interface/decl.c (gnat_to_gnu_entity) <object>: Create a mere + scalar constant instead of a reference for renaming of scalar literal. + Do not create a new object for constant renaming except for a function + call. Make sure a VAR_DECL is created for the renaming pointer. + * gcc-interface/trans.c (constant_decl_with_initializer_p): New. + (fold_constant_decl_in_expr): New function. + (Identifier_to_gnu): Use constant_decl_with_initializer_p. + For a constant renaming, try to fold a constant DECL in the result. + (lvalue_required_p) <N_Object_Renaming_Declaration>: Always return 1. + (Identifier_to_gnu): Reference the renamed object of constant renaming + pointers directly. + (Case_Statement_to_gnu): Do not re-fold the bounds of integer types. + Assert that the case values are constant. + * gcc-interface/utils.c (invalidate_global_renaming_pointers): Do not + invalidate constant renaming pointers. + +2014-04-15 Eric Botcazou <ebotcazou@adacore.com> * gcc-interface/utils.c (type_for_vector_element_p): New predicate. (build_vector_type_for_size): New function. diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index aed49b7..7c3f7e5 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -960,18 +960,20 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) 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. 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. */ + 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) + if (TREE_CODE (inner_object) == CALL_EXPR + || CONSTANT_CLASS_P (inner_object)) create_normal_object = true; } @@ -1030,15 +1032,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) about that failure. */ } - /* Case 3: If this is a constant renaming and creating a - new object is allowed and cheap, treat it as a normal - object whose initial value is what is being renamed. */ - if (const_flag - && !Is_Composite_Type - (Underlying_Type (Etype (gnat_entity)))) - ; - - /* Case 4: Make this into a constant pointer to the object we + /* 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. @@ -1050,68 +1044,59 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) The pointer is called a "renaming" pointer in this case. In the rare cases where we cannot stabilize the renamed - object, we just make a "bare" pointer, and the renamed - entity is always accessed indirectly through it. */ - else - { - /* We need to preserve the volatileness of the renamed - object through the indirection. */ - if (TREE_THIS_VOLATILE (gnu_expr) - && !TYPE_VOLATILE (gnu_type)) - gnu_type - = build_qualified_type (gnu_type, - (TYPE_QUALS (gnu_type) - | TYPE_QUAL_VOLATILE)); - gnu_type = build_reference_type (gnu_type); - 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. */ - if (maybe_stable_expr) - ; - - /* Otherwise, try to stabilize and attach the expression - to the pointer if the stabilization succeeds. - - Note that this might introduce SAVE_EXPRs and we don't - check whether we're at the global level or not. This - is fine since we are building a pointer initializer and - neither the pointer nor the initializing expression can - be accessed before the pointer elaboration has taken - place in a correct program. - - These SAVE_EXPRs will be evaluated at the right place - by either the evaluation of the initializer for the - non-global case or the elaboration code for the global - case, and will be attached to the elaboration procedure - in the latter case. */ - else - { - maybe_stable_expr - = gnat_stabilize_reference (gnu_expr, true, &stable); + object, we just make a "bare" pointer and the renamed + object will always be accessed indirectly through it. + + Note that we need to preserve the volatility of the renamed + object through the indirection. */ + if (TREE_THIS_VOLATILE (gnu_expr) && !TYPE_VOLATILE (gnu_type)) + gnu_type = build_qualified_type (gnu_type, + (TYPE_QUALS (gnu_type) + | TYPE_QUAL_VOLATILE)); + gnu_type = build_reference_type (gnu_type); + inner_const_flag = TREE_READONLY (gnu_expr); + const_flag = true; - if (stable) - renamed_obj = maybe_stable_expr; + /* 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. + + Note that this might introduce SAVE_EXPRs and we don't + check whether we are at the global level or not. This + is fine since we are building a pointer initializer and + neither the pointer nor the initializing expression can + be accessed before the pointer elaboration has taken + place in a correct program. + + These SAVE_EXPRs will be evaluated at the right place + by either the evaluation of the initializer for the + 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); - /* Attaching is actually performed downstream, as soon - as we have a VAR_DECL for the pointer we make. */ - } + if (stable) + renamed_obj = maybe_stable_expr; + } - if (type_annotate_only - && TREE_CODE (maybe_stable_expr) == ERROR_MARK) - gnu_expr = NULL_TREE; - else - gnu_expr = build_unary_op (ADDR_EXPR, gnu_type, - maybe_stable_expr); + if (type_annotate_only + && TREE_CODE (maybe_stable_expr) == ERROR_MARK) + gnu_expr = NULL_TREE; + else + gnu_expr + = build_unary_op (ADDR_EXPR, gnu_type, maybe_stable_expr); - gnu_size = NULL_TREE; - used_by_ref = true; - } + gnu_size = NULL_TREE; + used_by_ref = true; } } @@ -1483,10 +1468,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) /* Now create the variable or the constant and set various flags. */ gnu_decl - = create_var_decl (gnu_entity_name, gnu_ext_name, gnu_type, - gnu_expr, const_flag, Is_Public (gnat_entity), - imported_p || !definition, static_p, attr_list, - gnat_entity); + = create_var_decl_1 (gnu_entity_name, gnu_ext_name, gnu_type, + gnu_expr, const_flag, Is_Public (gnat_entity), + imported_p || !definition, static_p, + !renamed_obj, attr_list, gnat_entity); DECL_BY_REF_P (gnu_decl) = used_by_ref; DECL_POINTS_TO_READONLY_P (gnu_decl) = used_by_ref && inner_const_flag; DECL_CAN_NEVER_BE_NULL_P (gnu_decl) = Can_Never_Be_Null (gnat_entity); @@ -1517,7 +1502,7 @@ 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. Note that an external constant is at the global level. */ - if (TREE_CODE (gnu_decl) == VAR_DECL && renamed_obj) + if (renamed_obj) { SET_DECL_RENAMED_OBJECT (gnu_decl, renamed_obj); if ((!definition && kind == E_Constant) || global_bindings_p ()) diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index 3b6d5bd..ae7a2ef 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -898,17 +898,8 @@ lvalue_required_p (Node_Id gnat_node, tree gnu_type, bool constant, address_of_constant, aliased); case N_Object_Renaming_Declaration: - /* We need to make a real renaming only if the constant object is - aliased or if we may use a renaming pointer; otherwise we can - optimize and return the rvalue. We make an exception if the object - is an identifier since in this case the rvalue can be propagated - attached to the CONST_DECL. */ - return (!constant - || aliased - /* This should match the constant case of the renaming code. */ - || Is_Composite_Type - (Underlying_Type (Etype (Name (gnat_parent)))) - || Nkind (Name (gnat_parent)) == N_Identifier); + /* We need to preserve addresses through a renaming. */ + return 1; case N_Object_Declaration: /* We cannot use a constructor if this is an atomic object because @@ -968,6 +959,77 @@ lvalue_required_p (Node_Id gnat_node, tree gnu_type, bool constant, gcc_unreachable (); } +/* Return true if T is a constant DECL node that can be safely replaced + by its initializer. */ + +static bool +constant_decl_with_initializer_p (tree t) +{ + if (!TREE_CONSTANT (t) || !DECL_P (t) || !DECL_INITIAL (t)) + return false; + + /* Return false for aggregate types that contain a placeholder since + their initializers cannot be manipulated easily. */ + if (AGGREGATE_TYPE_P (TREE_TYPE (t)) + && !TYPE_IS_FAT_POINTER_P (TREE_TYPE (t)) + && type_contains_placeholder_p (TREE_TYPE (t))) + return false; + + return true; +} + +/* Return an expression equivalent to EXP but where constant DECL nodes + have been replaced by their initializer. */ + +static tree +fold_constant_decl_in_expr (tree exp) +{ + enum tree_code code = TREE_CODE (exp); + tree op0; + + switch (code) + { + case CONST_DECL: + case VAR_DECL: + if (!constant_decl_with_initializer_p (exp)) + return exp; + + return DECL_INITIAL (exp); + + case BIT_FIELD_REF: + case COMPONENT_REF: + op0 = fold_constant_decl_in_expr (TREE_OPERAND (exp, 0)); + if (op0 == TREE_OPERAND (exp, 0)) + return exp; + + return fold_build3 (code, TREE_TYPE (exp), op0, TREE_OPERAND (exp, 1), + TREE_OPERAND (exp, 2)); + + case ARRAY_REF: + case ARRAY_RANGE_REF: + op0 = fold_constant_decl_in_expr (TREE_OPERAND (exp, 0)); + if (op0 == TREE_OPERAND (exp, 0)) + return exp; + + return fold (build4 (code, TREE_TYPE (exp), op0, TREE_OPERAND (exp, 1), + TREE_OPERAND (exp, 2), TREE_OPERAND (exp, 3))); + + case VIEW_CONVERT_EXPR: + case REALPART_EXPR: + case IMAGPART_EXPR: + op0 = fold_constant_decl_in_expr (TREE_OPERAND (exp, 0)); + if (op0 == TREE_OPERAND (exp, 0)) + return exp; + + return fold_build1 (code, TREE_TYPE (exp), op0); + + default: + return exp; + } + + gcc_unreachable (); +} + /* Subroutine of gnat_to_gnu to translate gnat_node, an N_Identifier, to a GCC tree, which is returned. GNU_RESULT_TYPE_P is a pointer to where we should place the result type. */ @@ -1112,13 +1174,16 @@ Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p) true, false))) gnu_result = DECL_INITIAL (gnu_result); - /* If it's a renaming pointer and we are at the right binding level, - we can reference the renamed object directly, since the renamed - expression has been protected against multiple evaluations. */ + /* If it's a renaming pointer and, either the renamed object is constant + or we are at the right binding level, we can reference the renamed + object directly, since it is constant or has been protected against + multiple evaluations. */ if (TREE_CODE (gnu_result) == VAR_DECL && !DECL_LOOP_PARM_P (gnu_result) && DECL_RENAMED_OBJECT (gnu_result) - && (!DECL_RENAMING_GLOBAL_P (gnu_result) || global_bindings_p ())) + && (TREE_CONSTANT (DECL_RENAMED_OBJECT (gnu_result)) + || !DECL_RENAMING_GLOBAL_P (gnu_result) + || global_bindings_p ())) gnu_result = DECL_RENAMED_OBJECT (gnu_result); /* Otherwise, do the final dereference. */ @@ -1138,15 +1203,8 @@ Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p) /* If we have a constant declaration and its initializer, try to return the latter to avoid the need to call fold in lots of places and the need for - elaboration code if this identifier is used as an initializer itself. - Don't do it for aggregate types that contain a placeholder since their - initializers cannot be manipulated easily. */ - if (TREE_CONSTANT (gnu_result) - && DECL_P (gnu_result) - && DECL_INITIAL (gnu_result) - && !(AGGREGATE_TYPE_P (TREE_TYPE (gnu_result)) - && !TYPE_IS_FAT_POINTER_P (TREE_TYPE (gnu_result)) - && type_contains_placeholder_p (TREE_TYPE (gnu_result)))) + elaboration code if this identifier is used as an initializer itself. */ + if (constant_decl_with_initializer_p (gnu_result)) { bool constant_only = (TREE_CODE (gnu_result) == CONST_DECL && !DECL_CONST_CORRESPONDING_VAR (gnu_result)); @@ -1166,6 +1224,21 @@ Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p) gnu_result = DECL_INITIAL (gnu_result); } + /* But for a constant renaming we couldn't do that incrementally for its + definition because of the need to return an lvalue so, if the present + context doesn't itself require an lvalue, we try again here. */ + else if (Ekind (gnat_temp) == E_Constant + && Is_Elementary_Type (gnat_temp_type) + && Present (Renamed_Object (gnat_temp))) + { + if (require_lvalue < 0) + require_lvalue + = lvalue_required_p (gnat_node, gnu_result_type, true, false, + Is_Aliased (gnat_temp)); + if (!require_lvalue) + gnu_result = fold_constant_decl_in_expr (gnu_result); + } + /* The GNAT tree has the type of a function set to its result type, so we adjust here. Also use the type of the result if the Etype is a subtype that is nominally unconstrained. Likewise if this is a deferred constant @@ -2327,9 +2400,11 @@ Case_Statement_to_gnu (Node_Id gnat_node) /* First compile all the different case choices for the current WHEN alternative. */ for (gnat_choice = First (Discrete_Choices (gnat_when)); - Present (gnat_choice); gnat_choice = Next (gnat_choice)) + Present (gnat_choice); + gnat_choice = Next (gnat_choice)) { tree gnu_low = NULL_TREE, gnu_high = NULL_TREE; + tree label = create_artificial_label (input_location); switch (Nkind (gnat_choice)) { @@ -2353,8 +2428,8 @@ Case_Statement_to_gnu (Node_Id gnat_node) { tree gnu_type = get_unpadded_type (Entity (gnat_choice)); - gnu_low = fold (TYPE_MIN_VALUE (gnu_type)); - gnu_high = fold (TYPE_MAX_VALUE (gnu_type)); + gnu_low = TYPE_MIN_VALUE (gnu_type); + gnu_high = TYPE_MAX_VALUE (gnu_type); break; } @@ -2372,20 +2447,13 @@ Case_Statement_to_gnu (Node_Id gnat_node) gcc_unreachable (); } - /* If the case value is a subtype that raises Constraint_Error at - run time because of a wrong bound, then gnu_low or gnu_high is - not translated into an INTEGER_CST. In such a case, we need - to ensure that the when statement is not added in the tree, - otherwise it will crash the gimplifier. */ - if ((!gnu_low || TREE_CODE (gnu_low) == INTEGER_CST) - && (!gnu_high || TREE_CODE (gnu_high) == INTEGER_CST)) - { - add_stmt_with_node (build_case_label - (gnu_low, gnu_high, - create_artificial_label (input_location)), - gnat_choice); - choices_added_p = true; - } + /* Everything should be folded into constants at this point. */ + gcc_assert (!gnu_low || TREE_CODE (gnu_low) == INTEGER_CST); + gcc_assert (!gnu_high || TREE_CODE (gnu_high) == INTEGER_CST); + + add_stmt_with_node (build_case_label (gnu_low, gnu_high, label), + gnat_choice); + choices_added_p = true; } /* This construct doesn't define a scope so we shouldn't push a binding diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c index 8172f5f..4814f9a 100644 --- a/gcc/ada/gcc-interface/utils.c +++ b/gcc/ada/gcc-interface/utils.c @@ -2514,7 +2514,10 @@ record_global_renaming_pointer (tree decl) vec_safe_push (global_renaming_pointers, decl); } -/* Invalidate the global renaming pointers. */ +/* Invalidate the global renaming pointers that are not constant, lest their + renamed object contains SAVE_EXPRs tied to an elaboration routine. Note + that we should not blindly invalidate everything here because of the need + to propagate constant values through renaming. */ void invalidate_global_renaming_pointers (void) @@ -2526,7 +2529,8 @@ invalidate_global_renaming_pointers (void) return; FOR_EACH_VEC_ELT (*global_renaming_pointers, i, iter) - SET_DECL_RENAMED_OBJECT (iter, NULL_TREE); + if (!TREE_CONSTANT (DECL_RENAMED_OBJECT (iter))) + SET_DECL_RENAMED_OBJECT (iter, NULL_TREE); vec_free (global_renaming_pointers); } |