From: Eric Botcazou <[email protected]>
The incidental discovery of an old issue and its resolution has exposed the
convoluted handling of masters in Exp_Ch9, which uses two totally different
approaches to achieve the same goal, respectively in Build_Master_Entity and
Build_Class_Wide_Master, the latter being quite hard to follow. The handling
of activation chains for extended return statements is also a bit complex.
This gets rid of the second approach entirely for masters, as well as makes
the handling of activation chains uniform for all nodes.
No functional changes.
gcc/ada/ChangeLog:
* gen_il-gen-gen_nodes.adb (N_Extended_Return_Statement): Add
Activation_Chain_Entity semantic field.
* exp_ch3.adb (Build_Master): Use Build_Master_{Entity,Renaming} in
all cases.
(Expand_N_Object_Declaration): Small tweak.
* exp_ch6.adb (Make_Build_In_Place_Iface_Call_In_Allocator): Use
Build_Master_{Entity,Renaming} to build the master.
* exp_ch7.adb (Expand_N_Package_Declaration): Do not guard the call
to Build_Task_Activation_Call for the sake of consistency.
* exp_ch9.ads (Build_Class_Wide_Master): Delete.
(Find_Master_Scope): Likewise.
(Build_Protected_Subprogram_Call_Cleanup): Move to...
(First_Protected_Operation): Move to...
(Mark_Construct_As_Task_Master): New procedure.
* exp_ch9.adb (Build_Protected_Subprogram_Call_Cleanup): ...here.
(First_Protected_Operation): ...here.
(Build_Activation_Chain_Entity): Streamline handling of extended
return statements.
(Build_Class_Wide_Master): Delete.
(Build_Master_Entity): Streamline handling of extended return
statements and call Mark_Construct_As_Task_Master on the context.
(Build_Task_Activation_Call): Assert that the owner is not an
extended return statement.
(Find_Master_Scope): Delete.
(Mark_Construct_As_Task_Master): New procedure.
* sem_ch3.adb (Access_Definition): Use Build_Master_{Entity,Renaming}
in all cases to build a master.
* sem_ch6.adb (Check_Anonymous_Return): Rename to...
(Check_Anonymous_Access_Return_With_Tasks): ...this. At the end,
call Mark_Construct_As_Task_Master on the parent node.
(Analyze_Subprogram_Body_Helper): Adjust to above renaming.
(Create_Extra_Formals): Do not set Has_Master_Entity here.
* sinfo.ads (Activation_Chain_Entity): Adjust description.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/exp_ch3.adb | 14 +-
gcc/ada/exp_ch6.adb | 4 +-
gcc/ada/exp_ch7.adb | 4 +-
gcc/ada/exp_ch9.adb | 351 +++++--------------------------
gcc/ada/exp_ch9.ads | 35 +--
gcc/ada/gen_il-gen-gen_nodes.adb | 1 +
gcc/ada/sem_ch3.adb | 3 +-
gcc/ada/sem_ch6.adb | 53 ++---
gcc/ada/sinfo.ads | 4 +-
9 files changed, 97 insertions(+), 372 deletions(-)
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index fbc7060a744..57d2ec39974 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -6684,7 +6684,8 @@ package body Exp_Ch3 is
elsif not Is_Param_Block_Component_Type (Ptr_Typ)
and then Is_Limited_Class_Wide_Type (Desig_Typ)
then
- Build_Class_Wide_Master (Ptr_Typ);
+ Build_Master_Entity (Ptr_Typ);
+ Build_Master_Renaming (Ptr_Typ);
end if;
end Build_Master;
@@ -7651,7 +7652,9 @@ package body Exp_Ch3 is
-- If tasks are being declared, make sure we have an activation chain
-- defined for the tasks (has no effect if we already have one), and
-- also that a Master variable is established (and that the appropriate
- -- enclosing construct is established as a task master).
+ -- enclosing construct is established as a task master). And also deal
+ -- with objects initialized with a call to a BIP function that has task
+ -- formal parameters.
if Has_Task (Typ)
or else Might_Have_Tasks (Typ)
@@ -7660,12 +7663,7 @@ package body Exp_Ch3 is
then
Build_Activation_Chain_Entity (N);
- if Has_Task (Typ) then
- Build_Master_Entity (Def_Id);
-
- -- Handle objects initialized with BIP function calls
-
- elsif Has_BIP_Init_Expr then
+ if Has_Task (Typ) or else Has_BIP_Init_Expr then
Build_Master_Entity (Def_Id);
end if;
end if;
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 42111a416de..b388044fb3c 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -9954,7 +9954,6 @@ package body Exp_Ch6 is
Anon_Type := Create_Itype (E_Anonymous_Access_Type, Function_Call);
Set_Directly_Designated_Type (Anon_Type, Etype (BIP_Func_Call));
Set_Etype (Anon_Type, Anon_Type);
- Build_Class_Wide_Master (Anon_Type);
Tmp_Decl :=
Make_Object_Declaration (Loc,
@@ -9978,6 +9977,9 @@ package body Exp_Ch6 is
Insert_Action (Allocator, Tmp_Decl);
Expander_Mode_Restore;
+ Build_Master_Entity (Anon_Type);
+ Build_Master_Renaming (Anon_Type);
+
Make_Build_In_Place_Call_In_Allocator
(Allocator => Expression (Tmp_Decl),
Function_Call => Expression (Expression (Tmp_Decl)));
diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index c170c23451d..e3cde2e3f30 100644
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -5067,9 +5067,7 @@ package body Exp_Ch7 is
-- Generate task activation call as last step of elaboration
- if Present (Activation_Chain_Entity (N)) then
- Build_Task_Activation_Call (N);
- end if;
+ Build_Task_Activation_Call (N);
-- Verify the run-time semantics of pragma Initial_Condition at the
-- end of the private declarations when the package lacks a body.
diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb
index 4c63ec978ff..f23df88a5b8 100644
--- a/gcc/ada/exp_ch9.adb
+++ b/gcc/ada/exp_ch9.adb
@@ -243,6 +243,16 @@ package body Exp_Ch9 is
-- cleanup handler that unlocks the object in all cases. For details,
-- see Exp_Ch7.Expand_Cleanup_Actions.
+ procedure Build_Protected_Subprogram_Call_Cleanup
+ (Op_Spec : Node_Id;
+ Conc_Typ : Node_Id;
+ Loc : Source_Ptr;
+ Stmts : List_Id);
+ -- Append to Stmts the cleanups after a call to a protected subprogram
+ -- whose specification is Op_Spec. Conc_Typ is the concurrent type and Loc
+ -- the sloc for appended statements. The cleanup will either unlock the
+ -- protected object or serve pending entries.
+
function Build_Renamed_Formal_Declaration
(New_F : Entity_Id;
Formal : Entity_Id;
@@ -424,6 +434,10 @@ package body Exp_Ch9 is
-- the scope of Context_Id and Context_Decls is the declarative list of
-- Context.
+ function First_Protected_Operation (D : List_Id) return Node_Id;
+ -- Given the declarations list for a protected body, find the
+ -- first protected operation body.
+
function Index_Object (Spec_Id : Entity_Id) return Entity_Id;
-- Given a subprogram identifier, return the entity which is associated
-- with the protection entry index in the Protected_Body_Subprogram or
@@ -959,33 +973,6 @@ package body Exp_Ch9 is
-----------------------------------
procedure Build_Activation_Chain_Entity (N : Node_Id) is
- function Has_Activation_Chain (Stmt : Node_Id) return Boolean;
- -- Determine whether an extended return statement has activation chain
-
- --------------------------
- -- Has_Activation_Chain --
- --------------------------
-
- function Has_Activation_Chain (Stmt : Node_Id) return Boolean is
- Decl : Node_Id;
-
- begin
- Decl := First (Return_Object_Declarations (Stmt));
- while Present (Decl) loop
- if Nkind (Decl) = N_Object_Declaration
- and then Chars (Defining_Identifier (Decl)) = Name_uChain
- then
- return True;
- end if;
-
- Next (Decl);
- end loop;
-
- return False;
- end Has_Activation_Chain;
-
- -- Local variables
-
Context : Node_Id;
Context_Id : Entity_Id;
Decls : List_Id;
@@ -1010,19 +997,7 @@ package body Exp_Ch9 is
-- If activation chain entity has not been declared already, create one
- if Nkind (Context) = N_Extended_Return_Statement
- or else No (Activation_Chain_Entity (Context))
- then
- -- Since extended return statements do not store the entity of the
- -- chain, examine the return object declarations to avoid creating
- -- a duplicate.
-
- if Nkind (Context) = N_Extended_Return_Statement
- and then Has_Activation_Chain (Context)
- then
- return;
- end if;
-
+ if No (Activation_Chain_Entity (Context)) then
declare
Loc : constant Source_Ptr := Sloc (Context);
Chain : Entity_Id;
@@ -1031,18 +1006,7 @@ package body Exp_Ch9 is
begin
Chain := Make_Defining_Identifier (Sloc (N), Name_uChain);
- -- Note: An extended return statement is not really a task
- -- activator, but it does have an activation chain on which to
- -- store the tasks temporarily. On successful return, the tasks
- -- on this chain are moved to the chain passed in by the caller.
- -- We do not build an Activation_Chain_Entity for an extended
- -- return statement, because we do not want to build a call to
- -- Activate_Tasks. Task activation is the responsibility of the
- -- caller.
-
- if Nkind (Context) /= N_Extended_Return_Statement then
- Set_Activation_Chain_Entity (Context, Chain);
- end if;
+ Set_Activation_Chain_Entity (Context, Chain);
Decl :=
Make_Object_Declaration (Loc,
@@ -1184,155 +1148,6 @@ package body Exp_Ch9 is
Parameter_Associations => New_List (Concurrent_Ref (N)));
end Build_Call_With_Task;
- -----------------------------
- -- Build_Class_Wide_Master --
- -----------------------------
-
- procedure Build_Class_Wide_Master (Typ : Entity_Id) is
- Loc : constant Source_Ptr := Sloc (Typ);
- Master_Decl : Node_Id;
- Master_Id : Entity_Id;
- Master_Scope : Entity_Id;
- Name_Id : Node_Id;
- Related_Node : Node_Id;
- Ren_Decl : Node_Id;
-
- begin
- -- No action needed if the run-time has no tasking support
-
- if Global_No_Tasking then
- return;
- end if;
-
- -- Find the declaration that created the access type, which is either a
- -- type declaration, or an object declaration with an access definition,
- -- in which case the type is anonymous.
-
- if Is_Itype (Typ) then
- Related_Node := Associated_Node_For_Itype (Typ);
- else
- Related_Node := Parent (Typ);
- end if;
-
- Master_Scope := Find_Master_Scope (Typ);
-
- -- Nothing to do if the master scope already contains a _master entity.
- -- The only exception to this is the following scenario:
-
- -- Source_Scope
- -- Transient_Scope_1
- -- _master
-
- -- Transient_Scope_2
- -- use of master
-
- -- In this case the source scope is marked as having the master entity
- -- even though the actual declaration appears inside an inner scope. If
- -- the second transient scope requires a _master, it cannot use the one
- -- already declared because the entity is not visible.
-
- Name_Id := Make_Identifier (Loc, Name_uMaster);
- Master_Decl := Empty;
-
- if not Has_Master_Entity (Master_Scope)
- or else No (Current_Entity_In_Scope (Name_Id))
- then
- declare
- Ins_Nod : Node_Id;
- Par_Nod : Node_Id;
-
- begin
- Master_Decl := Build_Master_Declaration (Loc);
-
- -- Ensure that the master declaration is placed before its use
-
- Ins_Nod := Find_Hook_Context (Related_Node);
- while not Is_List_Member (Ins_Nod) loop
- Ins_Nod := Parent (Ins_Nod);
- end loop;
-
- Par_Nod := Parent (List_Containing (Ins_Nod));
-
- -- For internal blocks created by Wrap_Loop_Statement, Wrap_
- -- Statements_In_Block, and Build_Abort_Undefer_Block, remember
- -- that they have a task master entity declaration; required by
- -- Build_Master_Entity to avoid creating another master entity,
- -- and also ensures that subsequent calls to Find_Master_Scope
- -- return this scope as the master scope of Typ.
-
- if Is_Internal_Block (Par_Nod) then
- Set_Has_Master_Entity (Entity (Identifier (Par_Nod)));
-
- elsif Nkind (Par_Nod) = N_Handled_Sequence_Of_Statements
- and then Is_Internal_Block (Parent (Par_Nod))
- then
- Set_Has_Master_Entity (Entity (Identifier (Parent (Par_Nod))));
-
- -- Otherwise remember that this scope has an associated task
- -- master entity declaration.
-
- else
- Set_Has_Master_Entity (Master_Scope);
- end if;
-
- Insert_Before (First (List_Containing (Ins_Nod)), Master_Decl);
- Analyze (Master_Decl);
-
- -- Mark the containing scope as a task master. Masters associated
- -- with return statements are already marked at this stage (see
- -- Analyze_Subprogram_Body).
-
- if Ekind (Current_Scope) /= E_Return_Statement then
- declare
- Par : Node_Id := Related_Node;
-
- begin
- while Nkind (Par) /= N_Compilation_Unit loop
- Par := Parent (Par);
-
- -- If we fall off the top, we are at the outer level,
- -- and the environment task is our effective master,
- -- so nothing to mark.
-
- if Nkind (Par) in
- N_Block_Statement | N_Subprogram_Body | N_Task_Body
- then
- Set_Is_Task_Master (Par);
- exit;
- end if;
- end loop;
- end;
- end if;
- end;
- end if;
-
- Master_Id :=
- Make_Defining_Identifier (Loc, New_External_Name (Chars (Typ), 'M'));
-
- -- Generate:
- -- typeMnn renames _master;
-
- Ren_Decl :=
- Make_Object_Renaming_Declaration (Loc,
- Defining_Identifier => Master_Id,
- Subtype_Mark => New_Occurrence_Of (Standard_Integer, Loc),
- Name => Name_Id);
-
- -- If the master is declared locally, add the renaming declaration
- -- immediately after it, to prevent access-before-elaboration in the
- -- back-end.
-
- if Present (Master_Decl) then
- Insert_After (Master_Decl, Ren_Decl);
- Analyze (Ren_Decl);
-
- else
- Insert_Action (Related_Node, Ren_Decl);
- end if;
-
- Set_Master_Id (Typ, Master_Id);
- end Build_Class_Wide_Master;
-
--------------------------------
-- Build_Corresponding_Record --
--------------------------------
@@ -3256,47 +3071,11 @@ package body Exp_Ch9 is
Find_Enclosing_Context (Par, Context, Context_Id, Decls);
end if;
- -- When the enclosing context is a BIP function whose result type has
- -- tasks, the function has an extra formal that is the master of the
- -- tasks to be created by its returned object (that is, when its
- -- enclosing context is a return statement). However, if the body of
- -- the function creates tasks before its return statements, such tasks
- -- need their own master.
+ pragma Assert (not Is_Finalizer (Context_Id));
- if Has_Master_Entity (Context_Id)
- and then Ekind (Context_Id) = E_Function
- and then Is_Build_In_Place_Function (Context_Id)
- and then Needs_BIP_Task_Actuals (Context_Id)
- then
- -- No need to add it again if previously added
+ -- Nothing to do if the context already has a master
- declare
- Master_Present : Boolean;
-
- begin
- -- Handle transient scopes
-
- if Context_Id /= Current_Scope then
- Push_Scope (Context_Id);
- Master_Present :=
- Present (Current_Entity_In_Scope (Name_uMaster));
- Pop_Scope;
- else
- Master_Present :=
- Present (Current_Entity_In_Scope (Name_uMaster));
- end if;
-
- if Master_Present then
- return;
- end if;
- end;
-
- -- Nothing to do if the context already has a master; internally built
- -- finalizers don't need a master.
-
- elsif Has_Master_Entity (Context_Id)
- or else Is_Finalizer (Context_Id)
- then
+ if Has_Master_Entity (Context_Id) then
return;
end if;
@@ -3319,26 +3098,15 @@ package body Exp_Ch9 is
Analyze (Decl);
end if;
- -- Mark the enclosing scope and its associated construct as being task
- -- masters.
-
Set_Has_Master_Entity (Context_Id);
- while Present (Context)
- and then Nkind (Context) /= N_Compilation_Unit
- loop
- if Nkind (Context) in
- N_Block_Statement | N_Subprogram_Body | N_Task_Body
- then
- Set_Is_Task_Master (Context);
- exit;
+ -- Mark its associated construct as being a task master, but masters
+ -- associated with return statements are already marked at this stage
+ -- (see Analyze_Subprogram_Body_Helper).
- elsif Nkind (Parent (Context)) = N_Subunit then
- Context := Corresponding_Stub (Parent (Context));
- end if;
-
- Context := Parent (Context);
- end loop;
+ if Nkind (Context) /= N_Extended_Return_Statement then
+ Mark_Construct_As_Task_Master (Context);
+ end if;
end Build_Master_Entity;
---------------------------
@@ -4680,6 +4448,13 @@ package body Exp_Ch9 is
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);
+
Chain := Activation_Chain_Entity (Owner);
-- Nothing to do when there are no tasks to activate. This is indicated
@@ -13298,42 +13073,6 @@ package body Exp_Ch9 is
pragma Assert (Present (Context_Decls));
end Find_Enclosing_Context;
- -----------------------
- -- Find_Master_Scope --
- -----------------------
-
- function Find_Master_Scope (E : Entity_Id) return Entity_Id is
- S : Entity_Id;
-
- begin
- -- In Ada 2005, the master is the innermost enclosing scope that is not
- -- transient. If the enclosing block is the rewriting of a call or the
- -- scope is an extended return statement this is valid master. The
- -- master in an extended return is only used within the return, and is
- -- subsequently overwritten in Move_Activation_Chain, but it must exist
- -- now before that overwriting occurs.
-
- S := Scope (E);
-
- if Ada_Version >= Ada_2005 then
- while Is_Internal (S) loop
- if Nkind (Parent (S)) = N_Block_Statement
- and then Has_Master_Entity (S)
- then
- exit;
-
- elsif Ekind (S) = E_Return_Statement then
- exit;
-
- else
- S := Scope (S);
- end if;
- end loop;
- end if;
-
- return S;
- end Find_Master_Scope;
-
-------------------------------
-- First_Protected_Operation --
-------------------------------
@@ -14650,6 +14389,32 @@ package body Exp_Ch9 is
Attribute_Name => Name_Unchecked_Access)));
end Make_Unlock_Statement;
+ -----------------------------------
+ -- Mark_Construct_As_Task_Master --
+ -----------------------------------
+
+ procedure Mark_Construct_As_Task_Master (N : Node_Id) is
+ Nod : Node_Id := N;
+
+ begin
+ -- If we fall off the top, we are at the outer level, and the
+ -- environment task is our effective master, so nothing to mark.
+
+ while Nkind (Nod) /= N_Compilation_Unit loop
+ if Nkind (Nod) in N_Block_Statement | N_Subprogram_Body | N_Task_Body
+ then
+ Set_Is_Task_Master (Nod);
+ exit;
+
+ elsif Nkind (Parent (Nod)) = N_Subunit then
+ Nod := Corresponding_Stub (Parent (Nod));
+
+ else
+ Nod := Parent (Nod);
+ end if;
+ end loop;
+ end Mark_Construct_As_Task_Master;
+
------------------------------
-- Next_Protected_Operation --
------------------------------
diff --git a/gcc/ada/exp_ch9.ads b/gcc/ada/exp_ch9.ads
index 681114133fe..4e5bdcc6434 100644
--- a/gcc/ada/exp_ch9.ads
+++ b/gcc/ada/exp_ch9.ads
@@ -50,11 +50,6 @@ package Exp_Ch9 is
-- Task_Id of the associated task as the parameter. The caller is
-- responsible for analyzing and resolving the resulting tree.
- procedure Build_Class_Wide_Master (Typ : Entity_Id);
- -- Given an access-to-limited class-wide type or an access-to-limited
- -- interface, ensure that the designated type has a _master and generate
- -- a renaming of the said master to service the access type.
-
function Build_Master_Declaration (Loc : Source_Ptr) return Node_Id;
-- For targets supporting tasks, generate:
-- _Master : constant Integer := Current_Master.all;
@@ -99,16 +94,6 @@ package Exp_Ch9 is
-- External is False if the call is to another protected subprogram within
-- the same object.
- procedure Build_Protected_Subprogram_Call_Cleanup
- (Op_Spec : Node_Id;
- Conc_Typ : Node_Id;
- Loc : Source_Ptr;
- Stmts : List_Id);
- -- Append to Stmts the cleanups after a call to a protected subprogram
- -- whose specification is Op_Spec. Conc_Typ is the concurrent type and Loc
- -- the sloc for appended statements. The cleanup will either unlock the
- -- protected object or serve pending entries.
-
procedure Build_Task_Activation_Call (N : Node_Id);
-- This procedure is called for constructs that can be task activators,
-- i.e. task bodies, subprogram bodies, package bodies and blocks. If the
@@ -185,8 +170,7 @@ package Exp_Ch9 is
(Sloc : Source_Ptr;
Ent : Entity_Id;
Index : Node_Id;
- Ttyp : Entity_Id)
- return Node_Id;
+ Ttyp : Entity_Id) return Node_Id;
-- Returns an expression to compute a task entry index given the name of
-- the entry or entry family. For the case of a task entry family, the
-- Index parameter contains the expression for the subscript. Ttyp is the
@@ -267,19 +251,6 @@ package Exp_Ch9 is
-- Return the external version of a protected operation, which locks
-- the object before invoking the internal protected subprogram body.
- function Find_Master_Scope (E : Entity_Id) return Entity_Id;
- -- When a type includes tasks, a master entity is created in the scope, to
- -- be used by the runtime during activation. In general the master is the
- -- immediate scope in which the type is declared, but in Ada 2005, in the
- -- presence of synchronized classwide interfaces, the immediate scope of
- -- an anonymous access type may be a transient scope, which has no run-time
- -- presence. In this case, the scope of the master is the innermost scope
- -- that comes from source.
-
- function First_Protected_Operation (D : List_Id) return Node_Id;
- -- Given the declarations list for a protected body, find the
- -- first protected operation body.
-
procedure Install_Private_Data_Declarations
(Loc : Source_Ptr;
Spec_Id : Entity_Id;
@@ -345,6 +316,10 @@ package Exp_Ch9 is
-- Given the entity of the record type created for a protected type, build
-- a list of statements needed for proper initialization of the object.
+ procedure Mark_Construct_As_Task_Master (N : Node_Id);
+ -- Mark the innermost N_Block_Statement, N_Subprogram_Body or N_Task_Body
+ -- that is either N or enclosing N as being a task master.
+
function Next_Protected_Operation (N : Node_Id) return Node_Id;
-- Given a protected operation node (a subprogram or entry body), find the
-- following node in the declarations list.
diff --git a/gcc/ada/gen_il-gen-gen_nodes.adb b/gcc/ada/gen_il-gen-gen_nodes.adb
index 9334c98e394..750287f771b 100644
--- a/gcc/ada/gen_il-gen-gen_nodes.adb
+++ b/gcc/ada/gen_il-gen-gen_nodes.adb
@@ -1015,6 +1015,7 @@ 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)));
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index cc26ecab6ae..e302908e9db 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -958,7 +958,8 @@ package body Sem_Ch3 is
if Is_Limited_Record (Desig_Type)
and then Is_Class_Wide_Type (Desig_Type)
then
- Build_Class_Wide_Master (Anon_Type);
+ Build_Master_Entity (Defining_Identifier (Related_Nod));
+ Build_Master_Renaming (Anon_Type);
-- Similarly, if the type is an anonymous access that designates
-- tasks, create a master entity for it in the current context.
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 1235ea453b6..3b7e61ed11e 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -2434,11 +2434,11 @@ package body Sem_Ch6 is
procedure Build_Subprogram_Declaration;
-- Create a matching subprogram declaration for subprogram body N
- procedure Check_Anonymous_Return;
- -- Ada 2005: if a function returns an access type that denotes a task,
- -- or a type that contains tasks, we must create a master entity for
- -- the anonymous type, which typically will be used in an allocator
- -- in the body of the function.
+ procedure Check_Anonymous_Access_Return_With_Tasks;
+ -- If a function returns an anonymous access type that designates a task
+ -- or a type that contains tasks, create a master entity in the function
+ -- for the anonymous access type, and also mark the construct enclosing
+ -- the function as a task master.
procedure Check_Inline_Pragma (Spec : in out Node_Id);
-- Look ahead to recognize a pragma that may appear after the body.
@@ -2795,13 +2795,12 @@ package body Sem_Ch6 is
Body_Id := Analyze_Subprogram_Specification (Body_Spec);
end Build_Subprogram_Declaration;
- ----------------------------
- -- Check_Anonymous_Return --
- ----------------------------
+ ----------------------------------------------
+ -- Check_Anonymous_Access_Return_With_Tasks --
+ ----------------------------------------------
- procedure Check_Anonymous_Return is
+ procedure Check_Anonymous_Access_Return_With_Tasks is
Decl : Node_Id;
- Par : Node_Id;
Scop : Entity_Id;
begin
@@ -2837,29 +2836,14 @@ package body Sem_Ch6 is
Set_Declarations (N, New_List (Decl));
end if;
- Set_Master_Id (Etype (Scop), Defining_Identifier (Decl));
Set_Has_Master_Entity (Scop);
+ Set_Master_Id (Etype (Scop), Defining_Identifier (Decl));
- -- Now mark the containing scope as a task master
+ -- Now mark the enclosing construct as a task master
- Par := N;
- while Nkind (Par) /= N_Compilation_Unit loop
- Par := Parent (Par);
- pragma Assert (Present (Par));
-
- -- If we fall off the top, we are at the outer level, and
- -- the environment task is our effective master, so nothing
- -- to mark.
-
- if Nkind (Par)
- in N_Task_Body | N_Block_Statement | N_Subprogram_Body
- then
- Set_Is_Task_Master (Par, True);
- exit;
- end if;
- end loop;
+ Mark_Construct_As_Task_Master (Parent (N));
end if;
- end Check_Anonymous_Return;
+ end Check_Anonymous_Access_Return_With_Tasks;
-------------------------
-- Check_Inline_Pragma --
@@ -4476,7 +4460,12 @@ package body Sem_Ch6 is
Install_Private_With_Clauses (Body_Id);
end if;
- Check_Anonymous_Return;
+ -- If a function returns an anonymous access type that designates a task
+ -- or a type that contains tasks, we must create a master entity for the
+ -- anonymous access type, which typically will be used for an allocator
+ -- in the body of the function.
+
+ Check_Anonymous_Access_Return_With_Tasks;
-- Set the Protected_Formal field of each extra formal of the protected
-- subprogram to reference the corresponding extra formal of the
@@ -9420,10 +9409,6 @@ package body Sem_Ch6 is
(E, Standard_Integer,
E, BIP_Formal_Suffix (BIP_Task_Master));
- if Needs_BIP_Task_Actuals (Ref_E) then
- Set_Has_Master_Entity (E);
- end if;
-
Discard :=
Add_Extra_Formal
(E, RTE (RE_Activation_Chain_Access),
diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads
index c5d981d5302..34777c01cfb 100644
--- a/gcc/ada/sinfo.ads
+++ b/gcc/ada/sinfo.ads
@@ -757,8 +757,8 @@ package Sinfo is
-- 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
- -- does not have this attribute, although it does have an activation
- -- chain. This chain is used to store the tasks temporarily, and is not
+ -- 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.
--
2.51.0
