https://gcc.gnu.org/g:fc5301ce89bf69ed25bbe72205ee50d1fccfd1f1
commit r16-5656-gfc5301ce89bf69ed25bbe72205ee50d1fccfd1f1 Author: Eric Botcazou <[email protected]> Date: Mon Nov 17 08:45:21 2025 +0100 ada: Streamline implementation of masters in Exp_Ch9 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. Diff: --- 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 fbc7060a7442..57d2ec399745 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 42111a416de2..b388044fb3c3 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 c170c23451d8..e3cde2e3f30f 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 4c63ec978ff0..f23df88a5b81 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 - - declare - Master_Present : Boolean; + -- Nothing to do if the context already has a master - 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; - - elsif Nkind (Parent (Context)) = N_Subunit then - Context := Corresponding_Stub (Parent (Context)); - end if; + -- 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). - 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 681114133fe1..4e5bdcc64347 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 9334c98e3945..750287f771bf 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 cc26ecab6ae1..e302908e9db7 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 1235ea453b6a..3b7e61ed11eb 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 - - 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. + -- Now mark the enclosing construct as a task master - 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 c5d981d53023..34777c01cfb6 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.
