From: Eric Botcazou <[email protected]>
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.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/exp_aggr.adb | 28 +++---
gcc/ada/exp_ch9.adb | 141 ++++++++++++++++---------------
gcc/ada/gen_il-gen-gen_nodes.adb | 2 +-
3 files changed, 92 insertions(+), 79 deletions(-)
diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index d0c25e8346a..ba8bf71912b 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 ee98ab3b541..22c3515a46d 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);
+ Find_Enclosing_Context (N, Context, Context_Id, Context_Decls);
- -- If activation chain entity has not been declared already, create one
+ -- Nothing to do if the context already has an activation chain entity
- if not Has_Activation_Chain_Entity (Context_Id) then
- declare
- Loc : constant Source_Ptr := Sloc (Context);
- Chain : Entity_Id;
- Decl : Node_Id;
-
- begin
- Chain := Make_Defining_Identifier (Sloc (N), Name_uChain);
-
- Decl :=
- Make_Object_Declaration (Loc,
- Defining_Identifier => Chain,
- Aliased_Present => True,
- Object_Definition =>
- New_Occurrence_Of (RTE (RE_Activation_Chain), Loc));
-
- Prepend_To (Decls, Decl);
-
- -- Ensure that _chain appears in the proper scope of the context
-
- 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;
+ if Has_Activation_Chain_Entity (Context_Id) then
+ return;
end if;
+
+ 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)));
+
+ Prepend_To (Context_Decls, Decl);
+
+ -- Ensure that _chain appears in the proper scope of the context
+
+ 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 23ec869f4f3..09438f44a0c 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,
--
2.53.0
