Skip to content

R
riscv-gcc-1
Commit 516f608f by Arnaud Charlet
Options

[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
parent 2d42e881
Showing with 165 additions and 41 deletions
gcc/ada/ChangeLog
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) :=
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;
......
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 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.
......
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);
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment