2011-09-02 Basile Starynkevitch <basile@starynkevitch.net>

	MELT branch merged with trunk rev 178437 using svnmerge.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/melt-branch@178439 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 184 insertions, 50 deletions

diff --git a/gcc/ada/s-taprop-linux.adb b/gcc/ada/s-taprop-linux.adb
index f46736fbf5f..8d381ab9564 100644
--- a/gcc/ada/s-taprop-linux.adb
+++ b/gcc/ada/s-taprop-linux.adb
@@ -38,7 +38,6 @@ pragma Polling (Off);
 --  Turn off polling, we do not want ATC polling to take place during tasking
 --  operations. It causes infinite loops and other problems.
 
-with Ada.Unchecked_Conversion;
 with Ada.Unchecked_Deallocation;
 
 with Interfaces.C;
@@ -98,12 +97,6 @@ package body System.Task_Primitives.Operations is
    Dispatching_Policy : Character;
    pragma Import (C, Dispatching_Policy, "__gl_task_dispatching_policy");
 
-   --  The following are effectively constants, but they need to be initialized
-   --  by calling a pthread_ function.
-
-   Mutex_Attr   : aliased pthread_mutexattr_t;
-   Cond_Attr    : aliased pthread_condattr_t;
-
    Foreign_Task_Elaborated : aliased Boolean := True;
    --  Used to identified fake tasks (i.e., non-Ada Threads)
 
@@ -113,6 +106,10 @@ package body System.Task_Primitives.Operations is
    Abort_Handler_Installed : Boolean := False;
    --  True if a handler for the abort signal is installed
 
+   Null_Thread_Id : constant pthread_t := pthread_t'Last;
+   --  Constant to indicate that the thread identifier has not yet been
+   --  initialized.
+
    --------------------
    -- Local Packages --
    --------------------
@@ -154,13 +151,8 @@ package body System.Task_Primitives.Operations is
    -- Local Subprograms --
    -----------------------
 
-   subtype unsigned_long is Interfaces.C.unsigned_long;
-
    procedure Abort_Handler (signo : Signal);
 
-   function To_pthread_t is new Ada.Unchecked_Conversion
-     (unsigned_long, System.OS_Interface.pthread_t);
-
    -------------------
    -- Abort_Handler --
    -------------------
@@ -263,9 +255,13 @@ package body System.Task_Primitives.Operations is
    is
       pragma Unreferenced (Prio);
 
-      Result : Interfaces.C.int;
+      Mutex_Attr : aliased pthread_mutexattr_t;
+      Result     : Interfaces.C.int;
 
    begin
