[multiple changes]

2011-08-31  Jose Ruiz  <ruiz@adacore.com>

	* aspects.ads (Aspect_Id, Aspect_Argument, Aspect_Names): Add the
	dispatching domain aspect.
	* aspects.adb (Canonical_Aspect): Add entry for the dispatching domain
	aspect.
	* sem_ch13.adb (Analyze_Aspect_Specifications): Analyze the
	Dispatching_Domain aspect in a similar way as we do for the Priority
	aspect.
	* exp_ch9.adb (Expand_N_Task_Type_Declaration): Add the
	Dispatching_Domain component if a Dispatching_Domain pragma or aspect
	is present.
	(Make_Task_Create_Call): Add the Dispatching_Domain when creating a task
	* par-prag.adb (Prag): Add Pragma_Dispatching_Domain as a known pragma.
	* sem_prag.adb (Analyze_Pragma): Check the correctness of a pragma
	Dispatching_Domain and add it to the task definition.
	(Sig_Flags): Add Pragma_Dispatching_Domain.
	* rtsfind.ads, rtsfind.adb (RTU_Id, RE_Id, Get_Unit_Name): Add the
	support to find the types Dispatching_Domain and
	Dispatching_Domain_Access.
	* sinfo.ads, sinfo.adb (Has_Pragma_Dispatching_Domain,
	Set_Has_Pragma_Dispatching_Domain): Add these subprograms to set and
	query the availability of a pragma Dispatching_Domain.
	* snames.ads-tmpl (Name_uDispatching_Domain): Add this name required by
	the expander to pass the Dispatching_Domain when creating a task.
	(Name_Dispatching_Domain): Add this new name for a pragma.
	(Pragma_Id): Add the new Pragma_Dispatching_Domain.
	* s-tassta.ads, s-tassta.adb (Create_Task): Set the domain to which the
	task has been allocated at creation time.
	* s-tarest.adb (Create_Restricted_Task): The dispatching domain using
	Ravenscar is always null.
	* s-taskin.ads, s-taskin.adb (Initialize_ATCB): Set the domain to which
	the task has been allocated at creation time.
	* s-tporft.adb (Register_Foreign_Thread): A foreign task will not have
	a specific dispatching domain.
	* s-taprop-linux.adb, s-taprop-solaris.adb, s-taprop-vxworks.adb,
	s-taprop-mingw.adb (Create_Task): 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.

2011-08-31  Vincent Celier  <celier@adacore.com>

	* make.adb (Original_Gcc) : New constant String_Access.
	(Gnatmake): For VM targets, do not use VM version of the compiler if
	--GCC= has been specified.

2011-08-31  Thomas Quinot  <quinot@adacore.com>

	* sem_ch5.adb: Minor reformatting.

2011-08-31  Ed Schonberg  <schonberg@adacore.com>

	* exp_pakd.adb (Convert_To_PAT_Type): If prefix is a function call, do
	not reanalyze it.

2011-08-31  Bob Duff  <duff@adacore.com>

	* exp_ch4.adb (Expand_N_Selected_Component): Use the full type, in case
	the access type is private; we don't care about privacy in expansion.

2011-08-31  Ed Schonberg  <schonberg@adacore.com>

	* sem_aggr.adb (Resolve_Aggregate): In an instance, ignore aggregate
	subcomponents tnat may be limited, because they originate in view
	conflicts. If the original aggregate is legal and the actuals are
	legal, the aggregate itself is legal.

From-SVN: r178371

gcc/ada/ChangeLog

