diff options
author | Arnaud Charlet <charlet@gcc.gnu.org> | 2012-11-06 10:44:51 +0100 |
---|---|---|
committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2012-11-06 10:44:51 +0100 |
commit | 6bc057a79e2cef15d7dfd1170c1043cb0f271b04 (patch) | |
tree | a6504859fca4e60b28f22d72a2d374e0cfd7e0a9 /gcc | |
parent | 3c55062f3030f6dcd365f89ba9ecfea2131889b4 (diff) | |
download | gcc-6bc057a79e2cef15d7dfd1170c1043cb0f271b04.zip gcc-6bc057a79e2cef15d7dfd1170c1043cb0f271b04.tar.gz gcc-6bc057a79e2cef15d7dfd1170c1043cb0f271b04.tar.bz2 |
[multiple changes]
2012-11-06 Thomas Quinot <quinot@adacore.com>
* s-oscons-tmplt.c: Interfaces.C now needs to be WITH'd even
on platforms that do not support sockets (for the benefit of
subtype IOCTL_Req_T).
2012-11-06 Ed Schonberg <schonberg@adacore.com>
* par-ch4.adb (P_Primary): if-expressions, case-expressions,
and quantified expressions are legal if surrounded by parentheses
from an enclosing context, such as a call or an instantiation.
2012-11-06 Yannick Moy <moy@adacore.com>
* impunit.adb (Get_Kind_Of_Unit): Return appropriate kind for
predefined implementation files, instead of returning
Not_Predefined_Unit on all .adb files.
2012-11-06 Tristan Gingold <gingold@adacore.com>
* exp_ch9.adb (Build_Activation_Chain_Entity): Return immediately if
partition elaboration policy is sequential.
(Build_Task_Activation_Call): Likewise. Use
Activate_Restricted_Tasks on restricted profile.
(Make_Task_Create_Call): Do not use the _Chain
parameter if elaboration policy is sequential. Call
Create_Restricted_Task_Sequential in that case.
* exp_ch3.adb (Build_Initialization_Call): Change condition to
support concurrent elaboration policy.
(Build_Record_Init_Proc): Likewise.
(Init_Formals): Likewise.
* bindgen.adb (Gen_Adainit): Declare Partition_Elaboration_Policy
and set it in generated code if the elaboration policy is
sequential. The procedure called to activate all tasks is now
named __gnat_activate_all_tasks.
* rtsfind.adb (RE_Activate_Restricted_Task,
RE_Create_Restricted_Task_Sequential): New RE_Id literals.
* s-tarest.adb (Create_Restricted_Task): Added to create a task without
adding it on an activation chain.
(Activate_Tasks): Has now a Chain parameter.
(Activate_All_Tasks_Sequential): Added. Called by the binder to
activate all tasks.
(Activate_Restricted_Tasks): Added. Called during elaboration to
activate tasks of the units.
* s-tarest.ads: Remove pragma Partition_Elaboration_Policy.
(Partition_Elaboration_Policy): New variable (set by the binder).
(Create_Restricted_Task): Revert removal of the chain parameter.
(Create_Restricted_Task_Sequential): New procedure.
(Activate_Restricted_Tasks): Revert removal.
(Activate_All_Tasks_Sequential): New procedure.
From-SVN: r193214
Diffstat (limited to 'gcc')
-rw-r--r-- | gcc/ada/ChangeLog | 51 | ||||
-rw-r--r-- | gcc/ada/bindgen.adb | 53 | ||||
-rw-r--r-- | gcc/ada/exp_ch3.adb | 20 | ||||
-rw-r--r-- | gcc/ada/exp_ch9.adb | 43 | ||||
-rw-r--r-- | gcc/ada/impunit.adb | 14 | ||||
-rw-r--r-- | gcc/ada/par-ch4.adb | 38 | ||||
-rw-r--r-- | gcc/ada/rtsfind.ads | 20 | ||||
-rw-r--r-- | gcc/ada/s-oscons-tmplt.c | 7 | ||||
-rw-r--r-- | gcc/ada/s-tarest.adb | 119 | ||||
-rw-r--r-- | gcc/ada/s-tarest.ads | 64 |
10 files changed, 349 insertions, 80 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index fb23cb3..3d1ba27 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,54 @@ +2012-11-06 Thomas Quinot <quinot@adacore.com> + + * s-oscons-tmplt.c: Interfaces.C now needs to be WITH'd even + on platforms that do not support sockets (for the benefit of + subtype IOCTL_Req_T). + +2012-11-06 Ed Schonberg <schonberg@adacore.com> + + * par-ch4.adb (P_Primary): if-expressions, case-expressions, + and quantified expressions are legal if surrounded by parentheses + from an enclosing context, such as a call or an instantiation. + +2012-11-06 Yannick Moy <moy@adacore.com> + + * impunit.adb (Get_Kind_Of_Unit): Return appropriate kind for + predefined implementation files, instead of returning + Not_Predefined_Unit on all .adb files. + +2012-11-06 Tristan Gingold <gingold@adacore.com> + + * exp_ch9.adb (Build_Activation_Chain_Entity): Return immediately if + partition elaboration policy is sequential. + (Build_Task_Activation_Call): Likewise. Use + Activate_Restricted_Tasks on restricted profile. + (Make_Task_Create_Call): Do not use the _Chain + parameter if elaboration policy is sequential. Call + Create_Restricted_Task_Sequential in that case. + * exp_ch3.adb (Build_Initialization_Call): Change condition to + support concurrent elaboration policy. + (Build_Record_Init_Proc): Likewise. + (Init_Formals): Likewise. + * bindgen.adb (Gen_Adainit): Declare Partition_Elaboration_Policy + and set it in generated code if the elaboration policy is + sequential. The procedure called to activate all tasks is now + named __gnat_activate_all_tasks. + * rtsfind.adb (RE_Activate_Restricted_Task, + RE_Create_Restricted_Task_Sequential): New RE_Id literals. + * s-tarest.adb (Create_Restricted_Task): Added to create a task without + adding it on an activation chain. + (Activate_Tasks): Has now a Chain parameter. + (Activate_All_Tasks_Sequential): Added. Called by the binder to + activate all tasks. + (Activate_Restricted_Tasks): Added. Called during elaboration to + activate tasks of the units. + * s-tarest.ads: Remove pragma Partition_Elaboration_Policy. + (Partition_Elaboration_Policy): New variable (set by the binder). + (Create_Restricted_Task): Revert removal of the chain parameter. + (Create_Restricted_Task_Sequential): New procedure. + (Activate_Restricted_Tasks): Revert removal. + (Activate_All_Tasks_Sequential): New procedure. + 2012-11-06 Bernard Banner <banner@adacore.com> * adaint.c Add file macro definitions missing on Android. diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb index e178a57..f4260a3 100644 --- a/gcc/ada/bindgen.adb +++ b/gcc/ada/bindgen.adb @@ -488,10 +488,16 @@ package body Bindgen is WBI (""); end if; - if System_Tasking_Restricted_Stages_Used then - WBI (" procedure Activate_Tasks;"); - WBI (" pragma Import (C, Activate_Tasks," & - " ""__gnat_activate_tasks"");"); + if System_Tasking_Restricted_Stages_Used + and then Partition_Elaboration_Policy_Specified = 'S' + then + WBI (" Partition_Elaboration_Policy : Character;"); + WBI (" pragma Import (C, Partition_Elaboration_Policy," & + " ""__gnat_partition_elaboration_policy"");"); + WBI (""); + WBI (" procedure Activate_All_Tasks_Sequential;"); + WBI (" pragma Import (C, Activate_All_Tasks_Sequential," & + " ""__gnat_activate_all_tasks"");"); end if; WBI (" begin"); @@ -510,8 +516,18 @@ package body Bindgen is Write_Statement_Buffer; end if; + if System_Tasking_Restricted_Stages_Used + and then Partition_Elaboration_Policy_Specified = 'S' + then + Set_String (" Partition_Elaboration_Policy := '"); + Set_Char (Partition_Elaboration_Policy_Specified); + Set_String ("';"); + Write_Statement_Buffer; + end if; + if Main_Priority = No_Main_Priority and then Main_CPU = No_Main_CPU + and then not System_Tasking_Restricted_Stages_Used then WBI (" null;"); end if; @@ -587,10 +603,16 @@ package body Bindgen is -- Import task activation procedure for ravenscar - if System_Tasking_Restricted_Stages_Used then - WBI (" procedure Activate_Tasks;"); - WBI (" pragma Import (C, Activate_Tasks," & - " ""__gnat_activate_tasks"");"); + if System_Tasking_Restricted_Stages_Used + and then Partition_Elaboration_Policy_Specified = 'S' + then + WBI (" Partition_Elaboration_Policy : Character;"); + WBI (" pragma Import (C, Partition_Elaboration_Policy," & + " ""__gnat_partition_elaboration_policy"");"); + WBI (""); + WBI (" procedure Activate_All_Tasks_Sequential;"); + WBI (" pragma Import (C, Activate_All_Tasks_Sequential," & + " ""__gnat_activate_all_tasks"");"); end if; -- The import of the soft link which performs library-level object @@ -727,6 +749,15 @@ package body Bindgen is Set_String ("';"); Write_Statement_Buffer; + if System_Tasking_Restricted_Stages_Used + and then Partition_Elaboration_Policy_Specified = 'S' + then + Set_String (" Partition_Elaboration_Policy := '"); + Set_Char (Partition_Elaboration_Policy_Specified); + Set_String ("';"); + Write_Statement_Buffer; + end if; + Gen_Restrictions; WBI (" Priority_Specific_Dispatching :="); @@ -913,8 +944,10 @@ package body Bindgen is WBI (" Freeze_Dispatching_Domains;"); end if; - if System_Tasking_Restricted_Stages_Used then - WBI (" Activate_Tasks;"); + if System_Tasking_Restricted_Stages_Used + and then Partition_Elaboration_Policy_Specified = 'S' + then + WBI (" Activate_All_Tasks_Sequential;"); end if; -- Case of main program is CIL function or procedure diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index f7081a6..2434d5b 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -1537,10 +1537,10 @@ package body Exp_Ch3 is Append_To (Args, Make_Identifier (Loc, Name_uMaster)); end if; - -- Add _Chain (not done in the restricted profile because not used, - -- see comment for Create_Restricted_Task in s-tarest.ads). + -- Add _Chain (not done for sequential elaboration policy, see + -- comment for Create_Restricted_Task_Sequential in s-tarest.ads). - if not Restricted_Profile then + if Partition_Elaboration_Policy /= 'S' then Append_To (Args, Make_Identifier (Loc, Name_uChain)); end if; @@ -2004,11 +2004,10 @@ package body Exp_Ch3 is Append_To (Args, Make_Identifier (Loc, Name_uMaster)); end if; - if not Restricted_Profile then - - -- No _Chain for the restricted profile because not used, - -- see comment of Create_Restricted_Task in s-tarest.ads. + -- Add _Chain (not done for sequential elaboration policy, see + -- comment for Create_Restricted_Task_Sequential in s-tarest.ads). + if Partition_Elaboration_Policy /= 'S' then Append_To (Args, Make_Identifier (Loc, Name_uChain)); end if; @@ -7793,11 +7792,10 @@ package body Exp_Ch3 is Parameter_Type => New_Reference_To (RTE (RE_Master_Id), Loc))); - if not Restricted_Profile then - - -- No _Chain for the restricted profile because not used, see - -- comment for Create_Restricted_Task in s-tarest.ads. + -- Add _Chain (not done for sequential elaboration policy, see + -- comment for Create_Restricted_Task_Sequential in s-tarest.ads). + if Partition_Elaboration_Policy /= 'S' then Append_To (Formals, Make_Parameter_Specification (Loc, Defining_Identifier => diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index 82a7a30..f148e81 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -911,10 +911,10 @@ package body Exp_Ch9 is -- Start of processing for Build_Activation_Chain_Entity begin - -- Activation chain is never used in restricted profile, see comment - -- for Create_Restricted_Task in s-tarest.ads. + -- Activation chain is never used for sequential elaboration policy, see + -- comment for Create_Restricted_Task_Sequential in s-tarest.ads). - if Restricted_Profile then + if Partition_Elaboration_Policy = 'S' then return; end if; @@ -4900,10 +4900,10 @@ package body Exp_Ch9 is P : Node_Id; begin - -- On restricted profile, all the tasks will be activated at the end - -- of the elaboration (Sequential elaboration policy). + -- For sequential elaboration policy, all the tasks will be activated at + -- the end of the elaboration. - if Restricted_Profile then + if Partition_Elaboration_Policy = 'S' then return; end if; @@ -4925,7 +4925,11 @@ package body Exp_Ch9 is end if; if Present (Chain) then - Name := New_Reference_To (RTE (RE_Activate_Tasks), Loc); + if Restricted_Profile then + Name := New_Reference_To (RTE (RE_Activate_Restricted_Tasks), Loc); + else + Name := New_Reference_To (RTE (RE_Activate_Tasks), Loc); + end if; Call := Make_Procedure_Call_Statement (Loc, @@ -13980,10 +13984,10 @@ package body Exp_Ch9 is Prefix => Make_Identifier (Loc, New_External_Name (Tnam, 'E')), Attribute_Name => Name_Unchecked_Access)); - -- Chain parameter. This is a reference to the Chain parameter of the - -- initialization procedure. There is no chain in restricted profile. + -- Add Chain parameter (not done for sequential elaboration policy, see + -- comment for Create_Restricted_Task_Sequential in s-tarest.ads). - if not Restricted_Profile then + if Partition_Elaboration_Policy /= 'S' then Append_To (Args, Make_Identifier (Loc, Name_uChain)); end if; @@ -14015,11 +14019,20 @@ package body Exp_Ch9 is Prefix => Make_Identifier (Loc, Name_uInit), Selector_Name => Make_Identifier (Loc, Name_uTask_Id))); - if Restricted_Profile then - Name := New_Reference_To (RTE (RE_Create_Restricted_Task), Loc); - else - Name := New_Reference_To (RTE (RE_Create_Task), Loc); - end if; + declare + Create_RE : RE_Id; + begin + if Restricted_Profile then + if Partition_Elaboration_Policy = 'S' then + Create_RE := RE_Create_Restricted_Task_Sequential; + else + Create_RE := RE_Create_Restricted_Task; + end if; + else + Create_RE := RE_Create_Task; + end if; + Name := New_Reference_To (RTE (Create_RE), Loc); + end; return Make_Procedure_Call_Statement (Loc, diff --git a/gcc/ada/impunit.adb b/gcc/ada/impunit.adb index 712a688..ad4902a 100644 --- a/gcc/ada/impunit.adb +++ b/gcc/ada/impunit.adb @@ -663,10 +663,16 @@ package body Impunit is return Not_Predefined_Unit; end if; - -- Not predefined if file name does not end in .ads. This can - -- happen when non-standard file names are being used. - - if Name_Buffer (Name_Len - 3 .. Name_Len) /= ".ads" then + -- Not predefined if file name does not end in .ads or .adb. This can + -- happen when non-standard file names are being used. Calling this + -- function on a .adb file is used in GNATprove to detect when a + -- construct comes from an instance of a generic defined in a predefined + -- unit. + + if Name_Buffer (Name_Len - 3 .. Name_Len) /= ".ads" + and then + Name_Buffer (Name_Len - 3 .. Name_Len) /= ".adb" + then return Not_Predefined_Unit; end if; diff --git a/gcc/ada/par-ch4.adb b/gcc/ada/par-ch4.adb index 352feea..c3a7a4a 100644 --- a/gcc/ada/par-ch4.adb +++ b/gcc/ada/par-ch4.adb @@ -2359,6 +2359,8 @@ package body Ch4 is -- Error recovery: can raise Error_Resync function P_Primary return Node_Id is + Lparen : constant Boolean := Prev_Token = Tok_Left_Paren; + Scan_State : Saved_Scan_State; Node1 : Node_Id; @@ -2475,11 +2477,18 @@ package body Ch4 is return Error; -- If this looks like an if expression, then treat it that way - -- with an error message. + -- with an error message if not explicitly surrounded by + -- parentheses. elsif Ada_Version >= Ada_2012 then - Error_Msg_SC ("if expression must be parenthesized"); - return P_If_Expression; + Node1 := P_If_Expression; + + if not (Lparen and then Token = Tok_Right_Paren) then + Error_Msg + ("if expression must be parenthesized", Sloc (Node1)); + end if; + + return Node1; -- Otherwise treat as misused identifier @@ -2507,11 +2516,17 @@ package body Ch4 is return Error; -- If this looks like a case expression, then treat it that way - -- with an error message. + -- with an error message if not within parentheses. elsif Ada_Version >= Ada_2012 then - Error_Msg_SC ("case expression must be parenthesized"); - return P_Case_Expression; + Node1 := P_Case_Expression; + + if not (Lparen and then Token = Tok_Right_Paren) then + Error_Msg + ("case expression must be parenthesized", Sloc (Node1)); + end if; + + return Node1; -- Otherwise treat as misused identifier @@ -2528,8 +2543,15 @@ package body Ch4 is return Error; elsif Ada_Version >= Ada_2012 then - Error_Msg_SC ("quantified expression must be parenthesized"); - return P_Quantified_Expression; + Node1 := P_Quantified_Expression; + + if not (Lparen and then Token = Tok_Right_Paren) then + Error_Msg + ("quantified expression must be parenthesized", + Sloc (Node1)); + end if; + + return Node1; else diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads index 5f9c993..2bfbaa8 100644 --- a/gcc/ada/rtsfind.ads +++ b/gcc/ada/rtsfind.ads @@ -1762,10 +1762,12 @@ package Rtsfind is RE_Timed_Task_Entry_Call, -- System.Tasking.Rendezvous RE_Timed_Selective_Wait, -- System.Tasking.Rendezvous - RE_Complete_Restricted_Activation, -- System.Tasking.Restricted.Stages - RE_Create_Restricted_Task, -- System.Tasking.Restricted.Stages - RE_Complete_Restricted_Task, -- System.Tasking.Restricted.Stages - RE_Restricted_Terminated, -- System.Tasking.Restricted.Stages + RE_Activate_Restricted_Tasks, -- System.Tasking.Restricted.Stages + RE_Complete_Restricted_Activation, -- System.Tasking.Restricted.Stages + RE_Create_Restricted_Task, -- System.Tasking.Restricted.Stages + RE_Create_Restricted_Task_Sequential, -- System.Tasking.Restricted.Stages + RE_Complete_Restricted_Task, -- System.Tasking.Restricted.Stages + RE_Restricted_Terminated, -- System.Tasking.Restricted.Stages RE_Abort_Tasks, -- System.Tasking.Stages RE_Activate_Tasks, -- System.Tasking.Stages @@ -3054,10 +3056,12 @@ package Rtsfind is RE_Timed_Task_Entry_Call => System_Tasking_Rendezvous, RE_Timed_Selective_Wait => System_Tasking_Rendezvous, - RE_Complete_Restricted_Activation => System_Tasking_Restricted_Stages, - RE_Create_Restricted_Task => System_Tasking_Restricted_Stages, - RE_Complete_Restricted_Task => System_Tasking_Restricted_Stages, - RE_Restricted_Terminated => System_Tasking_Restricted_Stages, + RE_Activate_Restricted_Tasks => System_Tasking_Restricted_Stages, + RE_Complete_Restricted_Activation => System_Tasking_Restricted_Stages, + RE_Create_Restricted_Task => System_Tasking_Restricted_Stages, + RE_Create_Restricted_Task_Sequential => System_Tasking_Restricted_Stages, + RE_Complete_Restricted_Task => System_Tasking_Restricted_Stages, + RE_Restricted_Terminated => System_Tasking_Restricted_Stages, RE_Abort_Tasks => System_Tasking_Stages, RE_Activate_Tasks => System_Tasking_Stages, diff --git a/gcc/ada/s-oscons-tmplt.c b/gcc/ada/s-oscons-tmplt.c index c386a1f..0964886 100644 --- a/gcc/ada/s-oscons-tmplt.c +++ b/gcc/ada/s-oscons-tmplt.c @@ -252,14 +252,7 @@ main (void) { **/ TXT("-- This is the version for " TARGET) TXT("") - -#ifdef HAVE_SOCKETS -/** - ** The type definitions for struct hostent components uses Interfaces.C - **/ - TXT("with Interfaces.C;") -#endif /* package System.OS_Constants is diff --git a/gcc/ada/s-tarest.adb b/gcc/ada/s-tarest.adb index bba83ab..ec94313 100644 --- a/gcc/ada/s-tarest.adb +++ b/gcc/ada/s-tarest.adb @@ -111,6 +111,24 @@ package body System.Tasking.Restricted.Stages is -- Terminate the calling task. -- This should only be called by the Task_Wrapper procedure. + procedure Create_Restricted_Task + (Priority : Integer; + Stack_Address : System.Address; + Size : System.Parameters.Size_Type; + Task_Info : System.Task_Info.Task_Info_Type; + CPU : Integer; + State : Task_Procedure_Access; + Discriminants : System.Address; + Elaborated : Access_Boolean; + Task_Image : String; + Created_Task : Task_Id); + -- Code shared between Create_Restricted_Task_Concurrent and + -- Create_Restricted_Task_Sequential. See comment of the former in the + -- specification of this package. + + procedure Activate_Tasks (Chain : Task_Id); + -- Activate the list of tasks started by Chain + procedure Init_RTS; -- This procedure performs the initialization of the GNARL. -- It consists of initializing the environment task, global locks, and @@ -301,6 +319,40 @@ package body System.Tasking.Restricted.Stages is -- Restricted GNARLI -- ----------------------- + ----------------------------------- + -- Activate_All_Tasks_Sequential -- + ----------------------------------- + + procedure Activate_All_Tasks_Sequential is + begin + pragma Assert (Partition_Elaboration_Policy = 'S'); + + Activate_Tasks (Tasks_Activation_Chain); + Tasks_Activation_Chain := Null_Task; + end Activate_All_Tasks_Sequential; + + ------------------------------- + -- Activate_Restricted_Tasks -- + ------------------------------- + + procedure Activate_Restricted_Tasks + (Chain_Access : Activation_Chain_Access) is + begin + if Partition_Elaboration_Policy = 'S' then + + -- In sequential elaboration policy, the chain must be empty. This + -- procedure can be called if the unit has been compiled without + -- partition elaboration policy, but the partition has a sequential + -- elaboration policy. + + pragma Assert (Chain_Access.T_ID = Null_Task); + null; + else + Activate_Tasks (Chain_Access.T_ID); + Chain_Access.T_ID := Null_Task; + end if; + end Activate_Restricted_Tasks; + -------------------- -- Activate_Tasks -- -------------------- @@ -311,7 +363,7 @@ package body System.Tasking.Restricted.Stages is -- created before the activated task. That satisfies our -- in-order-of-creation ATCB locking policy. - procedure Activate_Tasks is + procedure Activate_Tasks (Chain : Task_Id) is Self_ID : constant Task_Id := STPO.Self; C : Task_Id; Activate_Prio : System.Any_Priority; @@ -333,7 +385,7 @@ package body System.Tasking.Restricted.Stages is -- Activate all the tasks in the chain. Creation of the thread of -- control was deferred until activation. So create it now. - C := Tasks_Activation_Chain; + C := Chain; while C /= null loop if C.Common.State /= Terminated then pragma Assert (C.Common.State = Unactivated); @@ -381,10 +433,6 @@ package body System.Tasking.Restricted.Stages is if Single_Lock then Unlock_RTS; end if; - - -- Remove the tasks from the chain - - Tasks_Activation_Chain := null; end Activate_Tasks; ------------------------------------ @@ -557,9 +605,66 @@ package body System.Tasking.Restricted.Stages is -- may be used by the operation of Ada code within the task. SSL.Create_TSD (Created_Task.Common.Compiler_Data); + end Create_Restricted_Task; + + procedure Create_Restricted_Task + (Priority : Integer; + Stack_Address : System.Address; + Size : System.Parameters.Size_Type; + Task_Info : System.Task_Info.Task_Info_Type; + CPU : Integer; + State : Task_Procedure_Access; + Discriminants : System.Address; + Elaborated : Access_Boolean; + Chain : in out Activation_Chain; + Task_Image : String; + Created_Task : Task_Id) is + begin + Create_Restricted_Task (Priority, Stack_Address, Size, Task_Info, + CPU, State, Discriminants, Elaborated, + Task_Image, Created_Task); + + -- Append this task to the activation chain + + if Partition_Elaboration_Policy = 'S' then + + -- In fact the elaboration policy is sequential, add this task to + -- the global activation chain to defer its activation. + + Created_Task.Common.Activation_Link := Tasks_Activation_Chain; + Tasks_Activation_Chain := Created_Task; + + else + Created_Task.Common.Activation_Link := Chain.T_ID; + Chain.T_ID := Created_Task; + end if; + end Create_Restricted_Task; + + --------------------------------------- + -- Create_Restricted_Task_Sequential -- + --------------------------------------- + + procedure Create_Restricted_Task_Sequential + (Priority : Integer; + Stack_Address : System.Address; + Size : System.Parameters.Size_Type; + Task_Info : System.Task_Info.Task_Info_Type; + CPU : Integer; + State : Task_Procedure_Access; + Discriminants : System.Address; + Elaborated : Access_Boolean; + Task_Image : String; + Created_Task : Task_Id) is + begin + Create_Restricted_Task (Priority, Stack_Address, Size, Task_Info, + CPU, State, Discriminants, Elaborated, + Task_Image, Created_Task); + + -- Append this task to the activation chain + Created_Task.Common.Activation_Link := Tasks_Activation_Chain; Tasks_Activation_Chain := Created_Task; - end Create_Restricted_Task; + end Create_Restricted_Task_Sequential; --------------------------- -- Finalize_Global_Tasks -- diff --git a/gcc/ada/s-tarest.ads b/gcc/ada/s-tarest.ads index c876975..6313be6 100644 --- a/gcc/ada/s-tarest.ads +++ b/gcc/ada/s-tarest.ads @@ -43,10 +43,6 @@ -- The restricted GNARLI is also composed of System.Protected_Objects and -- System.Protected_Objects.Single_Entry -pragma Partition_Elaboration_Policy (Sequential); --- This package only implements the sequential elaboration policy. This pragma --- will enforce it (and detect conflicts with user specified policy). - with System.Task_Info; with System.Parameters; @@ -124,6 +120,13 @@ package System.Tasking.Restricted.Stages is -- t1S : constant String := "t1"; -- tIP (t1, 3, _chain, t1S, 1); + Partition_Elaboration_Policy : Character := 'C'; + pragma Export (C, Partition_Elaboration_Policy, + "__gnat_partition_elaboration_policy"); + -- Partition elaboration policy. Value can be either 'C' for concurrent, + -- which is the default or 'S' for sequential. This value can be modified + -- by the binder generated code, before calling elaboration code. + procedure Create_Restricted_Task (Priority : Integer; Stack_Address : System.Address; @@ -133,10 +136,12 @@ package System.Tasking.Restricted.Stages is State : Task_Procedure_Access; Discriminants : System.Address; Elaborated : Access_Boolean; + Chain : in out Activation_Chain; Task_Image : String; Created_Task : Task_Id); -- Compiler interface only. Do not call from within the RTS. - -- This must be called to create a new task. + -- This must be called to create a new task, when the partition + -- elaboration policy is not specified (or is concurrent). -- -- Priority is the task's priority (assumed to be in the -- System.Any_Priority'Range) @@ -165,19 +170,58 @@ package System.Tasking.Restricted.Stages is -- Elaborated is a pointer to a Boolean that must be set to true on exit -- if the task could be successfully elaborated. -- + -- Chain is a linked list of task that needs to be created. On exit, + -- Created_Task.Activation_Link will be Chain.T_ID, and Chain.T_ID will be + -- Created_Task (the created task will be linked at the front of Chain). + -- -- Task_Image is a string created by the compiler that the run time can -- store to ease the debugging and the Ada.Task_Identification facility. -- -- Created_Task is the resulting task. -- -- This procedure can raise Storage_Error if the task creation fails + + procedure Create_Restricted_Task_Sequential + (Priority : Integer; + Stack_Address : System.Address; + Size : System.Parameters.Size_Type; + Task_Info : System.Task_Info.Task_Info_Type; + CPU : Integer; + State : Task_Procedure_Access; + Discriminants : System.Address; + Elaborated : Access_Boolean; + Task_Image : String; + Created_Task : Task_Id); + -- Compiler interface only. Do not call from within the RTS. + -- This must be called to create a new task, when the sequential partition + -- elaboration policy is used. + -- + -- The parameters are the same as Create_Restricted_Task_Concurrent, + -- except there is no Chain parameter (for the activation chain), as there + -- is only one global activation chain, which is declared in the body of + -- this package. + + procedure Activate_Restricted_Tasks + (Chain_Access : Activation_Chain_Access); + -- Compiler interface only. Do not call from within the RTS. + -- This must be called by the creator of a chain of one or more new tasks, + -- to activate them. The chain is a linked list that up to this point is + -- only known to the task that created them, though the individual tasks + -- are already in the All_Tasks_List. + -- + -- The compiler builds the chain in LIFO order (as a stack). Another + -- version of this procedure had code to reverse the chain, so as to + -- activate the tasks in the order of declaration. This might be nice, but + -- it is not needed if priority-based scheduling is supported, since all + -- the activated tasks synchronize on the activators lock before they start + -- activating and so they should start activating in priority order. -- - -- Contrary to Create_Task, there is no Chain parameter (for the activation - -- chain), as there is only one global activation chain, which is declared - -- in the body of this package. + -- When the partition elaboration policy is sequential, this procedure + -- does nothing, tasks will be activated at end of elaboration. - procedure Activate_Tasks; - pragma Export (C, Activate_Tasks, "__gnat_activate_tasks"); + procedure Activate_All_Tasks_Sequential; + pragma Export (C, Activate_All_Tasks_Sequential, + "__gnat_activate_all_tasks"); -- Binder interface only. Do not call from within the RTS. This must be -- called an the end of the elaboration to activate all tasks, in order -- to implement the sequential elaboration policy. |