Patchwork [Ada] Implementation of pragma CPU

login
register
mail settings
Submitter Arnaud Charlet
Date Oct. 18, 2010, 10:30 a.m.
Message ID <20101018103059.GA8188@adacore.com>
Download mbox | patch
Permalink /patch/68164/
State New
Headers show

Comments

Arnaud Charlet - Oct. 18, 2010, 10:30 a.m.
This patch adds the support of "pragma CPU" for controlling task affinity.
This pragma can appear in the task definition or in the declarative part of
the main subprogram. It uses the support of the underlying operating system,
and it is implemented (so far) on top of Linux, Windows and Solaris.

Tested on x86_64-pc-linux-gnu, committed on trunk

2010-10-18  Jose Ruiz  <ruiz@adacore.com>

	* exp_ch9.adb (Expand_N_Task_Type_Declaration): Add field corresponding
	to the affinity when expanding the task declaration.
	(Make_Task_Create_Call): Add the affinity parameter to the call to
	create task.
	* sem_prag.adb (Analyze_Pragma): Add the analysis for pragma CPU,
	taking into account the case when it applies to a subprogram (only for
	main and with static expression) or to a task.
	* par_prag.adb:(Prag): Make pragma CPU a valid one.
	* snames.ads-tmpl (Name_uCPU, Name_CPU): Add these new name identifiers
	used by the expander for handling the affinity parameter when creating
	a task.
	(Pragma_Id): Add Pragma_CPU as a valid one.
	* rtsfind.ads (RTU_Id): Make System_Multiprocessors accesible.
	(RE_Id, RE_Unit_Table): Make the entities RE_CPU_Range and
	RE_Unspecified_CPU visible.
	* sinfo.ads, sinfo.adb (Has_Pragma_CPU, Set_Has_Pragma_CPU): Add these
	two subprograms to set/get the flag indicating whether there is a
	pragma CPU which applies to the entity.
	* lib.ads, lib.adb (Unit_Record, Default_Main_CPU, Main_CPU,
	Set_Main_CPU): Add the field Main_CPU to Unit_Record to store the value
	of the affinity associated to the main subprogram (if any).
	Default_Main_CPU is used when no affinity is set. Subprograms
	Set_Main_CPU and Main_CPU are added to set/get the affinity of the main
	subprogram.
	* ali.ads, ali.adb (ALIs_Record): Add field Main_CPU to contain the
	value of the affinity of the main subprogram.
	(Scan_ALI): Get the affinity of the main subprogram (encoded as C=XX in
	the M line).
	* lib-writ.ads, lib-writ.adb (M_Parameters): Encode the affinity of the
	main subprogram in the M (main) line using C=XX.
	* lib-load.adb (Create_Dummy_Package_Unit, Load_Main_Source,
	Load_Unit): Add new field Main_CPU.
	* bindgen.adb (Gen_Adainit_Ada, Gen_Adainit_C): Add the code to pass
	the affinity of the main subprogram to the run time.
	* s-taskin.ads (Common_ATCB): Add the field Base_CPU to store the
	affinity.
	(Unspecified_CPU): Add this constant to identify the case when no
	affinity is set for tasks.
	* s-taskin.adb (Initialize_ATCB): Store the value coming from pragma
	CPU in the common part of the ATCB.
	(Initialize): Store the value coming from pragma CPU (for the
	environment task) in the common part of the ATCB.
	* s-tassta.ads, s-tassta.adb (Create_Task): Add the affinity specified
	by pragma CPU to the ATCB.
	* s-tarest.ads, s-tarest.adb (Create_Restricted_Task): Add the affinity
	specified by pragma CPU to the ATCB.
	* s-tporft.adb (Register_Foreign_Thread): Add the new affinity
	parameter to the call to Initialize_ATCB.
	* s-taprop-linux.adb (Create_Task): Change the attributes of the thread
	to include the task affinity before creation. Additionally, the
	affinity selected with Task_Info is also enforced changing the
	attributes at task creation time, instead of changing it after creation.
	(Initialize): Change the affinity of the environment task if required
	by a pragma CPU.
	* s-osinte-linux.ads (pthread_setaffinity_np): Instead of using a
	wrapper to check whether the function is available or not, use a weak
	symbol.
	(pthread_attr_setaffinity_np): Add the import of this function which is
	used to change the affinity in the attributes used to create a thread.
	* adaint.c (__gnat_pthread_attr_setaffinity_np): Remove this wrapper.
	It was used to check whether the pthread function was available or not,
	but the use of a weak symbol handles this situation in a cleaner way.
	* s-taprop-mingw.adb (Create_Task, Initialize): Change the affinity of
	tasks (including the environment task) if required by a pragma CPU.
	* s-taprop-solaris.adb (Enter_Task): Change the affinity of tasks
	(including the environment task) if required by a pragma CPU.
	* s-taprop-vxworks.adb (Create_Task, Initialize): Change the affinity
	of tasks (including the environment task) if required by a pragma CPU.
	* init.c (__gl_main_cpu): Make this value visible to the run time. It
	will pass the affinity of the environment task.

Patch

Index: lib.adb
===================================================================
--- lib.adb	(revision 165610)
+++ lib.adb	(working copy)
@@ -138,6 +138,11 @@  package body Lib is
       return Units.Table (U).Loading;
    end Loading;
 
+   function Main_CPU (U : Unit_Number_Type) return Int is
+   begin
+      return Units.Table (U).Main_CPU;
+   end Main_CPU;
+
    function Main_Priority (U : Unit_Number_Type) return Int is
    begin
       return Units.Table (U).Main_Priority;
@@ -231,6 +236,11 @@  package body Lib is
       Units.Table (U).Loading := B;
    end Set_Loading;
 
+   procedure Set_Main_CPU (U : Unit_Number_Type; P : Int) is
+   begin
+      Units.Table (U).Main_CPU := P;
+   end Set_Main_CPU;
+
    procedure Set_Main_Priority (U : Unit_Number_Type; P : Int) is
    begin
       Units.Table (U).Main_Priority := P;
Index: s-osinte-linux.ads
===================================================================
--- s-osinte-linux.ads	(revision 165610)
+++ s-osinte-linux.ads	(working copy)
@@ -7,7 +7,7 @@ 
 --                                  S p e c                                 --
 --                                                                          --
 --             Copyright (C) 1991-1994, Florida State University            --
---          Copyright (C) 1995-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1995-2010, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNARL is free software; you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -490,7 +490,18 @@  package System.OS_Interface is
      (thread     : pthread_t;
       cpusetsize : size_t;
       cpuset     : access cpu_set_t) return int;
-   pragma Import (C, pthread_setaffinity_np, "__gnat_pthread_setaffinity_np");
+   pragma Import (C, pthread_setaffinity_np, "pthread_setaffinity_np");
+   pragma Weak_External (pthread_setaffinity_np);
+   --  Use a weak symbol because this function may be available or not,
+   --  depending on the version of the system.
+
+   function pthread_attr_setaffinity_np
+     (attr       : access pthread_attr_t;
+      cpusetsize : size_t;
+      cpuset     : access cpu_set_t) return int;
+   pragma Import (C, pthread_attr_setaffinity_np,
+                  "pthread_attr_setaffinity_np");
+   pragma Weak_External (pthread_attr_setaffinity_np);
 
 private
 
Index: lib.ads
===================================================================
--- lib.ads	(revision 165610)
+++ lib.ads	(working copy)
@@ -357,6 +357,12 @@  package Lib is
    --      that the default priority is to be used (and is also used for
    --      entries that do not correspond to possible main programs).
 
+   --    Main_CPU
+   --      This field is used to indicate the affinity of a possible main
+   --      program, as set by a pragma CPU. A value of -1 indicates
+   --      that the default affinity is to be used (and is also used for
+   --      entries that do not correspond to possible main programs).
+
    --    Has_Allocator
    --      This flag is set if a subprogram unit has an allocator after the
    --      BEGIN (it is used to set the AB flag in the M ALI line).
@@ -392,6 +398,9 @@  package Lib is
    Default_Main_Priority : constant Int := -1;
    --  Value used in Main_Priority field to indicate default main priority
 
+   Default_Main_CPU : constant Int := -1;
+   --  Value used in Main_CPU field to indicate default main affinity
+
    function Cunit            (U : Unit_Number_Type) return Node_Id;
    function Cunit_Entity     (U : Unit_Number_Type) return Entity_Id;
    function Dependency_Num   (U : Unit_Number_Type) return Nat;