+2011-08-31  Jose Ruiz  <ruiz@adacore.com>
+
+	* aspects.ads (Aspect_Id, Aspect_Argument, Aspect_Names): Add the
+	dispatching domain aspect.
+	* aspects.adb (Canonical_Aspect): Add entry for the dispatching domain
+	aspect.
+	* sem_ch13.adb (Analyze_Aspect_Specifications): Analyze the
+	Dispatching_Domain aspect in a similar way as we do for the Priority
+	aspect.
+	* exp_ch9.adb (Expand_N_Task_Type_Declaration): Add the
+	Dispatching_Domain component if a Dispatching_Domain pragma or aspect
+	is present.
+	(Make_Task_Create_Call): Add the Dispatching_Domain when creating a task
+	* par-prag.adb (Prag): Add Pragma_Dispatching_Domain as a known pragma.
+	* sem_prag.adb (Analyze_Pragma): Check the correctness of a pragma
+	Dispatching_Domain and add it to the task definition.
+	(Sig_Flags): Add Pragma_Dispatching_Domain.
+	* rtsfind.ads, rtsfind.adb (RTU_Id, RE_Id, Get_Unit_Name): Add the
+	support to find the types Dispatching_Domain and
+	Dispatching_Domain_Access.
+	* sinfo.ads, sinfo.adb (Has_Pragma_Dispatching_Domain,
+	Set_Has_Pragma_Dispatching_Domain): Add these subprograms to set and
+	query the availability of a pragma Dispatching_Domain.
+	* snames.ads-tmpl (Name_uDispatching_Domain): Add this name required by
+	the expander to pass the Dispatching_Domain when creating a task.
+	(Name_Dispatching_Domain): Add this new name for a pragma.
+	(Pragma_Id): Add the new Pragma_Dispatching_Domain.
+	* s-tassta.ads, s-tassta.adb (Create_Task): Set the domain to which the
+	task has been allocated at creation time.
+	* s-tarest.adb (Create_Restricted_Task): The dispatching domain using
+	Ravenscar is always null.
+	* s-taskin.ads, s-taskin.adb (Initialize_ATCB): Set the domain to which
+	the task has been allocated at creation time.
+	* s-tporft.adb (Register_Foreign_Thread): A foreign task will not have
+	a specific dispatching domain.
+	* s-taprop-linux.adb, s-taprop-solaris.adb, s-taprop-vxworks.adb,
+	s-taprop-mingw.adb (Create_Task): 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.
+
+2011-08-31  Vincent Celier  <celier@adacore.com>
+
+	* make.adb (Original_Gcc) : New constant String_Access.
+	(Gnatmake): For VM targets, do not use VM version of the compiler if
+	--GCC= has been specified.
+
+2011-08-31  Thomas Quinot  <quinot@adacore.com>
+
+	* sem_ch5.adb: Minor reformatting.
+
+2011-08-31  Ed Schonberg  <schonberg@adacore.com>
+
+	* exp_pakd.adb (Convert_To_PAT_Type): If prefix is a function call, do
+	not reanalyze it.
+
+2011-08-31  Bob Duff  <duff@adacore.com>
+
+	* exp_ch4.adb (Expand_N_Selected_Component): Use the full type, in case
+	the access type is private; we don't care about privacy in expansion.
+
+2011-08-31  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_aggr.adb (Resolve_Aggregate): In an instance, ignore aggregate
+	subcomponents tnat may be limited, because they originate in view
+	conflicts. If the original aggregate is legal and the actuals are
+	legal, the aggregate itself is legal.
+
 2011-08-31  Matthew Heaney  <heaney@adacore.com>
 
 	* a-rbtgbo.adb (Clear_Tree): Assert representation invariant for lock

gcc/ada/aspects.adb

@@ -223,6 +223,7 @@ package body Aspects is
     Aspect_Default_Iterator             => Aspect_Default_Iterator,
     Aspect_Default_Value                => Aspect_Default_Value,
     Aspect_Discard_Names                => Aspect_Discard_Names,
+    Aspect_Dispatching_Domain           => Aspect_Dispatching_Domain,
     Aspect_Dynamic_Predicate            => Aspect_Predicate,
     Aspect_External_Tag                 => Aspect_External_Tag,
     Aspect_Favor_Top_Level              => Aspect_Favor_Top_Level,

gcc/ada/aspects.ads

@@ -53,6 +53,7 @@ package Aspects is
       Aspect_Default_Component_Value,
       Aspect_Default_Iterator,
       Aspect_Default_Value,
+      Aspect_Dispatching_Domain,
       Aspect_Dynamic_Predicate,
       Aspect_External_Tag,
       Aspect_Implicit_Dereference,
@@ -190,6 +191,7 @@ package Aspects is
                         Aspect_Default_Component_Value => Expression,
                         Aspect_Default_Iterator        => Name,
                         Aspect_Default_Value           => Expression,
+                        Aspect_Dispatching_Domain      => Expression,
                         Aspect_Dynamic_Predicate       => Expression,
                         Aspect_External_Tag            => Expression,
                         Aspect_Implicit_Dereference    => Name,
@@ -250,6 +252,7 @@ package Aspects is
      Aspect_Default_Value                => Name_Default_Value,
      Aspect_Default_Component_Value      => Name_Default_Component_Value,
      Aspect_Discard_Names                => Name_Discard_Names,
+     Aspect_Dispatching_Domain           => Name_Dispatching_Domain,
      Aspect_Dynamic_Predicate            => Name_Dynamic_Predicate,
      Aspect_Elaborate_Body               => Name_Elaborate_Body,
      Aspect_External_Tag                 => Name_External_Tag,

gcc/ada/exp_ch4.adb

@@ -7920,6 +7920,7 @@ package body Exp_Ch4 is
       --  Insert explicit dereference if required
 
       if Is_Access_Type (Ptyp) then
+         Set_Etype (P, Ptyp); -- in case it's private
          Insert_Explicit_Dereference (P);
          Analyze_And_Resolve (P, Designated_Type (Ptyp));
 

gcc/ada/exp_ch9.adb

@@ -10422,12 +10422,14 @@ package body Exp_Ch9 is
    --  values of this task. The general form of this type declaration is
 
    --    type taskV (discriminants) is record
