From: Gary Dismukes <dismu...@adacore.com>
There are cases where GNAT introduces a dependence on the secondary stack
in a build-in-place function with a result subtype that is definite, when
this dependence could be avoided. In particular this is done for record
types that requires finalization due to having a controlled component.
At one time such functions required the secondary stack in order to
properly handle cases where the function might raise an exception
(to avoid improper finalization in the caller), but that is no longer
necessary. We remove the dependence of these functions on the SS,
along with the BIPalloc formal and the generation of the big if_statement
that uses that formal.
An additional small change is to revise the condition for determining when
to generate SS mark/release within functions.
gcc/ada/ChangeLog:
* exp_ch6.ads (Make_Build_In_Place_Call_In_Allocator): Simplify comment.
* exp_ch6.adb (Make_Build_In_Place_Call_In_Allocator): Remove obsolete
comment about not being able to allocate fixed-size controlled results
on the caller side, and replace another obsolete comment with a simpler
comment. Call Build_Allocate_Deallocate_Proc when the function doesn't
need a BIPalloc formal to ensure that function results with controlled
parts allocated on the caller side will be chained for finalization.
(Make_Build_In_Place_Call_In_Object_Declaration): Call
Needs_BIP_Collection
on the function's Entity_Id rather than the function call.
(Needs_BIP_Collection): If a BIP function doesn't need a BIPalloc formal
then it doesn't need a BIP collection either; return False in that case.
(Needs_BIP_Alloc_Form): Remove test of Needs_BIP_Collection.
* exp_ch7.adb (Expand_Cleanup_Actions): Move test of Uses_Sec_Stack
to be the first conjunct in setting of Needs_Sec_Stack_Mark, and put
the other tests in a disjunction subsidiary to that. Improve preceding
comment.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/exp_ch6.adb | 49 +++++++++++++++------------------------------
gcc/ada/exp_ch6.ads | 6 ++----
gcc/ada/exp_ch7.adb | 20 +++++++++---------
3 files changed, 28 insertions(+), 47 deletions(-)
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 5056b1f990fa..58361e10bd9c 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -9093,27 +9093,6 @@ package body Exp_Ch6 is
-- tagged, the called function itself must perform the allocation of
-- the return object, so we pass parameters indicating that.
- -- But that's also the case when the result subtype needs finalization
- -- actions because the caller side allocation may result in undesirable
- -- finalization. Consider the following example:
- --
- -- function Make_Lim_Ctrl return Lim_Ctrl is
- -- begin
- -- return Result : Lim_Ctrl := raise Program_Error do
- -- null;
- -- end return;
- -- end Make_Lim_Ctrl;
- --
- -- Obj : Lim_Ctrl_Ptr := new Lim_Ctrl'(Make_Lim_Ctrl);
- --
- -- Even though the size of limited controlled type Lim_Ctrl is known,
- -- allocating Obj at the caller side will chain Obj on Lim_Ctrl_Ptr's
- -- finalization collection. The subsequent call to Make_Lim_Ctrl will
- -- fail during the initialization actions for Result, which means that
- -- Result (and Obj by extension) should not be finalized. However Obj
- -- will be finalized when access type Lim_Ctrl_Ptr goes out of scope
- -- since it is already attached on the its finalization collection.
-
if Needs_BIP_Alloc_Form (Function_Id) then
Temp_Init := Empty;
@@ -9278,11 +9257,7 @@ package body Exp_Ch6 is
end if;
end;
- -- When the function has a controlling result, an allocation-form
- -- parameter must be passed indicating that the caller is allocating
- -- the result object. This is needed because such a function can be
- -- called as a dispatching operation and must be treated similarly
- -- to functions with unconstrained result subtypes.
+ -- Add implicit actuals for the BIP formal parameters, if any
Add_Unconstrained_Actuals_To_Build_In_Place_Call
(Func_Call,
@@ -9307,6 +9282,14 @@ package body Exp_Ch6 is
Add_Access_Actual_To_Build_In_Place_Call
(Func_Call, Function_Id, Return_Obj_Actual);
+ -- If the allocation is done in the caller, create a custom Allocate
+ -- procedure if need be.
+
+ if not Needs_BIP_Alloc_Form (Function_Id) then
+ Build_Allocate_Deallocate_Proc
+ (Declaration_Node (Return_Obj_Access), Mark => Allocator);
+ end if;
+
-- Finally, replace the allocator node with a reference to the temp
Rewrite (Allocator, New_Occurrence_Of (Return_Obj_Access, Loc));
@@ -9768,7 +9751,7 @@ package body Exp_Ch6 is
-- ensure that the heap allocation can properly chain the object
-- and later finalize it when the library unit goes out of scope.
- if Needs_BIP_Collection (Func_Call) then
+ if Needs_BIP_Collection (Function_Id) then
Build_Finalization_Collection
(Typ => Ptr_Typ,
For_Lib_Level => True,
@@ -10331,6 +10314,12 @@ package body Exp_Ch6 is
Typ : constant Entity_Id := Underlying_Type (Etype (Func_Id));
begin
+ -- No need for BIP_Collection if allocation is always done in the caller
+
+ if not Needs_BIP_Alloc_Form (Func_Id) then
+ return False;
+ end if;
+
-- A formal for the finalization collection is needed for build-in-place
-- functions whose result type needs finalization or is a tagged type.
-- Tagged primitive build-in-place functions need such a formal because
@@ -10355,12 +10344,6 @@ package body Exp_Ch6 is
Typ : constant Entity_Id := Underlying_Type (Etype (Func_Id));
begin
- -- See Make_Build_In_Place_Call_In_Allocator for the rationale
-
- if Needs_BIP_Collection (Func_Id) then
- return True;
- end if;
-
-- A formal giving the allocation method is needed for build-in-place
-- functions whose result type is returned on the secondary stack or
-- is a tagged type. Tagged primitive build-in-place functions need
diff --git a/gcc/ada/exp_ch6.ads b/gcc/ada/exp_ch6.ads
index 5919627a4e7e..3867270e71a9 100644
--- a/gcc/ada/exp_ch6.ads
+++ b/gcc/ada/exp_ch6.ads
@@ -301,10 +301,8 @@ package Exp_Ch6 is
-- BIP_Alloc_Form parameter (see type BIP_Formal_Kind).
function Needs_BIP_Collection (Func_Id : Entity_Id) return Boolean;
- -- Ada 2005 (AI-318-02): Return True if the result subtype of function
- -- Func_Id might need finalization actions. This includes build-in-place
- -- functions with tagged result types, since they can be invoked via
- -- dispatching calls, and descendant types may require finalization.
+ -- Ada 2005 (AI-318-02): Return True if the function needs an implicit
+ -- BIP_Collection parameter (see type BIP_Formal_Kind).
function Needs_BIP_Task_Actuals (Func_Id : Entity_Id) return Boolean;
-- Return True if the function returns an object of a type that has tasks.
diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index 62e9d2cbb73f..d60c6edecdff 100644
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -4758,18 +4758,18 @@ package body Exp_Ch7 is
-- We mark the secondary stack if it is used in this construct, and
-- we're not returning a function result on the secondary stack, except
- -- that a build-in-place function that might or might not return on the
- -- secondary stack always needs a mark. A run-time test is required in
- -- the case where the build-in-place function has a BIP_Alloc extra
- -- parameter (see Create_Finalizer).
+ -- that a build-in-place function that only conditionally returns on
+ -- the secondary stack will also need a mark. A run-time test for doing
+ -- the release call is needed in the case where the build-in-place
+ -- function has a BIP_Alloc_Form parameter (see Create_Finalizer).
Needs_Sec_Stack_Mark : constant Boolean :=
- (Uses_Sec_Stack (Scop)
- and then
- not Sec_Stack_Needed_For_Return (Scop))
- or else
- (Is_Build_In_Place_Function (Scop)
- and then Needs_BIP_Alloc_Form (Scop));
+ Uses_Sec_Stack (Scop)
+ and then
+ (not Sec_Stack_Needed_For_Return (Scop)
+ or else
+ (Is_Build_In_Place_Function (Scop)
+ and then Needs_BIP_Alloc_Form (Scop)));
Needs_Custom_Cleanup : constant Boolean :=
Nkind (N) = N_Block_Statement
--
2.43.0
