[COMMITTED] ada: Adjust again the implementation of storage models

Message ID 20230530072113.2500553-1-poulhies@adacore.com
State Committed
Commit d5518dabfa4ea310ee237dd4944970c387f27b3f
Headers
Series [COMMITTED] ada: Adjust again the implementation of storage models |

Commit Message

Marc Poulhiès May 30, 2023, 7:21 a.m. UTC
  From: Eric Botcazou <ebotcazou@adacore.com>

The code generator must now be prepared to translate assignment statements
to objects allocated with a storage model and that are not initialized yet.

gcc/ada/

	* gcc-interface/trans.cc (Attribute_to_gnu) <Attr_Size>: Tweak.
	(gnat_to_gnu) <N_Assignment_Statement>: Declare a local variable.
	For a target with a storage model, use the Actual_Designated_Subtype
	to compute the size if it is present.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/gcc-interface/trans.cc | 51 +++++++++++++++++++---------------
 1 file changed, 29 insertions(+), 22 deletions(-)
  

Patch

diff --git a/gcc/ada/gcc-interface/trans.cc b/gcc/ada/gcc-interface/trans.cc
index 92c8dc33af8..4e5f26305f5 100644
--- a/gcc/ada/gcc-interface/trans.cc
+++ b/gcc/ada/gcc-interface/trans.cc
@@ -1945,24 +1945,20 @@  Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute)
 	  /* If this is a dereference and we have a special dynamic constrained
 	     subtype on the prefix, use it to compute the size; otherwise, use
 	     the designated subtype.  */
-	  if (Nkind (gnat_prefix) == N_Explicit_Dereference)
+	  if (Nkind (gnat_prefix) == N_Explicit_Dereference
+	      && Present (Actual_Designated_Subtype (gnat_prefix)))
 	    {
-	      Node_Id gnat_actual_subtype
-		= Actual_Designated_Subtype (gnat_prefix);
+	      tree gnu_actual_obj_type
+		= gnat_to_gnu_type (Actual_Designated_Subtype (gnat_prefix));
 	      tree gnu_ptr_type
 		= TREE_TYPE (gnat_to_gnu (Prefix (gnat_prefix)));
 
-	      if (TYPE_IS_FAT_OR_THIN_POINTER_P (gnu_ptr_type)
-		  && Present (gnat_actual_subtype))
-		{
-		  tree gnu_actual_obj_type
-		    = gnat_to_gnu_type (gnat_actual_subtype);
-		  gnu_type
-		    = build_unc_object_type_from_ptr (gnu_ptr_type,
-						      gnu_actual_obj_type,
-						      get_identifier ("SIZE"),
-						      false);
-		}
+	      if (TYPE_IS_FAT_OR_THIN_POINTER_P (gnu_ptr_type))
+		gnu_type
+		  = build_unc_object_type_from_ptr (gnu_ptr_type,
+						    gnu_actual_obj_type,
+						    get_identifier ("SIZE"),
+						    false);
 	    }
 
 	  gnu_result = TYPE_SIZE (gnu_type);
@@ -7378,13 +7374,13 @@  gnat_to_gnu (Node_Id gnat_node)
       /* Otherwise we need to build the assignment statement manually.  */
       else
 	{
+	  const Node_Id gnat_name = Name (gnat_node);
 	  const Node_Id gnat_expr = Expression (gnat_node);
 	  const Node_Id gnat_inner
 	    = Nkind (gnat_expr) == N_Qualified_Expression
 	      ? Expression (gnat_expr)
 	      : gnat_expr;
-	  const Entity_Id gnat_type
-	    = Underlying_Type (Etype (Name (gnat_node)));
+	  const Entity_Id gnat_type = Underlying_Type (Etype (gnat_name));
 	  const bool use_memset_p
 	    = Is_Array_Type (gnat_type)
 	      && Nkind (gnat_inner) == N_Aggregate
@@ -7409,8 +7405,8 @@  gnat_to_gnu (Node_Id gnat_node)
 
 	  gigi_checking_assert (!Do_Range_Check (gnat_expr));
 
-	  get_atomic_access (Name (gnat_node), &aa_type, &aa_sync);
-	  get_storage_model_access (Name (gnat_node), &gnat_smo);
+	  get_atomic_access (gnat_name, &aa_type, &aa_sync);
+	  get_storage_model_access (gnat_name, &gnat_smo);
 
 	  /* If an outer atomic access is required on the LHS, build the load-
 	     modify-store sequence.  */
@@ -7427,15 +7423,26 @@  gnat_to_gnu (Node_Id gnat_node)
 	  else if (Present (gnat_smo)
 		   && Present (Storage_Model_Copy_To (gnat_smo)))
 	    {
+	      tree gnu_size;
+
 	      /* We obviously cannot use memset in this case.  */
 	      gcc_assert (!use_memset_p);
 
-	      /* We cannot directly move between nonnative storage models.  */
-	      tree t = remove_conversions (gnu_rhs, false);
-	      gcc_assert (TREE_CODE (t) != LOAD_EXPR);
+	      /* If this is a dereference with a special dynamic constrained
+		 subtype on the node, use it to compute the size.  */
+	      if (Nkind (gnat_name) == N_Explicit_Dereference
+		  && Present (Actual_Designated_Subtype (gnat_name)))
+		{
+		  tree gnu_actual_obj_type
+		    = gnat_to_gnu_type (Actual_Designated_Subtype (gnat_name));
+		  gnu_size = TYPE_SIZE_UNIT (gnu_actual_obj_type);
+		}
+	      else
+		gnu_size = NULL_TREE;
 
 	      gnu_result
-		= build_storage_model_store (gnat_smo, gnu_lhs, gnu_rhs);
+		= build_storage_model_store (gnat_smo, gnu_lhs, gnu_rhs,
+					     gnu_size);
 	    }
 
 	  /* Or else, use memset when the conditions are met.  This has already