-   --      _Task_Id     : Task_Id;
-   --      entry_family : array (bounds) of Void;
-   --      _Priority    : Integer         := priority_expression;
-   --      _Size        : Size_Type       := Size_Type (size_expression);
-   --      _Task_Info   : Task_Info_Type  := task_info_expression;
-   --      _CPU         : Integer         := cpu_range_expression;
+   --      _Task_Id           : Task_Id;
+   --      entry_family       : array (bounds) of Void;
+   --      _Priority          : Integer            := priority_expression;
+   --      _Size              : Size_Type          := size_expression;
+   --      _Task_Info         : Task_Info_Type     := task_info_expression;
+   --      _CPU               : Integer            := cpu_range_expression;
+   --      _Relative_Deadline : Time_Span          := time_span_expression;
+   --      _Domain            : Dispatching_Domain := dd_expression;
    --    end record;
 
    --  The discriminants are present only if the corresponding task type has
@@ -10471,6 +10473,11 @@ package body Exp_Ch9 is
    --  argument that was present in the pragma, and is used to provide the
    --  Relative_Deadline parameter to the call to Create_Task.
 
+   --  The _Domain field is present only if a Dispatching_Domain pragma or
+   --  aspect appears in the task definition. The expression captures the
+   --  argument that was present in the pragma or aspect, and is used to
+   --  provide the Dispatching_Domain parameter to the call to Create_Task.
+
    --  When a task is declared, an instance of the task value record is
    --  created. The elaboration of this declaration creates the correct bounds
    --  for the entry families, and also evaluates the size, priority, and
@@ -10833,6 +10840,36 @@ package body Exp_Ch9 is
                          (Taskdef, Name_Relative_Deadline))))))));
       end if;
 
+      --  Add the _Dispatching_Domain component if a Dispatching_Domain pragma
+      --  or aspect is present. If we are using a restricted run time this
+      --  component will not be added (dispatching domains are not allowed by
+      --  the Ravenscar profile).
+
+      if not Restricted_Profile
+        and then Present (Taskdef)
+        and then Has_Pragma_Dispatching_Domain (Taskdef)
+      then
+         Append_To (Cdecls,
+           Make_Component_Declaration (Loc,
+             Defining_Identifier =>
+               Make_Defining_Identifier (Loc, Name_uDispatching_Domain),
+
+             Component_Definition =>
+               Make_Component_Definition (Loc,
+                 Aliased_Present    => False,
+                 Subtype_Indication =>
+                   New_Reference_To
+                     (RTE (RE_Dispatching_Domain_Access), Loc)),
+
+             Expression =>
+               Unchecked_Convert_To (RTE (RE_Dispatching_Domain_Access),
+                 Relocate_Node (
+                   Expression (First (
+                     Pragma_Argument_Associations (
+                       Find_Task_Or_Protected_Pragma
+                         (Taskdef, Name_Dispatching_Domain))))))));
+      end if;
+
       Insert_After (Size_Decl, Rec_Decl);
 
       --  Analyze the record declaration immediately after construction,
@@ -12782,6 +12819,31 @@ package body Exp_Ch9 is
               New_Reference_To (RTE (RE_Time_Span_Zero), Loc));
          end if;
 
+         --  Dispatching_Domain parameter. If no Dispatching_Domain pragma or
+         --  aspect is present, then the dispatching domain is null. If a
+         --  pragma or aspect is present, then the dispatching domain is taken
+         --  from the _Dispatching_Domain field of the task value record,
+         --  which was set from the pragma value. Note that this parameter
+         --  must not be generated for the restricted profiles since Ravenscar
+         --  does not allow dispatching domains.
+
+         --  Case where pragma or aspect Dispatching_Domain applies: use given
+         --  value.
+
+         if Present (Tdef) and then Has_Pragma_Dispatching_Domain (Tdef) then
+            Append_To (Args,
+              Make_Selected_Component (Loc,
+                Prefix        =>
+                  Make_Identifier (Loc, Name_uInit),
+                Selector_Name =>
+                  Make_Identifier (Loc, Name_uDispatching_Domain)));
+
+         --  No pragma or aspect Dispatching_Domain apply to the task
+
+         else
+            Append_To (Args, Make_Null (Loc));
+         end if;
+
          --  Number of entries. This is an expression of the form:
 
          --    n + _Init.a'Length + _Init.a'B'Length + ...

gcc/ada/exp_pakd.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT 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- --
@@ -702,7 +702,9 @@ package body Exp_Pakd is
       --  see Reset_Packed_Prefix. On the other hand, if the prefix is a simple
       --  array reference, reanalysis can produce spurious type errors when the
       --  PAT type is replaced again with the original type of the array. Same
-      --  for the case of a dereference. The following is correct and minimal,
+      --  for the case of a dereference. Ditto for function calls: expansion
+      --  may introduce additional actuals which will trigger errors if call
+      --  is reanalyzed. The following is correct and minimal,
       --  but the handling of more complex packed expressions in actuals is
       --  confused. Probably the problem only remains for actuals in calls.
 
