[Ada] Streamline implementation of renaming in gigi

[Ada] Streamline implementation of renaming in gigi

[Eric Botcazou]

[-- Attachment #1: Type: text/plain, Size: 842 bytes --]

The main changes are 1) the bulk of the implementation is put back entirely in 
gnat_to_gnu_entity and 2) the handling of lvalues is unified, i.e. no longer 
depends on the Materialize_Entity flag being present on the entity.

Tested on x86-64/Linux, applied on the mainline.


2020-06-23  Eric Botcazou  <ebotcazou@adacore.com>

	* gcc-interface/ada-tree.h (DECL_RENAMED_OBJECT): Delete.
	* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Variable>: Always use
	the stabilized reference directly for a renaming and create a variable
	pointing to it separately if requested.
	* gcc-interface/misc.c (gnat_print_decl): Adjust for deletion.
	* gcc-interface/trans.c (Identifier_to_gnu): Likewise.
	(gnat_to_gnu) <N_Object_Renaming_Declaration>:
	Do not deal with side-effects here.
	<N_Exception_Renaming_Declaration>: Likewise.

-- 
Eric Botcazou

[-- Attachment #2: p.diff --]
[-- Type: text/x-patch, Size: 11938 bytes --]

diff --git a/gcc/ada/gcc-interface/ada-tree.h b/gcc/ada/gcc-interface/ada-tree.h
index 11bfc37ea3d..461fa2b598c 100644
--- a/gcc/ada/gcc-interface/ada-tree.h
+++ b/gcc/ada/gcc-interface/ada-tree.h
@@ -525,13 +525,6 @@ do {						   \
 #define SET_DECL_INDUCTION_VAR(NODE, X) \
   SET_DECL_LANG_SPECIFIC (VAR_DECL_CHECK (NODE), X)
 
-/* In a VAR_DECL without the DECL_LOOP_PARM_P flag set and that is a renaming
-   pointer, points to the object being renamed, if any.  */
-#define DECL_RENAMED_OBJECT(NODE) \
-  GET_DECL_LANG_SPECIFIC (VAR_DECL_CHECK (NODE))
-#define SET_DECL_RENAMED_OBJECT(NODE, X) \
-  SET_DECL_LANG_SPECIFIC (VAR_DECL_CHECK (NODE), X)
-
 /* In a TYPE_DECL, points to the parallel type if any, otherwise 0.  */
 #define DECL_PARALLEL_TYPE(NODE) \
   GET_DECL_LANG_SPECIFIC (TYPE_DECL_CHECK (NODE))
diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c
index 63118bee930..270710b11d5 100644
--- a/gcc/ada/gcc-interface/decl.c
+++ b/gcc/ada/gcc-interface/decl.c
@@ -714,7 +714,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
 	bool mutable_p = false;
 	bool used_by_ref = false;
 	tree gnu_ext_name = NULL_TREE;
-	tree gnu_renamed_obj = NULL_TREE;
 	tree gnu_ada_size = NULL_TREE;
 
 	/* We need to translate the renamed object even though we are only
@@ -1041,13 +1040,13 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
 	    else if (type_is_padding_self_referential (TREE_TYPE (gnu_expr)))
 	      gnu_type = TREE_TYPE (gnu_expr);
 
-	    /* Case 1: if this is a constant renaming stemming from a function
-	       call, treat it as a normal object whose initial value is what
-	       is being renamed.  RM 3.3 says that the result of evaluating a
-	       function call is a constant object.  Therefore, it can be the
-	       inner object of a constant renaming and the renaming must be
-	       fully instantiated, i.e. it cannot be a reference to (part of)
-	       an existing object.  And treat other rvalues the same way.  */
+	    /* If this is a constant renaming stemming from a function call,
+	       treat it as a normal object whose initial value is what is being
+	       renamed.  RM 3.3 says that the result of evaluating a function
+	       call is a constant object.  Therefore, it can be the inner
+	       object of a constant renaming and the renaming must be fully
+	       instantiated, i.e. it cannot be a reference to (part of) an
+	       existing object.  And treat other rvalues the same way.  */
 	    tree inner = gnu_expr;
 	    while (handled_component_p (inner) || CONVERT_EXPR_P (inner))
 	      inner = TREE_OPERAND (inner, 0);
@@ -1089,92 +1088,75 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
 		    && DECL_RETURN_VALUE_P (inner)))
 	      ;
 
