[multiple changes]

2011-09-01  Robert Dewar  <dewar@adacore.com>

	* a-cbprqu.adb, a-cbprqu.ads, a-cuprqu.adb, a-cuprqu.ads,
	a-cbsyqu.adb, a-cbsyqu.ads: Minor reformatting.

2011-09-01  Ed Schonberg  <schonberg@adacore.com>

	* sem_attr.adb: Conditionalize aliasing predicates to Ada2012.

2011-09-01  Jose Ruiz  <ruiz@adacore.com>

	* aspects.ads (Aspect_Id, Aspect_Argument, Aspect_Names): Add the CPU
	aspect.
	* aspects.adb (Canonical_Aspect): Add entry for the CPU aspect.
	* sem_ch13.adb (Analyze_Aspect_Specifications): Analyze the CPU aspect
	in a similar way as we do for the Priority or Dispatching_Domain aspect.
	* s-mudido-affinity.adb (Dispatching_Domain_Tasks,
	Dispatching_Domains_Frozen): Move this local data to package
	System.Tasking because with the CPU aspect we need to have access
	to this data when creating the task in System.Tasking.Stages.Create_Task
	* s-taskin.ads (Dispatching_Domain_Tasks, Dispatching_Domains_Frozen):
	Move these variables from the body of
	System.Multiprocessors.Dispatching_Domains because with the CPU aspect
	we need to have access to this data when creating the task in
	System.Tasking.Stages.Create_Task.
	* s-taskin.adb (Initialize): Signal the allocation of the environment
	task to a CPU, if any, so that we know whether the CPU can be
	transferred to a different dispatching domain.
	* s-tassta.adb (Create_Task): Check whether the CPU to which this task
	is being allocated belongs to the dispatching domain where the task
	lives. Signal the allocation of the task to a CPU, if any, so that we
	know whether the CPU can be transferred to a different dispatching
	domain.

From-SVN: r178400

gcc/ada/ChangeLog

@@ -1,3 +1,37 @@
+2011-09-01  Robert Dewar  <dewar@adacore.com>
+
+	* a-cbprqu.adb, a-cbprqu.ads, a-cuprqu.adb, a-cuprqu.ads,
+	a-cbsyqu.adb, a-cbsyqu.ads: Minor reformatting.
+
+2011-09-01  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_attr.adb: Conditionalize aliasing predicates to Ada2012.
+
+2011-09-01  Jose Ruiz  <ruiz@adacore.com>
+
+	* aspects.ads (Aspect_Id, Aspect_Argument, Aspect_Names): Add the CPU
+	aspect.
+	* aspects.adb (Canonical_Aspect): Add entry for the CPU aspect.
+	* sem_ch13.adb (Analyze_Aspect_Specifications): Analyze the CPU aspect
+	in a similar way as we do for the Priority or Dispatching_Domain aspect.
+	* s-mudido-affinity.adb (Dispatching_Domain_Tasks,
+	Dispatching_Domains_Frozen): Move this local data to package
+	System.Tasking because with the CPU aspect we need to have access
+	to this data when creating the task in System.Tasking.Stages.Create_Task
+	* s-taskin.ads (Dispatching_Domain_Tasks, Dispatching_Domains_Frozen):
+	Move these variables from the body of
+	System.Multiprocessors.Dispatching_Domains because with the CPU aspect
+	we need to have access to this data when creating the task in
+	System.Tasking.Stages.Create_Task.
+	* s-taskin.adb (Initialize): Signal the allocation of the environment
+	task to a CPU, if any, so that we know whether the CPU can be
+	transferred to a different dispatching domain.
+	* s-tassta.adb (Create_Task): Check whether the CPU to which this task
+	is being allocated belongs to the dispatching domain where the task
+	lives. Signal the allocation of the task to a CPU, if any, so that we
+	know whether the CPU can be transferred to a different dispatching
+	domain.
+
 2011-09-01  Ed Schonberg  <schonberg@adacore.com>
 
 	* exp_attr.adb, sem_attr.adb, snames.ads-tmpl: Implementation of

gcc/ada/a-cbprqu.adb

@@ -2,7 +2,7 @@
 --                                                                          --
 --                         GNAT LIBRARY COMPONENTS                          --
 --                                                                          --
