From: Eric Botcazou <[email protected]>
The Master_Id of access types whose designated type contains tasks is set to
a renaming of the current _Master variable by means of Build_Master_Renaming
The exception is for anonymous access result types, whose Master_Id is set
to the current _Master variable by Check_Anonymous_Access_Return_With_Tasks.
This is fully correct because the entity of the variable is preresolved, but
is ambiguous in the .dg file because there can be several _Master variables
in the subprogram, which effectively represent distinct masters. Therefore
this makes the case of anonymous access result types also use a renaming.
gcc/ada/ChangeLog:
* exp_ch9.ads (Build_Master_Declaration): Minor tweaks in comment.
(Build_Master_Entity): Likewise.
(Build_Master_Renaming): Likewise.
(Build_Master_Renaming_Declaration): New function declaration.
* exp_ch9.adb (Build_Master_Declaration): Move around.
(Build_Master_Renaming_Declaration): New function.
(Build_Master_Renaming): Call Build_Master_Renaming_Declaration
to build the renaming declaration.
* sem_ch6.adb (Check_Anonymous_Access_Return_With_Tasks): Remove
useless guard on Declarations (N). Create a renaming declaration
for the current _Master variable and set is as the Master_Id of
the access result type.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/exp_ch9.adb | 145 ++++++++++++++++++++++++--------------------
gcc/ada/exp_ch9.ads | 14 +++--
gcc/ada/sem_ch6.adb | 19 +++---
3 files changed, 101 insertions(+), 77 deletions(-)
diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb
index 054c6db0605..6e1e0fedf34 100644
--- a/gcc/ada/exp_ch9.adb
+++ b/gcc/ada/exp_ch9.adb
@@ -1345,52 +1345,6 @@ package body Exp_Ch9 is
return Ecount;
end Build_Entry_Count_Expression;
- ------------------------------
- -- Build_Master_Declaration --
- ------------------------------
-
- function Build_Master_Declaration (Loc : Source_Ptr) return Node_Id is
- Master_Decl : Node_Id;
-
- begin
- -- Generate a dummy master if tasks or tasking hierarchies are
- -- prohibited.
-
- -- _Master : constant Integer := Library_Task_Level;
-
- if not Tasking_Allowed
- or else Restrictions.Set (No_Task_Hierarchy)
- or else not RTE_Available (RE_Current_Master)
- then
- Master_Decl :=
- Make_Object_Declaration (Loc,
- Defining_Identifier =>
- Make_Defining_Identifier (Loc, Name_uMaster),
- Constant_Present => True,
- Object_Definition =>
- New_Occurrence_Of (Standard_Integer, Loc),
- Expression =>
- Make_Integer_Literal (Loc, Library_Task_Level));
-
- -- Generate:
- -- _master : constant Integer := Current_Master.all;
-
- else
- Master_Decl :=
- Make_Object_Declaration (Loc,
- Defining_Identifier =>
- Make_Defining_Identifier (Loc, Name_uMaster),
- Constant_Present => True,
- Object_Definition =>
- New_Occurrence_Of (Standard_Integer, Loc),
- Expression =>
- Make_Explicit_Dereference (Loc,
- New_Occurrence_Of (RTE (RE_Current_Master), Loc)));
- end if;
-
- return Master_Decl;
- end Build_Master_Declaration;
-
---------------------------
-- Build_Parameter_Block --
---------------------------
@@ -3027,6 +2981,51 @@ package body Exp_Ch9 is
Handled_Statement_Sequence => Hand_Stmt_Seq);
end Build_Lock_Free_Unprotected_Subprogram_Body;
+ ------------------------------
+ -- Build_Master_Declaration --
+ ------------------------------
+
+ function Build_Master_Declaration (Loc : Source_Ptr) return Node_Id is
+ Master_Decl : Node_Id;
+
+ begin
+ -- Generate a dummy master if tasks or tasking hierarchies are
+ -- prohibited:
+ -- _Master : constant Integer := Library_Task_Level;
+
+ if not Tasking_Allowed
+ or else Restrictions.Set (No_Task_Hierarchy)
+ or else not RTE_Available (RE_Current_Master)
+ then
+ Master_Decl :=
+ Make_Object_Declaration (Loc,
+ Defining_Identifier =>
+ Make_Defining_Identifier (Loc, Name_uMaster),
+ Constant_Present => True,
+ Object_Definition =>
+ New_Occurrence_Of (Standard_Integer, Loc),
+ Expression =>
+ Make_Integer_Literal (Loc, Library_Task_Level));
+
+ -- Generate:
+ -- _Master : constant Integer := Current_Master.all;
+
+ else
+ Master_Decl :=
+ Make_Object_Declaration (Loc,
+ Defining_Identifier =>
+ Make_Defining_Identifier (Loc, Name_uMaster),
+ Constant_Present => True,
+ Object_Definition =>
+ New_Occurrence_Of (Standard_Integer, Loc),
+ Expression =>
+ Make_Explicit_Dereference (Loc,
+ New_Occurrence_Of (RTE (RE_Current_Master), Loc)));
+ end if;
+
+ return Master_Decl;
+ end Build_Master_Declaration;
+
-------------------------
-- Build_Master_Entity --
-------------------------
@@ -3107,6 +3106,35 @@ package body Exp_Ch9 is
end if;
end Build_Master_Entity;
+ ---------------------------------------
+ -- Build_Master_Renaming_Declaration --
+ ---------------------------------------
+
+ function Build_Master_Renaming_Declaration
+ (Ptr_Typ : Entity_Id;
+ Loc : Source_Ptr) return Node_Id
+ is
+ -- Generate:
+ -- <Ptr_Typ>M : Integer renames _Master;
+ -- and add a numeric suffix to the name to ensure that it is
+ -- unique in case other access types in nested constructs
+ -- are homonyms of this one.
+
+ Master_Id : constant Entity_Id :=
+ Make_Defining_Identifier (Loc,
+ New_External_Name (Chars (Ptr_Typ), 'M', -1));
+
+ Master_Decl : constant Node_Id :=
+ Make_Object_Renaming_Declaration (Loc,
+ Defining_Identifier => Master_Id,
+ Subtype_Mark =>
+ New_Occurrence_Of (Standard_Integer, Loc),
+ Name => Make_Identifier (Loc, Name_uMaster));
+
+ begin
+ return Master_Decl;
+ end Build_Master_Renaming_Declaration;
+
---------------------------
-- Build_Master_Renaming --
---------------------------
@@ -3115,10 +3143,10 @@ package body Exp_Ch9 is
(Ptr_Typ : Entity_Id;
Ins_Nod : Node_Id := Empty)
is
- Loc : constant Source_Ptr := Sloc (Ptr_Typ);
+ Loc : constant Source_Ptr := Sloc (Ptr_Typ);
+
Context : Node_Id;
Master_Decl : Node_Id;
- Master_Id : Entity_Id;
begin
-- No action needed if the run-time has no tasking support
@@ -3127,6 +3155,8 @@ package body Exp_Ch9 is
return;
end if;
+ Master_Decl := Build_Master_Renaming_Declaration (Ptr_Typ, Loc);
+
-- Determine the proper context to insert the master renaming
if Present (Ins_Nod) then
@@ -3169,28 +3199,11 @@ package body Exp_Ch9 is
Context := Parent (Ptr_Typ);
end if;
- -- Generate:
- -- <Ptr_Typ>M : Master_Id renames _Master;
- -- and add a numeric suffix to the name to ensure that it is
- -- unique in case other access types in nested constructs
- -- are homonyms of this one.
-
- Master_Id :=
- Make_Defining_Identifier (Loc,
- New_External_Name (Chars (Ptr_Typ), 'M', -1));
-
- Master_Decl :=
- Make_Object_Renaming_Declaration (Loc,
- Defining_Identifier => Master_Id,
- Subtype_Mark =>
- New_Occurrence_Of (Standard_Integer, Loc),
- Name => Make_Identifier (Loc, Name_uMaster));
-
Insert_Action (Context, Master_Decl);
-- The renamed master now services the access type
- Set_Master_Id (Ptr_Typ, Master_Id);
+ Set_Master_Id (Ptr_Typ, Defining_Identifier (Master_Decl));
end Build_Master_Renaming;
---------------------------
diff --git a/gcc/ada/exp_ch9.ads b/gcc/ada/exp_ch9.ads
index 29008d07d29..a4354eeec85 100644
--- a/gcc/ada/exp_ch9.ads
+++ b/gcc/ada/exp_ch9.ads
@@ -54,23 +54,29 @@ package Exp_Ch9 is
-- For targets supporting tasks, generate:
-- _Master : constant Integer := Current_Master.all;
-- For targets where tasks or tasking hierarchies are prohibited, generate:
- -- _Master : constant Master_Id := 3;
+ -- _Master : constant Integer := Library_Task_Level;
procedure Build_Master_Entity (Obj_Or_Typ : Entity_Id);
-- Given the name of an object or a type which is either a task, contains
- -- tasks or designates tasks, create a _master in the appropriate scope
+ -- tasks or designates tasks, create a _Master in the appropriate scope
-- which captures the value of Current_Master. Mark the nearest enclosing
-- body or block as being a task master.
+ function Build_Master_Renaming_Declaration
+ (Ptr_Typ : Entity_Id;
+ Loc : Source_Ptr) return Node_Id;
+ -- Generate:
+ -- <Ptr_Typ>M : Integer renames _Master;
+
procedure Build_Master_Renaming
(Ptr_Typ : Entity_Id;
Ins_Nod : Node_Id := Empty);
-- Given an access type Ptr_Typ whose designated type is either a task or
-- contains tasks, create a renaming of the form:
--
- -- <Ptr_Typ>M : Master_Id renames _Master;
+ -- <Ptr_Typ>M : Integer renames _Master;
--
- -- where _master denotes the task master of the enclosing context. Ins_Nod
+ -- where _Master denotes the task master of the enclosing context. Ins_Nod
-- is used to provide a specific insertion node for the renaming.
function Build_Protected_Sub_Specification
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index bd6c66d8c99..73ad8cf8d54 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -2850,18 +2850,23 @@ package body Sem_Ch6 is
then
Decl := Build_Master_Declaration (Loc);
- if Present (Declarations (N)) then
- Prepend (Decl, Declarations (N));
- else
- Set_Declarations (N, New_List (Decl));
- end if;
+ Prepend_To (Declarations (N), Decl);
+
+ -- Although Scop has a _master entity, it is not marked as a task
+ -- master as Build_Master_Entity would do, because its completion
+ -- cannot wait for the tasks it indirectly returns to terminate.
Set_Has_Master_Entity (Scop);
- Set_Master_Id (Etype (Scop), Defining_Identifier (Decl));
- -- Now mark the enclosing construct as a task master
+ -- Instead the enclosing construct is marked as a task master
Mark_Construct_As_Task_Master (Parent (N));
+
+ Decl := Build_Master_Renaming_Declaration (Etype (Scop), Loc);
+
+ Insert_After (First (Declarations (N)), Decl);
+
+ Set_Master_Id (Etype (Scop), Defining_Identifier (Decl));
end if;
end Check_Anonymous_Access_Return_With_Tasks;
--
2.53.0
