+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.
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");
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;
-- 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
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 :=");
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
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;
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;
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 =>
-- 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;
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;
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,
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;
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,
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;
-- 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;
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
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
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
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
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,
**/
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
-- 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
-- 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 --
--------------------
-- 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;
-- 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);
if Single_Lock then
Unlock_RTS;
end if;
-
- -- Remove the tasks from the chain
-
- Tasks_Activation_Chain := null;
end Activate_Tasks;
------------------------------------
-- 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 --
-- 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;
-- 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;
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)
-- 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.
projects / platform / upstream / gcc.git / commitdiff