@@ -367,6 +367,7 @@ package body System.Multiprocessors.Dispatching_Domains is
-- Attach the CPU to the task
T.Common.Base_CPU := CPU;
+ T.Common.CPU_Is_Explicit := True;
-- Change the number of tasks attached to a given task in the system
-- domain if needed.
@@ -259,6 +259,11 @@ package body System.Task_Primitives.Operations is
-- Initialize the lock L. If Ceiling_Support is True, then set the ceiling
-- to Prio. Returns 0 for success, or ENOMEM for out-of-memory.
+ function Requires_Affinity_Change
+ (Domain : Dispatching_Domain_Access) return Boolean;
+ -- Returns whether a call to pthread_setaffinity_np is required to assign a
+ -- task to Domain.
+
-------------------
-- Abort_Handler --
-------------------
@@ -521,6 +526,20 @@ package body System.Task_Primitives.Operations is
Ceiling_Violation := Result = EINVAL;
end Read_Lock;
+ ------------------------------
+ -- Requires_Affinity_Change --
+ ------------------------------
+
+ function Requires_Affinity_Change
+ (Domain : Dispatching_Domain_Access) return Boolean is
+ begin
+ return
+ Domain /= System_Domain
+ or else Domain.all
+ /= [Multiprocessors.CPU'First
+ .. Multiprocessors.Number_Of_CPUs => True];
+ end Requires_Affinity_Change;
+
------------
-- Unlock --
------------
@@ -941,7 +960,9 @@ package body System.Task_Primitives.Operations is
-- Support is available
- elsif T.Common.Base_CPU /= Multiprocessors.Not_A_Specific_CPU then
+ elsif T.Common.CPU_Is_Explicit
+ and then T.Common.Base_CPU /= Multiprocessors.Not_A_Specific_CPU
+ then
declare
CPUs : constant size_t :=
C.size_t (Multiprocessors.Number_Of_CPUs);
@@ -971,7 +992,7 @@ package body System.Task_Primitives.Operations is
-- Handle dispatching domains
- else
+ elsif Requires_Affinity_Change (T.Common.Domain) then
declare
CPUs : constant size_t :=
C.size_t (Multiprocessors.Number_Of_CPUs);
@@ -1464,6 +1485,8 @@ package body System.Task_Primitives.Operations is
if pthread_setaffinity_np'Address /= Null_Address
and then T.Common.LL.Thread /= Null_Thread_Id
+ and then (T.Common.CPU_Is_Explicit
+ or else Requires_Affinity_Change (T.Common.Domain))
then
declare
CPUs : constant size_t :=
@@ -514,7 +514,8 @@ package body System.Tasking.Restricted.Stages is
Initialize_ATCB
(Self_ID, State, Discriminants, Self_ID, Elaborated, Base_Priority,
- Base_CPU, null, Task_Info, Stack_Size, Created_Task, Success);
+ Base_CPU, CPU /= Unspecified_CPU, null, Task_Info, Stack_Size,
+ Created_Task, Success);
-- If we do our job right then there should never be any failures, which
-- was probably said about the Titanic; so just to be safe, let's retain
@@ -89,12 +89,12 @@ package body System.Tasking is
Elaborated : Access_Boolean;
Base_Priority : System.Any_Priority;
Base_CPU : System.Multiprocessors.CPU_Range;
+ CPU_Is_Explicit : Boolean;
Domain : Dispatching_Domain_Access;
Task_Info : System.Task_Info.Task_Info_Type;
Stack_Size : System.Parameters.Size_Type;
T : Task_Id;
- Success : out Boolean)
- is
+ Success : out Boolean) is
begin
T.Common.State := Unactivated;
@@ -110,9 +110,10 @@ package body System.Tasking is
-- would be illegal, because Common_ATCB is limited because
-- Task_Primitives.Private_Data is limited.
- T.Common.Parent := Parent;
- T.Common.Base_Priority := Base_Priority;
- T.Common.Base_CPU := Base_CPU;
+ T.Common.Parent := Parent;
+ T.Common.Base_Priority := Base_Priority;
+ T.Common.CPU_Is_Explicit := CPU_Is_Explicit;
+ T.Common.Base_CPU := Base_CPU;
-- The Domain defaults to that of the activator. But that can be null in
-- the case of foreign threads (see Register_Foreign_Thread), in which
@@ -235,6 +236,7 @@ package body System.Tasking is
Elaborated => null,
Base_Priority => Base_Priority,
Base_CPU => Base_CPU,
+ CPU_Is_Explicit => Main_CPU /= Unspecified_CPU,
Domain => System_Domain,
Task_Info => Task_Info.Unspecified_Task_Info,
Stack_Size => 0,
@@ -518,6 +518,17 @@ package System.Tasking is
--
-- Protection: Only written by Self, accessed by anyone
+ CPU_Is_Explicit : Boolean;
+ -- True if the task is either assigned to a CPU or explicitly not
+ -- assigned to a CPU through Not_A_Specific_CPU being used with the CPU
+ -- Aspect a subprogram in System.Multiprocessors.Dispatching_Domains.
+ -- False otherwise.
+ -- We keep track of this information to make it possible to accomodate
+ -- native affinity inheritance on some platforms when no RM D.16
+ -- features are used. An example of such a platform is Linux, where we
+ -- strive to make the taskset command line tool have the expected effect
+ -- when the program does not use RM D.16 features.
+
Base_CPU : System.Multiprocessors.CPU_Range;
-- Base CPU, only changed via dispatching domains package.
--
@@ -1184,18 +1195,19 @@ package System.Tasking is
-- System.Tasking.Initialization being present, as was done before.
procedure Initialize_ATCB
- (Self_ID : Task_Id;
- Task_Entry_Point : Task_Procedure_Access;
- Task_Arg : System.Address;
- Parent : Task_Id;
- Elaborated : Access_Boolean;
- Base_Priority : System.Any_Priority;
- Base_CPU : System.Multiprocessors.CPU_Range;
- Domain : Dispatching_Domain_Access;
- Task_Info : System.Task_Info.Task_Info_Type;
- Stack_Size : System.Parameters.Size_Type;
- T : Task_Id;
- Success : out Boolean);
+ (Self_ID : Task_Id;
+ Task_Entry_Point : Task_Procedure_Access;
+ Task_Arg : System.Address;
+ Parent : Task_Id;
+ Elaborated : Access_Boolean;
+ Base_Priority : System.Any_Priority;
+ Base_CPU : System.Multiprocessors.CPU_Range;
+ CPU_Is_Explicit : Boolean;
+ Domain : Dispatching_Domain_Access;
+ Task_Info : System.Task_Info.Task_Info_Type;
+ Stack_Size : System.Parameters.Size_Type;
+ T : Task_Id;
+ Success : out Boolean);
-- Initialize fields of the TCB for task T, and link into global TCB
-- structures. Call this only with abort deferred and holding RTS_Lock.
-- Self_ID is the calling task (normally the activator of T). Success is
@@ -584,7 +584,8 @@ package body System.Tasking.Stages is
end if;
Initialize_ATCB (Self_ID, State, Discriminants, P, Elaborated,
- Base_Priority, Base_CPU, Domain, Task_Info, Stack_Size, T, Success);
+ Base_Priority, Base_CPU, CPU /= Unspecified_CPU, Domain, Task_Info,
+ Stack_Size, T, Success);
if not Success then
Free (T);
@@ -66,8 +66,8 @@ begin
System.Tasking.Initialize_ATCB
(Self_Id, null, Null_Address, Null_Task,
Foreign_Task_Elaborated'Access,
- System.Priority'First, System.Multiprocessors.Not_A_Specific_CPU, null,
- Task_Info.Unspecified_Task_Info, 0, Self_Id, Succeeded);
+ System.Priority'First, System.Multiprocessors.Not_A_Specific_CPU, False,
+ null, Task_Info.Unspecified_Task_Info, 0, Self_Id, Succeeded);
Unlock_RTS;
pragma Assert (Succeeded);
From: Ronan Desplanques <desplanques@adacore.com> The primary motivation for this change is making the taskset command line tool work as expected for tasking programs that don't use features from section D.16 of the Ada reference manual. A couple of components are added to the ATCB record to make it possible to tell values that come from explicit aspects and subprogram calls from values that are inherited from activating tasks. gcc/ada/ChangeLog: * libgnarl/s-mudido__affinity.adb (Unchecked_Set_Affinity): Set new ATCB component. * libgnarl/s-taprop__linux.adb (Create_Task): Only set CPU affinity when required. (Requires_Affinity_Change): New subprogram. (Set_Task_Affinity): Likewise. * libgnarl/s-tarest.adb (Create_Restricted_Task): Adapt to Initialize_ATCB change. * libgnarl/s-taskin.adb (Initialize_ATCB): Update parameter list. Record whether aspects were explicitly specified. * libgnarl/s-taskin.ads (Common_ATCB): Add component. * libgnarl/s-tassta.adb (Create_Task): Update call to Initialize_ATCB. * libgnarl/s-tporft.adb (Register_Foreign_Thread): Likewise. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/libgnarl/s-mudido__affinity.adb | 1 + gcc/ada/libgnarl/s-taprop__linux.adb | 27 +++++++++++++++++-- gcc/ada/libgnarl/s-tarest.adb | 3 ++- gcc/ada/libgnarl/s-taskin.adb | 12 +++++---- gcc/ada/libgnarl/s-taskin.ads | 36 ++++++++++++++++--------- gcc/ada/libgnarl/s-tassta.adb | 3 ++- gcc/ada/libgnarl/s-tporft.adb | 4 +-- 7 files changed, 63 insertions(+), 23 deletions(-)