[Ada] Get rid of secondary stack for controlled components of limited types

The initial work didn't change anything for limited types because they use
a specific return mechanism for functions called build-in-place where there
is no anonymous return object, so the secondary stack was used only for the
sake of consistency with the nonlimited case.

This change aligns the limited case with the nonlimited case, i.e. either
they both use the primary stack or they both use the secondary stack.

gcc/ada/

	* exp_ch6.adb (Caller_Known_Size): Call Returns_On_Secondary_Stack
	instead of Requires_Transient_Scope and tidy up.
	(Needs_BIP_Alloc_Form): Likewise.
	* exp_util.adb (Initialized_By_Aliased_BIP_Func_Call): Also return
	true if the build-in-place function call has no BIPalloc parameter.
	(Is_Finalizable_Transient): Remove redundant test.

diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 3b5d59ca8732639a06173cf4e5ffbfcd3d769ae8..f9c6f3337502633c91c1151a94a3814968332381 100644 (file)
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -1055,11 +1055,12 @@ package body Exp_Ch6 is
      (Func_Call   : Node_Id;
       Result_Subt : Entity_Id) return Boolean
    is
+      Ctrl : constant Node_Id   := Controlling_Argument (Func_Call);
+      Utyp : constant Entity_Id := Underlying_Type (Result_Subt);
+
    begin
-      return
-          (Is_Definite_Subtype (Underlying_Type (Result_Subt))
-            and then No (Controlling_Argument (Func_Call)))
-        or else not Requires_Transient_Scope (Underlying_Type (Result_Subt));
+      return (No (Ctrl) and then Is_Definite_Subtype (Utyp))
+        or else not Returns_On_Secondary_Stack (Utyp);
    end Caller_Known_Size;
 
    -----------------------
@@ -10218,7 +10219,7 @@ package body Exp_Ch6 is
       pragma Assert (Is_Build_In_Place_Function (Func_Id));
       Func_Typ : constant Entity_Id := Underlying_Type (Etype (Func_Id));
    begin
-      return Requires_Transient_Scope (Func_Typ);
+      return Returns_On_Secondary_Stack (Func_Typ);
    end Needs_BIP_Alloc_Form;
 
    -------------------------------------

diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 290c3805627dbb0e65af7e65057b9d2bc9218499..8a8f07c449f7f6f03e886ad0b42a8fcce900ba50 100644 (file)
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -8368,9 +8368,10 @@ package body Exp_Util is
       function Initialized_By_Aliased_BIP_Func_Call
         (Trans_Id : Entity_Id) return Boolean;
       --  Determine whether transient object Trans_Id is initialized by a
-      --  build-in-place function call where the BIPalloc parameter is of
-      --  value 1 and BIPaccess is not null. This case creates an aliasing
-      --  between the returned value and the value denoted by BIPaccess.
+      --  build-in-place function call where the BIPalloc parameter either
+      --  does not exist or is Caller_Allocation, and BIPaccess is not null.
+      --  This case creates an aliasing between the returned value and the
+      --  value denoted by BIPaccess.
 
       function Is_Aliased
         (Trans_Id   : Entity_Id;
@@ -8427,11 +8428,14 @@ package body Exp_Util is
 
          if Is_Build_In_Place_Function_Call (Call) then
             declare
+               Caller_Allocation_Val : constant Uint :=
+                 UI_From_Int (BIP_Allocation_Form'Pos (Caller_Allocation));
+
                Access_Nam : Name_Id := No_Name;
                Access_OK  : Boolean := False;
                Actual     : Node_Id;
                Alloc_Nam  : Name_Id := No_Name;
-               Alloc_OK   : Boolean := False;
+               Alloc_OK   : Boolean := True;
                Formal     : Node_Id;
                Func_Id    : Entity_Id;
                Param      : Node_Id;
@@ -8466,7 +8470,7 @@ package body Exp_Util is
                             BIP_Formal_Suffix (BIP_Alloc_Form));
                      end if;
 
-                     --  A match for BIPaccess => Temp has been found
+                     --  A nonnull BIPaccess has been found
 
                      if Chars (Formal) = Access_Nam
                        and then Nkind (Actual) /= N_Null
@@ -8474,13 +8478,12 @@ package body Exp_Util is
                         Access_OK := True;
                      end if;
 
-                     --  A match for BIPalloc => 1 has been found
+                     --  A BIPalloc has been found
 
                      if Chars (Formal) = Alloc_Nam
                        and then Nkind (Actual) = N_Integer_Literal
-                       and then Intval (Actual) = Uint_1
                      then
-                        Alloc_OK := True;
+                        Alloc_OK := Intval (Actual) = Caller_Allocation_Val;
                      end if;
                   end if;
 
@@ -8767,7 +8770,6 @@ package body Exp_Util is
       return
         Ekind (Obj_Id) in E_Constant | E_Variable
           and then Needs_Finalization (Desig)
-          and then Requires_Transient_Scope (Desig)
           and then Nkind (Rel_Node) /= N_Simple_Return_Statement
           and then not Is_Part_Of_BIP_Return_Statement (Rel_Node)