+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
-- --
-- GNAT LIBRARY COMPONENTS --
-- --
--- ADA.CONTAINERS.BOUNDED_PRIORITY_QUEUES --
+-- ADA.CONTAINERS.BOUNDED_PRIORITY_QUEUES --
-- --
-- B o d y --
-- --
-- --
-- GNAT LIBRARY COMPONENTS --
-- --
--- ADA.CONTAINERS.BOUNDED_PRIORITY_QUEUES --
+-- ADA.CONTAINERS.BOUNDED_PRIORITY_QUEUES --
-- --
-- S p e c --
-- --
------------------------------------------------------------------------------
with System;
+
with Ada.Containers.Synchronized_Queue_Interfaces;
with Ada.Containers.Bounded_Doubly_Linked_Lists;
-- --
-- GNAT LIBRARY COMPONENTS --
-- --
--- ADA.CONTAINERS.BOUNDED_SYNCHRONIZED_QUEUES --
+-- ADA.CONTAINERS.BOUNDED_SYNCHRONIZED_QUEUES --
-- --
-- B o d y --
-- --
-- --
-- GNAT LIBRARY COMPONENTS --
-- --
--- ADA.CONTAINERS.BOUNDED_SYNCHRONIZED_QUEUES --
+-- ADA.CONTAINERS.BOUNDED_SYNCHRONIZED_QUEUES --
-- --
-- S p e c --
-- --
-- --
-- GNAT LIBRARY COMPONENTS --
-- --
--- ADA.CONTAINERS.UNBOUNDED_PRIORITY_QUEUES --
+-- ADA.CONTAINERS.UNBOUNDED_PRIORITY_QUEUES --
-- --
-- B o d y --
-- --
procedure Finalize (List : in out List_Type) is
X : Node_Access;
-
begin
while List.First /= null loop
X := List.First;
-- --
-- GNAT LIBRARY COMPONENTS --
-- --
--- ADA.CONTAINERS.UNBOUNDED_PRIORITY_QUEUES --
+-- ADA.CONTAINERS.UNBOUNDED_PRIORITY_QUEUES --
-- --
-- S p e c --
-- --
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,
Aspect_Bit_Order,
Aspect_Component_Size,
Aspect_Constant_Indexing,
+ Aspect_CPU,
Aspect_Default_Component_Value,
Aspect_Default_Iterator,
Aspect_Default_Value,
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,
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,
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 --
-----------------------
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 :=
"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";
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;
begin
-- Signal the end of the elaboration code
- Dispatching_Domains_Frozen := True;
+ ST.Dispatching_Domains_Frozen := True;
end Freeze_Dispatching_Domains;
-------------
-- 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;
Base_CPU : System.Multiprocessors.CPU_Range;
Success : Boolean;
+ use type System.Multiprocessors.CPU_Range;
+
begin
if Initialized then
return;
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.
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 --
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.
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;
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.
----------------------
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
------------------
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
when Aspect_Priority |
Aspect_Interrupt_Priority |
- Aspect_Dispatching_Domain =>
+ Aspect_Dispatching_Domain |
+ Aspect_CPU =>
declare
Pname : Name_Id;
begin
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;
-- 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
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)));
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);
projects / platform / upstream / gcc.git / commitdiff