diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 2a1a406850e..d71dcaf8969 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -358,9 +358,11 @@ package Einfo is
 --
 --       For objects, the Actual_Subtype is set only if this is a discriminated
 --       type. For arrays, the bounds of the expression are obtained and the
---       Etype of the object is directly the constrained subtype. This is
---       rather irregular, and the semantic checks that depend on the nominal
---       subtype being unconstrained use flag Is_Constr_Subt_For_U_Nominal(qv).
+--       Etype of the object is directly the constrained subtype, except in the
+--       case of a return object that lives on the secondary stack where Etype
+--       is the nominal unconstrained subtype. This is rather irregular and the
+--       semantic checks that depend on the nominal subtype being unconstrained
+--       use flag Is_Constr_Subt_For_U_Nominal(qv).
 
 --    Address_Clause (synthesized)
 --       Applies to entries, objects and subprograms. Set if an address clause
diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index 3f51ed6b457..4d8bb817b80 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -6841,7 +6841,7 @@ package body Exp_Aggr is
         or else Parent_Kind = N_Component_Association
         or else (Parent_Kind = N_Object_Declaration
                   and then (Needs_Finalization (Typ)
-                             or else Is_Build_In_Place_Return_Object
+                             or else Is_Special_Return_Object
                                        (Defining_Identifier (Parent_Node))))
         or else (Parent_Kind = N_Assignment_Statement
                   and then Inside_Init_Proc)
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index 5050ec6eab5..6de5843b4ba 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -6289,6 +6289,18 @@ package body Exp_Ch3 is
       --  Generate all default initialization actions for object Def_Id. Any
       --  new code is inserted after node After.
 
+      procedure Initialize_Return_Object
+        (Tag_Assign : Node_Id;
+         Adj_Call   : Node_Id;
+         Expr       : Node_Id;
+         Init_Stmt  : Node_Id;
+         After      : Node_Id);
+      --  Generate all initialization actions for return object Def_Id. Any
+      --  new code is inserted after node After.
+
+      function Make_Allocator_For_Return (Expr : Node_Id) return Node_Id;
+      --  Make an allocator for a return object initialized with Expr
+
       function OK_To_Rename_Ref (N : Node_Id) return Boolean;
       --  Return True if N denotes an entity with OK_To_Rename set
 
@@ -7047,6 +7059,108 @@ package body Exp_Ch3 is
          end if;
       end Default_Initialize_Object;
 
+      ------------------------------
+      -- Initialize_Return_Object --
+      ------------------------------
+
+      procedure Initialize_Return_Object
+        (Tag_Assign : Node_Id;
+         Adj_Call   : Node_Id;
+         Expr       : Node_Id;
+         Init_Stmt  : Node_Id;
+         After      : Node_Id)
+      is
+      begin
+         if Present (Tag_Assign) then
+            Insert_Action_After (After, Tag_Assign);
+         end if;
+
+         if Present (Adj_Call) then
+            Insert_Action_After (After, Adj_Call);
+         end if;
+
+         if No (Expr) then
+            Default_Initialize_Object (After);
+
+         elsif Is_Delayed_Aggregate (Expr)
+           and then not No_Initialization (N)
+         then
+            Convert_Aggr_In_Object_Decl (N);
+
+         elsif Present (Init_Stmt) then
+            Insert_Action_After (After, Init_Stmt);
+            Set_Expression (N, Empty);
+         end if;
+      end Initialize_Return_Object;
+
+      -------------------------------
+      -- Make_Allocator_For_Return --
+      -------------------------------
+
+      function Make_Allocator_For_Return (Expr : Node_Id) return Node_Id is
+         Func_Id : constant Entity_Id := Return_Applies_To (Scope (Def_Id));
+
+         Alloc : Node_Id;
+
+      begin
+         --  If the return object's declaration includes an expression and the
+         --  declaration isn't marked as No_Initialization, then we generate an
+         --  allocator with a qualified expression. Although this is necessary
+         --  only in the case where the result type is an interface (or class-
+         --  wide interface), we do it in all cases for the sake of consistency
+         --  instead of subsequently generating a separate assignment.
+
+         if Present (Expr)
+           and then not Is_Delayed_Aggregate (Expr)
+           and then not No_Initialization (N)
+         then
+            --  Ada 2005 (AI95-344): If the result type is class-wide, insert
+            --  a check that the level of the return expression's underlying
+            --  type is not deeper than the level of the master enclosing the
+            --  function.
+
+            --  AI12-043: The check is made immediately after the return object
+            --  is created.
+
+            if Is_Class_Wide_Type (Etype (Func_Id)) then
+               Apply_CW_Accessibility_Check (Expr, Func_Id);
+            end if;
+
+            --  We always use the type of the expression for the qualified
+            --  expression, rather than the return object's type. We cannot
+            --  always use the return object's type because the expression
+            --  might be of a specific type and the result object mignt not.
+
+            Alloc :=
+              Make_Allocator (Loc,
+                Expression =>
+                  Make_Qualified_Expression (Loc,
+                    Subtype_Mark =>
+                      New_Occurrence_Of (Etype (Expr), Loc),
+                    Expression   => New_Copy_Tree (Expr)));
+
+         else
+            Alloc :=
+              Make_Allocator (Loc,
+                Expression => New_Occurrence_Of (Typ, Loc));
+
+            --  If the return object requires default initialization, then it
+            --  will happen later following the elaboration of the renaming.
+            --  If we don't turn it off here, then the object will be default
+            --  initialized twice.
+
+            Set_No_Initialization (Alloc);
+         end if;
+
+         --  Set the flag indicating that the allocator is made for a special
+         --  return object. This is used to bypass various legality checks as
+         --  well as to make sure that the result is not adjusted twice.
+
+         Set_For_Special_Return_Object (Alloc);
+
+         return Alloc;
+      end Make_Allocator_For_Return;
+
       ----------------------
       -- OK_To_Rename_Ref --
       ----------------------
@@ -7060,10 +7174,9 @@ package body Exp_Ch3 is
 
       --  Local variables
 
-      Adj_Call   : Node_Id;
-      Expr_Q     : Node_Id;
-      Id_Ref     : Node_Id;
-      Tag_Assign : Node_Id;
+      Adj_Call   : Node_Id := Empty;
+      Expr_Q     : Node_Id := Empty;
+      Tag_Assign : Node_Id := Empty;
 
       Init_After : Node_Id := N;
       --  Node after which the initialization actions are to be inserted. This
@@ -7172,8 +7285,6 @@ package body Exp_Ch3 is
       --  Default initialization required, and no expression present
 
       if No (Expr) then
-         Expr_Q := Expr;
-
          --  If we have a type with a variant part, the initialization proc
          --  will contain implicit tests of the discriminant values, which
          --  counts as a violation of the restriction No_Implicit_Conditionals.
@@ -7232,7 +7343,7 @@ package body Exp_Ch3 is
             end if;
          end if;
 
-         if not Is_Build_In_Place_Return_Object (Def_Id) then
+         if not Is_Special_Return_Object (Def_Id) then
             Default_Initialize_Object (Init_After);
          end if;
 
@@ -7292,7 +7403,7 @@ package body Exp_Ch3 is
                Expander_Mode_Restore;
             end if;
 
-            if not Is_Build_In_Place_Return_Object (Def_Id) then
+            if not Is_Special_Return_Object (Def_Id) then
                Convert_Aggr_In_Object_Decl (N);
             end if;
 
@@ -7363,12 +7474,12 @@ package body Exp_Ch3 is
          then
             pragma Assert (Is_Class_Wide_Type (Typ));
 
-            --  If the object is a built-in-place return object, bypass special
+            --  If the object is a special return object, then bypass special
             --  treatment of class-wide interface initialization below. In this
             --  case, the expansion of the return statement will take care of
             --  creating the object (via allocator) and initializing it.
 
-            if Is_Build_In_Place_Return_Object (Def_Id) then
+            if Is_Special_Return_Object (Def_Id) then
                null;
 
             elsif Tagged_Type_Expansion then
@@ -7668,8 +7779,7 @@ package body Exp_Ch3 is
             if Present (Tag_Assign) then
                if Present (Following_Address_Clause (N)) then
                   Ensure_Freeze_Node (Def_Id);
-
-               else
+               elsif not Is_Special_Return_Object (Def_Id) then
                   Insert_Action_After (Init_After, Tag_Assign);
                end if;
 
@@ -7679,23 +7789,26 @@ package body Exp_Ch3 is
             --  record type.
 
             elsif Is_CPP_Constructor_Call (Expr) then
+               declare
+                  Id_Ref : constant Node_Id := New_Occurrence_Of (Def_Id, Loc);
 
