From 516f608f15dcef7a20a2e178c57e3e8078784331 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Thu, 1 Sep 2011 12:36:43 +0200 Subject: [PATCH] [multiple changes] 2011-09-01 Robert Dewar * 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 * sem_attr.adb: Conditionalize aliasing predicates to Ada2012. 2011-09-01 Jose Ruiz * 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 | 34 ++++++++++++++++++++++++++++++++++ gcc/ada/a-cbprqu.adb | 2 +- gcc/ada/a-cbprqu.ads | 3 ++- gcc/ada/a-cbsyqu.adb | 2 +- gcc/ada/a-cbsyqu.ads | 2 +- gcc/ada/a-cuprqu.adb | 3 +-- gcc/ada/a-cuprqu.ads | 2 +- gcc/ada/aspects.adb | 1 + gcc/ada/aspects.ads | 3 +++ gcc/ada/s-mudido-affinity.adb | 32 +++++++++----------------------- gcc/ada/s-taskin.adb | 19 ++++++++++++++++--- gcc/ada/s-taskin.ads | 38 +++++++++++++++++++++++++++++++++++++- gcc/ada/s-tassta.adb | 36 ++++++++++++++++++++++++++++++++---- gcc/ada/sem_attr.adb | 13 +++++++++++++ gcc/ada/sem_ch13.adb | 16 +++++++++++++--- 15 files changed, 165 insertions(+), 41 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 936a209..b8dea0d 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,37 @@ +2011-09-01 Robert Dewar + + * 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 + + * sem_attr.adb: Conditionalize aliasing predicates to Ada2012. + +2011-09-01 Jose Ruiz + + * 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 * exp_attr.adb, sem_attr.adb, snames.ads-tmpl: Implementation of diff --git a/gcc/ada/a-cbprqu.adb b/gcc/ada/a-cbprqu.adb index 99c9f08..ca04912 100644 --- a/gcc/ada/a-cbprqu.adb +++ b/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 -- -- -- diff --git a/gcc/ada/a-cbprqu.ads b/gcc/ada/a-cbprqu.ads index 1ee087a..9caef34 100644 --- a/gcc/ada/a-cbprqu.ads +++ b/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; diff --git a/gcc/ada/a-cbsyqu.adb b/gcc/ada/a-cbsyqu.adb index 7f8400e..cb2cbc5 100644 --- a/gcc/ada/a-cbsyqu.adb +++ b/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 -- -- -- diff --git a/gcc/ada/a-cbsyqu.ads b/gcc/ada/a-cbsyqu.ads index ab4a31c..26e86bc 100644 --- a/gcc/ada/a-cbsyqu.ads +++ b/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 -- -- -- diff --git a/gcc/ada/a-cuprqu.adb b/gcc/ada/a-cuprqu.adb index f83ca42..c1da3ee 100644 --- a/gcc/ada/a-cuprqu.adb +++ b/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; diff --git a/gcc/ada/a-cuprqu.ads b/gcc/ada/a-cuprqu.ads index c06faf3..ac5b19e 100644 --- a/gcc/ada/a-cuprqu.ads +++ b/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 -- -- -- diff --git a/gcc/ada/aspects.adb b/gcc/ada/aspects.adb index 5d374c8..48a1c89 100755 --- a/gcc/ada/aspects.adb +++ b/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, diff --git a/gcc/ada/aspects.ads b/gcc/ada/aspects.ads index 82ddec2..fc110d6b 100755 --- a/gcc/ada/aspects.ads +++ b/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, diff --git a/gcc/ada/s-mudido-affinity.adb b/gcc/ada/s-mudido-affinity.adb index c72dc39..35239b8 100644 --- a/gcc/ada/s-mudido-affinity.adb +++ b/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; diff --git a/gcc/ada/s-taskin.adb b/gcc/ada/s-taskin.adb index feb1fe9..17af062 100644 --- a/gcc/ada/s-taskin.adb +++ b/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. diff --git a/gcc/ada/s-taskin.ads b/gcc/ada/s-taskin.ads index 67e380a..6200d20 100644 --- a/gcc/ada/s-taskin.ads +++ b/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 -- diff --git a/gcc/ada/s-tassta.adb b/gcc/ada/s-tassta.adb index 994b395..3711ce3 100644 --- a/gcc/ada/s-tassta.adb +++ b/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. diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 119f6df..26fdcfa 100644 --- a/gcc/ada/sem_attr.adb +++ b/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 diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index f703a5b..0eb4ed7 100644 --- a/gcc/ada/sem_ch13.adb +++ b/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); -- 2.7.4