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.

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 ec8c8f6..e9c17ef 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 0a51b36..d9425e0 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 5c2ee90..df07869 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 95c95ed..9fade5d 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 1bae7e1..7785163 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 594a167..65e950a 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 66a9f02..a157032 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);