@@ -713,6 +715,7 @@ package body Exp_Pakd is
            (Nkind (Aexp) = N_Indexed_Component
              and then Is_Entity_Name (Prefix (Aexp)))
         or else Nkind (Aexp) = N_Explicit_Dereference
+        or else Nkind (Aexp) = N_Function_Call
       then
          Set_Analyzed (Aexp);
       end if;

gcc/ada/make.adb

@@ -671,7 +671,12 @@ package body Make is
    -- Compiler, Binder & Linker Data and Subprograms --
    ----------------------------------------------------
 
-   Gcc      : String_Access := Program_Name ("gcc", "gnatmake");
+   Gcc          : String_Access := Program_Name ("gcc", "gnatmake");
+   Original_Gcc : constant String_Access := Gcc;
+   --  Original_Gcc is used to check if Gcc has been modified by a switch
+   --  --GCC=, so that for VM platforms, it is not modified again, as it can
+   --  result in incorrect error messages if the compiler cannot be found.
+
    Gnatbind : String_Access := Program_Name ("gnatbind", "gnatmake");
    Gnatlink : String_Access := Program_Name ("gnatlink", "gnatmake");
    --  Default compiler, binder, linker programs
@@ -5973,10 +5978,6 @@ package body Make is
          Gnatlink := Saved_Gnatlink;
       end if;
 
-      Gcc_Path       := GNAT.OS_Lib.Locate_Exec_On_Path (Gcc.all);
-      Gnatbind_Path  := GNAT.OS_Lib.Locate_Exec_On_Path (Gnatbind.all);
-      Gnatlink_Path  := GNAT.OS_Lib.Locate_Exec_On_Path (Gnatlink.all);
-
       Bad_Compilation.Init;
 
       --  If project files are used, create the mapping of all the sources, so
@@ -6068,16 +6069,29 @@ package body Make is
                      --  instead.
 
                      Check_Object_Consistency := False;
-                     Gcc := new String'("jvm-gnatcompile");
+
+                     --  Do not modify Gcc is --GCC= was specified
+
+                     if Gcc = Original_Gcc then
+                        Gcc := new String'("jvm-gnatcompile");
+                     end if;
 
                   when Targparm.CLI_Target =>
-                     Gcc := new String'("dotnet-gnatcompile");
+                     --  Do not modify Gcc is --GCC= was specified
+
+                     if Gcc = Original_Gcc then
+                        Gcc := new String'("dotnet-gnatcompile");
+                     end if;
 
                   when Targparm.No_VM =>
                      raise Program_Error;
                end case;
             end if;
 
+            Gcc_Path       := GNAT.OS_Lib.Locate_Exec_On_Path (Gcc.all);
+            Gnatbind_Path  := GNAT.OS_Lib.Locate_Exec_On_Path (Gnatbind.all);
+            Gnatlink_Path  := GNAT.OS_Lib.Locate_Exec_On_Path (Gnatlink.all);
+
             --  If we have specified -j switch both from the project file
             --  and on the command line, the one from the command line takes
             --  precedence.

gcc/ada/par-prag.adb

@@ -1128,6 +1128,7 @@ begin
            Pragma_Default_Storage_Pool          |
            Pragma_Dimension                     |
            Pragma_Discard_Names                 |
+           Pragma_Dispatching_Domain            |
            Pragma_Eliminate                     |
            Pragma_Elaborate                     |
            Pragma_Elaborate_All                 |

gcc/ada/rtsfind.adb

@@ -321,6 +321,10 @@ package body Rtsfind is
       elsif U_Id in System_Child then
          Name_Buffer (7) := '.';
 
+         if U_Id in System_Multiprocessors_Child then
+            Name_Buffer (23) := '.';
+         end if;
+
          if U_Id in System_Storage_Pools_Child then
             Name_Buffer (21) := '.';
          end if;

gcc/ada/rtsfind.ads

@@ -371,6 +371,10 @@ package Rtsfind is
       System_WWd_Enum,
       System_WWd_Wchar,
 
+      --  Children of System.Multiprocessors
+
+      System_Multiprocessors_Dispatching_Domains,
+
       --  Children of System.Storage_Pools
 
       System_Storage_Pools_Subpools,
@@ -440,6 +444,11 @@ package Rtsfind is
      range System_Address_Image .. System_Tasking_Stages;
    --  Range of values for children or grandchildren of System
 
+   subtype System_Multiprocessors_Child is RTU_Id
+     range System_Multiprocessors_Dispatching_Domains ..
+       System_Multiprocessors_Dispatching_Domains;
+   --  Range of values for children of System.Multiprocessors
+
    subtype System_Storage_Pools_Child is RTU_Id
      range System_Storage_Pools_Subpools .. System_Storage_Pools_Subpools;
 