-               --  The call to the initialization procedure does NOT freeze the
-               --  object being initialized.
+               begin
+                  --  The call to the initialization procedure does NOT freeze
+                  --  the object being initialized.
 
-               Id_Ref := New_Occurrence_Of (Def_Id, Loc);
-               Set_Must_Not_Freeze (Id_Ref);
-               Set_Assignment_OK (Id_Ref);
+                  Set_Must_Not_Freeze (Id_Ref);
+                  Set_Assignment_OK (Id_Ref);
 
-               Insert_Actions_After (Init_After,
-                 Build_Initialization_Call (Loc, Id_Ref, Typ,
-                   Constructor_Ref => Expr));
+                  Insert_Actions_After (Init_After,
+                    Build_Initialization_Call (Loc, Id_Ref, Typ,
+                      Constructor_Ref => Expr));
 
-               --  We remove here the original call to the constructor
-               --  to avoid its management in the backend
+                  --  We remove here the original call to the constructor
+                  --  to avoid its management in the backend
 
-               Set_Expression (N, Empty);
-               return;
+                  Set_Expression (N, Empty);
+                  return;
+               end;
 
             --  Handle initialization of limited tagged types
 
@@ -7735,18 +7848,15 @@ package body Exp_Ch3 is
             then
                Set_Is_Known_Valid (Def_Id);
 
-            elsif Is_Access_Type (Typ) then
-
-               --  For access types set the Is_Known_Non_Null flag if the
-               --  initializing value is known to be non-null. We can also set
-               --  Can_Never_Be_Null if this is a constant.
+            --  For access types, set the Is_Known_Non_Null flag if the
+            --  initializing value is known to be non-null. We can also
+            --  set Can_Never_Be_Null if this is a constant.
 
-               if Known_Non_Null (Expr) then
-                  Set_Is_Known_Non_Null (Def_Id, True);
+            elsif Is_Access_Type (Typ) and then Known_Non_Null (Expr) then
+               Set_Is_Known_Non_Null (Def_Id, True);
 
-                  if Constant_Present (N) then
-                     Set_Can_Never_Be_Null (Def_Id);
-                  end if;
+               if Constant_Present (N) then
+                  Set_Can_Never_Be_Null (Def_Id);
                end if;
             end if;
 
@@ -7762,6 +7872,7 @@ package body Exp_Ch3 is
               and then not Is_Generic_Type (Typ)
             then
                Ensure_Valid (Expr);
+
                if Safe_To_Capture_Value (N, Def_Id) then
                   Set_Is_Known_Valid (Def_Id);
                end if;
@@ -7839,10 +7950,9 @@ package body Exp_Ch3 is
                    Obj_Ref => New_Occurrence_Of (Def_Id, Loc),
                    Typ     => Base_Typ);
 
-               --  Guard against a missing [Deep_]Adjust when the base type
-               --  was not properly frozen.
-
-               if Present (Adj_Call) then
+               if Present (Adj_Call)
+                 and then not Is_Special_Return_Object (Def_Id)
+               then
                   Insert_Action_After (Init_After, Adj_Call);
                end if;
             end if;
@@ -8092,78 +8202,12 @@ package body Exp_Ch3 is
                   --  an unconstrained array on the heap. In this case the
                   --  result object's type is a constrained array type even
                   --  though the function's type is unconstrained.
+
                   Obj_Alloc_Formal : constant Entity_Id :=
                     Build_In_Place_Formal (Func_Id, BIP_Alloc_Form);
                   Pool_Id          : constant Entity_Id :=
                     Make_Temporary (Loc, 'P');
 
-                  function Make_Allocator_For_BIP_Return return Node_Id;
-                  --  Make an allocator for the BIP return being processed
-
-                  -----------------------------------
-                  -- Make_Allocator_For_BIP_Return --
-                  -----------------------------------
-
-                  function Make_Allocator_For_BIP_Return return Node_Id is
-                     Alloc : Node_Id;
-
-                  begin
-                     if Present (Expr_Q)
-                       and then not Is_Delayed_Aggregate (Expr_Q)
-                       and then not No_Initialization (N)
-                     then
-                        --  Always use the type of the expression for the
-                        --  qualified expression, rather than the result type.
-                        --  In general we cannot always use the result type
-                        --  for the allocator, because the expression might be
-                        --  of a specific type, such as in the case of an
-                        --  aggregate or even a nonlimited object when the
-                        --  result type is a limited class-wide interface type.
-
-                        Alloc :=
-                          Make_Allocator (Loc,
-                            Expression =>
-                              Make_Qualified_Expression (Loc,
-                                Subtype_Mark =>
-                                  New_Occurrence_Of (Etype (Expr_Q), Loc),
-                                Expression   => New_Copy_Tree (Expr_Q)));
-
-                     else
-                        --  If the function returns a class-wide type we cannot
-                        --  use the return type for the allocator. Instead we
-                        --  use the type of the expression, which must be an
-                        --  aggregate of a definite type.
-
-                        if Is_Class_Wide_Type (Typ) then
-                           Alloc :=
-                             Make_Allocator (Loc,
-                               Expression =>
-                                 New_Occurrence_Of (Etype (Expr_Q), Loc));
-
-                        else
-                           Alloc :=
-                             Make_Allocator (Loc,
-                               Expression =>
-                                 New_Occurrence_Of (Typ, Loc));
-                        end if;
-
-                        --  If the object requires default initialization then
-                        --  that will happen later following the elaboration of
-                        --  the object renaming. If we don't turn it off here
-                        --  then the object will be default initialized twice.
-
-                        Set_No_Initialization (Alloc);
-                     end if;
-
-                     --  Set the flag indicating that the allocator came from
-                     --  a build-in-place return statement, so we can avoid
-                     --  adjusting the allocated object.
-
-                     Set_Alloc_For_BIP_Return (Alloc);
-
-                     return Alloc;
-                  end Make_Allocator_For_BIP_Return;
-
                   Acc_Typ        : Entity_Id;
                   Alloc_Obj_Decl : Node_Id;
                   Alloc_Obj_Id   : Entity_Id;
@@ -8209,13 +8253,13 @@ package body Exp_Ch3 is
 
                   --  First create the Heap_Allocator
 
-                  Heap_Allocator := Make_Allocator_For_BIP_Return;
+                  Heap_Allocator := Make_Allocator_For_Return (Expr_Q);
 
                   --  The Pool_Allocator is just like the Heap_Allocator,
                   --  except we set Storage_Pool and Procedure_To_Call so
                   --  it will use the user-defined storage pool.
 
-                  Pool_Allocator := Make_Allocator_For_BIP_Return;
+                  Pool_Allocator := Make_Allocator_For_Return (Expr_Q);
 
                   --  Do not generate the renaming of the build-in-place
                   --  pool parameter on ZFP because the parameter is not
@@ -8256,7 +8300,7 @@ package body Exp_Ch3 is
                   --  allocation.
 
                   else
-                     SS_Allocator := Make_Allocator_For_BIP_Return;
+                     SS_Allocator := Make_Allocator_For_Return (Expr_Q);
 
                      --  The heap and pool allocators are marked as
                      --  Comes_From_Source since they correspond to an
@@ -8427,7 +8471,10 @@ package body Exp_Ch3 is
                   --  From now on, the type of the return object is the
                   --  designated type.
 
-                  Set_Etype (Def_Id, Desig_Typ);
+                  if Desig_Typ /= Typ then
+                     Set_Etype (Def_Id, Desig_Typ);
+                     Set_Actual_Subtype (Def_Id, Typ);
+                  end if;
 
                   --  Remember the local access object for use in the
                   --  dereference of the renaming created below.