-	    /* Case 2: if the renaming entity need not be materialized, use
-	       the elaborated renamed expression for the renaming.  But this
-	       means that the caller is responsible for evaluating the address
-	       of the renaming in the correct place for the definition case to
-	       instantiate the SAVE_EXPRs.  But we cannot use this mechanism if
-	       the renamed object is an N_Expression_With_Actions because this
-	       would fail the assertion below.  */
-	    else if (!Materialize_Entity (gnat_entity)
-		     && Nkind (gnat_renamed_obj) != N_Expression_With_Actions)
+	    /* Otherwise, this is an lvalue being renamed, so it needs to be
+	       elaborated as a reference and substituted for the entity.  But
+	       this means that we must evaluate the address of the renaming
+	       in the definition case to instantiate the SAVE_EXPRs.  */
+	    else
 	      {
-		tree init = NULL_TREE;
+		tree gnu_init = NULL_TREE;
 
-		gnu_decl
-		  = elaborate_reference (gnu_expr, gnat_entity, definition,
-					 &init);
+		if (type_annotate_only && TREE_CODE (gnu_expr) == ERROR_MARK)
+		  break;
 
-		/* We cannot evaluate the first arm of a COMPOUND_EXPR in the
-		   correct place for this case.  */
-		gcc_assert (!init);
+		gnu_expr
+		  = elaborate_reference (gnu_expr, gnat_entity, definition,
+					 &gnu_init);
 
-		/* No DECL_EXPR will be created so the expression needs to be
+		/* No DECL_EXPR might be created so the expression needs to be
 		   marked manually because it will likely be shared.  */
 		if (global_bindings_p ())
-		  MARK_VISITED (gnu_decl);
+		  MARK_VISITED (gnu_expr);
 
 		/* This assertion will fail if the renamed object isn't aligned
 		   enough as to make it possible to honor the alignment set on
 		   the renaming.  */
 		if (align)
 		  {
-		    unsigned int ralign = DECL_P (gnu_decl)
-					  ? DECL_ALIGN (gnu_decl)
-					  : TYPE_ALIGN (TREE_TYPE (gnu_decl));
+		    const unsigned int ralign
+		      = DECL_P (gnu_expr)
+			? DECL_ALIGN (gnu_expr)
+			: TYPE_ALIGN (TREE_TYPE (gnu_expr));
 		    gcc_assert (ralign >= align);
 		  }
 
 		/* The expression might not be a DECL so save it manually.  */
+		gnu_decl = gnu_expr;
 		save_gnu_tree (gnat_entity, gnu_decl, true);
 		saved = true;
 		annotate_object (gnat_entity, gnu_type, NULL_TREE, false);
-		break;
-	      }
 