@@ -1446,6 +1455,8 @@ package Rtsfind is
 
      RE_Unspecified_CPU,                 -- System.Tasking
 
+     RE_Dispatching_Domain_Access,       -- System.Tasking
+
      RE_Abort_Defer,                     -- System.Soft_Links
      RE_Abort_Undefer,                   -- System.Soft_Links
      RE_Complete_Master,                 -- System.Soft_Links
@@ -1588,6 +1599,8 @@ package Rtsfind is
      RE_Width_Wide_Character,            -- System.Wid_WChar
      RE_Width_Wide_Wide_Character,       -- System.Wid_WChar
 
+     RE_Dispatching_Domain,              -- Dispatching_Domains
+
      RE_Protected_Entry_Body_Array,      -- Tasking.Protected_Objects.Entries
      RE_Protection_Entries,              -- Tasking.Protected_Objects.Entries
      RE_Protection_Entries_Access,       -- Tasking.Protected_Objects.Entries
@@ -2635,6 +2648,8 @@ package Rtsfind is
 
      RE_Unspecified_CPU                  => System_Tasking,
 
+     RE_Dispatching_Domain_Access        => System_Tasking,
+
      RE_Abort_Defer                      => System_Soft_Links,
      RE_Abort_Undefer                    => System_Soft_Links,
      RE_Complete_Master                  => System_Soft_Links,
@@ -2778,6 +2793,9 @@ package Rtsfind is
      RE_Width_Wide_Character             => System_Wid_WChar,
      RE_Width_Wide_Wide_Character        => System_Wid_WChar,
 
+     RE_Dispatching_Domain               =>
+       System_Multiprocessors_Dispatching_Domains,
+
      RE_Protected_Entry_Body_Array       =>
        System_Tasking_Protected_Objects_Entries,
      RE_Protection_Entries               =>

gcc/ada/s-taprop-linux.adb

@@ -818,6 +818,18 @@ 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 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);
 

gcc/ada/s-taprop-mingw.adb

@@ -895,9 +895,19 @@ package body System.Task_Primitives.Operations is
       Result         : DWORD;
       Entry_Point    : PTHREAD_START_ROUTINE;
 
-      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 not in T.Common.Domain'Range
+         or else not T.Common.Domain (T.Common.Base_CPU))
+      then
+         Succeeded := False;
+         return;
+      end if;
+
       pTaskParameter := To_Address (T);
 
       Entry_Point := To_PTHREAD_START_ROUTINE (Wrapper);

gcc/ada/s-taprop-solaris.adb

@@ -976,6 +976,18 @@ package body System.Task_Primitives.Operations is
       use System.Task_Info;
 
    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 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 + Page_Size);
 
       --  Since the initial signal mask of a thread is inherited from the

gcc/ada/s-taprop-vxworks.adb

@@ -891,6 +891,18 @@ package body System.Task_Primitives.Operations is
       Adjusted_Stack_Size : size_t;
 
    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 not in T.Common.Domain'Range
+         or else not T.Common.Domain (T.Common.Base_CPU))
+      then
+         Succeeded := False;
+         return;
+      end if;
+
       --  Ask for four extra bytes of stack space so that the ATCB pointer can
       --  be stored below the stack limit, plus extra space for the frame of
       --  Task_Wrapper. This is so the user gets the amount of stack requested

gcc/ada/s-tarest.adb

@@ -505,11 +505,13 @@ package body System.Tasking.Restricted.Stages is
       Write_Lock (Self_ID);
 
       --  With no task hierarchy, the parent of all non-Environment tasks that
-      --  are created must be the Environment task
+      --  are created must be the Environment task. Dispatching domains are
+      --  not allowed in Ravenscar, so the dispatching domain parameter will
+      --  always be null.
 
       Initialize_ATCB
         (Self_ID, State, Discriminants, Self_ID, Elaborated, Base_Priority,
-         Base_CPU, Task_Info, Size, Created_Task, Success);
+         Base_CPU, null, 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

gcc/ada/s-taskin.adb

@@ -99,6 +99,7 @@ package body System.Tasking is
       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;
@@ -121,6 +122,7 @@ package body System.Tasking is
       T.Common.Parent                   := Parent;
       T.Common.Base_Priority            := Base_Priority;
       T.Common.Base_CPU                 := Base_CPU;
+      T.Common.Domain                   := Domain;
       T.Common.Current_Priority         := 0;
       T.Common.Protected_Action_Nesting := 0;
       T.Common.Call                     := null;
@@ -209,7 +211,7 @@ package body System.Tasking is
       T := STPO.New_ATCB (0);
       Initialize_ATCB
         (null, null, Null_Address, Null_Task, null, Base_Priority, Base_CPU,
-         Task_Info.Unspecified_Task_Info, 0, T, Success);
+         null, Task_Info.Unspecified_Task_Info, 0, T, Success);
       pragma Assert (Success);
 
       STPO.Initialize (T);