@@ -8474,6 +8521,7 @@ package body Exp_Ch3 is
                   Alloc_Obj_Decl :=
                     Make_Object_Declaration (Loc,
                       Defining_Identifier => Alloc_Obj_Id,
+                      Constant_Present    => True,
                       Object_Definition   =>
                         New_Occurrence_Of (Acc_Typ, Loc),
                       Expression =>
@@ -8492,25 +8540,207 @@ package body Exp_Ch3 is
             --  Initialize the object now that it has got its final subtype,
             --  but before rewriting it as a renaming.
 
-            if No (Expr_Q) then
-               Default_Initialize_Object (Init_After);
+            Initialize_Return_Object
+              (Tag_Assign, Adj_Call, Expr_Q, Init_Stmt, Init_After);
 
-            elsif Is_Delayed_Aggregate (Expr_Q)
-              and then not No_Initialization (N)
-            then
-               Convert_Aggr_In_Object_Decl (N);
+            --  Replace the return object declaration with a renaming of a
+            --  dereference of the access value designating the return object.
 
-            elsif Present (Init_Stmt) then
-               Insert_Action_After (Init_After, Init_Stmt);
-               Set_Expression (N, Empty);
+            Expr_Q :=
+              Make_Explicit_Dereference (Loc,
+                Prefix => New_Occurrence_Of (Obj_Acc_Formal, Loc));
+            Set_Etype (Expr_Q, Etype (Def_Id));
+
+            Rewrite_As_Renaming := True;
+         end;
+
+      --  If we can rename the initialization expression, we need to make sure
+      --  that we use the proper type in the case of a return object that lives
+      --  on the secondary stack. See other cases below for a similar handling.
+
+      elsif Rewrite_As_Renaming then
+         if Is_Secondary_Stack_Return_Object (Def_Id) then
+            declare
+               Func_Id  : constant Entity_Id  :=
+                 Return_Applies_To (Scope (Def_Id));
+
+               Desig_Typ : constant Entity_Id :=
+                 (if Ekind (Typ) = E_Array_Subtype
+                  then Etype (Func_Id) else Typ);
+
+            begin
+               --  From now on, the type of the return object is the
+               --  designated type.
+
+               if Desig_Typ /= Typ then
+                  Set_Etype (Def_Id, Desig_Typ);
+                  Set_Actual_Subtype (Def_Id, Typ);
+               end if;
+            end;
+         end if;
+
+      --  If this is the return object of a function returning on the secondary
+      --  stack, convert the declaration to a renaming of the dereference of ah
+      --  allocator for the secondary stack.
+
+      --    Result : T [:= <expression>];
+
+      --  is converted to
+
+      --    type Txx is access all ...;
+      --    Rxx : constant Txx :=
+      --      new <expression-type>['(<expression>)][storage_pool =
+      --        system__secondary_stack__ss_pool][procedure_to_call =
+      --        system__secondary_stack__ss_allocate];
+
+      --    Result : T renames Rxx.all;
+
+      elsif Is_Secondary_Stack_Return_Object (Def_Id) then
+         declare
+            Func_Id  : constant Entity_Id  :=
+              Return_Applies_To (Scope (Def_Id));
+
+            Desig_Typ : constant Entity_Id :=
+              (if Ekind (Typ) = E_Array_Subtype
+               then Etype (Func_Id) else Typ);
+            --  Ensure that the we use a fat pointer when allocating
+            --  an unconstrained array on the heap. In this case the
+            --  result object's type is a constrained array type even
+            --  though the function's type is unconstrained.
+
+            Acc_Typ        : Entity_Id;
+            Alloc_Obj_Decl : Node_Id;
+            Alloc_Obj_Id   : Entity_Id;
+            Ptr_Type_Decl  : Node_Id;
+
+         begin
+            --  Create an access type designating the function's
+            --  result subtype.
+
+            Acc_Typ := Make_Temporary (Loc, 'A');
+
+            Ptr_Type_Decl :=
+              Make_Full_Type_Declaration (Loc,
+                Defining_Identifier => Acc_Typ,
+                Type_Definition     =>
+                  Make_Access_To_Object_Definition (Loc,
+                    All_Present        => True,
+                    Subtype_Indication =>
+                      New_Occurrence_Of (Desig_Typ, Loc)));
+
+            Insert_Action (N, Ptr_Type_Decl, Suppress => All_Checks);
+
+            Set_Associated_Storage_Pool (Acc_Typ, RTE (RE_SS_Pool));
+
+            Alloc_Obj_Id := Make_Temporary (Loc, 'R');
+
+            Alloc_Obj_Decl :=
+              Make_Object_Declaration (Loc,
+                Defining_Identifier => Alloc_Obj_Id,
+                Constant_Present    => True,
+                Object_Definition   =>
+                  New_Occurrence_Of (Acc_Typ, Loc),
+                Expression => Make_Allocator_For_Return (Expr_Q));
+
+            Insert_Action (N, Alloc_Obj_Decl, Suppress => All_Checks);
+
+            Set_Uses_Sec_Stack (Func_Id);
+            Set_Uses_Sec_Stack (Scope (Def_Id));
+            Set_Sec_Stack_Needed_For_Return (Scope (Def_Id));
+
+            --  From now on, the type of the return object is the
+            --  designated type.
+
+            if Desig_Typ /= Typ then
+               Set_Etype (Def_Id, Desig_Typ);
+               Set_Actual_Subtype (Def_Id, Typ);
             end if;
 
+            --  Initialize the object now that it has got its final subtype,
+            --  but before rewriting it as a renaming.
+
+            Initialize_Return_Object
+              (Tag_Assign, Adj_Call, Expr_Q, Empty, Init_After);
+
             --  Replace the return object declaration with a renaming of a
             --  dereference of the access value designating the return object.
 
             Expr_Q :=
               Make_Explicit_Dereference (Loc,
-                Prefix => New_Occurrence_Of (Obj_Acc_Formal, Loc));
+                Prefix => New_Occurrence_Of (Alloc_Obj_Id, Loc));
+            Set_Etype (Expr_Q, Etype (Def_Id));
+
+            Rewrite_As_Renaming := True;
+         end;
+
+      --  If this is the return object of a function returning a by-reference
+      --  type, convert the declaration to a renaming of the dereference of ah
+      --  allocator for the return stack.
+
+      --    Result : T [:= <expression>];
+
+      --  is converted to
+
+      --    type Txx is access all ...;
+      --    Rxx : constant Txx :=
+      --      new <expression-type>['(<expression>)][storage_pool =
+      --        system__secondary_stack__rs_pool][procedure_to_call =
+      --        system__secondary_stack__rs_allocate];
+
+      --    Result : T renames Rxx.all;
+
+      elsif Back_End_Return_Slot
+        and then Is_By_Reference_Return_Object (Def_Id)
+      then
+         declare
+            Acc_Typ        : Entity_Id;
+            Alloc_Obj_Decl : Node_Id;
+            Alloc_Obj_Id   : Entity_Id;
+            Ptr_Type_Decl  : Node_Id;
+
+         begin
+            --  Create an access type designating the function's
+            --  result subtype.
+
+            Acc_Typ := Make_Temporary (Loc, 'A');
+
+            Ptr_Type_Decl :=
+              Make_Full_Type_Declaration (Loc,
+                Defining_Identifier => Acc_Typ,
+                Type_Definition     =>
+                  Make_Access_To_Object_Definition (Loc,
+                    All_Present        => True,
+                    Subtype_Indication =>
+                      New_Occurrence_Of (Typ, Loc)));
+
+            Insert_Action (N, Ptr_Type_Decl, Suppress => All_Checks);
+
+            Set_Associated_Storage_Pool (Acc_Typ, RTE (RE_RS_Pool));
+
+            Alloc_Obj_Id := Make_Temporary (Loc, 'R');
+
+            Alloc_Obj_Decl :=
+              Make_Object_Declaration (Loc,
+                Defining_Identifier => Alloc_Obj_Id,
+                Constant_Present    => True,
+                Object_Definition   =>
+                  New_Occurrence_Of (Acc_Typ, Loc),
+                Expression => Make_Allocator_For_Return (Expr_Q));
+
+            Insert_Action (N, Alloc_Obj_Decl, Suppress => All_Checks);
+
+            --  Initialize the object now that it has got its final subtype,
+            --  but before rewriting it as a renaming.
+
+            Initialize_Return_Object
+              (Tag_Assign, Adj_Call, Expr_Q, Empty, Init_After);
+
+            --  Replace the return object declaration with a renaming of a
+            --  dereference of the access value designating the return object.
+
+            Expr_Q :=
+              Make_Explicit_Dereference (Loc,
+                Prefix => New_Occurrence_Of (Alloc_Obj_Id, Loc));
             Set_Etype (Expr_Q, Etype (Def_Id));
 
             Rewrite_As_Renaming := True;
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 7edef4c39c3..a8980a63d46 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -898,6 +898,11 @@ package body Exp_Ch4 is
                             (Directly_Designated_Type (Etype (N))));
             null;
 
+         --  Likewise if the allocator is made for a special return object
+
+         elsif For_Special_Return_Object (N) then
+            null;
+
          elsif Is_Tagged_Type (T) and then not Is_Class_Wide_Type (T) then
             TagT := T;
             TagR :=
