https://gcc.gnu.org/g:0c8bdc2411b3b123820f5b93d9ae7d8d12e06739
commit r15-4907-g0c8bdc2411b3b123820f5b93d9ae7d8d12e06739
Author: Ronan Desplanques <desplanq...@adacore.com>
Date: Fri Oct 11 14:54:15 2024 +0200
ada: Tweak CPU affinity handling
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.
Diff:
---
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(-)
diff --git a/gcc/ada/libgnarl/s-mudido__affinity.adb
b/gcc/ada/libgnarl/s-mudido__affinity.adb
index ec8c8f6c19f8..e9c17ef68b6e 100644
--- a/gcc/ada/libgnarl/s-mudido__affinity.adb
+++ b/gcc/ada/libgnarl/s-mudido__affinity.adb
@@ -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.
diff --git a/gcc/ada/libgnarl/s-taprop__linux.adb
b/gcc/ada/libgnarl/s-taprop__linux.adb
index 0a51b3601c07..d9425e0d2fa6 100644
--- a/gcc/ada/libgnarl/s-taprop__linux.adb
+++ b/gcc/ada/libgnarl/s-taprop__linux.adb
@@ -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 :=
diff --git a/gcc/ada/libgnarl/s-tarest.adb b/gcc/ada/libgnarl/s-tarest.adb
index 5c2ee90e84b7..df07869757fc 100644
--- a/gcc/ada/libgnarl/s-tarest.adb
+++ b/gcc/ada/libgnarl/s-tarest.adb
@@ -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
diff --git a/gcc/ada/libgnarl/s-taskin.adb b/gcc/ada/libgnarl/s-taskin.adb
index 95c95ed3110a..9fade5dea920 100644
--- a/gcc/ada/libgnarl/s-taskin.adb
+++ b/gcc/ada/libgnarl/s-taskin.adb
@@ -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,
diff --git a/gcc/ada/libgnarl/s-taskin.ads b/gcc/ada/libgnarl/s-taskin.ads
index 1bae7e114cf2..77851633181b 100644
--- a/gcc/ada/libgnarl/s-taskin.ads
+++ b/gcc/ada/libgnarl/s-taskin.ads
@@ -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
diff --git a/gcc/ada/libgnarl/s-tassta.adb b/gcc/ada/libgnarl/s-tassta.adb
index 594a16728666..65e950af655f 100644
--- a/gcc/ada/libgnarl/s-tassta.adb
+++ b/gcc/ada/libgnarl/s-tassta.adb
@@ -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);
diff --git a/gcc/ada/libgnarl/s-tporft.adb b/gcc/ada/libgnarl/s-tporft.adb
index 66a9f02656e8..a1570321f065 100644
--- a/gcc/ada/libgnarl/s-tporft.adb
+++ b/gcc/ada/libgnarl/s-tporft.adb
@@ -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);