-	    /* Case 3: otherwise, make a constant pointer to the object we
-	       are renaming and attach the object to the pointer after it is
-	       elaborated.  The object will be referenced directly instead
-	       of indirectly via the pointer to avoid aliasing problems with
-	       non-addressable entities.  The pointer is called a "renaming"
-	       pointer in this case.  Note that we also need to preserve the
-	       volatility of the renamed object through the indirection.  */
-	    else
-	      {
-		tree init = NULL_TREE;
+		/* If this is only a reference to the entity, we are done.  */
+		if (!definition)
+		  break;
 
-		if (TREE_THIS_VOLATILE (gnu_expr) && !TYPE_VOLATILE (gnu_type))
-		  gnu_type
-		    = change_qualified_type (gnu_type, TYPE_QUAL_VOLATILE);
-		gnu_type = build_reference_type (gnu_type);
-		used_by_ref = true;
-		const_flag = true;
-		volatile_flag = false;
-		inner_const_flag = TREE_READONLY (gnu_expr);
-		gnu_size = NULL_TREE;
+		/* Otherwise, emit the initialization statement, if any.  */
+		if (gnu_init)
+		  add_stmt (gnu_init);
 
-		gnu_renamed_obj
-		  = elaborate_reference (gnu_expr, gnat_entity, definition,
-					 &init);
+		/* If it needs to be materialized for debugging purposes, build
+		   the entity as indirect reference to the renamed object.  */
+		if (Materialize_Entity (gnat_entity))
+		  {
+		    gnu_type = build_reference_type (gnu_type);
+		    const_flag = true;
+		    volatile_flag = false;
 
-		/* The expression needs to be marked manually because it will
-		   likely be shared, even for a definition since the ADDR_EXPR
-		   built below can cause the first few nodes to be folded.  */
-		if (global_bindings_p ())
-		  MARK_VISITED (gnu_renamed_obj);
+		    gnu_expr = build_unary_op (ADDR_EXPR, gnu_type, gnu_expr);
 
-		if (type_annotate_only
-		    && TREE_CODE (gnu_renamed_obj) == ERROR_MARK)
-		  gnu_expr = NULL_TREE;
-		else
-		  {
-		    gnu_expr
-		      = build_unary_op (ADDR_EXPR, gnu_type, gnu_renamed_obj);
-		    if (init)
-		      gnu_expr
-			= build_compound_expr (TREE_TYPE (gnu_expr), init,
-					       gnu_expr);
+		    create_var_decl (gnu_entity_name, gnu_ext_name,
+				     TREE_TYPE (gnu_expr), gnu_expr,
+				     const_flag, Is_Public (gnat_entity),
+				     imported_p, static_flag, volatile_flag,
+				     artificial_p, debug_info_p, attr_list,
+				     gnat_entity, false);
 		  }
+
+		/* Otherwise, instantiate the SAVE_EXPRs if needed.  */
+		else if (TREE_SIDE_EFFECTS (gnu_expr))
+		  add_stmt (build_unary_op (ADDR_EXPR, NULL_TREE, gnu_expr));
+
+		break;
 	      }
 	  }
 
@@ -1538,7 +1520,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
 			     imported_p || !definition, static_flag,
 			     volatile_flag, artificial_p,
 			     debug_info_p && definition, attr_list,
-			     gnat_entity, !gnu_renamed_obj);
+			     gnat_entity, true);
 	DECL_BY_REF_P (gnu_decl) = used_by_ref;
 	DECL_POINTS_TO_READONLY_P (gnu_decl) = used_by_ref && inner_const_flag;
 	DECL_CAN_NEVER_BE_NULL_P (gnu_decl) = Can_Never_Be_Null (gnat_entity);
@@ -1566,10 +1548,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
 	else if (kind == E_Loop_Parameter)
 	  DECL_LOOP_PARM_P (gnu_decl) = 1;
 