---               ADA.CONTAINERS.BOUNDED_PRIORITY_QUEUES                     --
+--                  ADA.CONTAINERS.BOUNDED_PRIORITY_QUEUES                  --
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --

gcc/ada/a-cbprqu.ads

@@ -2,7 +2,7 @@
 --                                                                          --
 --                         GNAT LIBRARY COMPONENTS                          --
 --                                                                          --
---               ADA.CONTAINERS.BOUNDED_PRIORITY_QUEUES                     --
+--                  ADA.CONTAINERS.BOUNDED_PRIORITY_QUEUES                  --
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
@@ -32,6 +32,7 @@
 ------------------------------------------------------------------------------
 
 with System;
+
 with Ada.Containers.Synchronized_Queue_Interfaces;
 with Ada.Containers.Bounded_Doubly_Linked_Lists;
 

gcc/ada/a-cbsyqu.adb

@@ -2,7 +2,7 @@
 --                                                                          --
 --                         GNAT LIBRARY COMPONENTS                          --
 --                                                                          --
---               ADA.CONTAINERS.BOUNDED_SYNCHRONIZED_QUEUES                 --
+--                ADA.CONTAINERS.BOUNDED_SYNCHRONIZED_QUEUES                --
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --

gcc/ada/a-cbsyqu.ads

@@ -2,7 +2,7 @@
 --                                                                          --
 --                         GNAT LIBRARY COMPONENTS                          --
 --                                                                          --
---               ADA.CONTAINERS.BOUNDED_SYNCHRONIZED_QUEUES                 --
+--                ADA.CONTAINERS.BOUNDED_SYNCHRONIZED_QUEUES                --
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --

gcc/ada/a-cuprqu.adb

@@ -2,7 +2,7 @@
 --                                                                          --
 --                         GNAT LIBRARY COMPONENTS                          --
 --                                                                          --
---               ADA.CONTAINERS.UNBOUNDED_PRIORITY_QUEUES                   --
+--                 ADA.CONTAINERS.UNBOUNDED_PRIORITY_QUEUES                 --
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
@@ -124,7 +124,6 @@ package body Ada.Containers.Unbounded_Priority_Queues is
 
       procedure Finalize (List : in out List_Type) is
          X : Node_Access;
-
       begin
          while List.First /= null loop
             X := List.First;

gcc/ada/a-cuprqu.ads

@@ -2,7 +2,7 @@
 --                                                                          --
 --                         GNAT LIBRARY COMPONENTS                          --
 --                                                                          --
---               ADA.CONTAINERS.UNBOUNDED_PRIORITY_QUEUES                   --
+--                 ADA.CONTAINERS.UNBOUNDED_PRIORITY_QUEUES                 --
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --

gcc/ada/aspects.adb

@@ -219,6 +219,7 @@ package body Aspects is
     Aspect_Bit_Order                    => Aspect_Bit_Order,
     Aspect_Component_Size               => Aspect_Component_Size,
     Aspect_Constant_Indexing            => Aspect_Constant_Indexing,
+    Aspect_CPU                          => Aspect_CPU,
     Aspect_Default_Component_Value      => Aspect_Default_Component_Value,
     Aspect_Default_Iterator             => Aspect_Default_Iterator,
     Aspect_Default_Value                => Aspect_Default_Value,

gcc/ada/aspects.ads

@@ -50,6 +50,7 @@ package Aspects is
       Aspect_Bit_Order,
       Aspect_Component_Size,
       Aspect_Constant_Indexing,
+      Aspect_CPU,
       Aspect_Default_Component_Value,
       Aspect_Default_Iterator,
       Aspect_Default_Value,
@@ -188,6 +189,7 @@ package Aspects is
                         Aspect_Bit_Order               => Expression,
                         Aspect_Component_Size          => Expression,
                         Aspect_Constant_Indexing       => Name,
+                        Aspect_CPU                     => Expression,
                         Aspect_Default_Component_Value => Expression,
                         Aspect_Default_Iterator        => Name,
                         Aspect_Default_Value           => Expression,
@@ -248,6 +250,7 @@ package Aspects is
      Aspect_Compiler_Unit                => Name_Compiler_Unit,
      Aspect_Component_Size               => Name_Component_Size,
      Aspect_Constant_Indexing            => Name_Constant_Indexing,
+     Aspect_CPU                          => Name_CPU,
      Aspect_Default_Iterator             => Name_Default_Iterator,
      Aspect_Default_Value                => Name_Default_Value,
      Aspect_Default_Component_Value      => Name_Default_Component_Value,