@@ -946,19 +951,18 @@ package body Exp_Ch4 is
          --  Adjust procedure, and the object is built in place. In Ada 95, the
          --  object can be limited but not inherently limited if this allocator
          --  came from a return statement (we're allocating the result on the
-         --  secondary stack). In that case, the object will be moved, so we do
-         --  want to Adjust. However, if it's a nonlimited build-in-place
-         --  function call, Adjust is not wanted.
-         --
-         --  Needs_Finalization (DesigT) can differ from Needs_Finalization (T)
+         --  secondary stack); in that case, the object will be moved, so we do
+         --  want to Adjust. But the call is always skipped if the allocator is
+         --  made for a special return object because it's generated elsewhere.
+
+         --  Needs_Finalization (DesigT) may differ from Needs_Finalization (T)
          --  if one of the two types is class-wide, and the other is not.
 
          if Needs_Finalization (DesigT)
            and then Needs_Finalization (T)
            and then not Aggr_In_Place
            and then not Is_Limited_View (T)
-           and then not Alloc_For_BIP_Return (N)
-           and then not Is_Build_In_Place_Function_Call (Expression (N))
+           and then not For_Special_Return_Object (N)
          then
             --  An unchecked conversion is needed in the classwide case because
             --  the designated type can be an ancestor of the subtype mark of
@@ -2724,6 +2728,7 @@ package body Exp_Ch4 is
       Len        : Unat;
       J          : Nat;
       Clen       : Node_Id;
+      Decl       : Node_Id;
       Set        : Boolean;
 
    --  Start of processing for Expand_Concatenate
@@ -3250,10 +3255,32 @@ package body Exp_Ch4 is
       Set_Is_Internal       (Ent);
       Set_Debug_Info_Needed (Ent);
 
+      --  If the bound is statically known to be out of range, we do not want
+      --  to abort, we want a warning and a constraint error at run time. Note
+      --  that we have arranged that the result will not be treated as a static
+      --  constant, so we won't get an illegality during the insertion. We also
+      --  enable all checks (in particular range checks) in case the bounds of
+      --  Subtyp_Ind are out of range.
+
+      Decl :=
+        Make_Object_Declaration (Loc,
+          Defining_Identifier => Ent,
+          Object_Definition   => Subtyp_Ind);
+      Insert_Action (Cnode, Decl);
+
+      --  If the result of the concatenation appears as the initializing
+      --  expression of an object declaration, we can just rename the
+      --  result, rather than copying it.
+
+      Set_OK_To_Rename (Ent);
+
       --  If we are concatenating strings and the current scope already uses
-      --  the secondary stack, allocate the resulting string also on the
-      --  secondary stack to avoid putting too much pressure on the primary
-      --  stack.
+      --  the secondary stack, allocate the result also on the secondary stack
+      --  to avoid putting too much pressure on the primary stack.
+
+      --  We use an unconstrained allocation, i.e. we also allocate the bounds,
+      --  so that the result can be renamed in all contexts.
+
       --  Don't do this if -gnatd.h is set, as this will break the wrapping of
       --  Cnode in an Expression_With_Actions, see Expand_N_Op_Concat.
 
@@ -3263,84 +3290,77 @@ package body Exp_Ch4 is
         and then not Debug_Flag_Dot_H
       then
          --  Generate:
-         --     subtype Axx is ...;
-         --     type Ayy is access Axx;
-         --     Rxx : Ayy := new <subtype> [storage_pool = ss_pool];
-         --     Sxx : <subtype> renames Rxx.all;
+         --     subtype Axx is String (<low-bound> .. <high-bound>)
+         --     type Ayy is access String;
+         --     Rxx : Ayy := new <Axx> [storage_pool = ss_pool];
+         --     Sxx : String renames Rxx.all;
 
          declare
-            Alloc   : Node_Id;
             ConstrT : constant Entity_Id := Make_Temporary (Loc, 'A');
             Acc_Typ : constant Entity_Id := Make_Temporary (Loc, 'A');
+
+            Alloc   : Node_Id;
+            Deref   : Node_Id;
             Temp    : Entity_Id;
 
          begin
-            Insert_Action (Cnode,
+            Insert_Action (Decl,
               Make_Subtype_Declaration (Loc,
                 Defining_Identifier => ConstrT,
                 Subtype_Indication  => Subtyp_Ind),
               Suppress => All_Checks);
-            Freeze_Itype (ConstrT, Cnode);
 
-            Insert_Action (Cnode,
+            Freeze_Itype (ConstrT, Decl);
+
+            Insert_Action (Decl,
               Make_Full_Type_Declaration (Loc,
                 Defining_Identifier => Acc_Typ,
                 Type_Definition     =>
                   Make_Access_To_Object_Definition (Loc,
-                    Subtype_Indication => New_Occurrence_Of (ConstrT, Loc))),
+                    Subtype_Indication => New_Occurrence_Of (Atyp, Loc))),
               Suppress => All_Checks);
+
+            Mutate_Ekind (Acc_Typ, E_Access_Type);
+            Set_Associated_Storage_Pool (Acc_Typ, RTE (RE_SS_Pool));
+
             Alloc :=
               Make_Allocator (Loc,
                 Expression => New_Occurrence_Of (ConstrT, Loc));
 
-            --  Allocate on the secondary stack. This is currently done
-            --  only for type String, which normally doesn't have default
-            --  initialization, but we need to Set_No_Initialization in case
-            --  of Initialize_Scalars or Normalize_Scalars; otherwise, the
-            --  allocator will get transformed and will not use the secondary
-            --  stack.
+            --  This is currently done only for type String, which normally
+            --  doesn't have default initialization, but we need to set the
+            --  No_Initialization flag in case of either Initialize_Scalars
+            --  or Normalize_Scalars.
 
-            Set_Storage_Pool (Alloc, RTE (RE_SS_Pool));
-            Set_Procedure_To_Call (Alloc, RTE (RE_SS_Allocate));
             Set_No_Initialization (Alloc);
 
             Temp := Make_Temporary (Loc, 'R', Alloc);
-            Insert_Action (Cnode,
+            Insert_Action (Decl,
               Make_Object_Declaration (Loc,
                 Defining_Identifier => Temp,
                 Object_Definition   => New_Occurrence_Of (Acc_Typ, Loc),
                 Expression          => Alloc),
               Suppress => All_Checks);
 
-            Insert_Action (Cnode,
+            Deref :=
+              Make_Explicit_Dereference (Loc,
+                Prefix => New_Occurrence_Of (Temp, Loc));
+            Set_Etype (Deref, Atyp);
+
+            Rewrite (Decl,
               Make_Object_Renaming_Declaration (Loc,
                 Defining_Identifier => Ent,
-                Subtype_Mark        => New_Occurrence_Of (ConstrT, Loc),
-                Name                =>
-                  Make_Explicit_Dereference (Loc,
-                    Prefix => New_Occurrence_Of (Temp, Loc))),
-              Suppress => All_Checks);
-         end;
-      else
-         --  If the bound is statically known to be out of range, we do not
-         --  want to abort, we want a warning and a runtime constraint error.
-         --  Note that we have arranged that the result will not be treated as
-         --  a static constant, so we won't get an illegality during this
-         --  insertion.
-         --  We also enable checks (in particular range checks) in case the
-         --  bounds of Subtyp_Ind are out of range.
-
-         Insert_Action (Cnode,
-           Make_Object_Declaration (Loc,
-             Defining_Identifier => Ent,
-             Object_Definition   => Subtyp_Ind));
-      end if;
+                Subtype_Mark        => New_Occurrence_Of (Atyp, Loc),
+                Name                => Deref));
 
-      --  If the result of the concatenation appears as the initializing
-      --  expression of an object declaration, we can just rename the
-      --  result, rather than copying it.
+            --  We do not analyze this renaming declaration because this would
+            --  change the subtype of Ent back to a constrained string.
 
-      Set_OK_To_Rename (Ent);
+            Set_Etype (Ent, Atyp);
+            Set_Renamed_Object (Ent, Deref);
+            Set_Analyzed (Decl);
+         end;
+      end if;
 
       --  Catch the static out of range case now
 
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index ae59ad7017d..7555bf5dcf5 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -192,16 +192,6 @@ package body Exp_Ch6 is
    --  the activation Chain. Note: Master_Actual can be Empty, but only if
    --  there are no tasks.
 
-   procedure Apply_CW_Accessibility_Check (Exp : Node_Id; Func : Entity_Id);
-   --  Ada 2005 (AI95-344): If the result type is class-wide, insert a check
-   --  that the level of the return expression's underlying type is not deeper
-   --  than the level of the master enclosing the function. Always generate the
-   --  check when the type of the return expression is class-wide, when it's a
-   --  type conversion, or when it's a formal parameter. Otherwise suppress the
-   --  check in the case where the return expression has a specific type whose
-   --  level is known not to be statically deeper than the result type of the
-   --  function.
-
    function Caller_Known_Size
      (Func_Call   : Node_Id;
       Result_Subt : Entity_Id) return Boolean;
