[Ada] Get rid of secondary stack for most calls returning tagged types

This eliminates the use of the secondary stack to return specific tagged
types from functions in calls that are not dispatching on result, which
comprises returning controlled types, by introducing thunks whose only
purpose is to move the result from the primary to the secondary stack
for primitive functions that are controlling on result, and referencing
them in the dispatch table in lieu of the primitive functions.

The implementation reuses the existing machinery of interface thunks and
thus creates another kind of thunks, secondary stack thunks, which only
perform a call to the primitive function and return the result.

gcc/ada/

	* einfo.ads (Has_Controlling_Result): Document new usage.
	(Is_Thunk): Document secondary stack thunks.
	(Returns_By_Ref): Adjust.
	* exp_ch6.adb (Caller_Known_Size): Return true for tagged types.
	(Expand_N_Extended_Return_Statement): Do not call Set_By_Ref.
	(Expand_Simple_Function_Return): For a BIP return with an Alloc_Form
	parameter, mark the node as returning on the secondary stack.
	Replace call to Is_Limited_Interface with Is_Limited_View.  Deal wit
	secondary stack thunks.  Do not call Set_By_Ref.  Optimize the case
	of a call to a function whose type also needs finalization.
	(Needs_BIP_Task_Actuals): Replace Thunk_Entity with Thunk_Target.
	(Needs_BIP_Finalization_Master): Cosmetic fixes.
	(Needs_BIP_Alloc_Form): Check No_Secondary_Stack restriction and
	return true for tagged types.
	* exp_ch7.adb (Transient Scope Management): Update description.
	* exp_disp.adb (Expand_Dispatching_Call): Always set Returns_By_Ref
	on designated type if the call is dispatching on result.  Tidy up.
	(Expand_Interface_Thunk): Change type of Thunk_Code from Node_Id to
	List_Id.  Change type of local variables from Node_Id to Entity_Id.
	Propagate Aliased_Present flag to create the formals and explicitly
	set Has_Controlling_Result to False.  Build a secondary stack thunk
	if necessary in the function case.
	(Expand_Secondary_Stack_Thunk): New function.
	(Make_Secondary_DT): Build secondary stack thunks if necessary.
	(Make_DT): Likewise.
	(Register_Predefined_Primitive): Likewise.
	(Register_Primitive): Likewise.
	* exp_util.ads (Is_Secondary_Stack_Thunk): Declare.
	(Thunk_Target): Likewise.
	* exp_util.adb (Is_Secondary_Stack_Thunk): New function.
	(Thunk_Target): Likewise.
	* fe.h (Is_Secondary_Stack_Thunk): Declare.
	(Thunk_Target): Likewise.
	* gen_il-fields.ads (Opt_Field_Enum): Remove By_Ref.
	* gen_il-gen-gen_nodes.adb (N_Simple_Return_Statement): Likewise.
	(N_Extended_Return_Statement): Likewise.
	* sem_ch6.adb (Analyze_Subprogram_Specification): Skip check for
	abstract return type in the thunk case.
	(Create_Extra_Formals): Replace Thunk_Entity with Thunk_Target.
	* sem_disp.adb (Check_Controlling_Formals): Skip in the thunk case.
	* sem_util.adb: Add use and with clauses for Exp_Ch6.
	(Compute_Returns_By_Ref): Do not process procedures and only set
	the flag for direct return by reference.
	(Needs_Secondary_Stack): Do not return true for specific tagged
	types and adjust comments accordingly.
	* sinfo.ads (By_Ref): Delete.
	(N_Simple_Return_Statement): Remove By_Ref.
	(N_Extended_Return_Statement): Likewise.
	* gcc-interface/ada-tree.h (TYPE_RETURN_UNCONSTRAINED_P): Delete.
	* gcc-interface/decl.cc (gnat_to_gnu_subprog_type): Do not use it.
	Return by direct reference if the return type needs the secondary
	stack as well as for secondary stack thunks.
	* gcc-interface/gigi.h (fntype_same_flags_p): Remove parameter.
	* gcc-interface/misc.cc (gnat_type_hash_eq): Adjust to above change.
	* gcc-interface/trans.cc (finalize_nrv): Replace test on
	TYPE_RETURN_UNCONSTRAINED_P with TYPE_RETURN_BY_DIRECT_REF_P.
	(Subprogram_Body_to_gnu): Do not call maybe_make_gnu_thunk for
	secondary stack thunks.
	(Call_to_gnu): Do not test TYPE_RETURN_UNCONSTRAINED_P.
	(gnat_to_gnu) <N_Simple_Return_Statement>: In the return by direct
	reference case, test for the presence of Storage_Pool on the node
	to build an allocator.
	(maybe_make_gnu_thunk): Deal with Thunk_Entity and Thunk_Target.
	* gcc-interface/utils.cc (fntype_same_flags_p): Remove parameter.