gcc/ada/s-mudido-affinity.adb

@@ -41,21 +41,6 @@ package body System.Multiprocessors.Dispatching_Domains is
 
    package ST renames System.Tasking;
 
-   ----------------
-   -- Local data --
-   ----------------
-
-   Dispatching_Domain_Tasks : array (CPU'First .. Number_Of_CPUs) of Natural :=
-                                (others => 0);
-   --  We need to store whether there are tasks allocated to concrete
-   --  processors in the default system dispatching domain because we need to
-   --  check it before creating a new dispatching domain.
-   --  ??? Tasks allocated with pragma CPU are not taken into account here.
-
-   Dispatching_Domains_Frozen : Boolean := False;
-   --  True when the main procedure has been called. Hence, no new dispatching
-   --  domains can be created when this flag is True.
-
    -----------------------
    -- Local subprograms --
    -----------------------
@@ -132,6 +117,7 @@ package body System.Multiprocessors.Dispatching_Domains is
    function Create (First, Last : CPU) return Dispatching_Domain is
       use type System.Tasking.Dispatching_Domain;
       use type System.Tasking.Dispatching_Domain_Access;
+      use type System.Tasking.Array_Allocated_Tasks;
       use type System.Tasking.Task_Id;
 
       Valid_System_Domain : constant Boolean :=
@@ -177,7 +163,7 @@ package body System.Multiprocessors.Dispatching_Domains is
            "CPU range not currently in System_Dispatching_Domain";
 
       elsif
-        Dispatching_Domain_Tasks (First .. Last) /= (First .. Last => 0)
+        ST.Dispatching_Domain_Tasks (First .. Last) /= (First .. Last => 0)
       then
          raise Dispatching_Domain_Error with "CPU range has tasks assigned";
 
@@ -189,7 +175,7 @@ package body System.Multiprocessors.Dispatching_Domains is
          raise Dispatching_Domain_Error with
            "only the environment task can create dispatching domains";
 
-      elsif Dispatching_Domains_Frozen then
+      elsif ST.Dispatching_Domains_Frozen then
          raise Dispatching_Domain_Error with
            "cannot create dispatching domain after call to main program";
       end if;
@@ -253,7 +239,7 @@ package body System.Multiprocessors.Dispatching_Domains is
    begin
       --  Signal the end of the elaboration code
 
-      Dispatching_Domains_Frozen := True;
+      ST.Dispatching_Domains_Frozen := True;
    end Freeze_Dispatching_Domains;
 
    -------------
@@ -370,23 +356,23 @@ package body System.Multiprocessors.Dispatching_Domains is
       --  Change the number of tasks attached to a given task in the system
       --  domain if needed.
 
-      if not Dispatching_Domains_Frozen
+      if not ST.Dispatching_Domains_Frozen
         and then (Domain = null or else Domain = ST.System_Domain)
       then
          --  Reduce the number of tasks attached to the CPU from which this
          --  task is being moved, if needed.
 
          if Source_CPU /= Not_A_Specific_CPU then
-            Dispatching_Domain_Tasks (Source_CPU) :=
+            ST.Dispatching_Domain_Tasks (Source_CPU) :=
-              Dispatching_Domain_Tasks (Source_CPU) - 1;
+              ST.Dispatching_Domain_Tasks (Source_CPU) - 1;
          end if;
 
          --  Increase the number of tasks attached to the CPU to which this
          --  task is being moved, if needed.
 
          if CPU /= Not_A_Specific_CPU then
-            Dispatching_Domain_Tasks (CPU) :=
+            ST.Dispatching_Domain_Tasks (CPU) :=
-              Dispatching_Domain_Tasks (CPU) + 1;
+              ST.Dispatching_Domain_Tasks (CPU) + 1;
          end if;
       end if;
 

gcc/ada/s-taskin.adb

@@ -189,6 +189,8 @@ package body System.Tasking is
       Base_CPU      : System.Multiprocessors.CPU_Range;
       Success       : Boolean;
 
+      use type System.Multiprocessors.CPU_Range;
+
    begin
       if Initialized then
          return;
@@ -233,9 +235,20 @@ package body System.Tasking is
 
       T.Common.Domain := System_Domain;
 
-      --  ??? If we want to handle the interaction between pragma CPU and
+      Dispatching_Domain_Tasks :=
-      --  dispatching domains we would need to signal that this task is being
+        new Array_Allocated_Tasks'
-      --  allocated to a processor.
+          (Multiprocessors.CPU'First .. Multiprocessors.Number_Of_CPUs => 0);
+
+      --  Signal that this task is being allocated to a processor
+
+      if Base_CPU /= System.Multiprocessors.Not_A_Specific_CPU then
+
+         --  Increase the number of tasks attached to the CPU to which this
+         --  task is allocated.
+
+         Dispatching_Domain_Tasks (Base_CPU) :=
+           Dispatching_Domain_Tasks (Base_CPU) + 1;
+      end if;
 
       --  Only initialize the first element since others are not relevant
       --  in ravenscar mode. Rest of the initialization is done in Init_RTS.

gcc/ada/s-taskin.ads

@@ -394,7 +394,43 @@ package System.Tasking is
    type Dispatching_Domain_Access is access Dispatching_Domain;
 
    System_Domain : Dispatching_Domain_Access;
-   --  All processors belong to default system dispatching domain at start up
+   --  All processors belong to default system dispatching domain at start up.
+   --  We use a pointer which creates the actual variable for the reasons
+   --  explained bellow in Dispatching_Domain_Tasks.
+
+   Dispatching_Domains_Frozen : Boolean := False;
+   --  True when the main procedure has been called. Hence, no new dispatching
+   --  domains can be created when this flag is True.
+
+   type Array_Allocated_Tasks is
+     array (System.Multiprocessors.CPU range <>) of Natural;
+   --  At start-up time, we need to store the number of tasks attached to
+   --  concrete processors within the system domain (we can only create
+   --  dispatching domains with processors belonging to the system domain and
+   --  without tasks allocated).
+
+   type Array_Allocated_Tasks_Access is access Array_Allocated_Tasks;
+
+   Dispatching_Domain_Tasks : Array_Allocated_Tasks_Access;
+   --  We need to store whether there are tasks allocated to concrete
+   --  processors in the default system dispatching domain because we need to
+   --  check it before creating a new dispatching domain. Two comments about
+   --  the reason why we use a pointer here and not in package
+   --  Dispatching_Domains.
+   --  1) We use an array created dynamically in procedure Initialize which is
+   --  called at the beginning of the initialization of the run-time library.
+   --  Declaring a static array here in the spec would not work across
+   --  different installations because it would get the value of Number_Of_CPUs
+   --  from the machine where the run-time library is built, and not from the
+   --  machine where the application is executed. That is the reason why we
+   --  create the array (CPU'First .. Number_Of_CPUs) at execution time in the
+   --  procedure body, ensuring that the function Number_Of_CPUs is executed at
+   --  execution time (the same trick as we use for System_Domain).
+   --  2) We have moved this declaration from package Dispatching_Domains
+   --  because when we use a pragma CPU, the affinity is passed through the
+   --  call to Create_Task. Hence, at this point, we may need to update the
+   --  number of tasks associated to the processor, but we do not want to force
+   --  a dependency from this package on Dispatching_Domains.
 
    ------------------------------------
    -- Task related other definitions --

gcc/ada/s-tassta.adb

@@ -493,6 +493,8 @@ package body System.Tasking.Stages is
       Len           : Natural;
       Base_CPU      : System.Multiprocessors.CPU_Range;
 
+      use type System.Multiprocessors.CPU_Range;
+
       pragma Unreferenced (Relative_Deadline);
       --  EDF scheduling is not supported by any of the target platforms so
       --  this parameter is not passed any further.
@@ -540,10 +542,6 @@ package body System.Tasking.Stages is
             else System.Multiprocessors.CPU_Range (CPU));
       end if;
 