gcc/ada/s-taskin.ads

@@ -1136,6 +1136,7 @@ package System.Tasking is
       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;

gcc/ada/s-tassta.adb

@@ -475,6 +475,7 @@ package body System.Tasking.Stages is
       Task_Info         : System.Task_Info.Task_Info_Type;
       CPU               : Integer;
       Relative_Deadline : Ada.Real_Time.Time_Span;
+      Domain            : Dispatching_Domain_Access;
       Num_Entries       : Task_Entry_Index;
       Master            : Master_Level;
       State             : Task_Procedure_Access;
@@ -591,7 +592,7 @@ package body System.Tasking.Stages is
       end if;
 
       Initialize_ATCB (Self_ID, State, Discriminants, P, Elaborated,
-        Base_Priority, Base_CPU, Task_Info, Size, T, Success);
+        Base_Priority, Base_CPU, Domain, Task_Info, Size, T, Success);
 
       if not Success then
          Free (T);
@@ -642,12 +643,13 @@ package body System.Tasking.Stages is
          T.Common.Task_Image_Len := Len;
       end if;
 
-      --  ??? For the moment the task inherits the dispatching domain of the
-      --  parent. It will change when support for the Dispatching_Domain
-      --  aspect will be added, because that will allow setting the domain
-      --  in the spec of the task.
+      --  The task inherits the dispatching domain of the parent only if no
+      --  specific domain has been defined in the spec of the task (using the
+      --  dispatching domain pragma or aspect).
 
-      if T.Common.Activator /= null then
+      if T.Common.Domain /= null then
+         null;
+      elsif T.Common.Activator /= null then
          T.Common.Domain := T.Common.Activator.Common.Domain;
       else
          T.Common.Domain := System.Tasking.System_Domain;

gcc/ada/s-tassta.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  S p e c                                 --
 --                                                                          --
---          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2011, 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- --
@@ -172,6 +172,7 @@ package System.Tasking.Stages is
       Task_Info         : System.Task_Info.Task_Info_Type;
       CPU               : Integer;
       Relative_Deadline : Ada.Real_Time.Time_Span;
+      Domain            : Dispatching_Domain_Access;
       Num_Entries       : Task_Entry_Index;
       Master            : Master_Level;
       State             : Task_Procedure_Access;
@@ -195,6 +196,8 @@ package System.Tasking.Stages is
    --   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.
+   --  Domain is the dispatching domain associated with the created task by
+   --   means of a Dispatching_Domain pragma or aspect, or null if none.
    --  State is the compiler generated task's procedure body
    --  Discriminants is a pointer to a limited record whose discriminants
    --   are those of the task to create. This parameter should be passed as

gcc/ada/s-tporft.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                B o d y                                   --
 --                                                                          --
---          Copyright (C) 2002-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 2002-2011, 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- --
@@ -65,7 +65,7 @@ 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,
+      System.Priority'First, System.Multiprocessors.Not_A_Specific_CPU, null,
       Task_Info.Unspecified_Task_Info, 0, Self_Id, Succeeded);
    Unlock_RTS;
    pragma Assert (Succeeded);

gcc/ada/sem_aggr.adb

@@ -1052,8 +1052,14 @@ package body Sem_Aggr is
       end if;
 
       --  Ada 2005 (AI-287): Limited aggregates allowed
+      --  In an instance, ignore aggregate subcomponents tnat may be limited,
+      --  because they originate in view conflicts. If the original aggregate
+      --  is legal and the actuals are legal, the aggregate itself is legal.
 
-      if Is_Limited_Type (Typ) and then Ada_Version < Ada_2005 then
+      if Is_Limited_Type (Typ)
+        and then Ada_Version < Ada_2005
+        and then not In_Instance
+      then
          Error_Msg_N ("aggregate type cannot be limited", N);
          Explain_Limited_Type (Typ, N);
 

gcc/ada/sem_ch13.adb

@@ -1149,29 +1149,36 @@ package body Sem_Ch13 is
 
                   pragma Assert (not Delay_Required);
 
-               when Aspect_Priority | Aspect_Interrupt_Priority => declare
-                  Pname : Name_Id;
+               when Aspect_Priority           |
+                    Aspect_Interrupt_Priority |
+                    Aspect_Dispatching_Domain =>
+                  declare
+                     Pname : Name_Id;
+                  begin
+                     if A_Id = Aspect_Priority then
+                        Pname := Name_Priority;
 
-               begin
-                  if A_Id = Aspect_Priority then
-                     Pname := Name_Priority;
-                  else
-                     Pname := Name_Interrupt_Priority;
-                  end if;
+                     elsif A_Id = Aspect_Interrupt_Priority then
+                        Pname := Name_Interrupt_Priority;
 