@@ -405,6 +414,7 @@  package Lib is
    function Has_RACW         (U : Unit_Number_Type) return Boolean;
    function Is_Compiler_Unit (U : Unit_Number_Type) return Boolean;
    function Loading          (U : Unit_Number_Type) return Boolean;
+   function Main_CPU         (U : Unit_Number_Type) return Int;
    function Main_Priority    (U : Unit_Number_Type) return Int;
    function Munit_Index      (U : Unit_Number_Type) return Nat;
    function OA_Setting       (U : Unit_Number_Type) return Character;
@@ -424,6 +434,7 @@  package Lib is
    procedure Set_Is_Compiler_Unit (U : Unit_Number_Type; B : Boolean := True);
    procedure Set_Ident_String     (U : Unit_Number_Type; N : Node_Id);
    procedure Set_Loading          (U : Unit_Number_Type; B : Boolean := True);
+   procedure Set_Main_CPU         (U : Unit_Number_Type; P : Int);
    procedure Set_Main_Priority    (U : Unit_Number_Type; P : Int);
    procedure Set_OA_Setting       (U : Unit_Number_Type; C : Character);
    procedure Set_Unit_Name        (U : Unit_Number_Type; N : Unit_Name_Type);
@@ -664,6 +675,7 @@  private
    pragma Inline (Is_Compiler_Unit);
    pragma Inline (Increment_Serial_Number);
    pragma Inline (Loading);
+   pragma Inline (Main_CPU);
    pragma Inline (Main_Priority);
    pragma Inline (Munit_Index);
    pragma Inline (OA_Setting);
@@ -674,6 +686,7 @@  private
    pragma Inline (Set_Has_Allocator);
    pragma Inline (Set_Has_RACW);
    pragma Inline (Set_Loading);
+   pragma Inline (Set_Main_CPU);
    pragma Inline (Set_Main_Priority);
    pragma Inline (Set_OA_Setting);
    pragma Inline (Set_Unit_Name);
@@ -692,6 +705,7 @@  private
       Dependency_Num   : Int;
       Ident_String     : Node_Id;
       Main_Priority    : Int;
+      Main_CPU         : Int;
       Serial_Number    : Nat;
       Version          : Word;
       Error_Location   : Source_Ptr;
@@ -720,20 +734,21 @@  private
       Dependency_Num   at 28 range 0 .. 31;
       Ident_String     at 32 range 0 .. 31;
       Main_Priority    at 36 range 0 .. 31;
-      Serial_Number    at 40 range 0 .. 31;
-      Version          at 44 range 0 .. 31;
-      Error_Location   at 48 range 0 .. 31;
-      Fatal_Error      at 52 range 0 ..  7;
-      Generate_Code    at 53 range 0 ..  7;
-      Has_RACW         at 54 range 0 ..  7;
-      Dynamic_Elab     at 55 range 0 ..  7;
-      Is_Compiler_Unit at 56 range 0 ..  7;
-      OA_Setting       at 57 range 0 ..  7;
-      Loading          at 58 range 0 ..  7;
-      Has_Allocator    at 59 range 0 ..  7;
+      Main_CPU         at 40 range 0 .. 31;
+      Serial_Number    at 44 range 0 .. 31;
+      Version          at 48 range 0 .. 31;
+      Error_Location   at 52 range 0 .. 31;
+      Fatal_Error      at 56 range 0 ..  7;
+      Generate_Code    at 57 range 0 ..  7;
+      Has_RACW         at 58 range 0 ..  7;
+      Dynamic_Elab     at 59 range 0 ..  7;
+      Is_Compiler_Unit at 60 range 0 ..  7;
+      OA_Setting       at 61 range 0 ..  7;
+      Loading          at 62 range 0 ..  7;
+      Has_Allocator    at 63 range 0 ..  7;
    end record;
 
-   for Unit_Record'Size use 60 * 8;
+   for Unit_Record'Size use 64 * 8;
    --  This ensures that we did not leave out any fields
 
    package Units is new Table.Table (
Index: s-taprop-vxworks.adb
===================================================================
--- s-taprop-vxworks.adb	(revision 165610)
+++ s-taprop-vxworks.adb	(working copy)
@@ -43,6 +43,7 @@  with Ada.Unchecked_Deallocation;
 
 with Interfaces.C;
 
+with System.Multiprocessors;
 with System.Tasking.Debug;
 with System.Interrupt_Management;
 
@@ -868,9 +869,10 @@  package body System.Task_Primitives.Oper
       Succeeded  : out Boolean)
    is
       Adjusted_Stack_Size : size_t;
-      Result : int;
+      Result : int := 0;
 
       use System.Task_Info;
+      use type System.Multiprocessors.CPU_Range;
 
    begin
       --  Ask for four extra bytes of stack space so that the ATCB pointer can
@@ -936,14 +938,18 @@  package body System.Task_Primitives.Oper
 
       --  Set processor affinity
 
-      if T.Common.Task_Info /= Unspecified_Task_Info then
+      if T.Common.Base_CPU /= System.Multiprocessors.Not_A_Specific_CPU then
+         Result :=
+           taskCpuAffinitySet (T.Common.LL.Thread, int (T.Common.Base_CPU));
+
+      elsif T.Common.Task_Info /= Unspecified_Task_Info then
          Result :=
            taskCpuAffinitySet (T.Common.LL.Thread, T.Common.Task_Info);
+      end if;
 
-         if Result = -1 then
-            taskDelete (T.Common.LL.Thread);
-            T.Common.LL.Thread := -1;
-         end if;
+      if Result = -1 then
+         taskDelete (T.Common.LL.Thread);
+         T.Common.LL.Thread := -1;
       end if;
 
       if T.Common.LL.Thread = -1 then
@@ -1347,6 +1353,8 @@  package body System.Task_Primitives.Oper
    procedure Initialize (Environment_Task : Task_Id) is
       Result : int;
 
+      use type System.Multiprocessors.CPU_Range;
+
    begin
       Environment_Task_Id := Environment_Task;
 
@@ -1393,6 +1401,18 @@  package body System.Task_Primitives.Oper
       Environment_Task.Known_Tasks_Index := Known_Tasks'First;
 
       Enter_Task (Environment_Task);
+
+      --  Set processor affinity
+
+      if Environment_Task.Common.Base_CPU /=
+         System.Multiprocessors.Not_A_Specific_CPU
+      then
+         Result :=
+           taskCpuAffinitySet
+             (Environment_Task.Common.LL.Thread,
+              int (Environment_Task.Common.Base_CPU));
+         pragma Assert (Result /= -1);
+      end if;
    end Initialize;
 
 end System.Task_Primitives.Operations;
Index: sinfo.adb
===================================================================
--- sinfo.adb	(revision 165610)
+++ sinfo.adb	(working copy)
@@ -1453,6 +1453,15 @@  package body Sinfo is
       return Flag17 (N);
    end Has_No_Elaboration_Code;
 
+   function Has_Pragma_CPU
+      (N : Node_Id) return Boolean is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Subprogram_Body
+        or else NT (N).Nkind = N_Task_Definition);
+      return Flag10 (N);
+   end Has_Pragma_CPU;
+
    function Has_Pragma_Priority
       (N : Node_Id) return Boolean is
    begin
@@ -4423,6 +4432,15 @@  package body Sinfo is
       Set_Flag17 (N, Val);
    end Set_Has_No_Elaboration_Code;
 
+   procedure Set_Has_Pragma_CPU
+      (N : Node_Id; Val : Boolean := True) is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Subprogram_Body
+        or else NT (N).Nkind = N_Task_Definition);
+      Set_Flag10 (N, Val);
+   end Set_Has_Pragma_CPU;
+
    procedure Set_Has_Pragma_Priority
       (N : Node_Id; Val : Boolean := True) is
    begin
Index: exp_ch9.adb
===================================================================
--- exp_ch9.adb	(revision 165622)
+++ exp_ch9.adb	(working copy)
@@ -10315,6 +10315,7 @@  package body Exp_Ch9 is
    --      _Priority    : Integer         := priority_expression;
    --      _Size        : Size_Type       := Size_Type (size_expression);
    --      _Task_Info   : Task_Info_Type  := task_info_expression;
+   --      _CPU         : Integer         := cpu_range_expression;
    --    end record;
 
    --  The discriminants are present only if the corresponding task type has
@@ -10348,6 +10349,11 @@  package body Exp_Ch9 is
    --  present in the pragma, and is used to provide the Task_Image parameter
    --  to the call to Create_Task.
 
