[Ada] Get rid of secondary stack for controlled components

This eliminates the use of the secondary stack to return composite types
with controlled components from functions, by exposing the return slot of
these functions through the support interface of memory pools, much like
for the secondary stack itself.  This is piggybacked on the support of a
specific intrinsic function by the code generator, and can be disabled if
this support is not available, as well with the -gnatd_r debug switch.

The change also streamlines a bit the implementation by consistently using
the Needs_Finalization predicate, or its derivatives, in various places.

gcc/ada/

	* Makefile.rtl (GNATRTL_NONTASKING_OBJS): Add s-retsta.
	* debug.adb (d_r): Document usage.
	* exp_ch4.adb (Expand_N_Allocato): Deal with the return stack pool.
	* exp_ch6.adb (Expand_Simple_Function_Return): Replace calls to
	Requires_Transient_Scope with Returns_On_Secondary_Stack.  Deal
	with types that need finalization returned on the primary stack,
	use CW_Or_Needs_Finalization for those returned on the secondary.
	* exp_util.adb (Build_Allocate_Deallocate_Proc): Return early
	for the return stack pool.
	(Remove_Side_Effects): Call CW_Or_Needs_Finalization.
	* fe.h (Requires_Transient_Scope): Delete.
	(Returns_On_Secondary_Stack): Declare.
	* gnat1drv.adb (Adjust_Global_Switches): Set Back_End_Return_Slot
	to False when generating C code or if -gnatd_r is specified.
	* opt.ads (Back_End_Return_Slot): New boolean variable.
	* rtsfind.ads (RTU_Id): Add System_Return_Stack.
	(RE_Id): Add RE_RS_Allocate and RE_RS_Pool.
	(RE_Unit_Table): Add entries for RE_RS_Allocate and RE_RS_Pool.
	* sem_util.ads (CW_Or_Has_Controlled_Part): Delete.
	(CW_Or_Needs_Finalization): Declare.
	(Requires_Transient_Scope): Adjust description.
	(Returns_On_Secondary_Stack): Declare.
	* sem_util.adb (Compute_Returns_By_Ref): Set Returns_By_Ref on types
	which need finalization if they are returned on the secondary stack.
	(CW_Or_Has_Controlled_Part): Rename to...
	(CW_Or_Needs_Finalization): ...this.
	(Requires_Transient_Scope): Move bulk of implementation to...
	(Returns_On_Secondary_Stack): ...here.  Return true for types which
	need finalization only if the back-end return slot is not supported.
	* libgnat/s-retsta.ads: New file.
	* gcc-interface/ada-builtin-types.def (BT_FN_PTR_SSIZE): Define.
	* gcc-interface/ada-builtins.def (return_slot): Likewise.
	* gcc-interface/ada-tree.h (BUILT_IN_RETURN_SLOT): Likewise.
	* gcc-interface/decl.cc (gnat_to_gnu_subprog_type): Replace call to
	Requires_Transient_Scope with Returns_On_Secondary_Stack.
	* gcc-interface/trans.cc (gnat_to_gnu) <N_Simple_Return_Statement>:
	In the return by invisible reference, skip the copy if the source
	is the same as the destination.
	* gcc-interface/utils2.cc (build_call_alloc_dealloc_proc): Deal with
	the return stack pool.

6 files changed, 53 insertions, 13 deletions

diff --git a/gcc/ada/gcc-interface/ada-builtin-types.def b/gcc/ada/gcc-interface/ada-builtin-types.def
index f00845b..000d429 100644
--- a/gcc/ada/gcc-interface/ada-builtin-types.def
+++ b/gcc/ada/gcc-interface/ada-builtin-types.def
@@ -1,7 +1,7 @@
 /* This file contains the type definitions for the builtins exclusively
    used in the GNU Ada compiler.
 
-   Copyright (C) 2019 Free Software Foundation, Inc.
+   Copyright (C) 2019-2022 Free Software Foundation, Inc.
 
 This file is part of GCC.
 
@@ -22,4 +22,5 @@ along with GCC; see the file COPYING3.  If not see
 /* See builtin-types.def for details.  */
 
 DEF_FUNCTION_TYPE_1 (BT_FN_BOOL_BOOL, BT_BOOL, BT_BOOL)