-                  Aitem :=
-                    Make_Pragma (Loc,
-                      Pragma_Identifier            =>
-                        Make_Identifier (Sloc (Id), Pname),
-                      Pragma_Argument_Associations =>
-                        New_List
-                          (Make_Pragma_Argument_Association
-                            (Sloc (Id), Expression => Relocate_Node (Expr))));
+                     else
+                        Pname := Name_Dispatching_Domain;
+                     end if;
 
-                  Set_From_Aspect_Specification (Aitem, True);
+                     Aitem :=
+                       Make_Pragma (Loc,
+                           Pragma_Identifier            =>
+                             Make_Identifier (Sloc (Id), Pname),
+                           Pragma_Argument_Associations =>
+                             New_List
+                               (Make_Pragma_Argument_Association
+                                  (Sloc       => Sloc (Id),
+                                   Expression => Relocate_Node (Expr))));
 
-                  pragma Assert (not Delay_Required);
-               end;
+                     Set_From_Aspect_Specification (Aitem, True);
+
+                     pragma Assert (not Delay_Required);
+                  end;
 
                --  Aspects Pre/Post generate Precondition/Postcondition pragmas
                --  with a first argument that is the expression, and a second
@@ -1490,7 +1497,9 @@ package body Sem_Ch13 is
                      --  protected definition, which we need to create if it's
                      --  not there.
 
-                     when Aspect_Priority | Aspect_Interrupt_Priority =>
+                     when Aspect_Priority           |
+                          Aspect_Interrupt_Priority |
+                          Aspect_Dispatching_Domain =>
                         declare
                            T : Node_Id; -- the type declaration
                            L : List_Id; -- list of decls of task/protected
@@ -1503,7 +1512,9 @@ package body Sem_Ch13 is
                               T := N;
                            end if;
 
-                           if Nkind (T) = N_Protected_Type_Declaration then
+                           if Nkind (T) = N_Protected_Type_Declaration
+                             and then A_Id /= Aspect_Dispatching_Domain
+                           then
                               pragma Assert
                                 (Present (Protected_Definition (T)));
 
@@ -1520,8 +1531,7 @@ package body Sem_Ch13 is
                                        End_Label => Empty));
                               end if;
 
-                              L := Visible_Declarations
-                                     (Task_Definition (T));
+                              L := Visible_Declarations (Task_Definition (T));
 
                            else
                               raise Program_Error;
@@ -5880,6 +5890,9 @@ package body Sem_Ch13 is
          when Aspect_Bit_Order =>
             T := RTE (RE_Bit_Order);
 
+         when Aspect_Dispatching_Domain =>
+            T := RTE (RE_Dispatching_Domain);
+
          when Aspect_External_Tag =>
             T := Standard_String;
 

gcc/ada/sem_ch5.adb

@@ -2058,7 +2058,7 @@ package body Sem_Ch5 is
                         end if;
 
                         --  Set kind of loop parameter, which may be used in
-                        --  the subsequent analysis of of the condition in a
+                        --  the subsequent analysis of the condition in a
                         --  quantified expression.
 
                         Set_Ekind (Id, E_Loop_Parameter);

gcc/ada/sem_prag.adb

@@ -7866,6 +7866,54 @@ package body Sem_Prag is
             end if;
          end Discard_Names;
 
+         ------------------------
+         -- Dispatching_Domain --
+         ------------------------
+
+         --  pragma Dispatching_Domain (EXPRESSION);
+
+         when Pragma_Dispatching_Domain => Dispatching_Domain : declare
+            P   : constant Node_Id := Parent (N);
+            Arg : Node_Id;
+
+         begin
+            Ada_2012_Pragma;
+            Check_No_Identifiers;
+            Check_Arg_Count (1);
+
+            --  This pragma is born obsolete, but not the aspect
+
+            if not From_Aspect_Specification (N) then
+               Check_Restriction
+                 (No_Obsolescent_Features, Pragma_Identifier (N));
+            end if;
+
+            if 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_Dispatching_Domain));
+
+            --  Anything else is incorrect
+
+            else
+               Pragma_Misplaced;
+            end if;
+
+            if Has_Pragma_Dispatching_Domain (P) then
+               Error_Pragma ("duplicate pragma% not allowed");
+            else
+               Set_Has_Pragma_Dispatching_Domain (P, True);
+
+               if Nkind (P) = N_Task_Definition then
+                  Record_Rep_Item (Defining_Identifier (Parent (P)), N);
+               end if;
+            end if;
+         end Dispatching_Domain;
+
          ---------------
          -- Elaborate --
          ---------------
@@ -14462,6 +14510,7 @@ package body Sem_Prag is
       Pragma_Default_Storage_Pool          => -1,
       Pragma_Dimension                     => -1,
       Pragma_Discard_Names                 =>  0,
+      Pragma_Dispatching_Domain            => -1,
       Pragma_Elaborate                     => -1,
       Pragma_Elaborate_All                 => -1,
       Pragma_Elaborate_Body                => -1,