1 files changed, 56 insertions, 47 deletions

diff --git a/gcc/ada/gcc-interface/trans.cc b/gcc/ada/gcc-interface/trans.cc
index e80200e..8097a89 100644
--- a/gcc/ada/gcc-interface/trans.cc
+++ b/gcc/ada/gcc-interface/trans.cc
@@ -3725,7 +3725,7 @@ finalize_nrv (tree fndecl, bitmap nrv, vec<tree, va_gc> *other, Node_Id gnat_ret
   data.result = DECL_RESULT (fndecl);
   data.gnat_ret = gnat_ret;
   data.visited = new hash_set<tree>;
-  if (TYPE_RETURN_UNCONSTRAINED_P (TREE_TYPE (fndecl)))
+  if (TYPE_RETURN_BY_DIRECT_REF_P (TREE_TYPE (fndecl)))
     func = finalize_nrv_unc_r;
   else
     func = finalize_nrv_r;
@@ -3902,6 +3902,7 @@ Subprogram_Body_to_gnu (Node_Id gnat_node)
 
   /* Try to create a bona-fide thunk and hand it over to the middle-end.  */
   if (Is_Thunk (gnat_subprog)
+      && !Is_Secondary_Stack_Thunk (gnat_subprog)
       && maybe_make_gnu_thunk (gnat_subprog, gnu_subprog))
     return;
 
@@ -5252,10 +5253,9 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target,
 	  gnu_result_type = TREE_TYPE (gnu_call);
 	}
 
-      /* If the function returns an unconstrained array or by direct reference,
-	 we have to dereference the pointer.  */
-      if (TYPE_RETURN_UNCONSTRAINED_P (gnu_subprog_type)
-	  || TYPE_RETURN_BY_DIRECT_REF_P (gnu_subprog_type))
+      /* If the function returns by direct reference, we have to dereference
+	 the pointer.  */
+      if (TYPE_RETURN_BY_DIRECT_REF_P (gnu_subprog_type))
 	gnu_call = build_unary_op (INDIRECT_REF, NULL_TREE, gnu_call);
 
       if (gnu_target)