+DEF_FUNCTION_TYPE_1 (BT_FN_PTR_SSIZE, BT_PTR, BT_SSIZE)
 DEF_FUNCTION_TYPE_2 (BT_FN_BOOL_BOOL_BOOL, BT_BOOL, BT_BOOL, BT_BOOL)
diff --git a/gcc/ada/gcc-interface/ada-builtins.def b/gcc/ada/gcc-interface/ada-builtins.def
index dcdc4d9..8ba89a8 100644
--- a/gcc/ada/gcc-interface/ada-builtins.def
+++ b/gcc/ada/gcc-interface/ada-builtins.def
@@ -1,7 +1,7 @@
 /* This file contains the definitions for the builtins exclusively used
    in the GNU Ada compiler.
 
-   Copyright (C) 2019 Free Software Foundation, Inc.
+   Copyright (C) 2019-2022 Free Software Foundation, Inc.
 
 This file is part of GCC.
 
@@ -28,3 +28,4 @@ along with GCC; see the file COPYING3.  If not see
 DEF_ADA_BUILTIN        (BUILT_IN_EXPECT, "expect", BT_FN_BOOL_BOOL_BOOL, ATTR_CONST_NOTHROW_LEAF_LIST)
 DEF_ADA_BUILTIN        (BUILT_IN_LIKELY, "likely", BT_FN_BOOL_BOOL, ATTR_CONST_NOTHROW_LEAF_LIST)
 DEF_ADA_BUILTIN        (BUILT_IN_UNLIKELY, "unlikely", BT_FN_BOOL_BOOL, ATTR_CONST_NOTHROW_LEAF_LIST)
+DEF_ADA_BUILTIN        (BUILT_IN_RETURN_SLOT, "return_slot", BT_FN_PTR_SSIZE, ATTR_CONST_NOTHROW_LEAF_LIST)
diff --git a/gcc/ada/gcc-interface/ada-tree.h b/gcc/ada/gcc-interface/ada-tree.h
index 0ec81bc..ca718f4 100644
--- a/gcc/ada/gcc-interface/ada-tree.h
+++ b/gcc/ada/gcc-interface/ada-tree.h
@@ -577,5 +577,6 @@ do {						   \
 
 /* Small kludge to be able to define Ada built-in functions locally.
    We overload them on top of the C++ coroutines builtin functions.  */
-#define BUILT_IN_LIKELY   BUILT_IN_CORO_PROMISE
-#define BUILT_IN_UNLIKELY BUILT_IN_CORO_RESUME
+#define BUILT_IN_LIKELY      BUILT_IN_CORO_PROMISE
+#define BUILT_IN_UNLIKELY    BUILT_IN_CORO_RESUME
+#define BUILT_IN_RETURN_SLOT BUILT_IN_CORO_DESTROY
diff --git a/gcc/ada/gcc-interface/decl.cc b/gcc/ada/gcc-interface/decl.cc
index e6f2df8..c096b0d 100644
--- a/gcc/ada/gcc-interface/decl.cc
+++ b/gcc/ada/gcc-interface/decl.cc
@@ -5838,10 +5838,8 @@ gnat_to_gnu_subprog_type (Entity_Id gnat_subprog, bool definition,
 	  return_unconstrained_p = true;
 	}
 
-      /* Likewise, if the return type requires a transient scope, the return
-	 value will also be allocated on the secondary stack so the actual
-	 return type is the reference type.  */
-      else if (Requires_Transient_Scope (gnat_return_type))
+      /* This is for the other types returned on the secondary stack.  */
+      else if (Returns_On_Secondary_Stack (gnat_return_type))
 	{
 	  gnu_return_type = build_reference_type (gnu_return_type);
 	  return_unconstrained_p = true;
diff --git a/gcc/ada/gcc-interface/trans.cc b/gcc/ada/gcc-interface/trans.cc
index 57a9dee..b8a0d5d 100644
--- a/gcc/ada/gcc-interface/trans.cc
+++ b/gcc/ada/gcc-interface/trans.cc
@@ -7456,6 +7456,14 @@ gnat_to_gnu (Node_Id gnat_node)
 				    gnu_ret_obj);
 		gnu_result = build2 (INIT_EXPR, void_type_node,
 				     gnu_ret_deref, gnu_ret_val);
