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 --git a/gcc/ada/libgnarl/s-mudido__affinity.adb b/gcc/ada/libgnarl/s-mudido__affinity.adb
index ec8c8f6c19f87bf39b0a6ada541fadbf0b85776b..e9c17ef68b6eac2dbb7c3932d9e86eb3e3eb1cae 100644 (file)
--- 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 0a51b3601c0727b77eb705b7a982f39b35db12ce..d9425e0d2fa6a9c0a20aa7710bf4dbc7b1a959f1 100644 (file)
--- 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 5c2ee90e84b78faa1850e6a4d2eefb5bb3c67b1b..df07869757fc55f2930888c43d162d40ee35c161 100644 (file)
--- 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 95c95ed3110aacf84884db01af42ae5c836cfcbc..9fade5dea920e62108e0d9acf3087c251771dddf 100644 (file)
--- 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 1bae7e114cf20828e4986ae91cab8240cd6b942c..77851633181b0feb69d06675bfea8cd138bb2cc9 100644 (file)
--- 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 594a16728666e97e6753034dc0a5eaff7a177c10..65e950af655f1ec07c926564e0e987ab793f1971 100644 (file)
--- 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 66a9f02656e84e90cdaeeb63e0cfcce92a484ff9..a1570321f0651628e75cbc1fc16ee49bbac6672f 100644 (file)
--- 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);