@@ -5140,10 +5130,15 @@ package body Exp_Ch6 is
       end if;
 
       --  Another optimization: if the returned value is used to initialize an
-      --  object, and the secondary stack is not involved in the call, then no
-      --  need to copy/readjust/finalize, we can just initialize it in place.
-
-      if Nkind (Par) = N_Object_Declaration and then not Use_Sec_Stack then
+      --  object, then no need to copy/readjust/finalize, we can initialize it
+      --  in place. However, if the call returns on the secondary stack or this
+      --  is a special return object, then we need the expansion because we'll
+      --  be renaming the temporary as the (permanent) object.
+
+      if Nkind (Par) = N_Object_Declaration
+        and then not Use_Sec_Stack
+        and then not Is_Special_Return_Object (Defining_Entity (Par))
+      then
          return;
       end if;
 
@@ -5300,7 +5295,7 @@ package body Exp_Ch6 is
          --  Assert that if F says "return R : T := G(...) do..."
          --  then F and G are both b-i-p, or neither b-i-p.
 
-         if Nkind (Exp) = N_Function_Call then
+         if Present (Exp) and then Nkind (Exp) = N_Function_Call then
             pragma Assert (Ekind (Current_Subprogram) = E_Function);
             pragma Assert
               (Is_Build_In_Place_Function (Current_Subprogram) =
@@ -5308,16 +5303,6 @@ package body Exp_Ch6 is
             null;
          end if;
 
-         --  Ada 2005 (AI95-344): If the result type is class-wide, then insert
-         --  a check that the level of the return expression's underlying type
-         --  is not deeper than the level of the master enclosing the function.
-
-         --  AI12-043: The check is made immediately after the return object
-         --  is created.
-
-         if Present (Exp) and then Is_Class_Wide_Type (Ret_Typ) then
-            Apply_CW_Accessibility_Check (Exp, Func_Id);
-         end if;
       else
          Exp := Empty;
       end if;
@@ -6529,19 +6514,6 @@ package body Exp_Ch6 is
       --  need to reify the return object, so we can build it "in place", and
       --  we need a block statement to hang finalization and tasking stuff.
 
-      --  ??? In order to avoid disruption, we avoid translating to extended
-      --  return except in the cases where we really need to (Ada 2005 for
-      --  inherently limited). We might prefer to do this translation in all
-      --  cases (except perhaps for the case of Ada 95 inherently limited),
-      --  in order to fully exercise the Expand_N_Extended_Return_Statement
-      --  code. This would also allow us to do the build-in-place optimization
-      --  for efficiency even in cases where it is semantically not required.
-
-      --  As before, we check the type of the return expression rather than the
-      --  return type of the function, because the latter may be a limited
-      --  class-wide interface type, which is not a limited type, even though
-      --  the type of the expression may be.
-
       pragma Assert
         (Comes_From_Extended_Return_Statement (N)
           or else not Is_Build_In_Place_Function_Call (Exp)
@@ -6682,15 +6654,18 @@ package body Exp_Ch6 is
 
          --    type Ann is access R_Type;
          --    for Ann'Storage_pool use rs_pool;
-         --    Rnn : Ann := new Exp_Typ'(Exp);
+         --    Rnn : constant Ann := new Exp_Typ'(Exp);
          --    return Rnn.all;
 
          --  but optimize the case where the result is a function call that
          --  also needs finalization. In this case the result can directly be
          --  allocated on the return stack of the caller and no further
-         --  processing is required.
+         --  processing is required. Likewise if this is a return object.
 
-         if Present (Utyp)
+         if Comes_From_Extended_Return_Statement (N) then
+            null;
+
+         elsif Present (Utyp)
            and then Needs_Finalization (Utyp)
            and then not (Exp_Is_Function_Call
                           and then Needs_Finalization (Exp_Typ))
@@ -6733,6 +6708,7 @@ package body Exp_Ch6 is
 
                  Make_Object_Declaration (Loc,
                    Defining_Identifier => Temp,
+                   Constant_Present    => True,
                    Object_Definition   => New_Occurrence_Of (Acc_Typ, Loc),
                    Expression          => Alloc_Node)));
 
@@ -6753,11 +6729,16 @@ package body Exp_Ch6 is
 
          Set_Enclosing_Sec_Stack_Return (N);
 
+         --  Nothing else to do for a return object
+
+         if Comes_From_Extended_Return_Statement (N) then
+            null;
+
          --  Optimize the case where the result is a function call that also
          --  returns on the secondary stack. In this case the result is already
          --  on the secondary stack and no further processing is required.
 
-         if Exp_Is_Function_Call
+         elsif Exp_Is_Function_Call
            and then Needs_Secondary_Stack (Exp_Typ)
          then
             --  Remove side effects from the expression now so that other parts
@@ -6782,7 +6763,7 @@ package body Exp_Ch6 is
 
          --    type Ann is access R_Type;
          --    for Ann'Storage_pool use ss_pool;
-         --    Rnn : Ann := new Exp_Typ'(Exp);
+         --    Rnn : constant Ann := new Exp_Typ'(Exp);
          --    return Rnn.all;
 
          --  And we do the same for class-wide types that are not potentially
@@ -6806,7 +6787,6 @@ package body Exp_Ch6 is
 
             begin
                Mutate_Ekind (Acc_Typ, E_Access_Type);
-
                Set_Associated_Storage_Pool (Acc_Typ, RTE (RE_SS_Pool));
 
                --  This is an allocator for the secondary stack, and it's fine
@@ -6836,6 +6816,7 @@ package body Exp_Ch6 is
 
                  Make_Object_Declaration (Loc,
                    Defining_Identifier => Temp,
+                   Constant_Present    => True,
                    Object_Definition   => New_Occurrence_Of (Acc_Typ, Loc),
                    Expression          => Alloc_Node)));
 
@@ -7900,6 +7881,16 @@ package body Exp_Ch6 is
         and then Is_Build_In_Place_Function (Return_Applies_To (Scope (E)));
    end Is_Build_In_Place_Return_Object;
 
+   -----------------------------------
+   -- Is_By_Reference_Return_Object --
+   -----------------------------------
+
+   function Is_By_Reference_Return_Object (E : Entity_Id) return Boolean is
+   begin
+      return Is_Return_Object (E)
+        and then Is_By_Reference_Type (Etype (Return_Applies_To (Scope (E))));
+   end Is_By_Reference_Return_Object;
+
    -----------------------
    -- Is_Null_Procedure --
    -----------------------
@@ -7959,6 +7950,28 @@ package body Exp_Ch6 is
       end if;
    end Is_Null_Procedure;
 
+   --------------------------------------
+   -- Is_Secondary_Stack_Return_Object --
+   --------------------------------------
+
+   function Is_Secondary_Stack_Return_Object (E : Entity_Id) return Boolean is
+   begin
+      return Is_Return_Object (E)
+        and then Needs_Secondary_Stack (Etype (Return_Applies_To (Scope (E))));
+   end Is_Secondary_Stack_Return_Object;
+
+   ------------------------------
+   -- Is_Special_Return_Object --
+   ------------------------------
+
+   function Is_Special_Return_Object (E : Entity_Id) return Boolean is
+   begin
+      return Is_Build_In_Place_Return_Object (E)
+         or else Is_Secondary_Stack_Return_Object (E)
+         or else (Back_End_Return_Slot
+                   and then Is_By_Reference_Return_Object (E));
+   end Is_Special_Return_Object;
+
    -------------------------------------------
    -- Make_Build_In_Place_Call_In_Allocator --
    -------------------------------------------
diff --git a/gcc/ada/exp_ch6.ads b/gcc/ada/exp_ch6.ads
index 66888c51a07..41ddf8dd8d0 100644
--- a/gcc/ada/exp_ch6.ads
+++ b/gcc/ada/exp_ch6.ads
@@ -99,6 +99,16 @@ package Exp_Ch6 is
    --  Adds Extra_Actual as a named parameter association for the formal
    --  Extra_Formal in Subprogram_Call.
 
+   procedure Apply_CW_Accessibility_Check (Exp : Node_Id; Func : Entity_Id);
+   --  Ada 2005 (AI95-344): If the result type is class-wide, insert a check
+   --  that the level of the return expression's underlying type is not deeper
+   --  than the level of the master enclosing the function. Always generate the
+   --  check when the type of the return expression is class-wide, when it's a
+   --  type conversion, or when it's a formal parameter. Otherwise suppress the
+   --  check in the case where the return expression has a specific type whose
+   --  level is known not to be statically deeper than the result type of the
+   --  function.
+
    function BIP_Formal_Suffix (Kind : BIP_Formal_Kind) return String;
    --  Ada 2005 (AI-318-02): Returns a string to be used as the suffix of names
    --  for build-in-place formal parameters of the given kind.
