gimplify.c (gimplify_modify_expr_rhs): Do not do a direct assignment from the constructor either if the target is volatile.

* gimplify.c (gimplify_modify_expr_rhs) <VAR_DECL>: Do not do a direct
	assignment from the constructor either if the target is volatile.
ada/
	* einfo.ads (Is_True_Constant): Lift restriction on atomic objects.
	* sinfo.ads (Object Declaration): Likewise.
	(Assignment Statement): Likewise.
	* freeze.adb (Expand_Atomic_Aggregate): Remove useless test.
	Do not force Is_True_Constant to false on the temporary.
	(Freeze_Entity): Do not force Is_True_Constant to false on names on
	the RHS of object declarations.
	* gcc-interface/trans.c (lvalue_required_p) <N_Object_Declaration>:
	New case.  Return 1 if the object is atomic.
	<N_Assignment_Statement>: Likewise.

From-SVN: r146652

gcc/ChangeLog

@@ -1,3 +1,8 @@
+2009-04-23  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gimplify.c (gimplify_modify_expr_rhs) <VAR_DECL>: Do not do a direct
+	assignment from the constructor either if the target is volatile.
+
 2009-04-23  Daniel Jacobowitz  <dan@codesourcery.com>
 
 	* config/arm/arm.md (insv): Do not share operands[0].

gcc/ada/ChangeLog

@@ -1,3 +1,16 @@
+2009-04-23  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* einfo.ads (Is_True_Constant): Lift restriction on atomic objects.
+	* sinfo.ads (Object Declaration): Likewise.
+	(Assignment Statement): Likewise.
+	* freeze.adb (Expand_Atomic_Aggregate): Remove useless test.
+	Do not force Is_True_Constant to false on the temporary.
+	(Freeze_Entity): Do not force Is_True_Constant to false on names on
+	the RHS of object declarations.
+	* gcc-interface/trans.c (lvalue_required_p) <N_Object_Declaration>:
+	New case.  Return 1 if the object is atomic.
+	<N_Assignment_Statement>: Likewise.
+
 2009-04-23  Eric Botcazou  <ebotcazou@adacore.com>
 
 	* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Modular_Integer_Subtype>

gcc/ada/einfo.ads

@@ -2615,16 +2615,6 @@ package Einfo is
 --       that the constant was not modified by generated code (e.g. to set a
 --       discriminant in an init proc). Assignments by user or generated code
 --       will reset this flag.
---
---       Note: there is one situation in which the back end does not permit
---       this flag to be set, even if no assignments are generated. This is
---       the case of an object of a record or array type which is initialized
---       with an aggregate, and is itself used as the expression initializing
---       an atomic object, or the right hand side of an assignment to an atomic
---       object. In this case the object must not have Is_True_Constant set,
---       even though no assignments are generated (the reason for this is that
---       the back end must not optimize the object away, because that would
---       violate the restriction on aggregates in these positions).
 
 --    Is_Type (synthesized)
 --       Applies to all entities, true for a type entity

gcc/ada/freeze.adb

@@ -1120,7 +1120,6 @@ package body Freeze is
       if (Nkind (Parent (E)) = N_Object_Declaration
             or else Nkind (Parent (E)) = N_Assignment_Statement)
         and then Comes_From_Source (Parent (E))