gcc/ada/sinfo.adb

@@ -1471,6 +1471,14 @@ package body Sinfo is
       return Flag14 (N);
    end Has_Pragma_CPU;
 
+   function Has_Pragma_Dispatching_Domain
+     (N : Node_Id) return Boolean is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Task_Definition);
+      return Flag15 (N);
+   end Has_Pragma_Dispatching_Domain;
+
    function Has_Pragma_Priority
       (N : Node_Id) return Boolean is
    begin
@@ -4513,6 +4521,14 @@ package body Sinfo is
       Set_Flag14 (N, Val);
    end Set_Has_Pragma_CPU;
 
+   procedure Set_Has_Pragma_Dispatching_Domain
+      (N : Node_Id; Val : Boolean := True) is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Task_Definition);
+      Set_Flag15 (N, Val);
+   end Set_Has_Pragma_Dispatching_Domain;
+
    procedure Set_Has_Pragma_Priority
       (N : Node_Id; Val : Boolean := True) is
    begin

gcc/ada/sinfo.ads

@@ -1145,6 +1145,11 @@ package Sinfo is
    --    flag the presence of a CPU pragma in the declaration sequence (public
    --    or private in the task case).
 
+   --  Has_Pragma_Dispatching_Domain (Flag15-Sem)
+   --    A flag present in N_Task_Definition nodes to flag the presence of a
+   --    Dispatching_Domain 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 accommodates the rather
@@ -5061,6 +5066,7 @@ package Sinfo is
       --  Has_Task_Name_Pragma (Flag8-Sem)
       --  Has_Relative_Deadline_Pragma (Flag9-Sem)
       --  Has_Pragma_CPU (Flag14-Sem)
+      --  Has_Pragma_Dispatching_Domain (Flag15-Sem)
 
       --------------------
       -- 9.1  Task Item --
@@ -8493,6 +8499,9 @@ package Sinfo is
    function Has_Pragma_CPU
      (N : Node_Id) return Boolean;    -- Flag14
 
+   function Has_Pragma_Dispatching_Domain
+     (N : Node_Id) return Boolean;    -- Flag15
+
    function Has_Pragma_Priority
      (N : Node_Id) return Boolean;    -- Flag6
 
@@ -9462,6 +9471,9 @@ package Sinfo is
    procedure Set_Has_Pragma_CPU
      (N : Node_Id; Val : Boolean := True);    -- Flag14
 
+   procedure Set_Has_Pragma_Dispatching_Domain
+     (N : Node_Id; Val : Boolean := True);    -- Flag15
+
    procedure Set_Has_Pragma_Priority
      (N : Node_Id; Val : Boolean := True);    -- Flag6
 
@@ -11875,6 +11887,7 @@ package Sinfo is
    pragma Inline (Has_Self_Reference);
    pragma Inline (Has_No_Elaboration_Code);
    pragma Inline (Has_Pragma_CPU);
+   pragma Inline (Has_Pragma_Dispatching_Domain);
    pragma Inline (Has_Pragma_Priority);
    pragma Inline (Has_Pragma_Suppress_All);
    pragma Inline (Has_Private_View);
@@ -12194,6 +12207,7 @@ package Sinfo is
    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_Dispatching_Domain);
    pragma Inline (Set_Has_Pragma_Priority);
    pragma Inline (Set_Has_Pragma_Suppress_All);
    pragma Inline (Set_Has_Private_View);

gcc/ada/snames.ads-tmpl

@@ -156,6 +156,7 @@ package Snames is
    Name_uChain                         : constant Name_Id := N + $;
    Name_uController                    : constant Name_Id := N + $;
    Name_uCPU                           : constant Name_Id := N + $;
+   Name_uDispatching_Domain            : constant Name_Id := N + $;
    Name_uEntry_Bodies                  : constant Name_Id := N + $;
    Name_uExpunge                       : constant Name_Id := N + $;
    Name_uFinalizer                     : constant Name_Id := N + $;
@@ -360,6 +361,7 @@ package Snames is
    Name_Detect_Blocking                : constant Name_Id := N + $; -- Ada 05
    Name_Default_Storage_Pool           : constant Name_Id := N + $; -- Ada 12
    Name_Discard_Names                  : constant Name_Id := N + $;
+   Name_Dispatching_Domain             : constant Name_Id := N + $; -- Ada 12
    Name_Elaboration_Checks             : constant Name_Id := N + $; -- GNAT
    Name_Eliminate                      : constant Name_Id := N + $; -- GNAT
    Name_Extend_System                  : constant Name_Id := N + $; -- GNAT
@@ -1523,6 +1525,7 @@ package Snames is
       Pragma_Detect_Blocking,
       Pragma_Default_Storage_Pool,
       Pragma_Discard_Names,
+      Pragma_Dispatching_Domain,
       Pragma_Elaboration_Checks,
       Pragma_Eliminate,
       Pragma_Extend_System,