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) <GIMPLE_ASSIGN>: 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) <object>: Set DECL_CONST_ADDRESS_P according to the return value of above function. (gnat_to_gnu_entity) <E_Record_Type>: Force BLKmode for all types passed by reference. <E_Record_Subtype>: 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. <N_Explicit_Dereference>: New case. <N_Object_Declaration>: 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) <ADDR_EXPR>: Handle non-static constructors. * gcc-interface/utils.c (make_dummy_type): Set TREE_ADDRESSABLE if the type is passed by reference. (convert) <CONSTRUCTOR>: 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
This commit is contained in:
Eric Botcazou
Eric Botcazou
parent
b7e757713c
commit
cb3d597d15
@ -1,3 +1,9 @@
|
||||
2010-04-13 Eric Botcazou <ebotcazou@adacore.com>
|
||||
|
||||
* gimple.c (walk_gimple_op) <GIMPLE_ASSIGN>: 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 <doko@ubuntu.com>
|
||||
|
||||
* gcc.c (cc1_options): Handle -iplugindir before processing
|
||||
|
||||
@ -1,3 +1,36 @@
|
||||
2010-04-13 Eric Botcazou <ebotcazou@adacore.com>
|
||||
|
||||
* 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) <object>: Set DECL_CONST_ADDRESS_P according to
|
||||
the return value of above function.
|
||||
(gnat_to_gnu_entity) <E_Record_Type>: Force BLKmode for all types
|
||||
passed by reference.
|
||||
<E_Record_Subtype>: 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.
|
||||
<N_Explicit_Dereference>: New case.
|
||||
<N_Object_Declaration>: 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) <ADDR_EXPR>: Handle non-static constructors.
|
||||
* gcc-interface/utils.c (make_dummy_type): Set TREE_ADDRESSABLE if the
|
||||
type is passed by reference.
|
||||
(convert) <CONSTRUCTOR>: 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 <ebotcazou@adacore.com>
|
||||
|
||||
* gcc-interface/trans.c (Identifier_to_gnu): Use boolean variable.
|
||||
|
||||
@ -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. */
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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));
|
||||
}
|
||||
|
||||
@ -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;
|
||||
}
|
||||
|
||||
|
||||
@ -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);
|
||||
|
||||
|
||||
@ -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))
|
||||
|
||||
12
gcc/gimple.c
12
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++)
|
||||
{
|
||||
|
||||
@ -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,
|
||||
|
||||
Loading…
Reference in New Issue
Block a user