-      --  ??? If we want to handle the interaction between pragma CPU and
-      --  dispatching domains we would need to signal that this task is being
-      --  allocated to a processor.
-
       --  Find parent P of new Task, via master level number
 
       P := Self_ID;
@@ -658,6 +656,36 @@ package body System.Tasking.Stages is
       Unlock (Self_ID);
       Unlock_RTS;
 
+      --  The CPU associated to the task (if any) must belong to the
+      --  dispatching domain.
+
+      if Base_CPU /= System.Multiprocessors.Not_A_Specific_CPU and then
+        (Base_CPU not in T.Common.Domain'Range
+         or else not T.Common.Domain (Base_CPU))
+      then
+         Initialization.Undefer_Abort_Nestable (Self_ID);
+         raise Tasking_Error with "CPU not in dispatching domain";
+      end if;
+
+      --  In order to handle the interaction between pragma CPU and
+      --  dispatching domains we need to signal that this task is being
+      --  allocated to a processor. This is needed only for tasks belonging to
+      --  the system domain (the creation of new dispatching domains can only
+      --  take processors from the system domain) and only before the
+      --  environment task calls the main procedure (dispatching domains cannot
+      --  be created after this).
+
+      if Base_CPU /= System.Multiprocessors.Not_A_Specific_CPU
+        and then T.Common.Domain = System.Tasking.System_Domain
+        and then not System.Tasking.Dispatching_Domains_Frozen
+      then
+         --  Increase the number of tasks attached to the CPU to which this
+         --  task is being moved.
+
+         Dispatching_Domain_Tasks (Base_CPU) :=
+           Dispatching_Domain_Tasks (Base_CPU) + 1;
+      end if;
+
       --  Note: we should not call 'new' while holding locks since new
       --  may use locks (e.g. RTS_Lock under Windows) itself and cause a
       --  deadlock.