+   --  The _CPU field is present only if a CPU pragma appears in the task
+   --  definition. The expression captures the argument that was present in
+   --  the pragma, and is used to provide the CPU parameter to the call to
+   --  Create_Task.
+
    --  The _Relative_Deadline field is present only if a Relative_Deadline
    --  pragma appears in the task definition. The expression captures the
    --  argument that was present in the pragma, and is used to provide the
@@ -10666,6 +10672,27 @@  package body Exp_Ch9 is
                      (Taskdef, Name_Task_Info)))))));
       end if;
 
+      --  Add the _CPU component if a CPU pragma is present
+
+      if Present (Taskdef) and then Has_Pragma_CPU (Taskdef) then
+         Append_To (Cdecls,
+           Make_Component_Declaration (Loc,
+             Defining_Identifier =>
+               Make_Defining_Identifier (Loc, Name_uCPU),
+
+             Component_Definition =>
+               Make_Component_Definition (Loc,
+                 Aliased_Present    => False,
+                 Subtype_Indication =>
+                   New_Reference_To (RTE (RE_CPU_Range), Loc)),
+
+             Expression => New_Copy (
+               Expression (First (
+                 Pragma_Argument_Associations (
+                   Find_Task_Or_Protected_Pragma
+                     (Taskdef, Name_CPU)))))));
+      end if;
+
       --  Add the _Relative_Deadline component if a Relative_Deadline pragma is
       --  present. If we are using a restricted run time this component will
       --  not be added (deadlines are not allowed by the Ravenscar profile).
@@ -12593,6 +12620,23 @@  package body Exp_Ch9 is
            New_Reference_To (RTE (RE_Unspecified_Task_Info), Loc));
       end if;
 
+      --  CPU parameter. Set to Unspecified_CPU unless there is a CPU pragma,
+      --  in which case we take the value from the pragma. The parameter is
+      --  passed as an Integer because in the case of unspecified CPU the
+      --  value is not in the range of CPU_Range.
+
+      if Present (Tdef) and then Has_Pragma_CPU (Tdef) then
+         Append_To (Args,
+           Convert_To (Standard_Integer,
+             Make_Selected_Component (Loc,
+               Prefix => Make_Identifier (Loc, Name_uInit),
+               Selector_Name => Make_Identifier (Loc, Name_uCPU))));
+
+      else
+         Append_To (Args,
+           New_Reference_To (RTE (RE_Unspecified_CPU), Loc));
+      end if;
+
       if not Restricted_Profile then
 
          --  Deadline parameter. If no Relative_Deadline pragma is present,
Index: sinfo.ads
===================================================================
--- sinfo.ads	(revision 165610)
+++ sinfo.ads	(working copy)
@@ -1133,6 +1133,11 @@  package Sinfo is
    --    generate elaboration code, and non-preelaborated packages which do
    --    not generate elaboration code.
 
+   --  Has_Pragma_CPU (Flag10-Sem)
+   --    A flag present in N_Subprogram_Body and N_Task_Definition nodes to
+   --    flag the presence of a CPU pragma in the declaration sequence (public
+   --    or private in the task case).
+
    --  Has_Pragma_Suppress_All (Flag14-Sem)
    --    This flag is set in an N_Compilation_Unit node if the Suppress_All
    --    pragma appears anywhere in the unit. This accomodates the rather
@@ -4486,6 +4491,7 @@  package Sinfo is
       --  Is_Task_Master (Flag5-Sem)
       --  Was_Originally_Stub (Flag13-Sem)
       --  Has_Relative_Deadline_Pragma (Flag9-Sem)
+      --  Has_Pragma_CPU (Flag10-Sem)
 
       ------------------------------
       -- Parameterized Expression --
@@ -4969,6 +4975,7 @@  package Sinfo is
       --  Has_Task_Info_Pragma (Flag7-Sem)
       --  Has_Task_Name_Pragma (Flag8-Sem)
       --  Has_Relative_Deadline_Pragma (Flag9-Sem)
+      --  Has_Pragma_CPU (Flag10-Sem)
 
       --------------------
       -- 9.1  Task Item --
@@ -8316,6 +8323,9 @@  package Sinfo is
    function Has_No_Elaboration_Code
      (N : Node_Id) return Boolean;    -- Flag17
 
+   function Has_Pragma_CPU
+     (N : Node_Id) return Boolean;    -- Flag10
+
    function Has_Pragma_Priority
      (N : Node_Id) return Boolean;    -- Flag6
 
@@ -9264,6 +9274,9 @@  package Sinfo is
    procedure Set_Has_No_Elaboration_Code
      (N : Node_Id; Val : Boolean := True);    -- Flag17
 
+   procedure Set_Has_Pragma_CPU
+     (N : Node_Id; Val : Boolean := True);    -- Flag10
+
    procedure Set_Has_Pragma_Priority
      (N : Node_Id; Val : Boolean := True);    -- Flag6
 
@@ -11630,6 +11643,7 @@  package Sinfo is
    pragma Inline (Has_Local_Raise);
    pragma Inline (Has_Self_Reference);
    pragma Inline (Has_No_Elaboration_Code);
+   pragma Inline (Has_Pragma_CPU);
    pragma Inline (Has_Pragma_Priority);
    pragma Inline (Has_Pragma_Suppress_All);
    pragma Inline (Has_Private_View);
@@ -11942,6 +11956,7 @@  package Sinfo is
    pragma Inline (Set_Has_Local_Raise);
    pragma Inline (Set_Has_Dynamic_Range_Check);
    pragma Inline (Set_Has_No_Elaboration_Code);
+   pragma Inline (Set_Has_Pragma_CPU);
    pragma Inline (Set_Has_Pragma_Priority);
    pragma Inline (Set_Has_Pragma_Suppress_All);
    pragma Inline (Set_Has_Private_View);
Index: lib-writ.adb
===================================================================
--- lib-writ.adb	(revision 165610)
+++ lib-writ.adb	(working copy)
@@ -86,6 +86,7 @@  package body Lib.Writ is
          Ident_String     => Empty,
          Loading          => False,
          Main_Priority    => -1,
+         Main_CPU         => -1,
          Munit_Index      => 0,
          Serial_Number    => 0,
          Version          => 0,
@@ -142,6 +143,7 @@  package body Lib.Writ is
         Ident_String     => Empty,
         Loading          => False,
         Main_Priority    => -1,
+        Main_CPU         => -1,
         Munit_Index      => 0,
         Serial_Number    => 0,
         Version          => 0,
@@ -931,6 +933,11 @@  package body Lib.Writ is
                Write_Info_Str (" AB");
             end if;
 
+            if Main_CPU (Main_Unit) /= Default_Main_CPU then
+               Write_Info_Str (" C=");
+               Write_Info_Nat (Main_CPU (Main_Unit));
+            end if;
+
             Write_Info_Str (" W=");
             Write_Info_Char
               (WC_Encoding_Letters (Wide_Character_Encoding_Method));
Index: lib-writ.ads
===================================================================
--- lib-writ.ads	(revision 165610)
+++ lib-writ.ads	(working copy)
@@ -116,7 +116,7 @@  package Lib.Writ is
    --  -- M  Main Program --
    --  ---------------------
 
-   --    M type [priority] [T=time-slice] [AB] W=?
+   --    M type [priority] [T=time-slice] [AB] [C=cpu] W=?
 
    --      This line appears only if the main unit for this file is suitable
    --      for use as a main program. The parameters are:
@@ -148,7 +148,12 @@  package Lib.Writ is
    --          No_Allocators_After_Elaboration if it is present, and this
    --          unit is used as a main program (only the binder can find the
    --          violation, since only the binder knows the main program).
-   --
+
+   --        C=cpu
+
+   --          Present only if there was a valid pragma CPU in the
+   --          corresponding unit to set the main task affinity. It is an
+   --          unsigned decimal integer.
 
    --        W=?
 
Index: bindgen.adb
===================================================================
--- bindgen.adb	(revision 165610)
+++ bindgen.adb	(working copy)
@@ -127,6 +127,7 @@  package body Bindgen is
    --     Detect_Blocking               : Integer;
    --     Default_Stack_Size            : Integer;
    --     Leap_Seconds_Support          : Integer;
+   --     Main_CPU                      : Integer;
 
    --  Main_Priority is the priority value set by pragma Priority in the main
    --  program. If no such pragma is present, the value is -1.
@@ -215,6 +216,9 @@  package body Bindgen is
    --  disabled. A value of zero indicates that leap seconds are turned "off",
    --  while a value of one signifies "on" status.
 
+   --  Main_CPU is the processor set by pragma CPU in the main program. If no
+   --  such pragma is present, the value is -1.
+
    -----------------------
    -- Local Subprograms --
    -----------------------
