[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.

diff --git a/gcc/ada/gcc-interface/decl.cc b/gcc/ada/gcc-interface/decl.cc
index 3f6b88a72a3e82330dda5c8f4205e7dcb80eb09d..99277f0730617dcf17a522383e2590d781a168b4 100644 (file)
--- a/gcc/ada/gcc-interface/decl.cc
+++ b/gcc/ada/gcc-interface/decl.cc
@@ -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.  */

diff --git a/gcc/ada/gcc-interface/gigi.h b/gcc/ada/gcc-interface/gigi.h
index b88dfc1c0d59f95dfb1375b935339f4fbec6b4ae..1c1397a2d4fdfcc0e94b1cabf851f2e6e1975e9f 100644 (file)
--- a/gcc/ada/gcc-interface/gigi.h
+++ b/gcc/ada/gcc-interface/gigi.h
@@ -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);
 

diff --git a/gcc/ada/gcc-interface/trans.cc b/gcc/ada/gcc-interface/trans.cc
index 758df38c1c8c9d4fc99938d044369838ebc49f26..aec27e16569ac15637b134bf116b3f37a76d0357 100644 (file)
--- a/gcc/ada/gcc-interface/trans.cc
+++ b/gcc/ada/gcc-interface/trans.cc
@@ -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))