[gcc r14-3684] ada: Support setting task affinity on QNX

[gcc r14-3684] ada: Support setting task affinity on QNX

[Marc Poulhi?s]

https://gcc.gnu.org/g:46644c3fd7c2c6baf1bfde0734bfd50975faa1c4

commit r14-3684-g46644c3fd7c2c6baf1bfde0734bfd50975faa1c4
Author: Johannes Kliemann <kliemann@adacore.com>
Date:   Wed Aug 9 12:57:01 2023 +0000

    ada: Support setting task affinity on QNX
    
    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.

Diff:
---
 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 13335ef4acd3..423229854a8f 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;