[Ada] Improve code generated for aggregates of VFA type
This avoids using a full access for constants internally generated from assignments of aggregates with a Volatile_Full_Access type. gcc/ada/ * gcc-interface/gigi.h (simple_constant_p): Declare. * gcc-interface/decl.cc (gnat_to_gnu_entity) <E_Variable>: Strip the qualifiers from the type of a simple constant. (simple_constant_p): New predicate. * gcc-interface/trans.cc (node_is_atomic): Return true for objects with atomic type except for simple constants. (node_is_volatile_full_access): Return false for simple constants with VFA type.
This commit is contained in:
parent
40242ebb71
commit
1141fbd71e
@ -660,8 +660,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
|
||||
like variables. */
|
||||
if (definition
|
||||
&& !gnu_expr
|
||||
&& No (Address_Clause (gnat_entity))
|
||||
&& !No_Initialization (gnat_decl)
|
||||
&& No (Address_Clause (gnat_entity))
|
||||
&& No (gnat_renamed_obj))
|
||||
{
|
||||
gnu_decl = error_mark_node;
|
||||
@ -781,6 +781,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
|
||||
if (kind == E_Loop_Parameter)
|
||||
gnu_type = get_base_type (gnu_type);
|
||||
|
||||
/* If this is a simple constant, strip the qualifiers from its type,
|
||||
since the constant represents only its value. */
|
||||
else if (simple_constant_p (gnat_entity))
|
||||
gnu_type = TYPE_MAIN_VARIANT (gnu_type);
|
||||
|
||||
/* Reject non-renamed objects whose type is an unconstrained array or
|
||||
any object whose type is a dummy type or void. */
|
||||
if ((TREE_CODE (gnu_type) == UNCONSTRAINED_ARRAY_TYPE
|
||||
@ -9541,6 +9546,19 @@ promote_object_alignment (tree gnu_type, tree gnu_size, Entity_Id gnat_entity)
|
||||
return align;
|
||||
}
|
||||
|
||||
/* Return whether GNAT_ENTITY is a simple constant, i.e. it represents only
|
||||
its value and reading it has no side effects. */
|
||||
|
||||
bool
|
||||
simple_constant_p (Entity_Id gnat_entity)
|
||||
{
|
||||
return Ekind (gnat_entity) == E_Constant
|
||||
&& Present (Constant_Value (gnat_entity))
|
||||
&& !No_Initialization (gnat_entity)
|
||||
&& No (Address_Clause (gnat_entity))
|
||||
&& No (Renamed_Object (gnat_entity));
|
||||
}
|
||||
|
||||
/* Verify that TYPE is something we can implement atomically. If not, issue
|
||||
an error for GNAT_ENTITY. COMPONENT_P is true if we are being called to
|
||||
process a component type. */
|
||||
|
@ -998,6 +998,10 @@ extern Entity_Id get_debug_scope (Node_Id gnat_node, bool *is_subprogram);
|
||||
should be synchronized with Exp_Dbug.Debug_Renaming_Declaration. */
|
||||
extern bool can_materialize_object_renaming_p (Node_Id expr);
|
||||
|
||||
/* Return whether GNAT_ENTITY is a simple constant, i.e. it represents only
|
||||
its value and reading it has no side effects. */
|
||||
extern bool simple_constant_p (Entity_Id gnat_entity);
|
||||
|
||||
/* Return the size of TYPE, which must be a positive power of 2. */
|
||||
extern unsigned int resolve_atomic_size (tree type);
|
||||
|
||||
|
@ -4111,9 +4111,11 @@ node_is_atomic (Node_Id gnat_node)
|
||||
case N_Identifier:
|
||||
case N_Expanded_Name:
|
||||
gnat_entity = Entity (gnat_node);
|
||||
if (Ekind (gnat_entity) != E_Variable)
|
||||
if (!Is_Object (gnat_entity))
|
||||
break;
|
||||
return Is_Atomic (gnat_entity) || Is_Atomic (Etype (gnat_entity));
|
||||
return Is_Atomic (gnat_entity)
|
||||
|| (Is_Atomic (Etype (gnat_entity))
|
||||
&& !simple_constant_p (gnat_entity));
|
||||
|
||||
case N_Selected_Component:
|
||||
return Is_Atomic (Etype (gnat_node))
|
||||
@ -4152,7 +4154,8 @@ node_is_volatile_full_access (Node_Id gnat_node)
|
||||
if (!Is_Object (gnat_entity))
|
||||
break;
|
||||
return Is_Volatile_Full_Access (gnat_entity)
|
||||
|| Is_Volatile_Full_Access (Etype (gnat_entity));
|
||||
|| (Is_Volatile_Full_Access (Etype (gnat_entity))
|
||||
&& !simple_constant_p (gnat_entity));
|
||||
|
||||
case N_Selected_Component:
|
||||
return Is_Volatile_Full_Access (Etype (gnat_node))
|
||||
|
Loading…
Reference in New Issue
Block a user