+      Result := pthread_mutexattr_init (Mutex_Attr'Access);
+      pragma Assert (Result = 0);
+
       Result := pthread_mutex_init (L, Mutex_Attr'Access);
 
       pragma Assert (Result = 0 or else Result = ENOMEM);
@@ -281,9 +277,13 @@ package body System.Task_Primitives.Operations is
    is
       pragma Unreferenced (Level);
 
-      Result : Interfaces.C.int;
+      Mutex_Attr : aliased pthread_mutexattr_t;
+      Result     : Interfaces.C.int;
 
    begin
+      Result := pthread_mutexattr_init (Mutex_Attr'Access);
+      pragma Assert (Result = 0);
+
       Result := pthread_mutex_init (L, Mutex_Attr'Access);
 
       pragma Assert (Result = 0 or else Result = ENOMEM);
@@ -764,7 +764,9 @@ package body System.Task_Primitives.Operations is
    --------------------
 
    procedure Initialize_TCB (Self_ID : Task_Id; Succeeded : out Boolean) is
-      Result : Interfaces.C.int;
+      Mutex_Attr : aliased pthread_mutexattr_t;
+      Cond_Attr  : aliased pthread_condattr_t;
+      Result     : Interfaces.C.int;
 
    begin
       --  Give the task a unique serial number
@@ -773,11 +775,14 @@ package body System.Task_Primitives.Operations is
       Next_Serial_Number := Next_Serial_Number + 1;
       pragma Assert (Next_Serial_Number /= 0);
 
-      Self_ID.Common.LL.Thread := To_pthread_t (-1);
+      Self_ID.Common.LL.Thread := Null_Thread_Id;
 
       if not Single_Lock then
-         Result := pthread_mutex_init (Self_ID.Common.LL.L'Access,
-           Mutex_Attr'Access);
+         Result := pthread_mutexattr_init (Mutex_Attr'Access);
+         pragma Assert (Result = 0);
+
+         Result :=
+           pthread_mutex_init (Self_ID.Common.LL.L'Access, Mutex_Attr'Access);
          pragma Assert (Result = 0 or else Result = ENOMEM);
 
          if Result /= 0 then
@@ -786,8 +791,11 @@ package body System.Task_Primitives.Operations is
          end if;
       end if;
 
-      Result := pthread_cond_init (Self_ID.Common.LL.CV'Access,
-        Cond_Attr'Access);
+      Result := pthread_condattr_init (Cond_Attr'Access);
+      pragma Assert (Result = 0);
+
+      Result :=
+        pthread_cond_init (Self_ID.Common.LL.CV'Access, Cond_Attr'Access);
       pragma Assert (Result = 0 or else Result = ENOMEM);
 
       if Result = 0 then
@@ -820,6 +828,20 @@ package body System.Task_Primitives.Operations is
       use type System.Multiprocessors.CPU_Range;
 
    begin
+      --  Check whether both Dispatching_Domain and CPU are specified for
+      --  the task, and the CPU value is not contained within the range of
+      --  processors for the domain.
+
+      if T.Common.Domain /= null
+        and then T.Common.Base_CPU /= System.Multiprocessors.Not_A_Specific_CPU
+        and then
+          (T.Common.Base_CPU not in T.Common.Domain'Range
+            or else not T.Common.Domain (T.Common.Base_CPU))
+      then
+         Succeeded := False;
+         return;
+      end if;
+
       Adjusted_Stack_Size :=
          Interfaces.C.size_t (Stack_Size + Alternate_Stack_Size);
 
@@ -832,8 +854,7 @@ package body System.Task_Primitives.Operations is
       end if;
 
       Result :=
-        pthread_attr_setstacksize
-          (Attributes'Access, Adjusted_Stack_Size);
+        pthread_attr_setstacksize (Attributes'Access, Adjusted_Stack_Size);
       pragma Assert (Result = 0);
 
       Result :=
@@ -857,28 +878,70 @@ package body System.Task_Primitives.Operations is
 
       elsif T.Common.Base_CPU /= System.Multiprocessors.Not_A_Specific_CPU then
          declare
-            CPU_Set : aliased cpu_set_t := (bits => (others => False));
+            CPUs    : constant size_t :=
+                        Interfaces.C.size_t
+                          (System.Multiprocessors.Number_Of_CPUs);
+            CPU_Set : constant cpu_set_t_ptr := CPU_ALLOC (CPUs);
+            Size    : constant size_t := CPU_ALLOC_SIZE (CPUs);
+
          begin
-            CPU_Set.bits (Integer (T.Common.Base_CPU)) := True;
+            CPU_ZERO (Size, CPU_Set);
+            System.OS_Interface.CPU_SET
+              (int (T.Common.Base_CPU), Size, CPU_Set);
             Result :=
-              pthread_attr_setaffinity_np
-                (Attributes'Access,
-                 CPU_SETSIZE / 8,
-                 CPU_Set'Access);
+              pthread_attr_setaffinity_np (Attributes'Access, Size, CPU_Set);
             pragma Assert (Result = 0);
+
+            CPU_FREE (CPU_Set);
          end;
 
       --  Handle Task_Info
 
-      elsif T.Common.Task_Info /= null
-        and then T.Common.Task_Info.CPU_Affinity /= Task_Info.Any_CPU
-      then
+      elsif T.Common.Task_Info /= null then
          Result :=
            pthread_attr_setaffinity_np
              (Attributes'Access,
               CPU_SETSIZE / 8,
               T.Common.Task_Info.CPU_Affinity'Access);
          pragma Assert (Result = 0);
+
+      --  Handle dispatching domains
+
+      --  To avoid changing CPU affinities when not needed, we set the
+      --  affinity only when assigning to a domain other than the default
+      --  one, or when the default one has been modified.
+
+      elsif T.Common.Domain /= null and then
+        (T.Common.Domain /= ST.System_Domain
+          or else T.Common.Domain.all /=
+                    (Multiprocessors.CPU'First ..
+                     Multiprocessors.Number_Of_CPUs => True))
+      then
+         declare
+            CPUs    : constant size_t :=
+                        Interfaces.C.size_t
+                          (System.Multiprocessors.Number_Of_CPUs);
+            CPU_Set : constant cpu_set_t_ptr := CPU_ALLOC (CPUs);
+            Size    : constant size_t := CPU_ALLOC_SIZE (CPUs);
+
+         begin
+            CPU_ZERO (Size, CPU_Set);
+
+            --  Set the affinity to all the processors belonging to the
+            --  dispatching domain.
+
+            for Proc in T.Common.Domain'Range loop
+               if T.Common.Domain (Proc) then
+                  System.OS_Interface.CPU_SET (int (Proc), Size, CPU_Set);
+               end if;
+            end loop;
+
+            Result :=
+              pthread_attr_setaffinity_np (Attributes'Access, Size, CPU_Set);
+            pragma Assert (Result = 0);
+
+            CPU_FREE (CPU_Set);
+         end;
       end if;
 
       --  Since the initial signal mask of a thread is inherited from the
@@ -891,6 +954,7 @@ package body System.Task_Primitives.Operations is
          Attributes'Access,
          Thread_Body_Access (Wrapper),
          To_Address (T));
+
       pragma Assert
         (Result = 0 or else Result = EAGAIN or else Result = ENOMEM);
 
@@ -933,6 +997,7 @@ package body System.Task_Primitives.Operations is
       if T.Known_Tasks_Index /= -1 then
          Known_Tasks (T.Known_Tasks_Index) := null;
       end if;
+
       SC.Invalidate_Stack_Cache (T.Common.Compiler_Data.Pri_Stack_Info'Access);
       Free (Tmp);
 
@@ -971,7 +1036,9 @@ package body System.Task_Primitives.Operations is
    ----------------
 
    procedure Initialize (S : in out Suspension_Object) is
-      Result : Interfaces.C.int;
+      Mutex_Attr : aliased pthread_mutexattr_t;
+      Cond_Attr  : aliased pthread_condattr_t;
+      Result     : Interfaces.C.int;
 
    begin
       --  Initialize internal state (always to False (RM D.10(6)))
@@ -981,6 +1048,9 @@ package body System.Task_Primitives.Operations is
 
       --  Initialize internal mutex
 
+      Result := pthread_mutexattr_init (Mutex_Attr'Access);
+      pragma Assert (Result = 0);
+
       Result := pthread_mutex_init (S.L'Access, Mutex_Attr'Access);
 
       pragma Assert (Result = 0 or else Result = ENOMEM);
@@ -991,6 +1061,9 @@ package body System.Task_Primitives.Operations is
 
       --  Initialize internal condition variable
 
+      Result := pthread_condattr_init (Cond_Attr'Access);
+      pragma Assert (Result = 0);
+
       Result := pthread_cond_init (S.CV'Access, Cond_Attr'Access);
 
       pragma Assert (Result = 0 or else Result = ENOMEM);
@@ -1284,12 +1357,6 @@ package body System.Task_Primitives.Operations is
          end if;
       end loop;
 
-      Result := pthread_mutexattr_init (Mutex_Attr'Access);
-      pragma Assert (Result = 0);
-
-      Result := pthread_condattr_init (Cond_Attr'Access);
-      pragma Assert (Result = 0);
-
       Initialize_Lock (Single_RTS_Lock'Access, RTS_Lock_Level);
 
       --  Initialize the global RTS lock
@@ -1328,24 +1395,91 @@ package body System.Task_Primitives.Operations is
          Abort_Handler_Installed := True;
       end if;
 
-      --  pragma CPU for the environment task
+      --  pragma CPU and dispatching domains for the environment task
+
+      Set_Task_Affinity (Environment_Task);
+   end Initialize;
+
+   -----------------------
+   -- Set_Task_Affinity --
+   -----------------------
+
+   procedure Set_Task_Affinity (T : ST.Task_Id) is
+      use type System.Multiprocessors.CPU_Range;
+
+   begin
+      --  Do nothing if there is no support for setting affinities or the
+      --  underlying thread has not yet been created. If the thread has not
+      --  yet been created then the proper affinity will be set during its
+      --  creation.
 
       if pthread_setaffinity_np'Address /= System.Null_Address
-        and then Environment_Task.Common.Base_CPU /=
-                   System.Multiprocessors.Not_A_Specific_CPU
+        and then T.Common.LL.Thread /= Null_Thread_Id
       then
          declare
-            CPU_Set : aliased cpu_set_t := (bits => (others => False));
+            CPUs    : constant size_t :=
+                        Interfaces.C.size_t
+                          (System.Multiprocessors.Number_Of_CPUs);
+            CPU_Set : cpu_set_t_ptr := null;
+            Size    : constant size_t := CPU_ALLOC_SIZE (CPUs);
+
+            Result  : Interfaces.C.int;
+
          begin
-            CPU_Set.bits (Integer (Environment_Task.Common.Base_CPU)) := True;
-            Result :=
-              pthread_setaffinity_np
-                (Environment_Task.Common.LL.Thread,
-                 CPU_SETSIZE / 8,
-                 CPU_Set'Access);
-            pragma Assert (Result = 0);
+            --  We look at the specific CPU (Base_CPU) first, then at the
+            --  Task_Info field, and finally at the assigned dispatching
+            --  domain, if any.
+
+            if T.Common.Base_CPU /= Multiprocessors.Not_A_Specific_CPU then
+
+               --  Set the affinity to an unique CPU
+
+               CPU_Set := CPU_ALLOC (CPUs);
+               System.OS_Interface.CPU_ZERO (Size, CPU_Set);
+               System.OS_Interface.CPU_SET
+                 (int (T.Common.Base_CPU), Size, CPU_Set);
+
+            --  Handle Task_Info
+
+            elsif T.Common.Task_Info /= null then
+               CPU_Set := T.Common.Task_Info.CPU_Affinity'Access;
+
+            --  Handle dispatching domains
+
+            elsif T.Common.Domain /= null and then
+              (T.Common.Domain /= ST.System_Domain
+                or else T.Common.Domain.all /=
+                          (Multiprocessors.CPU'First ..
+                           Multiprocessors.Number_Of_CPUs => True))
+            then
+               --  Set the affinity to all the processors belonging to the
+               --  dispatching domain. To avoid changing CPU affinities when
+               --  not needed, we set the affinity only when assigning to a
+               --  domain other than the default one, or when the default one
+               --  has been modified.
+
+               CPU_Set := CPU_ALLOC (CPUs);
+               System.OS_Interface.CPU_ZERO (Size, CPU_Set);
+
+               for Proc in T.Common.Domain'Range loop
+                  System.OS_Interface.CPU_SET (int (Proc), Size, CPU_Set);
+               end loop;
+            end if;
+
+            --  We set the new affinity if needed. Otherwise, the new task
+            --  will inherit its creator's CPU affinity mask (according to
+            --  the documentation of pthread_setaffinity_np), which is
+            --  consistent with Ada's required semantics.
+
+            if CPU_Set /= null then
+               Result :=
+                 pthread_setaffinity_np (T.Common.LL.Thread, Size, CPU_Set);
+               pragma Assert (Result = 0);
+
+               CPU_FREE (CPU_Set);
+            end if;
          end;
       end if;
-   end Initialize;
+   end Set_Task_Affinity;
 
 end System.Task_Primitives.Operations;