From: Eric Botcazou <[email protected]>
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.
Tested on x86_64-pc-linux-gnu, committed on master.
---
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 f8ea99719e0..9c293f47814 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 e4a991074e1..ee98ab3b541 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);
- Chain := Activation_Chain_Entity (Owner);
+ -- Obtain the activation chain entity
+
+ 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 956dc72374f..31e7cb458fd 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 84bcc429642..716c1d33f7a 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 eeaa55d9b8f..23ec869f4f3 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 92b8f9a22b8..1b9d5f848c7 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 1ec49fb5e93..01f08ec4a22 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)
--
2.53.0