@@ -436,6 +440,7 @@  package body Bindgen is
 
    procedure Gen_Adainit_Ada is
       Main_Priority : Int renames ALIs.Table (ALIs.First).Main_Priority;
+      Main_CPU      : Int renames ALIs.Table (ALIs.First).Main_CPU;
 
    begin
       WBI ("   procedure " & Ada_Init_Name.all & " is");
@@ -520,9 +525,9 @@  package body Bindgen is
 
       Write_Statement_Buffer;
 
-      --  If the standard library is suppressed, then the only global variable
-      --  that might be needed (by the Ravenscar profile) is the priority of
-      --  the environment.
+      --  If the standard library is suppressed, then the only global variables
+      --  that might be needed (by the Ravenscar profile) are the priority and
+      --  the processor for the environment task.
 
       if Suppress_Standard_Library_On_Target then
          if Main_Priority /= No_Main_Priority then
@@ -532,6 +537,13 @@  package body Bindgen is
             WBI ("");
          end if;
 
+         if Main_CPU /= No_Main_CPU then
+            WBI ("      Main_CPU : Integer;");
+            WBI ("      pragma Import (C, Main_CPU," &
+                 " ""__gl_main_cpu"");");
+            WBI ("");
+         end if;
+
          WBI ("   begin");
 
          if Main_Priority /= No_Main_Priority then
@@ -539,8 +551,18 @@  package body Bindgen is
             Set_Int    (Main_Priority);
             Set_Char   (';');
             Write_Statement_Buffer;
+         end if;
 
-         else
+         if Main_CPU /= No_Main_CPU then
+            Set_String ("      Main_CPU := ");
+            Set_Int    (Main_CPU);
+            Set_Char   (';');
+            Write_Statement_Buffer;
+         end if;
+
+         if Main_Priority = No_Main_Priority
+           and then Main_CPU = No_Main_CPU
+         then
             WBI ("      null;");
          end if;
 
