mirror of git://gcc.gnu.org/git/gcc.git
[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
This commit is contained in:
parent
2d42e8812e
commit
516f608f15
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
-- --
|
||||
-- GNAT LIBRARY COMPONENTS --
|
||||
-- --
|
||||
-- ADA.CONTAINERS.BOUNDED_PRIORITY_QUEUES --
|
||||
-- ADA.CONTAINERS.BOUNDED_PRIORITY_QUEUES --
|
||||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
-- --
|
||||
-- GNAT LIBRARY COMPONENTS --
|
||||
-- --
|
||||
-- ADA.CONTAINERS.BOUNDED_SYNCHRONIZED_QUEUES --
|
||||
-- ADA.CONTAINERS.BOUNDED_SYNCHRONIZED_QUEUES --
|
||||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
-- --
|
||||
-- GNAT LIBRARY COMPONENTS --
|
||||
-- --
|
||||
-- ADA.CONTAINERS.BOUNDED_SYNCHRONIZED_QUEUES --
|
||||
-- ADA.CONTAINERS.BOUNDED_SYNCHRONIZED_QUEUES --
|
||||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -2,7 +2,7 @@
|
|||
-- --
|
||||
-- GNAT LIBRARY COMPONENTS --
|
||||
-- --
|
||||
-- ADA.CONTAINERS.UNBOUNDED_PRIORITY_QUEUES --
|
||||
-- ADA.CONTAINERS.UNBOUNDED_PRIORITY_QUEUES --
|
||||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
|
|
|
|||
|
|
@ -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,
|
||||
|
|
|
|||
|
|
@ -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,
|
||||
|
|
|
|||
|
|
@ -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) :=
|
||||
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;
|
||||
|
||||
|
|
|
|||
|
|
@ -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 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.
|
||||
|
|
|
|||
|
|
@ -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 --
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue