diff mbox series

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

Message ID 20220601084508.GA1247206@adacore.com
State New
Headers show
Series [Ada] Get rid of secondary stack for controlled components of limited types | expand

Commit Message

Pierre-Marie de Rodat June 1, 2022, 8:45 a.m. UTC 
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.

Tested on x86_64-pc-linux-gnu, committed on trunk

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 mbox series

Patch

diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
--- 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
--- 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)