https://gcc.gnu.org/g:46f5e13f7ca038f80c5bce90a006b1036f32d502
commit r17-1192-g46f5e13f7ca038f80c5bce90a006b1036f32d502 Author: Eric Botcazou <[email protected]> Date: Wed Apr 8 23:51:18 2026 +0200 ada: Replace Activation_Chain_Entity field by Has_Activation_Chain_Entity flag The former lives on selected nodes while the latter lives on scope entities. This is more consistent because 1) activation chains are entities attached to a scope and 2) master entities already use the Has_Master_Entity flag. The ultimate goal is to make transient scopes compatible with task types. No functional changes. gcc/ada/ChangeLog: PR ada/42413 * gen_il-fields.ads (Opt_Field_Enum): Remove Activation_Chain_Entity and add Has_Activation_Chain_Entity. * gen_il-gen-gen_entities.adb (Entity_Kind): Add new semantic flag Has_Activation_Chain_Entity. * gen_il-gen-gen_nodes.adb (N_Subprogram_Body): Remove Activation_Chain_Entity field. (N_Task_Body): Likewise. (N_Package_Declaration): Likewise. (N_Block_Statement): Likewise. (N_Extended_Return_Statement): Likewise. (N_Entry_Body): Likewise. * einfo.ads (Has_Activation_Chain_Entity): Document new flag. * sinfo.ads (Activation_Chain_Entity): Delete documentation. * exp_ch9.adb (Build_Activation_Chain_Entity): Replace uses of Activation_Chain_Entity by Has_Activation_Chain_Entity. (Build_Task_Activation_Call): Retrieve the activation chain entity by means of new helper function Activation_Chain_Entity. (Build_Task_Allocate_Block): Set Has_Activation_Chain_Entity in lieu of Activation_Chain_Entity. (Expand_N_Task_Body): Likewise. (Find_Enclosing_Context): Fix handling of N_Entry_Body. * sem_ch7.adb (May_Need_Implicit_Body): Replace test on Activation_Chain_Entity by Has_Activation_Chain_Entity. Diff: --- gcc/ada/einfo.ads | 18 +++++++ gcc/ada/exp_ch9.adb | 104 +++++++++++++++++++++++++----------- gcc/ada/gen_il-fields.ads | 2 +- gcc/ada/gen_il-gen-gen_entities.adb | 1 + gcc/ada/gen_il-gen-gen_nodes.adb | 6 --- gcc/ada/sem_ch7.adb | 2 +- gcc/ada/sinfo.ads | 19 ------- 7 files changed, 94 insertions(+), 58 deletions(-) diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index f8ea99719e03..9c293f478145 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -1488,6 +1488,17 @@ package Einfo is -- for Ghost entities without an assertion level, or a user-defined -- assertion level. +-- Has_Activation_Chain_Entity +-- Defined in entities that can appear in the scope stack (see spec +-- of Sem). It is set if an activation chain entity (_chain) has been +-- declared and initialized in the corresponding scope. + +-- Note that E_Return_Statement also has this attribute, although it is +-- not really a task activator: this chain is only used to store the +-- tasks temporarily, and is not used for activating them. On successful +-- completion of the return statement, the created tasks are moved onto +-- the caller's chain, and the caller activates them. + -- Has_Aliased_Components [implementation base type only] -- Defined in array type entities. Indicates that the component type -- of the array is aliased. Should this also be set for records to @@ -5320,6 +5331,7 @@ package Einfo is -- Contains_Ignored_Ghost_Code -- Delay_Cleanups -- Discard_Names + -- Has_Activation_Chain_Entity -- Has_Master_Entity -- Has_Nested_Block_With_Handler -- Is_Exception_Handler @@ -5632,6 +5644,7 @@ package Einfo is -- Delay_Cleanups -- Discard_Names -- Elaboration_Entity_Required + -- Has_Activation_Chain_Entity -- Has_Completion -- Has_Controlling_Result -- Has_Expanded_Contract (non-generic case only) @@ -5773,6 +5786,7 @@ package Einfo is -- E_Loop -- First_Exit_Statement + -- Has_Activation_Chain_Entity -- Has_Exit -- Has_Loop_Entry_Attributes -- Has_Master_Entity @@ -5887,6 +5901,7 @@ package Einfo is -- Elaborate_Body_Desirable (non-generic case only) -- Elaboration_Entity_Required -- From_Limited_With + -- Has_Activation_Chain_Entity -- Has_All_Calls_Remote -- Has_Completion -- Has_Forward_Instantiation @@ -5998,6 +6013,7 @@ package Einfo is -- Default_Expressions_Processed -- Delay_Cleanups -- Discard_Names + -- Has_Activation_Chain_Entity -- Has_Completion -- Has_Expanded_Contract (non-generic case only) -- Has_Master_Entity @@ -6169,6 +6185,7 @@ package Einfo is -- Return_Applies_To -- First_Entity $$$ -- Last_Entity $$$ + -- Has_Activation_Chain_Entity -- E_Signed_Integer_Type -- E_Signed_Integer_Subtype @@ -6254,6 +6271,7 @@ package Einfo is -- Contract -- SPARK_Aux_Pragma -- Delay_Cleanups + -- Has_Activation_Chain_Entity -- Has_Master_Entity -- Has_Storage_Size_Clause (base type only) -- Ignore_SPARK_Mode_Pragmas diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index e4a991074e1c..ee98ab3b541f 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -995,7 +995,7 @@ package body Exp_Ch9 is -- If activation chain entity has not been declared already, create one - if No (Activation_Chain_Entity (Context)) then + if not Has_Activation_Chain_Entity (Context_Id) then declare Loc : constant Source_Ptr := Sloc (Context); Chain : Entity_Id; @@ -1004,8 +1004,6 @@ package body Exp_Ch9 is begin Chain := Make_Defining_Identifier (Sloc (N), Name_uChain); - Set_Activation_Chain_Entity (Context, Chain); - Decl := Make_Object_Declaration (Loc, Defining_Identifier => Chain, @@ -1024,6 +1022,8 @@ package body Exp_Ch9 is else Analyze (Decl); end if; + + Set_Has_Activation_Chain_Entity (Context_Id); end; end if; end Build_Activation_Chain_Entity; @@ -4395,6 +4395,9 @@ package body Exp_Ch9 is function Activation_Call_Loc return Source_Ptr; -- Find a suitable source location for the activation call + function Activation_Chain_Entity (N : Node_Id) return Entity_Id; + -- Return the entity of the activation chain associated with N + ------------------------- -- Activation_Call_Loc -- ------------------------- @@ -4415,13 +4418,60 @@ package body Exp_Ch9 is end if; end Activation_Call_Loc; + ----------------------------- + -- Activation_Chain_Entity -- + ----------------------------- + + function Activation_Chain_Entity (N : Node_Id) return Entity_Id is + K : constant Node_Kind := Nkind (N); + Def_Id : constant Entity_Id := + (if K = N_Subprogram_Body and then Is_Task_Body_Procedure (N) + then Corresponding_Spec (Original_Node (N)) + else Unique_Defining_Entity (N)); + -- For task body procedures, the entity is chained on the task spec + + E : Entity_Id; + + begin + if not Has_Activation_Chain_Entity (Def_Id) then + return Empty; + end if; + + E := First_Entity (Def_Id); + while Present (E) loop + exit when Chars (E) = Name_uChain; + Next_Entity (E); + end loop; + + -- For package and subprogram bodies, entities first chained on the + -- spec may subsequently be moved to the body when they are created + -- during the analysis of the body, see the manipulation at the end + -- of Analyze_{Package,Subprogram}_Body_Helper. + + if No (E) + and then K in N_Package_Body | N_Subprogram_Body + and then Present (Corresponding_Spec (N)) + then + E := First_Entity (Defining_Entity (N)); + while Present (E) loop + exit when Chars (E) = Name_uChain; + Next_Entity (E); + end loop; + end if; + + -- The entity must be present if the flag is set + + pragma Assert (Present (E)); + + return E; + end Activation_Chain_Entity; + -- Local variables Chain : Entity_Id; Call : Node_Id; Loc : Source_Ptr; Name : Node_Id; - Owner : Node_Id; Stmt : Node_Id; -- Start of processing for Build_Task_Activation_Call @@ -4443,25 +4493,16 @@ package body Exp_Ch9 is return; end if; - -- Obtain the activation chain entity. Block statements, entry bodies, - -- subprogram bodies, and task bodies keep the entity in their nodes. - -- Package bodies on the other hand store it in the declaration of the - -- corresponding package spec. - - Owner := N; - - if Nkind (Owner) = N_Package_Body then - Owner := Unit_Declaration_Node (Corresponding_Spec (Owner)); - end if; - -- An extended return statement is not really a task activator, but it -- does have an activation chain on which to store tasks temporarily. -- On successful return, the tasks on this chain are moved to the chain -- passed in by the caller. - pragma Assert (Nkind (Owner) /= N_Extended_Return_Statement); + pragma Assert (Nkind (N) /= N_Extended_Return_Statement); + + -- Obtain the activation chain entity - Chain := Activation_Chain_Entity (Owner); + Chain := Activation_Chain_Entity (N); -- Nothing to do when there are no tasks to activate. This is indicated -- by a missing activation chain entity; also skip generating it when @@ -4604,7 +4645,7 @@ package body Exp_Ch9 is Has_Created_Identifier => True, Is_Task_Allocation_Block => True); - Set_Activation_Chain_Entity (Block, Chain); + Set_Has_Activation_Chain_Entity (Blkent); return Block; end Build_Task_Allocate_Block; @@ -11334,16 +11375,15 @@ package body Exp_Ch9 is -- callings sequence is identical. procedure Expand_N_Task_Body (N : Node_Id) is - Loc : constant Source_Ptr := Sloc (N); - Ttyp : constant Entity_Id := Corresponding_Spec (N); - Call : Node_Id; - New_N : Node_Id; + Loc : constant Source_Ptr := Sloc (N); + Ttyp : constant Entity_Id := Corresponding_Spec (N); + Call : Node_Id; Insert_Nod : Node_Id; - -- Used to determine the proper location of wrapper body insertions + New_N : Node_Id; begin - -- if no task body procedure, means we had an error in configurable + -- If no task body procedure, means we had an error in configurable -- run-time mode, and there is no point in proceeding further. if No (Task_Body_Procedure (Ttyp)) then @@ -11386,14 +11426,16 @@ package body Exp_Ch9 is Set_At_End_Proc (New_N, At_End_Proc (N)); -- If the task contains generic instantiations, cleanup actions are - -- delayed until after instantiation. Transfer the activation chain to - -- the subprogram, to insure that the activation call is properly - -- generated. It the task body contains inner tasks, indicate that the - -- subprogram is a task master. + -- delayed until after instantiation. Propagate the activation chain + -- to the subprogram, to ensure that the activation call is properly + -- generated, and indicate that the subprogram body is a task master. if Delay_Cleanups (Ttyp) then - Set_Activation_Chain_Entity (New_N, Activation_Chain_Entity (N)); - Set_Is_Task_Master (New_N, Is_Task_Master (N)); + Set_Has_Activation_Chain_Entity + (Task_Body_Procedure (Ttyp), Has_Activation_Chain_Entity (Ttyp)); + Set_Has_Master_Entity + (Task_Body_Procedure (Ttyp), Has_Master_Entity (Ttyp)); + Set_Is_Task_Master (New_N, Is_Task_Master (N)); end if; Rewrite (N, New_N); @@ -13051,7 +13093,7 @@ package body Exp_Ch9 is end if; elsif Nkind (Context) = N_Entry_Body then - Context_Id := Defining_Identifier (Context); + Context_Id := Corresponding_Spec (Context); elsif Nkind (Context) = N_Subprogram_Body then if Present (Corresponding_Spec (Context)) then diff --git a/gcc/ada/gen_il-fields.ads b/gcc/ada/gen_il-fields.ads index 956dc72374f0..31e7cb458fd7 100644 --- a/gcc/ada/gen_il-fields.ads +++ b/gcc/ada/gen_il-fields.ads @@ -61,7 +61,6 @@ package Gen_IL.Fields is Access_To_Subprogram_Definition, Access_Types_To_Process, Actions, - Activation_Chain_Entity, Acts_As_Spec, Actual_Designated_Subtype, Aggregate_Bounds_Or_Ancestor_Type, @@ -558,6 +557,7 @@ package Gen_IL.Fields is Generic_Homonym, Generic_Renamings, Ghost_Assertion_Level, + Has_Activation_Chain_Entity, Has_Aliased_Components, Has_Alignment_Clause, Has_All_Calls_Remote, diff --git a/gcc/ada/gen_il-gen-gen_entities.adb b/gcc/ada/gen_il-gen-gen_entities.adb index 84bcc429642c..716c1d33f7aa 100644 --- a/gcc/ada/gen_il-gen-gen_entities.adb +++ b/gcc/ada/gen_il-gen-gen_entities.adb @@ -64,6 +64,7 @@ begin -- Gen_IL.Gen.Gen_Entities Sm (Freeze_Node, Node_Id), Sm (From_Limited_With, Flag), Sm (Ghost_Assertion_Level, Node_Id), + Sm (Has_Activation_Chain_Entity, Flag), Sm (Has_Aliased_Components, Flag, Impl_Base_Type_Only), Sm (Has_Alignment_Clause, Flag), Sm (Has_All_Calls_Remote, Flag), diff --git a/gcc/ada/gen_il-gen-gen_nodes.adb b/gcc/ada/gen_il-gen-gen_nodes.adb index eeaa55d9b8f5..23ec869f4f34 100644 --- a/gcc/ada/gen_il-gen-gen_nodes.adb +++ b/gcc/ada/gen_il-gen-gen_nodes.adb @@ -737,7 +737,6 @@ begin -- Gen_IL.Gen.Gen_Nodes Sy (Handled_Statement_Sequence, Node_Id, Default_Empty), Sy (Bad_Is_Detected, Flag), Sy (At_End_Proc, Node_Id, Default_Empty), - Sm (Activation_Chain_Entity, Node_Id), Sm (Acts_As_Spec, Flag), Sm (Corresponding_Entry_Body, Node_Id), Sm (Has_Relative_Deadline_Pragma, Flag), @@ -760,7 +759,6 @@ begin -- Gen_IL.Gen.Gen_Nodes Sy (Declarations, List_Id, Default_No_List), Sy (Handled_Statement_Sequence, Node_Id, Default_Empty), Sy (At_End_Proc, Node_Id, Default_Empty), - Sm (Activation_Chain_Entity, Node_Id), Sm (Is_Task_Master, Flag))); Cc (N_Implicit_Label_Declaration, N_Later_Decl_Item, @@ -770,7 +768,6 @@ begin -- Gen_IL.Gen.Gen_Nodes Cc (N_Package_Declaration, N_Later_Decl_Item, (Sy (Specification, Node_Id), Sy (Aspect_Specifications, List_Id, Default_No_List), - Sm (Activation_Chain_Entity, Node_Id), Sm (Corresponding_Body, Node_Id), Sm (Parent_Spec, Node_Id))); @@ -915,7 +912,6 @@ begin -- Gen_IL.Gen.Gen_Nodes Sy (Is_Asynchronous_Call_Block, Flag), Sy (Is_Task_Allocation_Block, Flag), Sy (At_End_Proc, Node_Id, Default_Empty), - Sm (Activation_Chain_Entity, Node_Id), Sm (Cleanup_Actions, List_Id), Sm (Exception_Junk, Flag), Sm (Is_Abort_Block, Flag), @@ -1016,7 +1012,6 @@ begin -- Gen_IL.Gen.Gen_Nodes Cc (N_Extended_Return_Statement, N_Statement_Other_Than_Procedure_Call, (Sy (Return_Object_Declarations, List_Id), Sy (Handled_Statement_Sequence, Node_Id, Default_Empty), - Sm (Activation_Chain_Entity, Node_Id), Sm (Procedure_To_Call, Node_Id), Sm (Return_Statement_Entity, Node_Id), Sm (Storage_Pool, Node_Id))); @@ -1277,7 +1272,6 @@ begin -- Gen_IL.Gen.Gen_Nodes Sy (Handled_Statement_Sequence, Node_Id, Default_Empty), Sy (At_End_Proc, Node_Id, Default_Empty), Sy (Aspect_Specifications, List_Id, Default_No_List), - Sm (Activation_Chain_Entity, Node_Id), Sm (Corresponding_Spec, Node_Id))); Cc (N_Entry_Call_Alternative, Node_Kind, diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb index 92b8f9a22b8a..1b9d5f848c7a 100644 --- a/gcc/ada/sem_ch7.adb +++ b/gcc/ada/sem_ch7.adb @@ -2717,7 +2717,7 @@ package body Sem_Ch7 is begin if not Has_Completion (E) and then Nkind (P) = N_Package_Declaration - and then (Present (Activation_Chain_Entity (P)) or else Has_RACW (E)) + and then (Has_Activation_Chain_Entity (E) or else Has_RACW (E)) then B := Make_Package_Body (Sloc (E), diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index 1ec49fb5e93a..01f08ec4a22b 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -749,20 +749,6 @@ package Sinfo is -- how this field is used, as well as the description of the specific use -- for a particular node type. - -- Activation_Chain_Entity - -- This is used in tree nodes representing task activators (blocks, - -- subprogram bodies, package declarations, and task bodies). It is - -- initially Empty, and then gets set to point to the entity for the - -- declared Activation_Chain variable when the first task is declared. - -- When tasks are declared in the corresponding declarative region this - -- entity is located by name (its name is always _Chain) and the declared - -- tasks are added to the chain. Note that N_Extended_Return_Statement - -- also has this attribute, although it is not really a task activator: - -- this chain is only used to store the tasks temporarily, and is not - -- used for activating them. On successful completion of the return - -- statement, the tasks are moved to the caller's chain, and the caller - -- activates them. - -- Acts_As_Spec -- A flag set in the N_Subprogram_Body node for a subprogram body which -- is acting as its own spec. In the case of a library-level subprogram @@ -5199,7 +5185,6 @@ package Sinfo is -- Identifier block direct name (set to Empty if not present) -- Declarations (set to No_List if no DECLARE part) -- Handled_Statement_Sequence - -- Activation_Chain_Entity -- Cleanup_Actions -- At_End_Proc (set to Empty if no clean up procedure) -- Exception_Junk @@ -5498,7 +5483,6 @@ package Sinfo is -- Specification -- Declarations -- Handled_Statement_Sequence - -- Activation_Chain_Entity -- Corresponding_Spec -- At_End_Proc (set to Empty if no clean up procedure) -- Acts_As_Spec @@ -5695,7 +5679,6 @@ package Sinfo is -- Specification -- Corresponding_Body -- Parent_Spec - -- Activation_Chain_Entity -------------------------------- -- 7.1 Package Specification -- @@ -6034,7 +6017,6 @@ package Sinfo is -- Declarations -- Handled_Statement_Sequence -- Is_Task_Master - -- Activation_Chain_Entity -- Corresponding_Spec -- Was_Originally_Stub @@ -6218,7 +6200,6 @@ package Sinfo is -- Entry_Body_Formal_Part -- Declarations -- Handled_Statement_Sequence - -- Activation_Chain_Entity -- Corresponding_Spec -- At_End_Proc (set to Empty if no clean up procedure)