-        and then Nkind (E) = N_Aggregate
       then
          Temp :=
            Make_Defining_Identifier (Loc,
@@ -1136,13 +1135,6 @@ package body Freeze is
 
          Set_Expression (Parent (E), New_Occurrence_Of (Temp, Loc));
 
-         --  To prevent the temporary from being constant-folded (which would
-         --  lead to the same piecemeal assignment on the original target)
-         --  indicate to the back-end that the temporary is a variable with
-         --  real storage. See description of this flag in Einfo, and the notes
-         --  on N_Assignment_Statement and N_Object_Declaration in Sinfo.
-
-         Set_Is_True_Constant (Temp, False);
       end if;
    end Expand_Atomic_Aggregate;
 
@@ -2295,39 +2287,18 @@ package body Freeze is
             Set_Encoded_Interface_Name
               (E, Get_Default_External_Name (E));
 
-         --  Special processing for atomic objects appearing in object decls
+         --  If entity is an atomic object appearing in a declaration and
+         --  the expression is an aggregate, assign it to a temporary to
+         --  ensure that the actual assignment is done atomically rather
+         --  than component-wise (the assignment to the temp may be done
+         --  component-wise, but that is harmless).
 
          elsif Is_Atomic (E)
            and then Nkind (Parent (E)) = N_Object_Declaration
            and then Present (Expression (Parent (E)))
+           and then Nkind (Expression (Parent (E))) = N_Aggregate
          then
-            declare
-               Expr : constant Node_Id := Expression (Parent (E));
-
-            begin
-               --  If expression is an aggregate, assign to a temporary to
-               --  ensure that the actual assignment is done atomically rather
-               --  than component-wise (the assignment to the temp may be done
-               --  component-wise, but that is harmless).
-
-               if Nkind (Expr) = N_Aggregate then
-                  Expand_Atomic_Aggregate (Expr, Etype (E));
-
-               --  If the expression is a reference to a record or array object
-               --  entity, then reset Is_True_Constant to False so that the
-               --  compiler will not optimize away the intermediate object,
-               --  which we need in this case for the same reason (to ensure
-               --  that the actual assignment is atomic, rather than
-               --  component-wise).
-
-               elsif Is_Entity_Name (Expr)
-                 and then (Is_Record_Type (Etype (Expr))
-                             or else
-                           Is_Array_Type (Etype (Expr)))
-               then
-                  Set_Is_True_Constant (Entity (Expr), False);
-               end if;
-            end;
+            Expand_Atomic_Aggregate (Expression (Parent (E)), Etype (E));
          end if;
 
          --  For a subprogram, freeze all parameter types and also the return

gcc/ada/gcc-interface/trans.c

@@ -723,6 +723,18 @@ lvalue_required_p (Node_Id gnat_node, tree gnu_type, int aliased)
 		 (Underlying_Type (Etype (Name (gnat_parent))))
 	      || Nkind (Name (gnat_parent)) == N_Identifier);
 
