https://gcc.gnu.org/g:254a29ea571cee4c529d06b793f4c4ddb70ff15e
commit r17-1179-g254a29ea571cee4c529d06b793f4c4ddb70ff15e Author: Eric Botcazou <[email protected]> Date: Tue Apr 7 18:29:17 2026 +0200 ada: Further streamlining work This streamlines Build_Task_Allocate_Block from Exp_Ch9 by making it return the block statement only, changes Add_Task_Actuals_To_Build_In_Place_Call to deal with the master and activation chain actuals more consistently, as well as flattens an inner block in Make_Build_In_Place_Call_In_Allocator. No functional changes. gcc/ada/ChangeLog: * exp_ch9.ads (Build_Task_Allocate_Block): Change return type. * exp_ch9.adb (Build_Task_Allocate_Block): Likewise. Build an internal block entity instead of declaring an implicit label. * exp_aggr.adb (Convert_Aggr_In_Allocator): Adjust to above change. * exp_ch4.adb (Expand_N_Allocator): Likewise. * exp_ch6.adb (Add_Task_Actuals_To_Build_In_Place_Call): Add default value for Master_Actual parameter, change name of 4th parameter to Chain_Actual and deal with them consistently. (Make_Build_In_Place_Call_In_Allocator): Flatten block statement. Adjust call to Add_Task_Actuals_To_Build_In_Place_Call. (Make_Build_In_Place_Call_In_Anonymous_Context): Likewise. (Make_Build_In_Place_Call_In_Assignment): Likewise. (Make_Build_In_Place_Call_In_Object_Declaration): Likewise. * exp_ch7.adb (Build_Cleanup_Statements): Minor tweak. Diff: --- gcc/ada/exp_aggr.adb | 2 +- gcc/ada/exp_ch4.adb | 2 +- gcc/ada/exp_ch6.adb | 183 +++++++++++++++++++++++---------------------------- gcc/ada/exp_ch7.adb | 2 +- gcc/ada/exp_ch9.adb | 13 ++-- gcc/ada/exp_ch9.ads | 3 +- 6 files changed, 94 insertions(+), 111 deletions(-) diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 2f653dd123e0..d0c25e8346a1 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -3727,7 +3727,7 @@ package body Exp_Aggr is begin if Has_Task (Typ) then - Insert_Actions (N, Build_Task_Allocate_Block (Aggr, Stmts)); + Insert_Action (N, Build_Task_Allocate_Block (Aggr, Stmts)); else Insert_Actions (N, Stmts); end if; diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index fa567d32e5af..f39c80337e79 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -5089,7 +5089,7 @@ package body Exp_Ch4 is -- create a specific block to activate the created tasks. if Has_Task (Etyp) then - Insert_Actions (N, + Insert_Action (N, Build_Task_Allocate_Block (N, Init_Stmts), Suppress => All_Checks); else diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 6d434507d45f..e43e360ec7b8 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -175,20 +175,19 @@ package body Exp_Ch6 is procedure Add_Task_Actuals_To_Build_In_Place_Call (Function_Call : Node_Id; Function_Id : Entity_Id; - Master_Actual : Node_Id; - Chain : Node_Id := Empty); + Master_Actual : Node_Id := Empty; + Chain_Actual : Node_Id := Empty); -- Ada 2005 (AI-318-02): For a build-in-place call, if the result type - -- contains tasks, add two actual parameters: the master, and a pointer to - -- the caller's activation chain. Master_Actual is the actual parameter + -- contains tasks, add two actual parameters: the master, and a pointer + -- to the activation chain to pass. Master_Actual is the actual parameter -- expression to pass for the master. In most cases, this is the current - -- master (_master). The two exceptions are: If the function call is the + -- master (_master). The two exceptions are: if the function call is the -- initialization expression for an allocator, we pass the master of the - -- access type. If the function call is the initialization expression for a - -- return object, we pass along the master passed in by the caller. In most - -- contexts, the activation chain to pass is the local one, which is - -- indicated by No (Chain). However, in an allocator, the caller passes in - -- the activation Chain. Note: Master_Actual can be Empty, but only if - -- there are no tasks. + -- access type; if the function call is the initialization expression for + -- a return object, we pass along the master passed in by the caller. And + -- Chain_Actual is the reference to the activation chain to pass. In most + -- cases, the activation chain to pass is the local one (_chain). However, + -- in an allocator, it's the activation chain of the task allocation block. function Caller_Known_Size (Func_Call : Node_Id; @@ -628,18 +627,17 @@ package body Exp_Ch6 is procedure Add_Task_Actuals_To_Build_In_Place_Call (Function_Call : Node_Id; Function_Id : Entity_Id; - Master_Actual : Node_Id; - Chain : Node_Id := Empty) + Master_Actual : Node_Id := Empty; + Chain_Actual : Node_Id := Empty) is - Loc : constant Source_Ptr := Sloc (Function_Call); + Loc : constant Source_Ptr := Sloc (Function_Call); + Actual : Node_Id; - Chain_Actual : Node_Id; Chain_Formal : Node_Id; Master_Formal : Node_Id; begin - pragma Assert (Ekind (Function_Id) in E_Function - | E_Subprogram_Type); + pragma Assert (Ekind (Function_Id) in E_Function | E_Subprogram_Type); -- No such extra parameters are needed if there are no tasks @@ -661,27 +659,22 @@ package body Exp_Ch6 is Chain_Formal := Build_In_Place_Formal (Function_Id, BIP_Activation_Chain); - Chain_Actual := Make_Null (Loc); - Analyze_And_Resolve (Chain_Actual, Etype (Chain_Formal)); - Add_Extra_Actual_To_Call - (Function_Call, Chain_Formal, Chain_Actual); + Actual := Make_Null (Loc); + Analyze_And_Resolve (Actual, Etype (Chain_Formal)); + Add_Extra_Actual_To_Call (Function_Call, Chain_Formal, Actual); end if; return; end if; - Actual := Master_Actual; - -- Use a dummy _master actual in case of No_Task_Hierarchy if Restriction_Active (No_Task_Hierarchy) then Actual := Make_Integer_Literal (Loc, Library_Task_Level); - - -- In the case where we use the master associated with an access type, - -- the actual is an entity and requires an explicit reference. - - elsif Nkind (Actual) = N_Defining_Identifier then - Actual := New_Occurrence_Of (Actual, Loc); + elsif Present (Master_Actual) then + Actual := Master_Actual; + else + Actual := Make_Identifier (Loc, Name_uMaster); end if; -- Locate the implicit master parameter in the called function @@ -702,29 +695,25 @@ package body Exp_Ch6 is -- Create the actual which is a pointer to the current activation chain if Restriction_Active (No_Task_Hierarchy) then - Chain_Actual := Make_Null (Loc); - - elsif No (Chain) then - Chain_Actual := + Actual := Make_Null (Loc); + elsif Present (Chain_Actual) then + Actual := Make_Attribute_Reference (Loc, - Prefix => Make_Identifier (Loc, Name_uChain), + Prefix => Chain_Actual, Attribute_Name => Name_Unrestricted_Access); - - -- Allocator case; make a reference to the Chain passed in by the caller - else - Chain_Actual := + Actual := Make_Attribute_Reference (Loc, - Prefix => New_Occurrence_Of (Chain, Loc), + Prefix => Make_Identifier (Loc, Name_uChain), Attribute_Name => Name_Unrestricted_Access); end if; - Analyze_And_Resolve (Chain_Actual, Etype (Chain_Formal)); + Analyze_And_Resolve (Actual, Etype (Chain_Formal)); -- Build the parameter association for the new actual and add it to the -- end of the function's actuals. - Add_Extra_Actual_To_Call (Function_Call, Chain_Formal, Chain_Actual); + Add_Extra_Actual_To_Call (Function_Call, Chain_Formal, Actual); end Add_Task_Actuals_To_Build_In_Place_Call; ----------------------- @@ -8670,15 +8659,18 @@ package body Exp_Ch6 is Func_Call : constant Node_Id := Unqual_Conv (Function_Call); Func_Id : constant Entity_Id := Get_Function_Entity (Func_Call); Result_Subt : constant Entity_Id := Available_View (Etype (Func_Id)); + Has_Tasks : constant Boolean := Might_Have_Tasks (Result_Subt); - Ref_Func_Call : Node_Id; - New_Allocator : Node_Id; - Return_Obj_Access : Entity_Id; -- temp for function result - Temp_Init : Node_Id; -- initial value of Return_Obj_Access Alloc_Form : BIP_Allocation_Form; + Assign : Node_Id; + Chain : Node_Id; -- activation chain, in case of tasks + Master : Node_Id; -- master, in case of tasks + New_Allocator : Node_Id; Pool_Actual : Node_Id; -- Present if Alloc_Form = User_Storage_Pool + Ref_Func_Call : Node_Id; + Return_Obj_Access : Entity_Id; -- temp for function result Return_Obj_Actual : Node_Id; -- the temp.all, in caller-allocates case - Chain : Entity_Id; -- activation chain, in case of tasks + Temp_Init : Node_Id; -- initial value of Return_Obj_Access begin -- Mark the call as processed as a build-in-place call @@ -8821,58 +8813,54 @@ package body Exp_Ch6 is -- that the full types will be compatible, but the types not visibly -- compatible. - elsif Nkind (Function_Call) - in N_Type_Conversion | N_Unchecked_Type_Conversion + elsif Nkind (Function_Call) in N_Type_Conversion + | N_Unchecked_Type_Conversion then Ref_Func_Call := Unchecked_Convert_To (Acc_Type, Ref_Func_Call); end if; - declare - Assign : constant Node_Id := - Make_Assignment_Statement (Loc, - Name => New_Occurrence_Of (Return_Obj_Access, Loc), - Expression => Ref_Func_Call); - -- Assign the result of the function call into the temp. In the - -- caller-allocates case, this is overwriting the temp with its - -- initial value, which has no effect. In the callee-allocates case, - -- this is setting the temp to point to the object allocated by the - -- callee. Unchecked_Convert is needed for T'Input where T is derived - -- from a controlled type. - - Actions : List_Id; - -- Actions to be inserted. If there are no tasks, this is just the - -- assignment statement. If the allocated object has tasks, we need - -- to wrap the assignment in a block that activates them. The - -- activation chain of that block must be passed to the function, - -- rather than some outer chain. - - begin - if Might_Have_Tasks (Result_Subt) then - Actions := - Build_Task_Allocate_Block (Allocator, New_List (Assign)); - Chain := Activation_Chain_Entity (Last (Actions)); - else - Actions := New_List (Assign); - Chain := Empty; - end if; + -- Assign the result of the function call into the temporary. In the + -- caller-allocates case, this is overwriting the temporary with its + -- initial value, which has no effect. In the callee-allocates case, + -- this is setting the temporary to point to the object allocated by + -- the callee. + + Assign := + Make_Assignment_Statement (Loc, + Name => New_Occurrence_Of (Return_Obj_Access, Loc), + Expression => Ref_Func_Call); + + -- If the allocated object has tasks, we need to wrap the assignment in + -- a block that activates them. The activation chain of that block must + -- be passed to the function rather than some outer chain. + + if Has_Tasks then + Assign := Build_Task_Allocate_Block (Allocator, New_List (Assign)); + Master := New_Occurrence_Of (Master_Id (Acc_Type), Loc); + Chain := + New_Occurrence_Of ( + Defining_Identifier (First (Declarations (Assign))), Loc); + else + Master := Empty; + Chain := Empty; + end if; - -- See the Needs_Cleanup predicate in Expand_Allocator_Expression + -- See the Needs_Cleanup predicate in Expand_Allocator_Expression - if Alloc_Form = Caller_Allocation - and then not For_Special_Return_Object (Allocator) - and then not (Is_Entity_Name (Name (Func_Call)) - and then No_Raise (Entity (Name (Func_Call)))) - and then not Restriction_Active (No_Exception_Propagation) - and then RTE_Available (RE_Free) - and then not Debug_Flag_QQ - then - Insert_Action (Allocator, - Build_Cleanup_For_Allocator (Loc, - Return_Obj_Access, Storage_Pool (Allocator), Actions)); - else - Insert_Actions (Allocator, Actions); - end if; - end; + if Alloc_Form = Caller_Allocation + and then not For_Special_Return_Object (Allocator) + and then not (Is_Entity_Name (Name (Func_Call)) + and then No_Raise (Entity (Name (Func_Call)))) + and then not Restriction_Active (No_Exception_Propagation) + and then RTE_Available (RE_Free) + and then not Debug_Flag_QQ + then + Insert_Action (Allocator, + Build_Cleanup_For_Allocator (Loc, + Return_Obj_Access, Storage_Pool (Allocator), New_List (Assign))); + else + Insert_Action (Allocator, Assign); + end if; -- Add implicit actuals for the BIP formal parameters, if any @@ -8886,10 +8874,7 @@ package body Exp_Ch6 is (Func_Call, Func_Id, Ptr_Typ => Acc_Type); Add_Task_Actuals_To_Build_In_Place_Call - (Func_Call, - Func_Id, - Master_Actual => Master_Id (Acc_Type), - Chain => Chain); + (Func_Call, Func_Id, Master_Actual => Master, Chain_Actual => Chain); -- Add an implicit actual to the function call that provides access -- to the allocated object. An unchecked conversion to the (specific) @@ -9008,7 +8993,7 @@ package body Exp_Ch6 is (Func_Call, Func_Id); Add_Task_Actuals_To_Build_In_Place_Call - (Func_Call, Func_Id, Make_Identifier (Loc, Name_uMaster)); + (Func_Call, Func_Id); -- Pass a null value to the function since no return object is -- available on the caller side. @@ -9069,7 +9054,7 @@ package body Exp_Ch6 is (Func_Call, Func_Id); Add_Task_Actuals_To_Build_In_Place_Call - (Func_Call, Func_Id, Make_Identifier (Loc, Name_uMaster)); + (Func_Call, Func_Id); -- Add an implicit actual to the function call that provides access to -- the caller's return object. @@ -9401,7 +9386,7 @@ package body Exp_Ch6 is else Add_Task_Actuals_To_Build_In_Place_Call - (Func_Call, Func_Id, Make_Identifier (Loc, Name_uMaster)); + (Func_Call, Func_Id); end if; Add_Access_Actual_To_Build_In_Place_Call diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index c62529c49084..292327c67c51 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -1450,7 +1450,7 @@ package body Exp_Ch7 is New_Occurrence_Of (RTE (RE_Expunge_Unactivated_Tasks), Loc), Parameter_Associations => New_List ( - New_Occurrence_Of (Activation_Chain_Entity (N), Loc)))); + Make_Identifier (Loc, Name_uChain)))); -- Attempt to cancel an asynchronous entry call whenever the block which -- contains the abortable part is exited. diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index 77e19f905bdc..e4a991074e1c 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -4565,15 +4565,18 @@ package body Exp_Ch9 is function Build_Task_Allocate_Block (N : Node_Id; - Init_Stmts : List_Id) return List_Id + Init_Stmts : List_Id) return Node_Id is Loc : constant Source_Ptr := Sloc (N); Chain : constant Entity_Id := Make_Defining_Identifier (Loc, Name_uChain); - Blkent : constant Entity_Id := Make_Temporary (Loc, 'A'); + Blkent : constant Entity_Id := + New_Internal_Entity (E_Block, Current_Scope, Loc, 'B'); Block : Node_Id; begin + Set_Etype (Blkent, Standard_Void_Type); + Append_To (Init_Stmts, Make_Procedure_Call_Statement (Loc, Name => New_Occurrence_Of (RTE (RE_Activate_Tasks), Loc), @@ -4603,11 +4606,7 @@ package body Exp_Ch9 is Set_Activation_Chain_Entity (Block, Chain); - return New_List ( - Make_Implicit_Label_Declaration (Loc, - Defining_Identifier => Blkent, - Label_Construct => Block), - Block); + return Block; end Build_Task_Allocate_Block; ----------------------------------- diff --git a/gcc/ada/exp_ch9.ads b/gcc/ada/exp_ch9.ads index 3d882f2262d6..8101636610ed 100644 --- a/gcc/ada/exp_ch9.ads +++ b/gcc/ada/exp_ch9.ads @@ -109,11 +109,10 @@ package Exp_Ch9 is function Build_Task_Allocate_Block (N : Node_Id; - Init_Stmts : List_Id) return List_Id; + Init_Stmts : List_Id) return Node_Id; -- This function is used for allocators where the designated type is a task -- or contains tasks. In this case, the initialization call is replaced by: -- - -- blockname : label; -- blockname : declare -- _Chain : Activation_Chain; --