+		/* Avoid a useless copy with __builtin_return_slot.  */
+		if (TREE_CODE (gnu_ret_val) == INDIRECT_REF)
+		  gnu_result
+		    = build3 (COND_EXPR, void_type_node,
+			      fold_build2 (NE_EXPR, boolean_type_node,
+					   TREE_OPERAND (gnu_ret_val, 0),
+					   gnu_ret_obj),
+			      gnu_result, NULL_TREE);
 		add_stmt_with_node (gnu_result, gnat_node);
 		gnu_ret_val = NULL_TREE;
 	      }
diff --git a/gcc/ada/gcc-interface/utils2.cc b/gcc/ada/gcc-interface/utils2.cc
index 76622da..ae81a0d 100644
--- a/gcc/ada/gcc-interface/utils2.cc
+++ b/gcc/ada/gcc-interface/utils2.cc
@@ -2141,9 +2141,9 @@ build_call_alloc_dealloc_proc (tree gnu_obj, tree gnu_size, tree gnu_type,
   tree gnu_proc = gnat_to_gnu (gnat_proc);
   tree gnu_call;
 
-  /* A storage pool's underlying type is a record type (for both predefined
-     storage pools and GNAT simple storage pools). The secondary stack uses
-     the same mechanism, but its pool object (SS_Pool) is an integer.  */
+  /* A storage pool's underlying type is a record type for both predefined
+     storage pools and GNAT simple storage pools.  The return and secondary
+     stacks use the same mechanism, but their pool object is an integer.  */
   if (Is_Record_Type (Underlying_Type (Etype (gnat_pool))))
     {
       /* The size is the third parameter; the alignment is the
@@ -2170,7 +2170,6 @@ build_call_alloc_dealloc_proc (tree gnu_obj, tree gnu_size, tree gnu_type,
 				      gnu_size, gnu_align);
     }
 
-  /* Secondary stack case.  */
   else
     {
       /* The size is the second parameter.  */
@@ -2180,10 +2179,42 @@ build_call_alloc_dealloc_proc (tree gnu_obj, tree gnu_size, tree gnu_type,
 
       gnu_size = convert (gnu_size_type, gnu_size);
 
+      if (DECL_BUILT_IN_CLASS (gnu_proc) == BUILT_IN_FRONTEND
+	  && DECL_FE_FUNCTION_CODE (gnu_proc) == BUILT_IN_RETURN_SLOT)
+	{
+	  /* This must be an allocation of the return stack in a function that
+	     returns by invisible reference.  */
+	  gcc_assert (!gnu_obj);
+	  gcc_assert (current_function_decl
+		      && TREE_ADDRESSABLE (TREE_TYPE (current_function_decl)));
+	  tree gnu_ret_size;
+
+	  gnu_call = DECL_RESULT (current_function_decl);
+
+	  /* The allocation has alreay been done by the caller so we check that
+	     we are not going to overflow the return slot.  */
+	  if (TYPE_CI_CO_LIST (TREE_TYPE (current_function_decl)))
+	    gnu_ret_size
+	      = TYPE_SIZE_UNIT
+                (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (TREE_TYPE (gnu_call)))));
+	  else
+	    gnu_ret_size = TYPE_SIZE_UNIT (TREE_TYPE (TREE_TYPE (gnu_call)));
+
+	  gnu_call
+	    = fold_build3 (COND_EXPR, TREE_TYPE (gnu_call),
+			   fold_build2 (LE_EXPR, boolean_type_node,
+				        fold_convert (sizetype, gnu_size),
+					gnu_ret_size),
+			   gnu_call,
+			   build_call_raise (PE_Explicit_Raise, Empty,
+					     N_Raise_Program_Error));
+	}
+
       /* The first arg is the address of the object, for a deallocator,
 	 then the size.  */
-      if (gnu_obj)
+      else if (gnu_obj)
 	gnu_call = build_call_n_expr (gnu_proc, 2, gnu_obj, gnu_size);
+
       else
 	gnu_call = build_call_n_expr (gnu_proc, 1, gnu_size);
     }