From dbb0c80c36033590f8ad63ea1cdaabcf79c52fd3 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Thu, 5 May 2022 18:08:50 +0200 Subject: [PATCH] [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. --- gcc/ada/exp_ch6.adb | 11 ++++++----- gcc/ada/exp_util.adb | 20 +++++++++++--------- 2 files changed, 17 insertions(+), 14 deletions(-) diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 3b5d59c..f9c6f33 100644 --- 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 290c380..8a8f07c 100644 --- 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) -- 2.7.4