@@ -158,13 +168,28 @@ package Exp_Ch6 is
    --  True in >= Ada 2005 and must be False in Ada 95.
 
    function Is_Build_In_Place_Return_Object (E : Entity_Id) return Boolean;
-   --  Ada 2005 (AI-318-02): Return True is E is a return object of a function
+   --  Ada 2005 (AI-318-02): Return True if E is a return object of a function
    --  that uses build-in-place protocols.
 
+   function Is_By_Reference_Return_Object (E : Entity_Id) return Boolean;
+   --  Return True if E is a return object of a function whose return type is
+   --  required to be passed by reference, as defined in (RM 6.2(4-9)).
+
    function Is_Null_Procedure (Subp : Entity_Id) return Boolean;
    --  Predicate to recognize stubbed procedures and null procedures, which
    --  can be inlined unconditionally in all cases.
 
+   function Is_Secondary_Stack_Return_Object (E : Entity_Id) return Boolean;
+   --  Return True if E is a return object of a function whose return type is
+   --  returned on the secondary stack.
+
+   function Is_Special_Return_Object (E : Entity_Id) return Boolean;
+   --  Return True if E is the return object of a function and is handled in a
+   --  special way by the expander. In most cases, return objects are handled
+   --  like any other variables or constants but, in a few special cases, they
+   --  are further expanded into more elaborate constructs, whose common goal
+   --  is to elide the copy operation associated with the return.
+
    procedure Make_Build_In_Place_Call_In_Allocator
      (Allocator     : Node_Id;
       Function_Call : Node_Id);
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index bcfb39ce21d..84b0c0e2941 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -9166,7 +9166,11 @@ package body Exp_Util is
       return
         Present (Expr)
           and then Nkind (Unqual_Conv (Expr)) = N_Explicit_Dereference
-          and then Nkind (Parent (Expr)) = N_Simple_Return_Statement;
+          and then (Nkind (Parent (Expr)) = N_Simple_Return_Statement
+                     or else
+                       (Nkind (Parent (Expr)) = N_Object_Renaming_Declaration
+                         and then
+                        Is_Return_Object (Defining_Entity (Parent (Expr)))));
    end Is_Related_To_Func_Return;
 
    --------------------------------
diff --git a/gcc/ada/gcc-interface/trans.cc b/gcc/ada/gcc-interface/trans.cc
index a012271abf3..59332f93614 100644
--- a/gcc/ada/gcc-interface/trans.cc
+++ b/gcc/ada/gcc-interface/trans.cc
@@ -8473,9 +8473,10 @@ gnat_to_gnu (Node_Id gnat_node)
 	  declaration, return the result unmodified because we want to use the
 	  return slot optimization in this case.
 
-       5. If this is a reference to an unconstrained array which is used as the
-	  prefix of an attribute reference that requires an lvalue, return the
-	  result unmodified because we want to return the original bounds.
+       5. If this is a reference to an unconstrained array which is used either
+	  as the prefix of an attribute reference that requires an lvalue or in
+	  a return statement, then return the result unmodified because we want
+	  to return the original bounds.
 
        6. Finally, if the type of the result is already correct.  */
 
@@ -8539,8 +8540,9 @@ gnat_to_gnu (Node_Id gnat_node)
 
   else if (TREE_CODE (TREE_TYPE (gnu_result)) == UNCONSTRAINED_ARRAY_TYPE
 	   && Present (Parent (gnat_node))
-	   && Nkind (Parent (gnat_node)) == N_Attribute_Reference
-	   && lvalue_required_for_attribute_p (Parent (gnat_node)))
+	   && ((Nkind (Parent (gnat_node)) == N_Attribute_Reference
+	        && lvalue_required_for_attribute_p (Parent (gnat_node)))
+	       || Nkind (Parent (gnat_node)) == N_Simple_Return_Statement))
     ;
 
   else if (TREE_TYPE (gnu_result) != gnu_result_type)
diff --git a/gcc/ada/gen_il-fields.ads b/gcc/ada/gen_il-fields.ads
index e0dba9e6a5c..bc424ab3c3b 100644
--- a/gcc/ada/gen_il-fields.ads
+++ b/gcc/ada/gen_il-fields.ads
@@ -69,7 +69,6 @@ package Gen_IL.Fields is
       Address_Warning_Posted,
       Aggregate_Bounds,
       Aliased_Present,
-      Alloc_For_BIP_Return,
       All_Others,
       All_Present,
       Alternatives,
@@ -189,6 +188,7 @@ package Gen_IL.Fields is
       Float_Truncate,
       Formal_Type_Definition,
       Forwards_OK,
+      For_Special_Return_Object,
       From_Aspect_Specification,
       From_At_Mod,
       From_Conditional_Expression,