@@ -7439,52 +7439,58 @@ gnat_to_gnu (Node_Id gnat_node)
 	      gnu_ret_val = TREE_OPERAND (gnu_ret_val, 0);
 
 	    /* If the function returns by direct reference, return a pointer
-	       to the return value.  */
-	    if (TYPE_RETURN_BY_DIRECT_REF_P (gnu_subprog_type)
-		|| By_Ref (gnat_node))
-	      gnu_ret_val = build_unary_op (ADDR_EXPR, NULL_TREE, gnu_ret_val);
-
-	    /* Otherwise, if it returns an unconstrained array, we have to
-	       allocate a new version of the result and return it.  */
-	    else if (TYPE_RETURN_UNCONSTRAINED_P (gnu_subprog_type))
+	       to the return value, possibly after allocating it.  */
+	    if (TYPE_RETURN_BY_DIRECT_REF_P (gnu_subprog_type))
 	      {
-		gnu_ret_val = maybe_unconstrained_array (gnu_ret_val);
-
-		/* And find out whether this is a candidate for Named Return
-		   Value.  If so, record it.  */
-		if (optimize
-		    && !optimize_debug
-		    && !TYPE_CI_CO_LIST (gnu_subprog_type))
+		if (Present (Storage_Pool (gnat_node)))
 		  {
-		    tree ret_val = gnu_ret_val;
-
-		    /* Strip useless conversions around the return value.  */
-		    if (gnat_useless_type_conversion (ret_val))
-		      ret_val = TREE_OPERAND (ret_val, 0);
-
-		    /* Strip unpadding around the return value.  */
-		    if (TREE_CODE (ret_val) == COMPONENT_REF
-			&& TYPE_IS_PADDING_P
-			   (TREE_TYPE (TREE_OPERAND (ret_val, 0))))
-		      ret_val = TREE_OPERAND (ret_val, 0);
-
-		    /* Now apply the test to the return value.  */
-		    if (return_value_ok_for_nrv_p (NULL_TREE, ret_val))
+		    gnu_ret_val = maybe_unconstrained_array (gnu_ret_val);
+
+		    /* And find out whether it is a candidate for Named Return
+		       Value.  If so, record it.  Note that we disable this NRV
+		       optimization when we're preserving the control flow as
+		       it entails hoisting the allocation done below.  */
+		    if (optimize
+			&& !optimize_debug
+			&& !TYPE_CI_CO_LIST (gnu_subprog_type))
 		      {
-			if (!f_named_ret_val)
-			  f_named_ret_val = BITMAP_GGC_ALLOC ();
-			bitmap_set_bit (f_named_ret_val, DECL_UID (ret_val));
-			if (!f_gnat_ret)
-			  f_gnat_ret = gnat_node;
+			tree ret_val = gnu_ret_val;
+
+			/* Strip conversions around the return value.  */
+			if (gnat_useless_type_conversion (ret_val))
+			  ret_val = TREE_OPERAND (ret_val, 0);
+
+			/* Strip unpadding around the return value.  */
+			if (TREE_CODE (ret_val) == COMPONENT_REF
+			    && TYPE_IS_PADDING_P
+			      (TREE_TYPE (TREE_OPERAND (ret_val, 0))))
+			  ret_val = TREE_OPERAND (ret_val, 0);
+
+			/* Now apply the test to the return value.  */
+			if (return_value_ok_for_nrv_p (NULL_TREE, ret_val))
+			  {
+			    if (!f_named_ret_val)
+			      f_named_ret_val = BITMAP_GGC_ALLOC ();
+			    bitmap_set_bit (f_named_ret_val,
+					    DECL_UID (ret_val));
+			    if (!f_gnat_ret)
+			      f_gnat_ret = gnat_node;
+			  }
 		      }
+
+		    gnu_ret_val
+		      = build_allocator (TREE_TYPE (gnu_ret_val),
+					 gnu_ret_val,
+					 TREE_TYPE (gnu_ret_obj),
+					 Procedure_To_Call (gnat_node),
+					 Storage_Pool (gnat_node),
+					 gnat_node,
+					 false);
 		  }
 
-		gnu_ret_val = build_allocator (TREE_TYPE (gnu_ret_val),
-					       gnu_ret_val,
-					       TREE_TYPE (gnu_ret_obj),
-					       Procedure_To_Call (gnat_node),
-					       Storage_Pool (gnat_node),
-					       gnat_node, false);
+		else
+		  gnu_ret_val
+		    = build_unary_op (ADDR_EXPR, NULL_TREE, gnu_ret_val);
 	      }
 
 	    /* Otherwise, if it returns by invisible reference, dereference
@@ -10670,7 +10676,8 @@ make_covariant_thunk (Entity_Id gnat_thunk, tree gnu_thunk)
 static bool
 maybe_make_gnu_thunk (Entity_Id gnat_thunk, tree gnu_thunk)
 {
-  const Entity_Id gnat_target = Thunk_Entity (gnat_thunk);
+  /* We use the Thunk_Target to compute the properties of the thunk.  */
+  const Entity_Id gnat_target = Thunk_Target (gnat_thunk);
 
   /* Check that the first formal of the target is the only controlling one.  */
   Entity_Id gnat_formal = First_Formal (gnat_target);
@@ -10738,7 +10745,9 @@ maybe_make_gnu_thunk (Entity_Id gnat_thunk, tree gnu_thunk)
       indirect_offset = (HOST_WIDE_INT) (POINTER_SIZE / BITS_PER_UNIT);
     }
 
-  tree gnu_target = gnat_to_gnu_entity (gnat_target, NULL_TREE, false);
+  /* But we generate a call to the Thunk_Entity in the thunk.  */
+  tree gnu_target
+    = gnat_to_gnu_entity (Thunk_Entity (gnat_thunk), NULL_TREE, false);
 
   /* If the target is local, then thunk and target must have the same context
      because cgraph_node::expand_thunk can only forward the static chain.  */