From cb3d597d15475a12d37a3c01dc7f8e12d2c9eff1 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Tue, 13 Apr 2010 07:08:24 +0000 Subject: [PATCH] gimple.c (walk_gimple_op): Do not request a pure rvalue on the RHS if the LHS is of a non-renamable type. * gimple.c (walk_gimple_op) : Do not request a pure rvalue on the RHS if the LHS is of a non-renamable type. * tree-ssa-ccp.c (maybe_fold_offset_to_component_ref): Fold result. ada/ * gcc-interface/ada-tree.h (TYPE_BY_REFERENCE_P): Delete. (DECL_CONST_ADDRESS_P): New macro. (SET_DECL_ORIGINAL_FIELD_TO_FIELD): Likewise. (SAME_FIELD_P): Likewise. * gcc-interface/decl.c (constructor_address_p): New static function. (gnat_to_gnu_entity) : Set DECL_CONST_ADDRESS_P according to the return value of above function. (gnat_to_gnu_entity) : Force BLKmode for all types passed by reference. : Likewise. Set TREE_ADDRESSABLE on the type if it passed by reference. (make_packable_type): Use SET_DECL_ORIGINAL_FIELD_TO_FIELD. (create_field_decl_from): Likewise. (substitute_in_type): Likewise. (purpose_member_field): Use SAME_FIELD_P. * gcc-interface/misc.c (must_pass_by_ref): Test TREE_ADDRESSABLE. * gcc-interface/trans.c (lvalue_required_p): Add ADDRESS_OF_CONSTANT parameter and adjust recursive calls. : New case. : Return 1 if the object is of a class-wide type. Adjust calls to lvalue_required_p. Do not return the initializer of a DECL_CONST_ADDRESS_P constant if an lvalue is required for it. (call_to_gnu): Delay issuing error message for a misaligned actual and avoid the associated back-end assertion. Test TREE_ADDRESSABLE. (gnat_gimplify_expr) : Handle non-static constructors. * gcc-interface/utils.c (make_dummy_type): Set TREE_ADDRESSABLE if the type is passed by reference. (convert) : Convert in-place in more cases. * gcc-interface/utils2.c (build_cond_expr): Drop TYPE_BY_REFERENCE_P. (build_simple_component_ref): Use SAME_FIELD_P. From-SVN: r158254 --- gcc/ChangeLog | 6 ++ gcc/ada/ChangeLog | 33 +++++++ gcc/ada/gcc-interface/ada-tree.h | 21 ++++- gcc/ada/gcc-interface/decl.c | 59 +++++++----- gcc/ada/gcc-interface/misc.c | 2 +- gcc/ada/gcc-interface/trans.c | 153 ++++++++++++++++++++----------- gcc/ada/gcc-interface/utils.c | 23 +++-- gcc/ada/gcc-interface/utils2.c | 14 +-- gcc/gimple.c | 12 ++- gcc/tree-ssa-ccp.c | 6 +- 10 files changed, 225 insertions(+), 104 deletions(-) diff --git a/gcc/ChangeLog b/gcc/ChangeLog index 3e197ab5ecd..c011b808658 100644 --- a/gcc/ChangeLog +++ b/gcc/ChangeLog @@ -1,3 +1,9 @@ +2010-04-13 Eric Botcazou + + * gimple.c (walk_gimple_op) : Do not request a pure + rvalue on the RHS if the LHS is of a non-renamable type. + * tree-ssa-ccp.c (maybe_fold_offset_to_component_ref): Fold result. + 2010-04-13 Matthias Klose * gcc.c (cc1_options): Handle -iplugindir before processing diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 22a68c4cc89..233c8b952fd 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,36 @@ +2010-04-13 Eric Botcazou + + * gcc-interface/ada-tree.h (TYPE_BY_REFERENCE_P): Delete. + (DECL_CONST_ADDRESS_P): New macro. + (SET_DECL_ORIGINAL_FIELD_TO_FIELD): Likewise. + (SAME_FIELD_P): Likewise. + * gcc-interface/decl.c (constructor_address_p): New static function. + (gnat_to_gnu_entity) : Set DECL_CONST_ADDRESS_P according to + the return value of above function. + (gnat_to_gnu_entity) : Force BLKmode for all types + passed by reference. + : Likewise. + Set TREE_ADDRESSABLE on the type if it passed by reference. + (make_packable_type): Use SET_DECL_ORIGINAL_FIELD_TO_FIELD. + (create_field_decl_from): Likewise. + (substitute_in_type): Likewise. + (purpose_member_field): Use SAME_FIELD_P. + * gcc-interface/misc.c (must_pass_by_ref): Test TREE_ADDRESSABLE. + * gcc-interface/trans.c (lvalue_required_p): Add ADDRESS_OF_CONSTANT + parameter and adjust recursive calls. + : New case. + : Return 1 if the object is of a class-wide type. + Adjust calls to lvalue_required_p. Do not return the initializer of a + DECL_CONST_ADDRESS_P constant if an lvalue is required for it. + (call_to_gnu): Delay issuing error message for a misaligned actual and + avoid the associated back-end assertion. Test TREE_ADDRESSABLE. + (gnat_gimplify_expr) : Handle non-static constructors. + * gcc-interface/utils.c (make_dummy_type): Set TREE_ADDRESSABLE if the + type is passed by reference. + (convert) : Convert in-place in more cases. + * gcc-interface/utils2.c (build_cond_expr): Drop TYPE_BY_REFERENCE_P. + (build_simple_component_ref): Use SAME_FIELD_P. + 2010-04-12 Eric Botcazou * gcc-interface/trans.c (Identifier_to_gnu): Use boolean variable. diff --git a/gcc/ada/gcc-interface/ada-tree.h b/gcc/ada/gcc-interface/ada-tree.h index 8a646fe3704..5c54c30c375 100644 --- a/gcc/ada/gcc-interface/ada-tree.h +++ b/gcc/ada/gcc-interface/ada-tree.h @@ -102,9 +102,6 @@ do { \ front-end. */ #define TYPE_EXTRA_SUBTYPE_P(NODE) TYPE_LANG_FLAG_2 (NODE) -/* Nonzero for composite types if this is a by-reference type. */ -#define TYPE_BY_REFERENCE_P(NODE) TYPE_LANG_FLAG_2 (NODE) - /* For RECORD_TYPE, UNION_TYPE, and QUAL_UNION_TYPE, nonzero if this is the type for an object whose type includes its template in addition to its value (only true for RECORD_TYPE). */ @@ -325,6 +322,10 @@ do { \ been elaborated and TREE_READONLY is not set on it. */ #define DECL_READONLY_ONCE_ELAB(NODE) DECL_LANG_FLAG_0 (VAR_DECL_CHECK (NODE)) +/* Nonzero in a CONST_DECL if its value is (essentially) the address of a + constant CONSTRUCTOR. */ +#define DECL_CONST_ADDRESS_P(NODE) DECL_LANG_FLAG_0 (CONST_DECL_CHECK (NODE)) + /* Nonzero if this decl is always used by reference; i.e., an INDIRECT_REF is needed to access the object. */ #define DECL_BY_REF_P(NODE) DECL_LANG_FLAG_1 (NODE) @@ -369,6 +370,20 @@ do { \ #define SET_DECL_ORIGINAL_FIELD(NODE, X) \ SET_DECL_LANG_SPECIFIC (FIELD_DECL_CHECK (NODE), X) +/* Set DECL_ORIGINAL_FIELD of FIELD1 to (that of) FIELD2. */ +#define SET_DECL_ORIGINAL_FIELD_TO_FIELD(FIELD1, FIELD2) \ + SET_DECL_ORIGINAL_FIELD ((FIELD1), \ + DECL_ORIGINAL_FIELD (FIELD2) \ + ? DECL_ORIGINAL_FIELD (FIELD2) : (FIELD2)) + +/* Return true if FIELD1 and FIELD2 represent the same field. */ +#define SAME_FIELD_P(FIELD1, FIELD2) \ + ((FIELD1) == (FIELD2) \ + || DECL_ORIGINAL_FIELD (FIELD1) == (FIELD2) \ + || (FIELD1) == DECL_ORIGINAL_FIELD (FIELD2) \ + || (DECL_ORIGINAL_FIELD (FIELD1) \ + && (DECL_ORIGINAL_FIELD (FIELD1) == DECL_ORIGINAL_FIELD (FIELD2)))) + /* In a VAR_DECL, points to the object being renamed if the VAR_DECL is a renaming pointer, otherwise 0. Note that this object is guaranteed to be protected against multiple evaluations. */ diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index dd768910022..a333170cb16 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -138,6 +138,7 @@ static bool same_discriminant_p (Entity_Id, Entity_Id); static bool array_type_has_nonaliased_component (tree, Entity_Id); static bool compile_time_known_address_p (Node_Id); static bool cannot_be_superflat_p (Node_Id); +static bool constructor_address_p (tree); static void components_to_record (tree, Node_Id, tree, int, bool, tree *, bool, bool, bool, bool, bool); static Uint annotate_value (tree); @@ -1376,6 +1377,15 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) DECL_IGNORED_P (gnu_decl) = 1; } + /* If this is a constant, even if we don't need a true variable, we + may need to avoid returning the initializer in every case. That + can happen for the address of a (constant) constructor because, + upon dereferencing it, the constructor will be reinjected in the + tree, which may not be valid in every case; see lvalue_required_p + for more details. */ + if (TREE_CODE (gnu_decl) == CONST_DECL) + DECL_CONST_ADDRESS_P (gnu_decl) = constructor_address_p (gnu_expr); + /* If this is declared in a block that contains a block with an exception handler, we must force this variable in memory to suppress an invalid optimization. */ @@ -2892,10 +2902,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) false, all_rep, is_unchecked_union, debug_info_p, false); - /* If it is a tagged record force the type to BLKmode to insure that - these objects will always be put in memory. Likewise for limited - record types. */ - if (Is_Tagged_Type (gnat_entity) || Is_Limited_Record (gnat_entity)) + /* If it is passed by reference, force BLKmode to ensure that objects ++ of this type will always be put in memory. */ + if (Is_By_Reference_Type (gnat_entity)) SET_TYPE_MODE (gnu_type, BLKmode); /* We used to remove the associations of the discriminants and _Parent @@ -3216,8 +3225,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) finish_record_type (gnu_type, gnu_field_list, 2, false); /* See the E_Record_Type case for the rationale. */ - if (Is_Tagged_Type (gnat_entity) - || Is_Limited_Record (gnat_entity)) + if (Is_By_Reference_Type (gnat_entity)) SET_TYPE_MODE (gnu_type, BLKmode); else compute_record_mode (gnu_type); @@ -4388,8 +4396,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition) || Is_Class_Wide_Equivalent_Type (gnat_entity)) TYPE_ALIGN_OK (gnu_type) = 1; - if (AGGREGATE_TYPE_P (gnu_type) && Is_By_Reference_Type (gnat_entity)) - TYPE_BY_REFERENCE_P (gnu_type) = 1; + /* If the type is passed by reference, objects of this type must be + fully addressable and cannot be copied. */ + if (Is_By_Reference_Type (gnat_entity)) + TREE_ADDRESSABLE (gnu_type) = 1; /* ??? Don't set the size for a String_Literal since it is either confirming or we don't handle it properly (if the low bound is @@ -5397,6 +5407,20 @@ cannot_be_superflat_p (Node_Id gnat_range) return (tree_int_cst_lt (gnu_hb, gnu_lb) == 0); } + +/* Return true if GNU_EXPR is (essentially) the address of a CONSTRUCTOR. */ + +static bool +constructor_address_p (tree gnu_expr) +{ + while (TREE_CODE (gnu_expr) == NOP_EXPR + || TREE_CODE (gnu_expr) == CONVERT_EXPR + || TREE_CODE (gnu_expr) == NON_LVALUE_EXPR) + gnu_expr = TREE_OPERAND (gnu_expr, 0); + + return (TREE_CODE (gnu_expr) == ADDR_EXPR + && TREE_CODE (TREE_OPERAND (gnu_expr, 0)) == CONSTRUCTOR); +} /* Given GNAT_ENTITY, elaborate all expressions that are required to be elaborated at the point of its definition, but do nothing else. */ @@ -6033,10 +6057,7 @@ make_packable_type (tree type, bool in_record) !DECL_NONADDRESSABLE_P (old_field)); DECL_INTERNAL_P (new_field) = DECL_INTERNAL_P (old_field); - SET_DECL_ORIGINAL_FIELD - (new_field, (DECL_ORIGINAL_FIELD (old_field) - ? DECL_ORIGINAL_FIELD (old_field) : old_field)); - + SET_DECL_ORIGINAL_FIELD_TO_FIELD (new_field, old_field); if (TREE_CODE (new_type) == QUAL_UNION_TYPE) DECL_QUALIFIER (new_field) = DECL_QUALIFIER (old_field); @@ -7253,9 +7274,8 @@ annotate_object (Entity_Id gnat_entity, tree gnu_type, tree size, bool by_ref) UI_From_Int (TYPE_ALIGN (gnu_type) / BITS_PER_UNIT)); } -/* Return first element of field list whose TREE_PURPOSE is ELEM or whose - DECL_ORIGINAL_FIELD of TREE_PURPOSE is ELEM. Return NULL_TREE if there - is no such element in the list. */ +/* Return first element of field list whose TREE_PURPOSE is the same as ELEM. + Return NULL_TREE if there is no such element in the list. */ static tree purpose_member_field (const_tree elem, tree list) @@ -7263,7 +7283,7 @@ purpose_member_field (const_tree elem, tree list) while (list) { tree field = TREE_PURPOSE (list); - if (elem == field || elem == DECL_ORIGINAL_FIELD (field)) + if (SAME_FIELD_P (field, elem)) return list; list = TREE_CHAIN (list); } @@ -8035,8 +8055,7 @@ create_field_decl_from (tree old_field, tree field_type, tree record_type, } DECL_INTERNAL_P (new_field) = DECL_INTERNAL_P (old_field); - t = DECL_ORIGINAL_FIELD (old_field); - SET_DECL_ORIGINAL_FIELD (new_field, t ? t : old_field); + SET_DECL_ORIGINAL_FIELD_TO_FIELD (new_field, old_field); DECL_DISCRIMINANT_NUMBER (new_field) = DECL_DISCRIMINANT_NUMBER (old_field); TREE_THIS_VOLATILE (new_field) = TREE_THIS_VOLATILE (old_field); @@ -8372,9 +8391,7 @@ substitute_in_type (tree t, tree f, tree r) } DECL_CONTEXT (new_field) = nt; - SET_DECL_ORIGINAL_FIELD (new_field, - (DECL_ORIGINAL_FIELD (field) - ? DECL_ORIGINAL_FIELD (field) : field)); + SET_DECL_ORIGINAL_FIELD_TO_FIELD (new_field, field); TREE_CHAIN (new_field) = TYPE_FIELDS (nt); TYPE_FIELDS (nt) = new_field; diff --git a/gcc/ada/gcc-interface/misc.c b/gcc/ada/gcc-interface/misc.c index 570bd111a95..8c647d35972 100644 --- a/gcc/ada/gcc-interface/misc.c +++ b/gcc/ada/gcc-interface/misc.c @@ -700,7 +700,7 @@ must_pass_by_ref (tree gnu_type) and does not produce compatibility problems with C, since C does not have such objects. */ return (TREE_CODE (gnu_type) == UNCONSTRAINED_ARRAY_TYPE - || (AGGREGATE_TYPE_P (gnu_type) && TYPE_BY_REFERENCE_P (gnu_type)) + || TREE_ADDRESSABLE (gnu_type) || (TYPE_SIZE (gnu_type) && TREE_CODE (TYPE_SIZE (gnu_type)) != INTEGER_CST)); } diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index 42e07b5d170..97ac2f38108 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -215,7 +215,7 @@ static tree extract_values (tree, tree); static tree pos_to_constructor (Node_Id, tree, Entity_Id); static tree maybe_implicit_deref (tree); static void set_expr_location_from_node (tree, Node_Id); -static int lvalue_required_p (Node_Id, tree, bool, bool); +static int lvalue_required_p (Node_Id, tree, bool, bool, bool); /* Hooks for debug info back-ends, only supported and used in a restricted set of configurations. */ @@ -703,8 +703,9 @@ lvalue_required_for_attribute_p (Node_Id gnat_node) /* Return a positive value if an lvalue is required for GNAT_NODE. GNU_TYPE is the type that will be used for GNAT_NODE in the translated GNU tree. CONSTANT indicates whether the underlying object represented by GNAT_NODE - is constant in the Ada sense, ALIASED whether it is aliased (but the latter - doesn't affect the outcome if CONSTANT is not true). + is constant in the Ada sense. If it is, ADDRESS_OF_CONSTANT indicates + whether its value is the address of a constant and ALIASED whether it is + aliased. If it isn't, ADDRESS_OF_CONSTANT and ALIASED are ignored. The function climbs up the GNAT tree starting from the node and returns 1 upon encountering a node that effectively requires an lvalue downstream. @@ -713,7 +714,7 @@ lvalue_required_for_attribute_p (Node_Id gnat_node) static int lvalue_required_p (Node_Id gnat_node, tree gnu_type, bool constant, - bool aliased) + bool address_of_constant, bool aliased) { Node_Id gnat_parent = Parent (gnat_node), gnat_temp; @@ -753,11 +754,13 @@ lvalue_required_p (Node_Id gnat_node, tree gnu_type, bool constant, return 0; aliased |= Has_Aliased_Components (Etype (gnat_node)); - return lvalue_required_p (gnat_parent, gnu_type, constant, aliased); + return lvalue_required_p (gnat_parent, gnu_type, constant, + address_of_constant, aliased); case N_Selected_Component: aliased |= Is_Aliased (Entity (Selector_Name (gnat_parent))); - return lvalue_required_p (gnat_parent, gnu_type, constant, aliased); + return lvalue_required_p (gnat_parent, gnu_type, constant, + address_of_constant, aliased); case N_Object_Renaming_Declaration: /* We need to make a real renaming only if the constant object is @@ -775,8 +778,14 @@ lvalue_required_p (Node_Id gnat_node, tree gnu_type, bool constant, case N_Object_Declaration: /* We cannot use a constructor if this is an atomic object because the actual assignment might end up being done component-wise. */ - return Is_Composite_Type (Underlying_Type (Etype (gnat_node))) - && Is_Atomic (Defining_Entity (gnat_parent)); + return ((Is_Composite_Type (Underlying_Type (Etype (gnat_node))) + && Is_Atomic (Defining_Entity (gnat_parent))) + /* We don't use a constructor if this is a class-wide object + because the effective type of the object is the equivalent + type of the class-wide subtype and it smashes most of the + data into an array of bytes to which we cannot convert. */ + || Ekind ((Etype (Defining_Entity (gnat_parent)))) + == E_Class_Wide_Subtype); case N_Assignment_Statement: /* We cannot use a constructor if the LHS is an atomic object because @@ -790,7 +799,17 @@ lvalue_required_p (Node_Id gnat_node, tree gnu_type, bool constant, go through the conversion. */ return lvalue_required_p (gnat_parent, get_unpadded_type (Etype (gnat_parent)), - constant, aliased); + constant, address_of_constant, aliased); + + case N_Explicit_Dereference: + /* We look through dereferences for address of constant because we need + to handle the special cases listed above. */ + if (constant && address_of_constant) + return lvalue_required_p (gnat_parent, + get_unpadded_type (Etype (gnat_parent)), + true, false, true); + + /* ... fall through ... */ default: return 0; @@ -895,12 +914,13 @@ Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p) statement alternative or a record discriminant. There is no possible volatile-ness short-circuit here since Volatile constants must bei imported per C.6. */ - if (Ekind (gnat_temp) == E_Constant && Is_Scalar_Type (gnat_temp_type) + if (Ekind (gnat_temp) == E_Constant + && Is_Scalar_Type (gnat_temp_type) && !Is_Imported (gnat_temp) && Present (Address_Clause (gnat_temp))) { require_lvalue = lvalue_required_p (gnat_node, gnu_result_type, true, - Is_Aliased (gnat_temp)); + false, Is_Aliased (gnat_temp)); use_constant_initializer = !require_lvalue; } @@ -999,15 +1019,18 @@ Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p) { bool constant_only = (TREE_CODE (gnu_result) == CONST_DECL && !DECL_CONST_CORRESPONDING_VAR (gnu_result)); + bool address_of_constant = (TREE_CODE (gnu_result) == CONST_DECL + && DECL_CONST_ADDRESS_P (gnu_result)); - /* If there is a (corresponding) variable, we only want to return - the constant value if an lvalue is not required. Evaluate this - now if we have not already done so. */ - if (!constant_only && require_lvalue < 0) - require_lvalue = lvalue_required_p (gnat_node, gnu_result_type, true, - Is_Aliased (gnat_temp)); + /* If there is a (corresponding) variable or this is the address of a + constant, we only want to return the initializer if an lvalue isn't + required. Evaluate this now if we have not already done so. */ + if ((!constant_only || address_of_constant) && require_lvalue < 0) + require_lvalue + = lvalue_required_p (gnat_node, gnu_result_type, true, + address_of_constant, Is_Aliased (gnat_temp)); - if (constant_only || !require_lvalue) + if ((constant_only && !address_of_constant) || !require_lvalue) gnu_result = unshare_expr (DECL_INITIAL (gnu_result)); } @@ -2538,29 +2561,6 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target) { tree gnu_copy = gnu_name; - /* If the type is passed by reference, a copy is not allowed. */ - if (AGGREGATE_TYPE_P (gnu_formal_type) - && TYPE_BY_REFERENCE_P (gnu_formal_type)) - post_error - ("misaligned actual cannot be passed by reference", gnat_actual); - - /* For users of Starlet we issue a warning because the interface - apparently assumes that by-ref parameters outlive the procedure - invocation. The code still will not work as intended, but we - cannot do much better since low-level parts of the back-end - would allocate temporaries at will because of the misalignment - if we did not do so here. */ - else if (Is_Valued_Procedure (Entity (Name (gnat_node)))) - { - post_error - ("?possible violation of implicit assumption", gnat_actual); - post_error_ne - ("?made by pragma Import_Valued_Procedure on &", gnat_actual, - Entity (Name (gnat_node))); - post_error_ne ("?because of misalignment of &", gnat_actual, - gnat_formal); - } - /* If the actual type of the object is already the nominal type, we have nothing to do, except if the size is self-referential in which case we'll remove the unpadding below. */ @@ -2593,6 +2593,33 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target) gnu_name = build1 (SAVE_EXPR, TREE_TYPE (gnu_name), gnu_name); TREE_SIDE_EFFECTS (gnu_name) = 1; + /* If the type is passed by reference, a copy is not allowed. */ + if (TREE_ADDRESSABLE (gnu_formal_type)) + { + post_error ("misaligned actual cannot be passed by reference", + gnat_actual); + + /* Avoid the back-end assertion on temporary creation. */ + gnu_name = TREE_OPERAND (gnu_name, 0); + } + + /* For users of Starlet we issue a warning because the interface + apparently assumes that by-ref parameters outlive the procedure + invocation. The code still will not work as intended, but we + cannot do much better since low-level parts of the back-end + would allocate temporaries at will because of the misalignment + if we did not do so here. */ + else if (Is_Valued_Procedure (Entity (Name (gnat_node)))) + { + post_error + ("?possible violation of implicit assumption", gnat_actual); + post_error_ne + ("?made by pragma Import_Valued_Procedure on &", gnat_actual, + Entity (Name (gnat_node))); + post_error_ne ("?because of misalignment of &", gnat_actual, + gnat_formal); + } + /* Set up to move the copy back to the original if needed. */ if (Ekind (gnat_formal) != E_In_Parameter) { @@ -5770,21 +5797,41 @@ gnat_gimplify_expr (tree *expr_p, gimple_seq *pre_p, case ADDR_EXPR: op = TREE_OPERAND (expr, 0); - /* If we are taking the address of a constant CONSTRUCTOR, force it to - be put into static memory. We know it's going to be readonly given - the semantics we have and it's required to be in static memory when - the reference is in an elaboration procedure. */ - if (TREE_CODE (op) == CONSTRUCTOR && TREE_CONSTANT (op)) + if (TREE_CODE (op) == CONSTRUCTOR) { - tree new_var = create_tmp_var (TREE_TYPE (op), "C"); - TREE_ADDRESSABLE (new_var) = 1; + /* If we are taking the address of a constant CONSTRUCTOR, make sure + it is put into static memory. We know it's going to be read-only + given the semantics we have and it must be in static memory when + the reference is in an elaboration procedure. */ + if (TREE_CONSTANT (op)) + { + tree new_var = create_tmp_var_raw (TREE_TYPE (op), "C"); + TREE_ADDRESSABLE (new_var) = 1; + gimple_add_tmp_var (new_var); - TREE_READONLY (new_var) = 1; - TREE_STATIC (new_var) = 1; - DECL_INITIAL (new_var) = op; + TREE_READONLY (new_var) = 1; + TREE_STATIC (new_var) = 1; + DECL_INITIAL (new_var) = op; + + TREE_OPERAND (expr, 0) = new_var; + recompute_tree_invariant_for_addr_expr (expr); + } + + /* Otherwise explicitly create the local temporary. That's required + if the type is passed by reference. */ + else + { + tree mod, new_var = create_tmp_var_raw (TREE_TYPE (op), "C"); + TREE_ADDRESSABLE (new_var) = 1; + gimple_add_tmp_var (new_var); + + mod = build2 (INIT_EXPR, TREE_TYPE (new_var), new_var, op); + gimplify_and_add (mod, pre_p); + + TREE_OPERAND (expr, 0) = new_var; + recompute_tree_invariant_for_addr_expr (expr); + } - TREE_OPERAND (expr, 0) = new_var; - recompute_tree_invariant_for_addr_expr (expr); return GS_ALL_DONE; } diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c index cf0ff60b485..7353bdc7a82 100644 --- a/gcc/ada/gcc-interface/utils.c +++ b/gcc/ada/gcc-interface/utils.c @@ -294,8 +294,8 @@ make_dummy_type (Entity_Id gnat_type) TYPE_DUMMY_P (gnu_type) = 1; TYPE_STUB_DECL (gnu_type) = create_type_stub_decl (TYPE_NAME (gnu_type), gnu_type); - if (AGGREGATE_TYPE_P (gnu_type) && Is_By_Reference_Type (gnat_type)) - TYPE_BY_REFERENCE_P (gnu_type) = 1; + if (Is_By_Reference_Type (gnat_type)) + TREE_ADDRESSABLE (gnu_type) = 1; SET_DUMMY_NODE (gnat_underlying, gnu_type); @@ -3852,11 +3852,14 @@ convert (tree type, tree expr) return expr; } - /* Likewise for a conversion between original and packable version, but - we have to work harder in order to preserve type consistency. */ + /* Likewise for a conversion between original and packable version, or + conversion between types of the same size and with the same list of + fields, but we have to work harder to preserve type consistency. */ if (code == ecode && code == RECORD_TYPE - && TYPE_NAME (type) == TYPE_NAME (etype)) + && (TYPE_NAME (type) == TYPE_NAME (etype) + || tree_int_cst_equal (TYPE_SIZE (type), TYPE_SIZE (etype)))) + { VEC(constructor_elt,gc) *e = CONSTRUCTOR_ELTS (expr); unsigned HOST_WIDE_INT len = VEC_length (constructor_elt, e); @@ -3871,10 +3874,14 @@ convert (tree type, tree expr) FOR_EACH_CONSTRUCTOR_ELT(e, idx, index, value) { - constructor_elt *elt = VEC_quick_push (constructor_elt, v, NULL); - /* We expect only simple constructors. Otherwise, punt. */ - if (!(index == efield || index == DECL_ORIGINAL_FIELD (efield))) + constructor_elt *elt; + /* We expect only simple constructors. */ + if (!SAME_FIELD_P (index, efield)) break; + /* The field must be the same. */ + if (!SAME_FIELD_P (efield, field)) + break; + elt = VEC_quick_push (constructor_elt, v, NULL); elt->index = field; elt->value = convert (TREE_TYPE (field), value); diff --git a/gcc/ada/gcc-interface/utils2.c b/gcc/ada/gcc-interface/utils2.c index 7d78c25ffba..dbe83ed7ff8 100644 --- a/gcc/ada/gcc-interface/utils2.c +++ b/gcc/ada/gcc-interface/utils2.c @@ -1293,10 +1293,9 @@ build_cond_expr (tree result_type, tree condition_operand, /* If the result type is unconstrained, take the address of the operands and then dereference the result. Likewise if the result type is passed by - reference because creating a temporary of this type is not allowed. */ + reference, but this is natively handled in the gimplifier. */ if (TREE_CODE (result_type) == UNCONSTRAINED_ARRAY_TYPE - || CONTAINS_PLACEHOLDER_P (TYPE_SIZE (result_type)) - || (AGGREGATE_TYPE_P (result_type) && TYPE_BY_REFERENCE_P (result_type))) + || CONTAINS_PLACEHOLDER_P (TYPE_SIZE (result_type))) { result_type = build_pointer_type (result_type); true_operand = build_unary_op (ADDR_EXPR, result_type, true_operand); @@ -1588,22 +1587,15 @@ build_simple_component_ref (tree record_variable, tree component, tree new_field; /* First loop thru normal components. */ - for (new_field = TYPE_FIELDS (record_type); new_field; new_field = TREE_CHAIN (new_field)) - if (field == new_field - || DECL_ORIGINAL_FIELD (new_field) == field - || new_field == DECL_ORIGINAL_FIELD (field) - || (DECL_ORIGINAL_FIELD (field) - && (DECL_ORIGINAL_FIELD (field) - == DECL_ORIGINAL_FIELD (new_field)))) + if (SAME_FIELD_P (field, new_field)) break; /* Next, loop thru DECL_INTERNAL_P components if we haven't found the component in the first search. Doing this search in 2 steps is required to avoiding hidden homonymous fields in the _Parent field. */ - if (!new_field) for (new_field = TYPE_FIELDS (record_type); new_field; new_field = TREE_CHAIN (new_field)) diff --git a/gcc/gimple.c b/gcc/gimple.c index ce1f75a884e..aab6ef25f34 100644 --- a/gcc/gimple.c +++ b/gcc/gimple.c @@ -1324,11 +1324,15 @@ walk_gimple_op (gimple stmt, walk_tree_fn callback_op, switch (gimple_code (stmt)) { case GIMPLE_ASSIGN: - /* Walk the RHS operands. A formal temporary LHS may use a - COMPONENT_REF RHS. */ + /* Walk the RHS operands. If the LHS is of a non-renamable type or + is a register variable, we may use a COMPONENT_REF on the RHS. */ if (wi) - wi->val_only = !is_gimple_reg (gimple_assign_lhs (stmt)) - || !gimple_assign_single_p (stmt); + { + tree lhs = gimple_assign_lhs (stmt); + wi->val_only + = (is_gimple_reg_type (TREE_TYPE (lhs)) && !is_gimple_reg (lhs)) + || !gimple_assign_single_p (stmt); + } for (i = 1; i < gimple_num_ops (stmt); i++) { diff --git a/gcc/tree-ssa-ccp.c b/gcc/tree-ssa-ccp.c index f0106ebc940..e6149490774 100644 --- a/gcc/tree-ssa-ccp.c +++ b/gcc/tree-ssa-ccp.c @@ -1980,7 +1980,7 @@ maybe_fold_offset_to_component_ref (location_t loc, tree record_type, if (cmp == 0 && useless_type_conversion_p (orig_type, field_type)) { - t = build3 (COMPONENT_REF, field_type, base, f, NULL_TREE); + t = fold_build3 (COMPONENT_REF, field_type, base, f, NULL_TREE); return t; } @@ -2004,7 +2004,7 @@ maybe_fold_offset_to_component_ref (location_t loc, tree record_type, /* If we matched, then set offset to the displacement into this field. */ - new_base = build3 (COMPONENT_REF, field_type, base, f, NULL_TREE); + new_base = fold_build3 (COMPONENT_REF, field_type, base, f, NULL_TREE); SET_EXPR_LOCATION (new_base, loc); /* Recurse to possibly find the match. */ @@ -2027,7 +2027,7 @@ maybe_fold_offset_to_component_ref (location_t loc, tree record_type, /* If we get here, we've got an aggregate field, and a possibly nonzero offset into them. Recurse and hope for a valid match. */ - base = build3 (COMPONENT_REF, field_type, base, f, NULL_TREE); + base = fold_build3 (COMPONENT_REF, field_type, base, f, NULL_TREE); SET_EXPR_LOCATION (base, loc); t = maybe_fold_offset_to_array_ref (loc, base, offset, orig_type,