diff --git a/gcc/ada/gen_il-gen-gen_nodes.adb b/gcc/ada/gen_il-gen-gen_nodes.adb
index ba4539140fe..ec0eba74d06 100644
--- a/gcc/ada/gen_il-gen-gen_nodes.adb
+++ b/gcc/ada/gen_il-gen-gen_nodes.adb
@@ -494,7 +494,7 @@ begin -- Gen_IL.Gen.Gen_Nodes
        (Sy (Expression, Node_Id, Default_Empty),
         Sy (Subpool_Handle_Name, Node_Id, Default_Empty),
         Sy (Null_Exclusion_Present, Flag, Default_False),
-        Sm (Alloc_For_BIP_Return, Flag),
+        Sm (For_Special_Return_Object, Flag),
         Sm (Do_Storage_Check, Flag),
         Sm (Is_Dynamic_Coextension, Flag),
         Sm (Is_Static_Coextension, Flag),
diff --git a/gcc/ada/gen_il-internals.adb b/gcc/ada/gen_il-internals.adb
index cec5b94b6fc..09fe99f44bc 100644
--- a/gcc/ada/gen_il-internals.adb
+++ b/gcc/ada/gen_il-internals.adb
@@ -257,8 +257,6 @@ package body Gen_IL.Internals is
          --  Special cases for the same reason as in the above Image
          --  function for Opt_Type_Enum.
 
-         when Alloc_For_BIP_Return =>
-            return "Alloc_For_BIP_Return";
          when Assignment_OK =>
             return "Assignment_OK";
          when Backwards_OK =>
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index abee91f27fd..5334e486800 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -3781,6 +3781,11 @@ package body Sem_Ch3 is
       --  Obj_Decl carrying type Obj_Typ has explicit initialization. Emit
       --  a compile-time warning if this is not the case.
 
+      procedure Check_Return_Subtype_Indication (Obj_Decl : Node_Id);
+      --  Check that the return subtype indication properly matches the result
+      --  subtype of the function in an extended return object declaration, as
+      --  required by RM 6.5(5.1/2-5.3/2).
+
       function Count_Tasks (T : Entity_Id) return Uint;
       --  This function is called when a non-generic library level object of a
       --  task type is declared. Its function is to count the static number of
@@ -3954,6 +3959,134 @@ package body Sem_Ch3 is
          Check_Component (Obj_Typ, Obj_Decl);
       end Check_For_Null_Excluding_Components;
 
+      -------------------------------------
+      -- Check_Return_Subtype_Indication --
+      -------------------------------------
+
+      procedure Check_Return_Subtype_Indication (Obj_Decl : Node_Id) is
+         Obj_Id  : constant Entity_Id := Defining_Identifier (Obj_Decl);
+         Obj_Typ : constant Entity_Id := Etype (Obj_Id);
+         Func_Id : constant Entity_Id := Return_Applies_To (Scope (Obj_Id));
+         R_Typ   : constant Entity_Id := Etype (Func_Id);
+         Indic   : constant Node_Id   :=
+                     Object_Definition (Original_Node (Obj_Decl));
+
+         procedure Error_No_Match (N : Node_Id);
+         --  Output error messages for case where types do not statically
+         --  match. N is the location for the messages.
+
+         --------------------
+         -- Error_No_Match --
+         --------------------
+
+         procedure Error_No_Match (N : Node_Id) is
+         begin
+            Error_Msg_N
+              ("subtype must statically match function result subtype", N);
+
+            if not Predicates_Match (Obj_Typ, R_Typ) then
+               Error_Msg_Node_2 := R_Typ;
+               Error_Msg_NE
+                 ("\predicate of& does not match predicate of&",
+                  N, Obj_Typ);
+            end if;
+         end Error_No_Match;
+
+      --  Start of processing for Check_Return_Subtype_Indication
+
+      begin
+         --  First, avoid cascaded errors
+
+         if Error_Posted (Obj_Decl) or else Error_Posted (Indic) then
+            return;
+         end if;
+
+         --  "return access T" case; check that the return statement also has
+         --  "access T", and that the subtypes statically match:
+         --   if this is an access to subprogram the signatures must match.
+
+         if Is_Anonymous_Access_Type (R_Typ) then
+            if Is_Anonymous_Access_Type (Obj_Typ) then
+               if Ekind (Designated_Type (Obj_Typ)) /= E_Subprogram_Type
+               then
+                  if Base_Type (Designated_Type (Obj_Typ)) /=
+                     Base_Type (Designated_Type (R_Typ))
+                    or else not Subtypes_Statically_Match (Obj_Typ, R_Typ)
+                  then
+                     Error_No_Match (Subtype_Mark (Indic));
+                  end if;
+
+               else
+                  --  For two anonymous access to subprogram types, the types
+                  --  themselves must be type conformant.
+
+                  if not Conforming_Types
+                           (Obj_Typ, R_Typ, Fully_Conformant)
+                  then
+                     Error_No_Match (Indic);
+                  end if;
+               end if;
+
+            else
+               Error_Msg_N ("must use anonymous access type", Indic);
+            end if;
+
+         --  If the return object is of an anonymous access type, then report
+         --  an error if the function's result type is not also anonymous.
+
+         elsif Is_Anonymous_Access_Type (Obj_Typ) then
+            pragma Assert (not Is_Anonymous_Access_Type (R_Typ));
+            Error_Msg_N
+              ("anonymous access not allowed for function with named access "
+               & "result", Indic);
+
+         --  Subtype indication case: check that the return object's type is
+         --  covered by the result type, and that the subtypes statically match
+         --  when the result subtype is constrained. Also handle record types
+         --  with unknown discriminants for which we have built the underlying
+         --  record view. Coverage is needed to allow specific-type return
+         --  objects when the result type is class-wide (see AI05-32).
+
+         elsif Covers (Base_Type (R_Typ), Base_Type (Obj_Typ))
+           or else (Is_Underlying_Record_View (Base_Type (Obj_Typ))
+                     and then
+                       Covers
+                         (Base_Type (R_Typ),
+                          Underlying_Record_View (Base_Type (Obj_Typ))))
+         then
+            --  A null exclusion may be present on the return type, on the
+            --  function specification, on the object declaration or on the
+            --  subtype itself.
+
+            if Is_Access_Type (R_Typ)
+              and then
+                (Can_Never_Be_Null (R_Typ)
+                  or else Null_Exclusion_Present (Parent (Func_Id))) /=
+                            Can_Never_Be_Null (Obj_Typ)
+            then
+               Error_No_Match (Indic);
+            end if;
+
+            --  AI05-103: for elementary types, subtypes must statically match
+
+            if Is_Constrained (R_Typ) or else Is_Access_Type (R_Typ) then
+               if not Subtypes_Statically_Match (Obj_Typ, R_Typ) then
+                  Error_No_Match (Indic);
+               end if;
+            end if;
+
+         --  All remaining cases are illegal
+
+         --  Note: previous versions of this subprogram allowed the return
+         --  value to be the ancestor of the return type if the return type
+         --  was a null extension. This was plainly incorrect.
+
+         else
+            Error_Msg_N
+              ("wrong type for return_subtype_indication", Indic);
+         end if;
+      end Check_Return_Subtype_Indication;
+
       -----------------
       -- Count_Tasks --
       -----------------
@@ -5047,6 +5180,12 @@ package body Sem_Ch3 is
          end if;
       end if;
 
+      --  Check specific legality rules for a return object
+
+      if Is_Return_Object (Id) then
+         Check_Return_Subtype_Indication (N);
+      end if;
+
       --  Some simple constant-propagation: if the expression is a constant
       --  string initialized with a literal, share the literal. This avoids
       --  a run-time copy.
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index c8c0d80ffcd..da5aa5fe88f 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -44,6 +44,7 @@ with Opt;            use Opt;
 with Output;         use Output;
 with Restrict;       use Restrict;
 with Rident;         use Rident;
+with Rtsfind;        use Rtsfind;
 with Sem;            use Sem;
 with Sem_Aux;        use Sem_Aux;
 with Sem_Case;       use Sem_Case;
@@ -733,43 +734,16 @@ package body Sem_Ch4 is
             end;
          end if;
 
-         --  Check for missing initialization. Skip this check if we already
-         --  had errors on analyzing the allocator, since in that case these
-         --  are probably cascaded errors.
+         --  Check for missing initialization. Skip this check if the allocator
+         --  is made for a special return object or if we already had errors on
+         --  analyzing the allocator since, in that case, these are very likely
+         --  cascaded errors.
 
          if not Is_Definite_Subtype (Type_Id)
+           and then not For_Special_Return_Object (N)
            and then Serious_Errors_Detected = Sav_Errs
          then
-            --  The build-in-place machinery may produce an allocator when
-            --  the designated type is indefinite but the underlying type is
-            --  not. In this case the unknown discriminants are meaningless
-            --  and should not trigger error messages. Check the parent node
-            --  because the allocator is marked as coming from source.
-
-            if Present (Underlying_Type (Type_Id))
-              and then Is_Definite_Subtype (Underlying_Type (Type_Id))
-              and then not Comes_From_Source (Parent (N))
-            then
-               null;
-
-            --  An unusual case arises when the parent of a derived type is
-            --  a limited record extension  with unknown discriminants, and
-            --  its full view has no discriminants.
-            --
-            --  A more general fix might be to create the proper underlying
-            --  type for such a derived type, but it is a record type with
-            --  no private attributes, so this required extending the
-            --  meaning of this attribute. ???
-
-            elsif Ekind (Etype (Type_Id)) = E_Record_Type_With_Private
-              and then Present (Underlying_Type (Etype (Type_Id)))
-              and then
-                not Has_Discriminants (Underlying_Type (Etype (Type_Id)))
-              and then not Comes_From_Source (Parent (N))
-            then
-               null;
-
-            elsif Is_Class_Wide_Type (Type_Id) then
+            if Is_Class_Wide_Type (Type_Id) then
                Error_Msg_N
                  ("initialization required in class-wide allocation", N);
 
@@ -842,6 +816,27 @@ package body Sem_Ch4 is
          Error_Msg_N ("cannot allocate abstract object", E);
       end if;
 
+      Set_Etype (N, Acc_Type);
+
+      --  If this is an allocator for the return stack, then no restriction may
+      --  be violated since it's just a low-level access to the primary stack.
+
+      if Nkind (Parent (N)) = N_Object_Declaration
+        and then Is_Entity_Name (Object_Definition (Parent (N)))
+        and then Is_Access_Type (Entity (Object_Definition (Parent (N))))
+      then
+         declare
+            Pool : constant Entity_Id :=
+              Associated_Storage_Pool
+                (Root_Type (Entity (Object_Definition (Parent (N)))));
+
+         begin
+            if Present (Pool) and then Is_RTE (Pool, RE_RS_Pool) then
+               goto Leave;
+            end if;
+         end;
+      end if;
+
       if Has_Task (Designated_Type (Acc_Type)) then
          Check_Restriction (No_Tasking, N);
          Check_Restriction (Max_Tasks, N);
@@ -893,12 +888,11 @@ package body Sem_Ch4 is
          end if;
       end if;
 
-      Set_Etype (N, Acc_Type);
-
       if not Is_Library_Level_Entity (Acc_Type) then
          Check_Restriction (No_Local_Allocators, N);
       end if;
 
+   <<Leave>>
       if Serious_Errors_Detected > Sav_Errs then
          Set_Error_Posted (N);
          Set_Etype (N, Any_Type);
diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb
index c1523ae11e2..344b3ebfdb2 100644
--- a/gcc/ada/sem_ch5.adb
+++ b/gcc/ada/sem_ch5.adb
@@ -307,7 +307,8 @@ package body Sem_Ch5 is
          --  get the actual subtype (needed for the unconstrained case). If the
          --  operand is the actual in an entry declaration, then within the
          --  accept statement it is replaced with a local renaming, which may
-         --  also have an actual subtype.
+         --  also have an actual subtype. Likewise for a return object that
+         --  lives on the secondary stack.
 
          if Is_Entity_Name (Opnd)
            and then (Ekind (Entity (Opnd)) in E_Out_Parameter
@@ -318,7 +319,8 @@ package body Sem_Ch5 is
                           and then Nkind (Parent (Entity (Opnd))) =
                                      N_Object_Renaming_Declaration
                           and then Nkind (Parent (Parent (Entity (Opnd)))) =
-                                     N_Accept_Statement))
+                                     N_Accept_Statement)
+                      or else Is_Secondary_Stack_Return_Object (Entity (Opnd)))
          then
             Opnd_Type := Get_Actual_Subtype (Opnd);
 
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index d567f79b27e..f46ca46fc64 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -746,10 +746,6 @@ package body Sem_Ch6 is
       --  Ada 2022: Check that the return expression in a No_Return function
       --  meets the conditions specified by RM 6.5.1(5.1/5).
 
