https://gcc.gnu.org/g:9b37bb85d8e15ce0ddef579741cc8c70d08b7868
commit r17-1193-g9b37bb85d8e15ce0ddef579741cc8c70d08b7868 Author: Eric Botcazou <[email protected]> Date: Fri Apr 10 12:35:21 2026 +0200 ada: Small tweaks in task activation support code This streamlines Build_Activation_Chain_Entity, factors out common code in Exp_Ch9, and changes the category of the Is_Task_Allocation_Block flag. No functional changes. gcc/ada/ChangeLog: PR ada/42413 * exp_aggr.adb (Build_Record_Aggr_Code): Minor tweak. * exp_ch9.adb (Make_Task_Activation_Call): New helper function. (Build_Activation_Chain_Entity): Streamline. (Build_Master_Entity): Rename local variable. (Build_Task_Activation_Call): Call Make_Task_Activation_Call. (Build_Task_Allocate_Block): Likewise. Set Is_Task_Allocation_Block separately after having created the block. * gen_il-gen-gen_nodes.adb (N_Block_Statement): Change the category of Is_Task_Allocation_Block flag from syntactic to semantic. Diff: --- gcc/ada/exp_aggr.adb | 28 +++++---- gcc/ada/exp_ch9.adb | 133 ++++++++++++++++++++------------------- gcc/ada/gen_il-gen-gen_nodes.adb | 2 +- 3 files changed, 88 insertions(+), 75 deletions(-) diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index d0c25e8346a1..ba8bf71912b5 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -3345,21 +3345,27 @@ package body Exp_Aggr is Generate_Finalization_Actions; end if; - -- Ada 2005 (AI-287): If the component type has tasks then - -- generate the activation chain and master entities (except - -- in case of an allocator because in that case these entities - -- are generated by Build_Task_Allocate_Block). + -- Ada 2005 (AI-287): If the component type has tasks, then + -- generate the activation chain entity, except in the case + -- of an allocator, where it will be created by the call to + -- Build_Task_Allocate_Block from Convert_Aggr_In_Allocator. - declare - Inside_Allocator : Boolean := False; - P : Node_Id := Parent (N); + if Has_Task (Ctype) then + declare + Inside_Allocator : Boolean := False; + P : Node_Id; - begin - if Is_Task_Type (Ctype) or else Has_Task (Ctype) then + begin + P := Parent (N); while Present (P) loop if Nkind (P) = N_Allocator then Inside_Allocator := True; exit; + + -- Prevent the search from going too far + + elsif Is_Body_Or_Package_Declaration (P) then + exit; end if; P := Parent (P); @@ -3368,8 +3374,8 @@ package body Exp_Aggr is if not Inside_Init_Proc and not Inside_Allocator then Build_Activation_Chain_Entity (N); end if; - end if; - end; + end; + end if; if not Restriction_Active (No_Default_Initialization) then Append_List_To (L, diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index ee98ab3b541f..22c3515a46d3 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -454,6 +454,11 @@ package body Exp_Ch9 is -- Determine whether Id is a function or a procedure and is marked as a -- private primitive. + function Make_Task_Activation_Call + (Loc : Source_Ptr; + Chain : Entity_Id) return Node_Id; + -- Build a call to Activate_Tasks with Chain as the single parameter + function Make_Unlock_Statement (Prot_Type : E_Protected_Type_Id; Op_Spec : N_Subprogram_Specification_Id; @@ -971,9 +976,10 @@ package body Exp_Ch9 is ----------------------------------- procedure Build_Activation_Chain_Entity (N : Node_Id) is - Context : Node_Id; - Context_Id : Entity_Id; - Decls : List_Id; + Context : Node_Id; + Context_Id : Entity_Id; + Context_Decls : List_Id; + Decl : Node_Id; -- Start of processing for Build_Activation_Chain_Entity @@ -991,41 +997,35 @@ package body Exp_Ch9 is return; end if; - Find_Enclosing_Context (N, Context, Context_Id, Decls); - - -- If activation chain entity has not been declared already, create one - - if not Has_Activation_Chain_Entity (Context_Id) then - declare - Loc : constant Source_Ptr := Sloc (Context); - Chain : Entity_Id; - Decl : Node_Id; + Find_Enclosing_Context (N, Context, Context_Id, Context_Decls); - begin - Chain := Make_Defining_Identifier (Sloc (N), Name_uChain); + -- Nothing to do if the context already has an activation chain entity - Decl := - Make_Object_Declaration (Loc, - Defining_Identifier => Chain, - Aliased_Present => True, - Object_Definition => - New_Occurrence_Of (RTE (RE_Activation_Chain), Loc)); + if Has_Activation_Chain_Entity (Context_Id) then + return; + end if; - Prepend_To (Decls, Decl); + Decl := + Make_Object_Declaration (Sloc (N), + Defining_Identifier => + Make_Defining_Identifier (Sloc (N), Name_uChain), + Aliased_Present => True, + Object_Definition => + New_Occurrence_Of (RTE (RE_Activation_Chain), Sloc (N))); - -- Ensure that _chain appears in the proper scope of the context + Prepend_To (Context_Decls, Decl); - if Context_Id /= Current_Scope then - Push_Scope (Context_Id); - Analyze (Decl); - Pop_Scope; - else - Analyze (Decl); - end if; + -- Ensure that _chain appears in the proper scope of the context - Set_Has_Activation_Chain_Entity (Context_Id); - end; + if Context_Id /= Current_Scope then + Push_Scope (Context_Id); + Analyze (Decl); + Pop_Scope; + else + Analyze (Decl); end if; + + Set_Has_Activation_Chain_Entity (Context_Id); end Build_Activation_Chain_Entity; ---------------------------- @@ -3034,10 +3034,10 @@ package body Exp_Ch9 is ------------------------- procedure Build_Master_Entity (N : Node_Id) is - Context : Node_Id; - Context_Id : Entity_Id; - Decl : Node_Id; - Decls : List_Id; + Context : Node_Id; + Context_Id : Entity_Id; + Context_Decls : List_Id; + Decl : Node_Id; begin -- No action needed if the run-time has no tasking support @@ -3051,16 +3051,16 @@ package body Exp_Ch9 is -- proper insertion point is the component list. if Is_Record_Type (Current_Scope) then - Context := N; + Context := N; Context_Id := Current_Scope; - Decls := List_Containing (Context); + Context_Decls := List_Containing (Context); -- Default case for object declarations and access types. Note that the -- context is updated to the nearest enclosing body, block, package, or -- return statement. else - Find_Enclosing_Context (N, Context, Context_Id, Decls); + Find_Enclosing_Context (N, Context, Context_Id, Context_Decls); end if; pragma Assert (not Is_Finalizer (Context_Id)); @@ -3076,7 +3076,7 @@ package body Exp_Ch9 is -- The master is inserted at the start of the declarative list of the -- context. - Prepend_To (Decls, Decl); + Prepend_To (Context_Decls, Decl); -- In certain cases where transient scopes are involved, the immediate -- scope is not always the proper master scope. Ensure that the master @@ -4471,7 +4471,6 @@ package body Exp_Ch9 is Chain : Entity_Id; Call : Node_Id; Loc : Source_Ptr; - Name : Node_Id; Stmt : Node_Id; -- Start of processing for Build_Task_Activation_Call @@ -4530,19 +4529,7 @@ package body Exp_Ch9 is Loc := Activation_Call_Loc; - if Restricted_Profile then - Name := New_Occurrence_Of (RTE (RE_Activate_Restricted_Tasks), Loc); - else - Name := New_Occurrence_Of (RTE (RE_Activate_Tasks), Loc); - end if; - - Call := - Make_Procedure_Call_Statement (Loc, - Name => Name, - Parameter_Associations => - New_List (Make_Attribute_Reference (Loc, - Prefix => New_Occurrence_Of (Chain, Loc), - Attribute_Name => Name_Unchecked_Access))); + Call := Make_Task_Activation_Call (Loc, Chain); if Nkind (N) = N_Package_Declaration then if Present (Private_Declarations (Specification (N))) then @@ -4617,14 +4604,9 @@ package body Exp_Ch9 is begin Set_Etype (Blkent, Standard_Void_Type); + Set_Has_Activation_Chain_Entity (Blkent); - Append_To (Init_Stmts, - Make_Procedure_Call_Statement (Loc, - Name => New_Occurrence_Of (RTE (RE_Activate_Tasks), Loc), - Parameter_Associations => New_List ( - Make_Attribute_Reference (Loc, - Prefix => New_Occurrence_Of (Chain, Loc), - Attribute_Name => Name_Unchecked_Access)))); + Append_To (Init_Stmts, Make_Task_Activation_Call (Loc, Chain)); Block := Make_Block_Statement (Loc, @@ -4642,10 +4624,9 @@ package body Exp_Ch9 is Handled_Statement_Sequence => Make_Handled_Sequence_Of_Statements (Loc, Init_Stmts), - Has_Created_Identifier => True, - Is_Task_Allocation_Block => True); + Has_Created_Identifier => True); - Set_Has_Activation_Chain_Entity (Blkent); + Set_Is_Task_Allocation_Block (Block); return Block; end Build_Task_Allocate_Block; @@ -14020,6 +14001,32 @@ package body Exp_Ch9 is return L; end Make_Initialize_Protection; + ------------------------------- + -- Make_Task_Activation_Call -- + ------------------------------- + + function Make_Task_Activation_Call + (Loc : Source_Ptr; + Chain : Entity_Id) return Node_Id + is + Name : Node_Id; + + begin + if Restricted_Profile then + Name := New_Occurrence_Of (RTE (RE_Activate_Restricted_Tasks), Loc); + else + Name := New_Occurrence_Of (RTE (RE_Activate_Tasks), Loc); + end if; + + return + Make_Procedure_Call_Statement (Loc, + Name => Name, + Parameter_Associations => + New_List (Make_Attribute_Reference (Loc, + Prefix => New_Occurrence_Of (Chain, Loc), + Attribute_Name => Name_Unchecked_Access))); + end Make_Task_Activation_Call; + --------------------------- -- Make_Task_Create_Call -- --------------------------- diff --git a/gcc/ada/gen_il-gen-gen_nodes.adb b/gcc/ada/gen_il-gen-gen_nodes.adb index 23ec869f4f34..09438f44a0cb 100644 --- a/gcc/ada/gen_il-gen-gen_nodes.adb +++ b/gcc/ada/gen_il-gen-gen_nodes.adb @@ -910,13 +910,13 @@ begin -- Gen_IL.Gen.Gen_Nodes Sy (Handled_Statement_Sequence, Node_Id, Default_Empty), Sy (Has_Created_Identifier, Flag), Sy (Is_Asynchronous_Call_Block, Flag), - Sy (Is_Task_Allocation_Block, Flag), Sy (At_End_Proc, Node_Id, Default_Empty), Sm (Cleanup_Actions, List_Id), Sm (Exception_Junk, Flag), Sm (Is_Abort_Block, Flag), Sm (Is_Expanded_Dispatching_Call, Flag), Sm (Is_Initialization_Block, Flag), + Sm (Is_Task_Allocation_Block, Flag), Sm (Is_Task_Master, Flag))); Cc (N_Case_Statement, N_Statement_Other_Than_Procedure_Call,
