This patch adds the support for the CPU aspect to control the allocation of
tasks to processors.
The following test case should compile quietly in Ada 2012 mode, and execute
without any message (task T should execute on the first processor):
pragma Ada_2012;
procedure Test_CPU_Aspect is
task T with CPU => 1;
task body T is
begin
null;
end T;
begin
null;
end Test_CPU_Aspect;
Tested on x86_64-pc-linux-gnu, committed on trunk
2011-09-01 Jose Ruiz <r...@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.
Index: s-tassta.adb
===================================================================
--- s-tassta.adb (revision 178381)
+++ s-tassta.adb (working copy)
@@ -493,6 +493,8 @@
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 @@
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 @@
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.
Index: s-mudido-affinity.adb
===================================================================
--- s-mudido-affinity.adb (revision 178381)
+++ s-mudido-affinity.adb (working copy)
@@ -41,21 +41,6 @@
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 @@
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 @@
"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 @@
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 @@
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 @@
-- 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) :=
- Dispatching_Domain_Tasks (Source_CPU) - 1;
+ ST.Dispatching_Domain_Tasks (Source_CPU) :=
+ 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) :=
- Dispatching_Domain_Tasks (CPU) + 1;
+ ST.Dispatching_Domain_Tasks (CPU) :=
+ ST.Dispatching_Domain_Tasks (CPU) + 1;
end if;
end if;
Index: aspects.adb
===================================================================
--- aspects.adb (revision 178381)
+++ aspects.adb (working copy)
@@ -219,6 +219,7 @@
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,
Index: aspects.ads
===================================================================
--- aspects.ads (revision 178381)
+++ aspects.ads (working copy)
@@ -50,6 +50,7 @@
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 @@
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 @@
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,
Index: sem_ch13.adb
===================================================================
--- sem_ch13.adb (revision 178381)
+++ sem_ch13.adb (working copy)
@@ -1151,7 +1151,8 @@
when Aspect_Priority |
Aspect_Interrupt_Priority |
- Aspect_Dispatching_Domain =>
+ Aspect_Dispatching_Domain |
+ Aspect_CPU =>
declare
Pname : Name_Id;
begin
@@ -1161,6 +1162,9 @@
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 @@
-- 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 @@
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 @@
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);
Index: s-taskin.adb
===================================================================
--- s-taskin.adb (revision 178381)
+++ s-taskin.adb (working copy)
@@ -189,6 +189,8 @@
Base_CPU : System.Multiprocessors.CPU_Range;
Success : Boolean;
+ use type System.Multiprocessors.CPU_Range;
+
begin
if Initialized then
return;
@@ -233,10 +235,21 @@
T.Common.Domain := System_Domain;
- -- ??? 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.
+ Dispatching_Domain_Tasks :=
+ new Array_Allocated_Tasks'
+ (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.
Index: s-taskin.ads
===================================================================
--- s-taskin.ads (revision 178381)
+++ s-taskin.ads (working copy)
@@ -394,8 +394,44 @@
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 --
------------------------------------