-      procedure Check_Return_Subtype_Indication (Obj_Decl : Node_Id);
-      --  Check that the return_subtype_indication properly matches the result
-      --  subtype of the function, as required by RM-6.5(5.1/2-5.3/2).
-
       --------------------------------
       -- Check_No_Return_Expression --
       --------------------------------
@@ -778,135 +774,6 @@ package body Sem_Ch6 is
             Return_Expr);
       end Check_No_Return_Expression;
 
-      -------------------------------------
-      -- Check_Return_Subtype_Indication --
-      -------------------------------------
-
-      procedure Check_Return_Subtype_Indication (Obj_Decl : Node_Id) is
-         Return_Obj : constant Node_Id   := Defining_Identifier (Obj_Decl);
-
-         R_Stm_Type : constant Entity_Id := Etype (Return_Obj);
-         --  Subtype given in the extended return statement (must match R_Type)
-
-         Subtype_Ind : constant Node_Id :=
-                         Object_Definition (Original_Node (Obj_Decl));
-
-         procedure Error_No_Match (N : Node_Id);
-         --  Output error messages for case where types do not statically
-         --  match. N is the location for the messages.
-
-         --------------------
-         -- Error_No_Match --
-         --------------------
-
-         procedure Error_No_Match (N : Node_Id) is
-         begin
-            Error_Msg_N
-              ("subtype must statically match function result subtype", N);
-
-            if not Predicates_Match (R_Stm_Type, R_Type) then
-               Error_Msg_Node_2 := R_Type;
-               Error_Msg_NE
-                 ("\predicate of& does not match predicate of&",
-                  N, R_Stm_Type);
-            end if;
-         end Error_No_Match;
-
-      --  Start of processing for Check_Return_Subtype_Indication
-
-      begin
-         --  First, avoid cascaded errors
-
-         if Error_Posted (Obj_Decl) or else Error_Posted (Subtype_Ind) then
-            return;
-         end if;
-
-         --  "return access T" case; check that the return statement also has
-         --  "access T", and that the subtypes statically match:
-         --   if this is an access to subprogram the signatures must match.
-
-         if Is_Anonymous_Access_Type (R_Type) then
-            if Is_Anonymous_Access_Type (R_Stm_Type) then
-               if Ekind (Designated_Type (R_Stm_Type)) /= E_Subprogram_Type
-               then
-                  if Base_Type (Designated_Type (R_Stm_Type)) /=
-                     Base_Type (Designated_Type (R_Type))
-                    or else not Subtypes_Statically_Match (R_Stm_Type, R_Type)
-                  then
-                     Error_No_Match (Subtype_Mark (Subtype_Ind));
-                  end if;
-
-               else
-                  --  For two anonymous access to subprogram types, the types
-                  --  themselves must be type conformant.
-
-                  if not Conforming_Types
-                           (R_Stm_Type, R_Type, Fully_Conformant)
-                  then
-                     Error_No_Match (Subtype_Ind);
-                  end if;
-               end if;
-
-            else
-               Error_Msg_N ("must use anonymous access type", Subtype_Ind);
-            end if;
-
-         --  If the return object is of an anonymous access type, then report
-         --  an error if the function's result type is not also anonymous.
-
-         elsif Is_Anonymous_Access_Type (R_Stm_Type) then
-            pragma Assert (not Is_Anonymous_Access_Type (R_Type));
-            Error_Msg_N
-              ("anonymous access not allowed for function with named access "
-               & "result", Subtype_Ind);
-
-         --  Subtype indication case: check that the return object's type is
-         --  covered by the result type, and that the subtypes statically match
-         --  when the result subtype is constrained. Also handle record types
-         --  with unknown discriminants for which we have built the underlying
-         --  record view. Coverage is needed to allow specific-type return
-         --  objects when the result type is class-wide (see AI05-32).
-
-         elsif Covers (Base_Type (R_Type), Base_Type (R_Stm_Type))
-           or else (Is_Underlying_Record_View (Base_Type (R_Stm_Type))
-                     and then
-                       Covers
-                         (Base_Type (R_Type),
-                          Underlying_Record_View (Base_Type (R_Stm_Type))))
-         then
-            --  A null exclusion may be present on the return type, on the
-            --  function specification, on the object declaration or on the
-            --  subtype itself.
-
-            if Is_Access_Type (R_Type)
-              and then
-                (Can_Never_Be_Null (R_Type)
-                  or else Null_Exclusion_Present (Parent (Scope_Id))) /=
-                            Can_Never_Be_Null (R_Stm_Type)
-            then
-               Error_No_Match (Subtype_Ind);
-            end if;
-
-            --  AI05-103: for elementary types, subtypes must statically match
-
-            if Is_Constrained (R_Type) or else Is_Access_Type (R_Type) then
-               if not Subtypes_Statically_Match (R_Stm_Type, R_Type) then
-                  Error_No_Match (Subtype_Ind);
-               end if;
-            end if;
-
-         --  All remaining cases are illegal
-
-         --  Note: previous versions of this subprogram allowed the return
-         --  value to be the ancestor of the return type if the return type
-         --  was a null extension. This was plainly incorrect.
-
-         else
-            Error_Msg_N
-              ("wrong type for return_subtype_indication", Subtype_Ind);
-         end if;
-      end Check_Return_Subtype_Indication;
-
       ---------------------
       -- Local Variables --
       ---------------------
@@ -1016,8 +883,6 @@ package body Sem_Ch6 is
             Set_Is_Return_Object (Defining_Identifier (Obj_Decl));
             Analyze (Obj_Decl);
 
-            Check_Return_Subtype_Indication (Obj_Decl);
-
             if Present (HSS) then
                Analyze (HSS);
 
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 4bbec65d6a0..b54ed93a7f7 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -5622,7 +5622,7 @@ package body Sem_Res is
       --  caller does use an allocator, it will be caught at the call site.
 
       if No_Pool_Assigned (Typ)
-        and then not Alloc_For_BIP_Return (N)
+        and then not For_Special_Return_Object (N)
       then
          Error_Msg_N ("allocation from empty storage pool!", N);
 
diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
index 7accb018a69..104ee663c0e 100644
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -842,10 +842,6 @@ package Sinfo is
    --    known at compile time, this field points to an N_Range node with those
    --    bounds. Otherwise Empty.
 
-   --  Alloc_For_BIP_Return
-   --    Present in N_Allocator nodes. True if the allocator is one of those
-   --    generated for a build-in-place return statement.
-
    --  All_Others
    --    Present in an N_Others_Choice node. This flag is set for an others
    --    exception where all exceptions are to be caught, even those that are
@@ -1344,6 +1340,10 @@ package Sinfo is
    --    cannot figure it out. If both flags Forwards_OK and Backwards_OK are
    --    set, it means that the front end can assure no overlap of operands.
 
+   --  For_Special_Return_Object
+   --    Present in N_Allocator nodes. True if the allocator is generated for
+   --    the initialization of a special return object.
+
    --  From_Aspect_Specification
    --    Processing of aspect specifications typically results in insertion in
    --    the tree of corresponding pragma or attribute definition clause nodes.
@@ -4777,7 +4777,7 @@ package Sinfo is
       --  Subpool_Handle_Name (set to Empty if not present)
       --  Storage_Pool
       --  Procedure_To_Call
-      --  Alloc_For_BIP_Return
+      --  For_Special_Return_Object
       --  Null_Exclusion_Present
       --  No_Initialization
       --  Is_Static_Coextension
diff --git a/gcc/ada/treepr.adb b/gcc/ada/treepr.adb
index a9f40887d8a..a0f45c422be 100644
--- a/gcc/ada/treepr.adb
+++ b/gcc/ada/treepr.adb
@@ -269,8 +269,9 @@ package body Treepr is
    function Image (F : Node_Or_Entity_Field) return String is
    begin
       case F is
-         when F_Alloc_For_BIP_Return =>
-            return "Alloc_For_BIP_Return";
+         --  We special case the following; otherwise the compiler will use
+         --  the usual Mixed_Case convention.
+
          when F_Assignment_OK =>
             return "Assignment_OK";
          when F_Backwards_OK =>