gcc/ada/sem_attr.adb

@@ -3883,6 +3883,12 @@ package body Sem_Attr is
       ----------------------
 
       when Attribute_Overlaps_Storage =>
+         if Ada_Version < Ada_2012 then
+            Error_Msg_N
+              ("attribute Overlaps_Storage is an Ada 2012 feature", N);
+            Error_Msg_N
+              ("\unit must be compiled with -gnat2012 switch", N);
+         end if;
          Check_E1;
 
          --  Both arguments must be objects of any type
@@ -4374,6 +4380,13 @@ package body Sem_Attr is
       ------------------
 
       when Attribute_Same_Storage =>
+         if Ada_Version < Ada_2012 then
+            Error_Msg_N
+              ("attribute Same_Storage is an Ada 2012 feature", N);
+            Error_Msg_N
+              ("\unit must be compiled with -gnat2012 switch", N);
+         end if;
+
          Check_E1;
 
          --  The arguments must be objects of any type

gcc/ada/sem_ch13.adb

@@ -1151,7 +1151,8 @@ package body Sem_Ch13 is
 
                when Aspect_Priority           |
                     Aspect_Interrupt_Priority |
-                    Aspect_Dispatching_Domain =>
+                    Aspect_Dispatching_Domain |
+                    Aspect_CPU                  =>
                   declare
                      Pname : Name_Id;
                   begin
@@ -1161,6 +1162,9 @@ package body Sem_Ch13 is
                      elsif A_Id = Aspect_Interrupt_Priority then
                         Pname := Name_Interrupt_Priority;
 
+                     elsif A_Id = Aspect_CPU then
+                        Pname := Name_CPU;
+
                      else
                         Pname := Name_Dispatching_Domain;
                      end if;
@@ -1495,11 +1499,13 @@ package body Sem_Ch13 is
 
                      --  For Priority aspects, insert into the task or
                      --  protected definition, which we need to create if it's
-                     --  not there.
+                     --  not there. The same applies to CPU and
+                     --  Dispatching_Domain but only to tasks.
 
                      when Aspect_Priority           |
                           Aspect_Interrupt_Priority |
-                          Aspect_Dispatching_Domain =>
+                          Aspect_Dispatching_Domain |
+                          Aspect_CPU                  =>
                         declare
                            T : Node_Id; -- the type declaration
                            L : List_Id; -- list of decls of task/protected
@@ -1514,6 +1520,7 @@ package body Sem_Ch13 is
 
                            if Nkind (T) = N_Protected_Type_Declaration
                              and then A_Id /= Aspect_Dispatching_Domain
+                             and then A_Id /= Aspect_CPU
                            then
                               pragma Assert
                                 (Present (Protected_Definition (T)));
@@ -5890,6 +5897,9 @@ package body Sem_Ch13 is
          when Aspect_Bit_Order =>
             T := RTE (RE_Bit_Order);
 
+         when Aspect_CPU =>
+            T := RTE (RE_CPU_Range);
+
          when Aspect_Dispatching_Domain =>
             T := RTE (RE_Dispatching_Domain);