@@ -571,6 +593,9 @@  package body Bindgen is
          WBI ("      Num_Specific_Dispatching : Integer;");
          WBI ("      pragma Import (C, Num_Specific_Dispatching, " &
               """__gl_num_specific_dispatching"");");
+         WBI ("      Main_CPU : Integer;");
+         WBI ("      pragma Import (C, Main_CPU, " &
+              """__gl_main_cpu"");");
 
          WBI ("      Interrupt_States : System.Address;");
          WBI ("      pragma Import (C, Interrupt_States, " &
@@ -731,6 +756,11 @@  package body Bindgen is
          Set_Char (';');
          Write_Statement_Buffer;
 
+         Set_String ("      Main_CPU := ");
+         Set_Int    (Main_CPU);
+         Set_Char   (';');
+         Write_Statement_Buffer;
+
          WBI ("      Interrupt_States := Local_Interrupt_States'Address;");
 
          Set_String ("      Num_Interrupt_States := ");
@@ -891,6 +921,7 @@  package body Bindgen is
 
    procedure Gen_Adainit_C is
       Main_Priority : Int renames ALIs.Table (ALIs.First).Main_Priority;
+      Main_CPU      : Int renames ALIs.Table (ALIs.First).Main_CPU;
 
    begin
       WBI ("void " & Ada_Init_Name.all & " (void)");
@@ -934,8 +965,8 @@  package body Bindgen is
 
       if Suppress_Standard_Library_On_Target then
 
-         --  Case of High_Integrity_Mode mode. Set __gl_main_priority if needed
-         --  for the Ravenscar profile.
+         --  Case of High_Integrity_Mode mode. Set __gl_main_priority and
+         --  __gl_main_cpu if needed for the Ravenscar profile.
 
          if Main_Priority /= No_Main_Priority then
             WBI ("   extern int __gl_main_priority;");
@@ -945,6 +976,14 @@  package body Bindgen is
             Write_Statement_Buffer;
          end if;
 
+         if Main_CPU /= No_Main_CPU then
+            WBI ("   extern int __gl_main_cpu;");
+            Set_String ("   __gl_main_cpu = ");
+            Set_Int    (Main_CPU);
+            Set_Char   (';');
+            Write_Statement_Buffer;
+         end if;
+
       --  Normal case (standard library not suppressed)
 
       else
@@ -1030,6 +1069,12 @@  package body Bindgen is
          Set_String ("';");
          Write_Statement_Buffer;
 
+         WBI ("   extern int __gl_main_cpu;");
+         Set_String ("   __gl_main_cpu = ");
+         Set_Int (Main_CPU);
+         Set_Char (';');
+         Write_Statement_Buffer;
+
          Gen_Restrictions_C;
 
          WBI ("   extern const void *__gl_interrupt_states;");
Index: sem_prag.adb
===================================================================
--- sem_prag.adb	(revision 165614)
+++ sem_prag.adb	(working copy)
@@ -415,7 +415,7 @@  package body Sem_Prag is
 
       procedure Check_In_Main_Program;
       --  Common checks for pragmas that appear within a main program
-      --  (Priority, Main_Storage, Time_Slice, Relative_Deadline).
+      --  (Priority, Main_Storage, Time_Slice, Relative_Deadline, CPU).
 
       procedure Check_Interrupt_Or_Attach_Handler;
       --  Common processing for first argument of pragma Interrupt_Handler or
@@ -6961,6 +6961,92 @@  package body Sem_Prag is
             end if;
          end CPP_Vtable;
 
+         ---------
+         -- CPU --
+         ---------
+
+         --  pragma CPU (EXPRESSION);
+
+         when Pragma_CPU => CPU : declare
+            P   : constant Node_Id := Parent (N);
+            Arg : Node_Id;
+
+         begin
+            Ada_2012_Pragma;
+            Check_No_Identifiers;
+            Check_Arg_Count (1);
+
+            --  Subprogram case
+
+            if Nkind (P) = N_Subprogram_Body then
+               Check_In_Main_Program;
+
+               Arg := Get_Pragma_Arg (Arg1);
+               Analyze_And_Resolve (Arg, Any_Integer);
+
+               --  Must be static
+
+               if not Is_Static_Expression (Arg) then
+                  Flag_Non_Static_Expr
+                    ("main subprogram affinity is not static!", Arg);
+                  raise Pragma_Exit;
+
+               --  If constraint error, then we already signalled an error
+
+               elsif Raises_Constraint_Error (Arg) then
+                  null;
+
+               --  Otherwise check in range
+
+               else
+                  declare
+                     CPU_Id : constant Entity_Id := RTE (RE_CPU_Range);
+                     --  This is the entity System.Multiprocessors.CPU_Range;
+
+                     Val : constant Uint := Expr_Value (Arg);
+
+                  begin
+                     if Val < Expr_Value (Type_Low_Bound (CPU_Id))
+                          or else
+                        Val > Expr_Value (Type_High_Bound (CPU_Id))
+                     then
+                        Error_Pragma_Arg
+                          ("main subprogram CPU is out of range", Arg1);
+                     end if;
+                  end;
+               end if;
+
+               Set_Main_CPU
+                    (Current_Sem_Unit, UI_To_Int (Expr_Value (Arg)));
+
+            --  Task case
+
+            elsif Nkind (P) = N_Task_Definition then
+               Arg := Get_Pragma_Arg (Arg1);
+
+               --  The expression must be analyzed in the special manner
+               --  described in "Handling of Default and Per-Object
+               --  Expressions" in sem.ads.
+
+               Preanalyze_Spec_Expression (Arg, RTE (RE_CPU_Range));
+
+            --  Anything else is incorrect
+
+            else
+               Pragma_Misplaced;
+            end if;
+
+            if Has_Pragma_CPU (P) then
+               Error_Pragma ("duplicate pragma% not allowed");
+            else
+               Set_Has_Pragma_CPU (P, True);
+
+               if Nkind (P) = N_Task_Definition then
+                  Record_Rep_Item (Defining_Identifier (Parent (P)), N);
+               end if;
+            end if;
+         end CPU;
+
          -----------
          -- Debug --
          -----------
@@ -13513,6 +13599,7 @@  package body Sem_Prag is
       Pragma_CPP_Constructor               =>  0,
       Pragma_CPP_Virtual                   =>  0,
       Pragma_CPP_Vtable                    =>  0,
+      Pragma_CPU                           => -1,
       Pragma_C_Pass_By_Copy                =>  0,
       Pragma_Comment                       =>  0,
       Pragma_Common_Object                 => -1,
Index: s-tassta.adb
===================================================================
--- s-tassta.adb	(revision 165624)
+++ s-tassta.adb	(working copy)
@@ -473,6 +473,7 @@  package body System.Tasking.Stages is
      (Priority          : Integer;
       Size              : System.Parameters.Size_Type;
       Task_Info         : System.Task_Info.Task_Info_Type;
+      CPU               : Integer;
       Relative_Deadline : Ada.Real_Time.Time_Span;
       Num_Entries       : Task_Entry_Index;
       Master            : Master_Level;
@@ -489,6 +490,7 @@  package body System.Tasking.Stages is
       Success       : Boolean;
       Base_Priority : System.Any_Priority;
       Len           : Natural;
+      Base_CPU      : System.Multiprocessors.CPU_Range;
 
       pragma Unreferenced (Relative_Deadline);
       --  EDF scheduling is not supported by any of the target platforms so
@@ -522,6 +524,21 @@  package body System.Tasking.Stages is
          then Self_ID.Common.Base_Priority
          else System.Any_Priority (Priority));
 
+      if CPU /= Unspecified_CPU
+        and then (CPU < Integer (System.Multiprocessors.CPU_Range'First)
+          or else CPU > Integer (System.Multiprocessors.CPU_Range'Last)
+          or else CPU > Integer (System.Multiprocessors.Number_Of_CPUs))
+      then
+         raise Tasking_Error with "CPU not in range";
+
+      --  Normal CPU affinity
+      else
+         Base_CPU :=
+           (if CPU = Unspecified_CPU
+            then Self_ID.Common.Base_CPU
+            else System.Multiprocessors.CPU_Range (CPU));
+      end if;
+
       --  Find parent P of new Task, via master level number
 
       P := Self_ID;
@@ -570,7 +587,7 @@  package body System.Tasking.Stages is
       end if;
 
       Initialize_ATCB (Self_ID, State, Discriminants, P, Elaborated,
-        Base_Priority, Task_Info, Size, T, Success);
+        Base_Priority, Base_CPU, Task_Info, Size, T, Success);
 
       if not Success then
          Free (T);
Index: s-tassta.ads
===================================================================
--- s-tassta.ads	(revision 165610)
+++ s-tassta.ads	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                  S p e c                                 --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNARL is free software; you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -81,10 +81,10 @@  package System.Tasking.Stages is
    --         _init.discr := discr;
    --         _init._task_id := null;
    --         create_task (unspecified_priority, tZ,
-   --           unspecified_task_info, ada__real_time__time_span_zero, 0,
-   --           _master, task_procedure_access!(tB'address),
-   --           _init'address, tE'unchecked_access, _chain, _task_id, _init.
-   --           _task_id);
+   --           unspecified_task_info, unspecified_cpu,
+   --           ada__real_time__time_span_zero, 0, _master,
+   --           task_procedure_access!(tB'address), _init'address,
+   --           tE'unchecked_access, _chain, _task_id, _init._task_id);
    --         return;
    --      end tVIP;
    --   ]
@@ -170,6 +170,7 @@  package System.Tasking.Stages is
      (Priority          : Integer;
       Size              : System.Parameters.Size_Type;
       Task_Info         : System.Task_Info.Task_Info_Type;
+      CPU               : Integer;
       Relative_Deadline : Ada.Real_Time.Time_Span;
       Num_Entries       : Task_Entry_Index;
       Master            : Master_Level;
@@ -188,6 +189,10 @@  package System.Tasking.Stages is
    --  Size is the stack size of the task to create
    --  Task_Info is the task info associated with the created task, or
    --   Unspecified_Task_Info if none.
+   --  CPU is the task affinity. We pass it as an Integer because the
+   --   undefined value is not in the range of CPU_Range. Static range
+   --   checks are performed when analyzing the pragma, and dynamic ones are
+   --   performed before setting the affinity at run time.
    --  Relative_Deadline is the relative deadline associated with the created
    --   task by means of a pragma Relative_Deadline, or 0.0 if none.
    --  State is the compiler generated task's procedure body
Index: rtsfind.ads
===================================================================
--- rtsfind.ads	(revision 165610)
+++ rtsfind.ads	(working copy)
@@ -265,6 +265,7 @@  package Rtsfind is
       System_Machine_Code,
       System_Mantissa,
       System_Memcop,
+      System_Multiprocessors,
       System_Pack_03,
       System_Pack_05,
       System_Pack_06,
@@ -839,6 +840,8 @@  package Rtsfind is
 
      RE_Mantissa_Value,                  -- System_Mantissa
 
+     RE_CPU_Range,                       -- System.Multiprocessors
+
      RE_Bits_03,                         -- System.Pack_03
      RE_Get_03,                          -- System.Pack_03
      RE_Set_03,                          -- System.Pack_03
@@ -1426,6 +1429,8 @@  package Rtsfind is
      RE_Activation_Chain_Access,         -- System.Tasking
      RE_Storage_Size,                    -- System.Tasking
 
+     RE_Unspecified_CPU,                 -- System.Tasking
+
      RE_Abort_Defer,                     -- System.Soft_Links
      RE_Abort_Undefer,                   -- System.Soft_Links
      RE_Complete_Master,                 -- System.Soft_Links
@@ -2012,6 +2017,8 @@  package Rtsfind is
 
      RE_Mantissa_Value                   => System_Mantissa,
 
+     RE_CPU_Range                        => System_Multiprocessors,
+
      RE_Bits_03                          => System_Pack_03,
      RE_Get_03                           => System_Pack_03,
      RE_Set_03                           => System_Pack_03,
@@ -2599,6 +2606,8 @@  package Rtsfind is
      RE_Activation_Chain_Access          => System_Tasking,
      RE_Storage_Size                     => System_Tasking,
 
+     RE_Unspecified_CPU                  => System_Tasking,
+
      RE_Abort_Defer                      => System_Soft_Links,
      RE_Abort_Undefer                    => System_Soft_Links,
      RE_Complete_Master                  => System_Soft_Links,
Index: s-tarest.adb
===================================================================
--- s-tarest.adb	(revision 165610)
+++ s-tarest.adb	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                  B o d y                                 --
 --                                                                          --
---         Copyright (C) 1999-2009, Free Software Foundation, Inc.          --
+--         Copyright (C) 1999-2010, Free Software Foundation, Inc.          --
 --                                                                          --
 -- GNARL is free software; you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -458,6 +458,7 @@  package body System.Tasking.Restricted.S
       Stack_Address : System.Address;
       Size          : System.Parameters.Size_Type;
       Task_Info     : System.Task_Info.Task_Info_Type;
+      CPU           : Integer;
       State         : Task_Procedure_Access;
       Discriminants : System.Address;
       Elaborated    : Access_Boolean;
@@ -467,6 +468,7 @@  package body System.Tasking.Restricted.S
    is
       Self_ID       : constant Task_Id := STPO.Self;
       Base_Priority : System.Any_Priority;
+      Base_CPU      : System.Multiprocessors.CPU_Range;
       Success       : Boolean;
       Len           : Integer;
 
@@ -481,6 +483,21 @@  package body System.Tasking.Restricted.S
          then Self_ID.Common.Base_Priority
          else System.Any_Priority (Priority));
 
+      if CPU /= Unspecified_CPU
+        and then (CPU < Integer (System.Multiprocessors.CPU_Range'First)
+          or else CPU > Integer (System.Multiprocessors.CPU_Range'Last)
+          or else CPU > Integer (System.Multiprocessors.Number_Of_CPUs))
+      then
+         raise Tasking_Error with "CPU not in range";
+
+      --  Normal CPU affinity
+      else
+         Base_CPU :=
+           (if CPU = Unspecified_CPU
+            then Self_ID.Common.Base_CPU
+            else System.Multiprocessors.CPU_Range (CPU));
+      end if;
+
       if Single_Lock then
          Lock_RTS;
       end if;
@@ -492,7 +509,7 @@  package body System.Tasking.Restricted.S
 
       Initialize_ATCB
         (Self_ID, State, Discriminants, Self_ID, Elaborated, Base_Priority,
-         Task_Info, Size, Created_Task, Success);
+         Base_CPU, Task_Info, 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
Index: s-tarest.ads
===================================================================
--- s-tarest.ads	(revision 165610)
+++ s-tarest.ads	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                  S p e c                                 --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNARL is free software; you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -87,9 +87,9 @@  package System.Tasking.Restricted.Stages
    --         system__tasking__ada_task_control_blockIP (_init._atcb, 0);
    --         _init._task_id := _init._atcb'unchecked_access;
    --         create_restricted_task (unspecified_priority, tZ,
-   --           unspecified_task_info, task_procedure_access!(tB'address),
-   --           _init'address, tE'unchecked_access, _chain, _task_name, _init.
-   --           _task_id);
+   --           unspecified_task_info, unspecified_cpu,
+   --           task_procedure_access!(tB'address), _init'address,
+   --           tE'unchecked_access, _chain, _task_name, _init._task_id);
    --         return;
    --      end tVIP;
 
@@ -127,6 +127,7 @@  package System.Tasking.Restricted.Stages
       Stack_Address : System.Address;
       Size          : System.Parameters.Size_Type;
       Task_Info     : System.Task_Info.Task_Info_Type;
+      CPU           : Integer;
       State         : Task_Procedure_Access;
       Discriminants : System.Address;
       Elaborated    : Access_Boolean;
@@ -149,6 +150,11 @@  package System.Tasking.Restricted.Stages
    --  Task_Info is the task info associated with the created task, or
    --  Unspecified_Task_Info if none.
    --
+   --  CPU is the task affinity. We pass it as an Integer to avoid an explicit
+   --   dependency from System.Multiprocessors when not needed. Static range
+   --   checks are performed when analyzing the pragma, and dynamic ones are
+   --   performed before setting the affinity at run time.
+   --
    --  State is the compiler generated task's procedure body
    --
    --  Discriminants is a pointer to a limited record whose discriminants are
Index: s-taprop-mingw.adb
===================================================================
--- s-taprop-mingw.adb	(revision 165615)
+++ s-taprop-mingw.adb	(working copy)
@@ -43,6 +43,7 @@  with Ada.Unchecked_Deallocation;
 with Interfaces.C;
 with Interfaces.C.Strings;
 
+with System.Multiprocessors;
 with System.Tasking.Debug;
 with System.OS_Primitives;
 with System.Task_Info;
@@ -890,6 +891,8 @@  package body System.Task_Primitives.Oper
       Result         : DWORD;
       Entry_Point    : PTHREAD_START_ROUTINE;
 
+      use type System.Multiprocessors.CPU_Range;
+
    begin
       pTaskParameter := To_Address (T);
 
@@ -949,9 +952,17 @@  package body System.Task_Primitives.Oper
          SetThreadPriorityBoost (hTask, DisablePriorityBoost => Win32.TRUE);
       end if;
 
-      --  Step 4: Handle Task_Info
+      --  Step 4: Handle pragma CPU and Task_Info
+
+      if T.Common.Base_CPU /= System.Multiprocessors.Not_A_Specific_CPU then
+         --  The CPU numbering in pragma CPU starts at 1 while the subprogram
+         --  to set the affinity starts at 0, therefore we must substract 1.
+
+         Result := SetThreadIdealProcessor
+           (hTask, ProcessorId (T.Common.Base_CPU) - 1);
+         pragma Assert (Result = 1);
 
-      if T.Common.Task_Info /= null then
+      elsif T.Common.Task_Info /= null then
          if T.Common.Task_Info.CPU /= Task_Info.Any_CPU then
             Result := SetThreadIdealProcessor (hTask, T.Common.Task_Info.CPU);
             pragma Assert (Result = 1);
@@ -1062,6 +1073,10 @@  package body System.Task_Primitives.Oper
       Discard : BOOL;
       pragma Unreferenced (Discard);
 
+      Result : DWORD;
+
+      use type System.Multiprocessors.CPU_Range;
+
    begin
       Environment_Task_Id := Environment_Task;
       OS_Primitives.Initialize;
@@ -1092,6 +1107,20 @@  package body System.Task_Primitives.Oper
       Environment_Task.Known_Tasks_Index := Known_Tasks'First;
 
       Enter_Task (Environment_Task);
+
+      --  pragma CPU for the environment task
+
+      if Environment_Task.Common.Base_CPU /=
+         System.Multiprocessors.Not_A_Specific_CPU
+      then
+         --  The CPU numbering in pragma CPU starts at 1 while the subprogram
+         --  to set the affinity starts at 0, therefore we must substract 1.
+
+         Result := SetThreadIdealProcessor
+           (Environment_Task.Common.LL.Thread,
+            ProcessorId (Environment_Task.Common.Base_CPU) - 1);
+         pragma Assert (Result = 1);
+      end if;
    end Initialize;
 
    ---------------------
Index: s-taprop-linux.adb
===================================================================
--- s-taprop-linux.adb	(revision 165610)
+++ s-taprop-linux.adb	(working copy)
@@ -48,6 +48,7 @@  with System.Tasking.Debug;
 with System.Interrupt_Management;
 with System.OS_Primitives;
 with System.Stack_Checking.Operations;
+with System.Multiprocessors;
 
 with System.Soft_Links;
 --  We use System.Soft_Links instead of System.Tasking.Initialization
@@ -819,6 +820,8 @@  package body System.Task_Primitives.Oper
       Adjusted_Stack_Size : Interfaces.C.size_t;
       Result              : Interfaces.C.int;
 
+      use type System.Multiprocessors.CPU_Range;
+
    begin
       Adjusted_Stack_Size :=
          Interfaces.C.size_t (Stack_Size + Alternate_Stack_Size);
@@ -841,6 +844,48 @@  package body System.Task_Primitives.Oper
           (Attributes'Access, PTHREAD_CREATE_DETACHED);
       pragma Assert (Result = 0);
 
+      --  We were calling pthread_setaffinity_np (after thread creation but
+      --  before thread activation) to set the affinity but it was not
+      --  behaving as expected. Now we set the required attributes for the
+      --  creation of the thread, which is working correctly and it is
+      --  more appropriate.
+
+      if pthread_attr_setaffinity_np'Address = System.Null_Address then
+         --  Nothing to do with the affinities if there is not the underlying
+         --  support.
+
+         null;
+
+      --  Handle pragma CPU
+
+      elsif T.Common.Base_CPU /= System.Multiprocessors.Not_A_Specific_CPU then
+         declare
+            CPU_Set : aliased cpu_set_t := (bits => (others => False));
+
+         begin
+            CPU_Set.bits (Integer (T.Common.Base_CPU)) := True;
+
+            Result :=
+              pthread_attr_setaffinity_np
+                (Attributes'Access,
+                 CPU_SETSIZE / 8,
+                 CPU_Set'Access);
+            pragma Assert (Result = 0);
+         end;
+
+      --  Handle Task_Info
+
+      elsif T.Common.Task_Info /= null
+        and then T.Common.Task_Info.CPU_Affinity /= Task_Info.Any_CPU
+      then
+         Result :=
+           pthread_attr_setaffinity_np
+             (Attributes'Access,
+              CPU_SETSIZE / 8,
+              T.Common.Task_Info.CPU_Affinity'Access);
+         pragma Assert (Result = 0);
+      end if;
+
       --  Since the initial signal mask of a thread is inherited from the
       --  creator, and the Environment task has all its signals masked, we
       --  do not need to manipulate caller's signal mask at this point.
@@ -863,19 +908,6 @@  package body System.Task_Primitives.Oper
 
       Succeeded := True;
 
-      --  Handle Task_Info
-
-      if T.Common.Task_Info /= null then
-         if T.Common.Task_Info.CPU_Affinity /= Task_Info.Any_CPU then
-            Result :=
-              pthread_setaffinity_np
-                (T.Common.LL.Thread,
-                 CPU_SETSIZE / 8,
-                 T.Common.Task_Info.CPU_Affinity'Access);
-            pragma Assert (Result = 0);
-         end if;
-      end if;
-
       Result := pthread_attr_destroy (Attributes'Access);
       pragma Assert (Result = 0);
 
@@ -1238,6 +1270,8 @@  package body System.Task_Primitives.Oper
       --    's'   Interrupt_State pragma set state to System (use "default"
       --           system handler)
 
+      use type System.Multiprocessors.CPU_Range;
+
    begin
       Environment_Task_Id := Environment_Task;
 
@@ -1298,6 +1332,26 @@  package body System.Task_Primitives.Oper
          pragma Assert (Result = 0);
          Abort_Handler_Installed := True;
       end if;
+
+      --  pragma CPU for the environment task
+
+      if Environment_Task.Common.Base_CPU /=
+        System.Multiprocessors.Not_A_Specific_CPU
+      then
+         declare
+            CPU_Set : aliased cpu_set_t := (bits => (others => False));
+
+         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);
+         end;
+      end if;
    end Initialize;
 
 end System.Task_Primitives.Operations;
Index: s-taprop-solaris.adb
===================================================================
--- s-taprop-solaris.adb	(revision 165610)
+++ s-taprop-solaris.adb	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                  B o d y                                 --
 --                                                                          --
---         Copyright (C) 1992-2009, Free Software Foundation, Inc.          --
+--         Copyright (C) 1992-2010, Free Software Foundation, Inc.          --
 --                                                                          --
 -- GNARL is free software; you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -42,6 +42,7 @@  with Ada.Unchecked_Deallocation;
 
 with Interfaces.C;
 
+with System.Multiprocessors;
 with System.Tasking.Debug;
 with System.Interrupt_Management;
 with System.OS_Primitives;
@@ -866,12 +867,30 @@  package body System.Task_Primitives.Oper
       Last_Proc : processorid_t;  --  Last processor #
 
       use System.Task_Info;
+      use type System.Multiprocessors.CPU_Range;
+
    begin
       Self_ID.Common.LL.Thread := thr_self;
 
       Self_ID.Common.LL.LWP := lwp_self;
 
-      if Self_ID.Common.Task_Info /= null then
+      --  pragma CPU
+
+      if Self_ID.Common.Base_CPU /=
+         System.Multiprocessors.Not_A_Specific_CPU
+      then
+         --  The CPU numbering in pragma CPU starts at 1 while the subprogram
+         --  to set the affinity starts at 0, therefore we must substract 1.
+
+         Result :=
+           processor_bind
+             (P_LWPID, P_MYID, processorid_t (Self_ID.Common.Base_CPU) - 1,
+              null);
+         pragma Assert (Result = 0);
+
+      --  Task_Info
+
+      elsif Self_ID.Common.Task_Info /= null then
          if Self_ID.Common.Task_Info.New_LWP
            and then Self_ID.Common.Task_Info.CPU /= CPU_UNCHANGED
          then
Index: init.c
===================================================================
--- init.c	(revision 165620)
+++ init.c	(working copy)
@@ -86,6 +86,7 @@  extern void Raise_From_Signal_Handler (s
 
 /* Global values computed by the binder.  */
 int   __gl_main_priority                 = -1;
+int   __gl_main_cpu                      = -1;
 int   __gl_time_slice_val                = -1;
 char  __gl_wc_encoding                   = 'n';
 char  __gl_locking_policy                = ' ';
Index: ali.adb
===================================================================
--- ali.adb	(revision 165610)
+++ ali.adb	(working copy)
@@ -818,6 +818,7 @@  package body ALI is
         Last_Unit                  => No_Unit_Id,
         Locking_Policy             => ' ',
         Main_Priority              => -1,
+        Main_CPU                   => -1,
         Main_Program               => None,
         No_Object                  => False,
         Normalize_Scalars          => False,
@@ -919,6 +920,14 @@  package body ALI is
 
                Skip_Space;
 
+               if Nextc = 'C' then
+                  P := P + 1;
+                  Checkc ('=');
+                  ALIs.Table (Id).Main_CPU := Get_Nat;
+               end if;
+
+               Skip_Space;
+
                Checkc ('W');
                Checkc ('=');
                ALIs.Table (Id).WC_Encoding := Getc;
Index: ali.ads
===================================================================
--- ali.ads	(revision 165610)
+++ ali.ads	(working copy)
@@ -131,6 +131,12 @@  package ALI is
       --  that no parameter was found, or no M line was present. Not set if
       --  'M' appears in Ignore_Lines.
 
+      Main_CPU : Int;
+      --  Indicates processor if Main_Program field indicates that this can
+      --  be a main program. A value of -1 (No_Main_CPU) indicates that no C
+      --  parameter was found, or no M line was present. Not set if 'M' appears
+      --  in Ignore_Lines.
+
       Time_Slice_Value : Int;
       --  Indicates value of time slice parameter from T=xxx on main program
       --  line. A value of -1 indicates that no T=xxx parameter was found, or
@@ -212,6 +218,9 @@  package ALI is
    No_Main_Priority : constant Int := -1;
    --  Code for no main priority set
 
+   No_Main_CPU : constant Int := -1;
+   --  Code for no main cpu set
+
    package ALIs is new Table.Table (
      Table_Component_Type => ALIs_Record,
      Table_Index_Type     => ALI_Id,
Index: lib-load.adb
===================================================================
--- lib-load.adb	(revision 165610)
+++ lib-load.adb	(working copy)
@@ -220,6 +220,7 @@  package body Lib.Load is
         Ident_String     => Empty,
         Loading          => False,
         Main_Priority    => Default_Main_Priority,
+        Main_CPU         => Default_Main_CPU,
         Munit_Index      => 0,
         Serial_Number    => 0,
         Source_Index     => No_Source_File,
@@ -325,6 +326,7 @@  package body Lib.Load is
            Ident_String     => Empty,
            Loading          => True,
            Main_Priority    => Default_Main_Priority,
+           Main_CPU         => Default_Main_CPU,
            Munit_Index      => 0,
            Serial_Number    => 0,
            Source_Index     => Main_Source_File,
@@ -655,6 +657,7 @@  package body Lib.Load is
               Ident_String     => Empty,
               Loading          => True,
               Main_Priority    => Default_Main_Priority,
+              Main_CPU         => Default_Main_CPU,
               Munit_Index      => 0,
               Serial_Number    => 0,
               Source_Index     => Src_Ind,
Index: par-prag.adb
===================================================================
--- par-prag.adb	(revision 165610)
+++ par-prag.adb	(working copy)
@@ -1118,6 +1118,7 @@  begin
            Pragma_CPP_Constructor               |
            Pragma_CPP_Virtual                   |
            Pragma_CPP_Vtable                    |
+           Pragma_CPU                           |
            Pragma_C_Pass_By_Copy                |
            Pragma_Comment                       |
            Pragma_Common_Object                 |
Index: s-tporft.adb
===================================================================
--- s-tporft.adb	(revision 165610)
+++ s-tporft.adb	(working copy)
@@ -35,6 +35,8 @@  with System.Task_Info;
 with System.Soft_Links;
 --  used to initialize TSD for a C thread, in function Self
 
+with System.Multiprocessors;
+
 separate (System.Task_Primitives.Operations)
 function Register_Foreign_Thread (Thread : Thread_Id) return Task_Id is
    Local_ATCB : aliased Ada_Task_Control_Block (0);
@@ -63,8 +65,8 @@  begin
    System.Tasking.Initialize_ATCB
      (Self_Id, null, Null_Address, Null_Task,
       Foreign_Task_Elaborated'Access,
-      System.Priority'First, Task_Info.Unspecified_Task_Info, 0, Self_Id,
-      Succeeded);
+      System.Priority'First, System.Multiprocessors.Not_A_Specific_CPU,
+      Task_Info.Unspecified_Task_Info, 0, Self_Id, Succeeded);
    Unlock_RTS;
    pragma Assert (Succeeded);
 
Index: adaint.c
===================================================================
--- adaint.c	(revision 165610)
+++ adaint.c	(working copy)
@@ -811,7 +811,10 @@  __gnat_fopen (char *path, char *mode, in
 }
 
 FILE *
-__gnat_freopen (char *path, char *mode, FILE *stream, int encoding ATTRIBUTE_UNUSED)
+__gnat_freopen (char *path,
+		char *mode,
+		FILE *stream,
+		int encoding ATTRIBUTE_UNUSED)
 {
 #if defined (_WIN32) && ! defined (__vxworks) && ! defined (IS_CROSS)
   TCHAR wpath[GNAT_MAX_PATH_LEN];
@@ -1094,7 +1097,8 @@  __gnat_stat_to_attr (int fd, char* name,
     attr->file_length = statbuf.st_size;  /* all systems */
 
 #ifndef __MINGW32__
-  /* on Windows requires extra system call, see comment in __gnat_file_exists_attr */
+  /* on Windows requires extra system call, see comment in
+     __gnat_file_exists_attr */
   attr->exists = !ret;
 #endif
 
@@ -2035,7 +2039,8 @@  __gnat_is_readable_file_attr (char* name
      {
         ZeroMemory (&GenericMapping, sizeof (GENERIC_MAPPING));
         GenericMapping.GenericRead = GENERIC_READ;
-        attr->readable = __gnat_check_OWNER_ACL (wname, FILE_READ_DATA, GenericMapping);
+	attr->readable =
+	  __gnat_check_OWNER_ACL (wname, FILE_READ_DATA, GenericMapping);
      }
      else
         attr->readable = GetFileAttributes (wname) != INVALID_FILE_ATTRIBUTES;
@@ -2108,7 +2113,8 @@  __gnat_is_executable_file_attr (char* na
          ZeroMemory (&GenericMapping, sizeof (GENERIC_MAPPING));
          GenericMapping.GenericExecute = GENERIC_EXECUTE;
 
-         attr->executable = __gnat_check_OWNER_ACL (wname, FILE_EXECUTE, GenericMapping);
+         attr->executable =
+           __gnat_check_OWNER_ACL (wname, FILE_EXECUTE, GenericMapping);
        }
      else
        attr->executable = GetFileAttributes (wname) != INVALID_FILE_ATTRIBUTES
@@ -2717,7 +2723,8 @@  __gnat_locate_regular_file (char *file_n
 
   {
     /* The result has to be smaller than path_val + file_name.  */
-    char *file_path = (char *) alloca (strlen (path_val) + strlen (file_name) + 2);
+    char *file_path =
+      (char *) alloca (strlen (path_val) + strlen (file_name) + 2);
 
     for (;;)
       {
@@ -2773,8 +2780,9 @@  __gnat_locate_exec (char *exec_name, cha
   char *ptr;
   if (!strstr (exec_name, HOST_EXECUTABLE_SUFFIX))
     {
-      char *full_exec_name
-        = (char *) alloca (strlen (exec_name) + strlen (HOST_EXECUTABLE_SUFFIX) + 1);
+      char *full_exec_name =
+        (char *) alloca
+	  (strlen (exec_name) + strlen (HOST_EXECUTABLE_SUFFIX) + 1);
 
       strcpy (full_exec_name, exec_name);
       strcat (full_exec_name, HOST_EXECUTABLE_SUFFIX);
@@ -3654,33 +3662,6 @@  void __main (void) {}
 #endif
 #endif
 
-#if defined (linux) || defined(__GLIBC__)
-/* pthread affinity support */
-
-int __gnat_pthread_setaffinity_np (pthread_t th,
-			           size_t cpusetsize,
-			           const void *cpuset);
-
-#ifdef CPU_SETSIZE
-#include <pthread.h>
-int
-__gnat_pthread_setaffinity_np (pthread_t th,
-			       size_t cpusetsize,
-			       const cpu_set_t *cpuset)
-{
-  return pthread_setaffinity_np (th, cpusetsize, cpuset);
-}
-#else
-int
-__gnat_pthread_setaffinity_np (pthread_t th ATTRIBUTE_UNUSED,
-			       size_t cpusetsize ATTRIBUTE_UNUSED,
-			       const void *cpuset ATTRIBUTE_UNUSED)
-{
-  return 0;
-}
-#endif
-#endif
-
 #if defined (linux)
 /* There is no function in the glibc to retrieve the LWP of the current
    thread. We need to do a system call in order to retrieve this
Index: snames.ads-tmpl
===================================================================
--- snames.ads-tmpl	(revision 165619)
+++ snames.ads-tmpl	(working copy)
@@ -153,6 +153,7 @@  package Snames is
    Name_uChain                         : constant Name_Id := N + $;
    Name_uClean                         : constant Name_Id := N + $;
    Name_uController                    : constant Name_Id := N + $;
+   Name_uCPU                           : constant Name_Id := N + $;
    Name_uEntry_Bodies                  : constant Name_Id := N + $;
    Name_uExpunge                       : constant Name_Id := N + $;
    Name_uFinal_List                    : constant Name_Id := N + $;
@@ -442,6 +443,7 @@  package Snames is
    Name_CPP_Constructor                : constant Name_Id := N + $; -- GNAT
    Name_CPP_Virtual                    : constant Name_Id := N + $; -- GNAT
    Name_CPP_Vtable                     : constant Name_Id := N + $; -- GNAT
+   Name_CPU                            : constant Name_Id := N + $; -- Ada 12
    Name_Debug                          : constant Name_Id := N + $; -- GNAT
    Name_Dimension                      : constant Name_Id := N + $; -- GNAT
    Name_Elaborate                      : constant Name_Id := N + $; -- Ada 83
@@ -1528,6 +1530,7 @@  package Snames is
       Pragma_CPP_Constructor,
       Pragma_CPP_Virtual,
       Pragma_CPP_Vtable,
+      Pragma_CPU,
       Pragma_Debug,
       Pragma_Dimension,
       Pragma_Elaborate,
Index: s-taskin.adb
===================================================================
--- s-taskin.adb	(revision 165610)
+++ s-taskin.adb	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                  B o d y                                 --
 --                                                                          --
---          Copyright (C) 1992-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNARL is free software; you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -98,6 +98,7 @@  package body System.Tasking is
       Parent           : Task_Id;
       Elaborated       : Access_Boolean;
       Base_Priority    : System.Any_Priority;
+      Base_CPU         : System.Multiprocessors.CPU_Range;
       Task_Info        : System.Task_Info.Task_Info_Type;
       Stack_Size       : System.Parameters.Size_Type;
       T                : Task_Id;
@@ -119,6 +120,7 @@  package body System.Tasking is
 
       T.Common.Parent                   := Parent;
       T.Common.Base_Priority            := Base_Priority;
+      T.Common.Base_CPU                 := Base_CPU;
       T.Common.Current_Priority         := 0;
       T.Common.Protected_Action_Nesting := 0;
       T.Common.Call                     := null;
@@ -170,12 +172,19 @@  package body System.Tasking is
    --  because we use the value -1 to indicate the default main priority, and
    --  that is of course not in Priority'range.
 
+   Main_CPU : Integer;
+   pragma Import (C, Main_CPU, "__gl_main_cpu");
+   --  Affinity for main task. Note that this is of type Integer, not
+   --  CPU_Range, because we use the value -1 to indicate the unassigned
+   --  affinity, and that is of course not in CPU_Range'Range.
+
    Initialized : Boolean := False;
    --  Used to prevent multiple calls to Initialize
 
    procedure Initialize is
       T             : Task_Id;
       Base_Priority : Any_Priority;
+      Base_CPU      : System.Multiprocessors.CPU_Range;
       Success       : Boolean;
 
    begin
@@ -192,9 +201,14 @@  package body System.Tasking is
          then Default_Priority
          else Priority (Main_Priority));
 
+      Base_CPU :=
+        (if Main_CPU = Unspecified_CPU
+         then System.Multiprocessors.Not_A_Specific_CPU
+         else System.Multiprocessors.CPU_Range (Main_CPU));
+
       T := STPO.New_ATCB (0);
       Initialize_ATCB
-        (null, null, Null_Address, Null_Task, null, Base_Priority,
+        (null, null, Null_Address, Null_Task, null, Base_Priority, Base_CPU,
          Task_Info.Unspecified_Task_Info, 0, T, Success);
       pragma Assert (Success);
 
Index: s-taskin.ads
===================================================================
--- s-taskin.ads	(revision 165610)
+++ s-taskin.ads	(working copy)
@@ -42,6 +42,7 @@  with System.Task_Info;
 with System.Soft_Links;
 with System.Task_Primitives;
 with System.Stack_Usage;
+with System.Multiprocessors;
 
 package System.Tasking is
    pragma Preelaborate;
@@ -464,6 +465,11 @@  package System.Tasking is
       --
       --  Protection: Only written by Self, accessed by anyone
 
+      Base_CPU : System.Multiprocessors.CPU_Range;
+      --  Base CPU, only changed via dispatching domains package.
+      --
+      --  Protection: Self.L
+
       Current_Priority : System.Any_Priority;
       --  Active priority, except that the effects of protected object
       --  priority ceilings are not reflected. This only reflects explicit
@@ -694,9 +700,9 @@  package System.Tasking is
    Independent_Task_Level : constant Master_Level := 2;
    Library_Task_Level     : constant Master_Level := 3;
 
-   ------------------------------
-   -- Task size, priority info --
-   ------------------------------
+   -------------------
+   -- Priority info --
+   -------------------
 
    Unspecified_Priority : constant Integer := System.Priority'First - 1;
 
@@ -706,6 +712,13 @@  package System.Tasking is
    subtype Rendezvous_Priority is Integer
      range Priority_Not_Boosted .. System.Any_Priority'Last;
 
+   -------------------
+   -- Affinity info --
+   -------------------
+
+   Unspecified_CPU : constant := -1;
+   --  No affinity specified
+
    ------------------------------------
    -- Rendezvous related definitions --
    ------------------------------------
@@ -1091,6 +1104,7 @@  package System.Tasking is
       Parent           : Task_Id;
       Elaborated       : Access_Boolean;
       Base_Priority    : System.Any_Priority;
+      Base_CPU         : System.Multiprocessors.CPU_Range;
       Task_Info        : System.Task_Info.Task_Info_Type;
       Stack_Size       : System.Parameters.Size_Type;
       T                : Task_Id;