-	/* If this is a renaming pointer, attach the renamed object to it.  */
-	if (gnu_renamed_obj)
-	  SET_DECL_RENAMED_OBJECT (gnu_decl, gnu_renamed_obj);
-
 	/* If this is a constant and we are defining it or it generates a real
 	   symbol at the object level and we are referencing it, we may want
 	   or need to have a true variable to represent it:
diff --git a/gcc/ada/gcc-interface/misc.c b/gcc/ada/gcc-interface/misc.c
index f360ad4da22..3999f9cc2be 100644
--- a/gcc/ada/gcc-interface/misc.c
+++ b/gcc/ada/gcc-interface/misc.c
@@ -467,9 +467,6 @@ gnat_print_decl (FILE *file, tree node, int indent)
       if (DECL_LOOP_PARM_P (node))
 	print_node (file, "induction var", DECL_INDUCTION_VAR (node),
 		    indent + 4);
-      else
-	print_node (file, "renamed object", DECL_RENAMED_OBJECT (node),
-		    indent + 4);
       break;
 
     default:
diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c
index a64b6d00d00..c32bdb96a5e 100644
--- a/gcc/ada/gcc-interface/trans.c
+++ b/gcc/ada/gcc-interface/trans.c
@@ -1249,25 +1249,16 @@ Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p)
 					  true)))
 	gnu_result = DECL_INITIAL (gnu_result);
 
-      /* If it's a renaming pointer, get to the renamed object.  */
-      if (TREE_CODE (gnu_result) == VAR_DECL
-          && !DECL_LOOP_PARM_P (gnu_result)
-	  && DECL_RENAMED_OBJECT (gnu_result))
-	gnu_result = DECL_RENAMED_OBJECT (gnu_result);
-
-      /* Otherwise, do the final dereference.  */
-      else
-	{
-	  gnu_result = build_unary_op (INDIRECT_REF, NULL_TREE, gnu_result);
+      /* Do the final dereference.  */
+      gnu_result = build_unary_op (INDIRECT_REF, NULL_TREE, gnu_result);
 
-	  if ((TREE_CODE (gnu_result) == INDIRECT_REF
-	       || TREE_CODE (gnu_result) == UNCONSTRAINED_ARRAY_REF)
-	      && No (Address_Clause (gnat_entity)))
-	    TREE_THIS_NOTRAP (gnu_result) = 1;
+      if ((TREE_CODE (gnu_result) == INDIRECT_REF
+	   || TREE_CODE (gnu_result) == UNCONSTRAINED_ARRAY_REF)
+	  && No (Address_Clause (gnat_entity)))
+	TREE_THIS_NOTRAP (gnu_result) = 1;
 
-	  if (read_only)
-	    TREE_READONLY (gnu_result) = 1;
-	}
+      if (read_only)
+	TREE_READONLY (gnu_result) = 1;
     }
 
   /* If we have a constant declaration and its initializer, try to return the
@@ -6543,31 +6534,19 @@ gnat_to_gnu (Node_Id gnat_node)
 		&& (Is_Array_Type (Etype (gnat_temp))
 		    || Is_Record_Type (Etype (gnat_temp))
 		    || Is_Concurrent_Type (Etype (gnat_temp)))))
-	{
-	  tree gnu_temp
-	    = gnat_to_gnu_entity (gnat_temp,
-				  gnat_to_gnu (Renamed_Object (gnat_temp)),
-				  true);
-	  /* See case 2 of renaming in gnat_to_gnu_entity.  */
-	  if (TREE_SIDE_EFFECTS (gnu_temp))
-	    gnu_result = build_unary_op (ADDR_EXPR, NULL_TREE, gnu_temp);
-	}
+	gnat_to_gnu_entity (gnat_temp,
+			    gnat_to_gnu (Renamed_Object (gnat_temp)),
+			    true);
       break;
 
     case N_Exception_Renaming_Declaration:
       gnat_temp = Defining_Entity (gnat_node);
       gnu_result = alloc_stmt_list ();
 
-      /* See the above case for the rationale.  */
       if (Present (Renamed_Entity (gnat_temp)))
-	{
-	  tree gnu_temp
-	    = gnat_to_gnu_entity (gnat_temp,
-				  gnat_to_gnu (Renamed_Entity (gnat_temp)),
-				  true);
-	  if (TREE_SIDE_EFFECTS (gnu_temp))
-	    gnu_result = build_unary_op (ADDR_EXPR, NULL_TREE, gnu_temp);
-	}
+	gnat_to_gnu_entity (gnat_temp,
+			    gnat_to_gnu (Renamed_Entity (gnat_temp)),
+			    true);
       break;
 
     case N_Subprogram_Renaming_Declaration: