From: Johannes Kliemann <kliem...@adacore.com>
QNX does not support setting the thread affinity via a POSIX API.
This implementation uses QNX's native Thread_Ctl API to set the
thread affinity for Ada tasks.
gcc/ada/
* libgnarl/s-taprop__qnx.adb: Implement Set_Task_Affinity.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/libgnarl/s-taprop__qnx.adb | 45 ++++++++++++++++++++++++++----
1 file changed, 40 insertions(+), 5 deletions(-)
diff --git a/gcc/ada/libgnarl/s-taprop__qnx.adb
b/gcc/ada/libgnarl/s-taprop__qnx.adb
index 13335ef4acd..423229854a8 100644
--- a/gcc/ada/libgnarl/s-taprop__qnx.adb
+++ b/gcc/ada/libgnarl/s-taprop__qnx.adb
@@ -49,6 +49,7 @@ with System.Interrupt_Management;
with System.OS_Constants;
with System.OS_Primitives;
with System.Task_Info;
+with System.Multiprocessors;
with System.Soft_Links;
-- We use System.Soft_Links instead of System.Tasking.Initialization
@@ -1317,12 +1318,46 @@ package body System.Task_Primitives.Operations is
-----------------------
procedure Set_Task_Affinity (T : ST.Task_Id) is
- pragma Unreferenced (T);
-
+ use type Multiprocessors.CPU_Range;
+
+ function Thread_Ctl_Ext
+ (Pid : pid_t;
+ Tid : Thread_Id;
+ Command : Interfaces.C.unsigned;
+ Runmask : Interfaces.C.size_t) return Interfaces.C.int
+ with
+ Import, Convention => C, External_Name => "ThreadCtlExt";
+ -- Thread_Ctl_Ext is a generic thread control function in QNX.
+ -- It is defined locally because in the C API its second
+ -- argument is a void pointer that takes different actual
+ -- pointer types or values depending on the command. This
+ -- particular instance of this function only accepts the
+ -- NTO_TCTL_RUNMASK command. The void * pointer in the C
+ -- interface is interpreted as bitmask for this command.
+ -- In the binding size_t is used as an integer type that
+ -- always has the same size as a pointer.
+
+ NTO_TCTL_RUNMASK : constant := 4;
+ -- Command for Thread_Ctl. Using this command in Thread_Ctl
+ -- allows the caller to pass a bitmask that describes on
+ -- which CPU the current thread is allowed to run on.
+
+ Pid : constant pid_t := getpid;
+ Result : Interfaces.C.int;
+ Runmask : Interfaces.C.size_t;
+ -- Each set bit in runmask represents a processor that the thread
+ -- can run on. If all bits are set to one the thread can run on any CPU.
begin
- -- Setting task affinity is not supported by the underlying system
-
- null;
+ if T.Common.Base_CPU = Multiprocessors.Not_A_Specific_CPU then
+ Runmask := Interfaces.C.size_t'Last;
+ else
+ Runmask :=
+ Interfaces.C.size_t
+ (2 ** Natural (T.Common.Base_CPU - Multiprocessors.CPU'First));
+ end if;
+ Result :=
+ Thread_Ctl_Ext (Pid, Get_Thread_Id (T), NTO_TCTL_RUNMASK, Runmask);
+ pragma Assert (Result = 0);
end Set_Task_Affinity;
end System.Task_Primitives.Operations;
--
2.40.0