+    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));
+
+    case N_Assignment_Statement:
+      /* We cannot use a constructor if the LHS 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 (Entity (Name (gnat_parent)));
+
     default:
       return 0;
     }

gcc/ada/sinfo.ads

@@ -2152,11 +2152,8 @@ package Sinfo is
       --  Note: the back end places some restrictions on the form of the
       --  Expression field. If the object being declared is Atomic, then
       --  the Expression may not have the form of an aggregate (since this
-      --  might cause the back end to generate separate assignments). It
-      --  also cannot be a reference to an object marked as a true constant
-      --  (Is_True_Constant flag set), where the object is itself initialized
-      --  with an aggregate. If necessary the front end must generate an
-      --  extra temporary (with Is_True_Constant set False), and initialize
+      --  might cause the back end to generate separate assignments). In this
+      --  case the front end must generate an extra temporary and initialize
       --  this temporary as required (the temporary itself is not atomic).
 
       --  Note: there is not node kind for object definition. Instead, the
@@ -3848,11 +3845,8 @@ package Sinfo is
       --  Note: the back end places some restrictions on the form of the
       --  Expression field. If the object being assigned to is Atomic, then
       --  the Expression may not have the form of an aggregate (since this
-      --  might cause the back end to generate separate assignments). It
-      --  also cannot be a reference to an object marked as a true constant
-      --  (Is_True_Constant flag set), where the object is itself initialized
-      --  with an aggregate. If necessary the front end must generate an
-      --  extra temporary (with Is_True_Constant set False), and initialize
+      --  might cause the back end to generate separate assignments). In this
+      --  case the front end must generate an extra temporary and initialize
       --  this temporary as required (the temporary itself is not atomic).
 
       -----------------------

gcc/gimplify.c

@@ -3982,11 +3982,14 @@ gimplify_modify_expr_rhs (tree *expr_p, tree *from_p, tree *to_p,
     switch (TREE_CODE (*from_p))
       {
       case VAR_DECL:
-	/* If we're assigning from a constant constructor, move the
-	   constructor expression to the RHS of the MODIFY_EXPR.  */
+	/* If we're assigning from a read-only variable initialized with
+	   a constructor, do the direct assignment from the constructor,
+	   but only if neither source nor target are volatile since this
+	   latter assignment might end up being done on a per-field basis.  */
 	if (DECL_INITIAL (*from_p)
 	    && TREE_READONLY (*from_p)
 	    && !TREE_THIS_VOLATILE (*from_p)
+	    && !TREE_THIS_VOLATILE (*to_p)
 	    && TREE_CODE (DECL_INITIAL (*from_p)) == CONSTRUCTOR)
 	  {
 	    tree old_from = *from_p;

gcc/testsuite/ChangeLog

@@ -1,3 +1,8 @@
+2009-04-23  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gnat.dg/atomic1.adb: New test.
+	* gnat.dg/atomic1_pkg.ads: New helper.
+
 2009-04-23  Steve Ellcey  <sje@cup.hp.com>
 
 	PR testsuite/39623

gcc/testsuite/gnat.dg/atomic1.adb

@@ -0,0 +1,17 @@
+-- { dg-do compile }
+-- { dg-options "-O0 -fdump-tree-gimple" }
+
+with Atomic1_Pkg; use Atomic1_Pkg;
+
+procedure Atomic1 is
+
+   C_16 : constant R16 := (2, 3, 5, 7);
+   C_32 : constant R32 := (1, 1, 2, 3, 5, 8, 13, 5);
+
+begin
+   V_16 := C_16;
+   V_32 := C_32;
+end;
+
+-- { dg-final { scan-tree-dump-times "v_16" 1 "gimple"} }
+-- { dg-final { scan-tree-dump-times "v_32" 1 "gimple"} }

gcc/testsuite/gnat.dg/atomic1_pkg.ads

@@ -0,0 +1,47 @@
+package Atomic1_Pkg is
+
+   type Four_Bits is mod 2 ** 4;
+
+   type R16 is record
+      F1 : Four_Bits;
+      F2 : Four_Bits;
+      F3 : Four_Bits;
+      F4 : Four_Bits;
+   end record;
+   for R16 use record
+      F1 at 0 range 0  ..  3;
+      F2 at 0 range 4  ..  7;
+      F3 at 0 range 8  .. 11;
+      F4 at 0 range 12 .. 15;
+   end record;
+
+   type R32 is record
+      F1 : Four_Bits;
+      F2 : Four_Bits;
+      F3 : Four_Bits;
+      F4 : Four_Bits;
+      F5 : Four_Bits;
+      F6 : Four_Bits;
+      F7 : Four_Bits;
+      F8 : Four_Bits;
+   end record;
+   for R32 use record
+      F1 at 0 range 0  ..  3;
+      F2 at 0 range 4  ..  7;
+      F3 at 0 range 8  .. 11;
+      F4 at 0 range 12 .. 15;
+      F5 at 0 range 16 .. 19;
+      F6 at 0 range 20 .. 23;
+      F7 at 0 range 24 .. 27;
+      F8 at 0 range 28 .. 31;
+   end record;
+
+   C_16 : constant R16 := (2, 3, 5, 7);
+   C_32 : constant R32 := (1, 1, 2, 3, 5, 8, 13, 5);
+
+   V_16 : R16;
+   pragma Atomic (V_16);
+   V_32 : R32;
+   pragma Atomic (V_32);
+
+end Atomic1_Pkg;