+2018-12-03 Patrick Bernardi <bernardi@adacore.com>
+
+ * libgnarl/s-taskin.ads (ATC_Level_Base): Redefine to span from
+ -1 to Max_ATC_Nesting so that 0 represents no ATC nesting and -1
+ represented a completed task. To increase readability, new
+ constants are introduced to represent key ATC nesting levels.
+ Consequently, Level_No_Pending_Abort replaces
+ ATC_Level_Infinity. ATC_Level related definitions now
+ documented.
+ (Ada_Task_Control_Block): The default initialization of
+ components ATC_Nesting_Level and Pending_ATC_Level now use new
+ ATC_Level_Base constants. Comments improved
+ * libgnarl/s-taskin.adb (Initialize): Improve the initialisation
+ of the first element of the Entry_Calls array to facilitate
+ better maintenance.
+ * libgnarl/s-taasde.ads: Update comment.
+ * libgnarl/s-taasde.adb, libgnarl/s-taenca.adb,
+ libgnarl/s-tasren.adb, libgnarl/s-tassta.adb,
+ libgnarl/s-tasuti.ads, libgnarl/s-tasuti.adb: Use new
+ ATC_Level_Base constants.
+ * libgnarl/s-tarest.adb (Create_Restricted_Task): Improve the
+ initialisation of the first element of the task's Entry_Calls
+ array to facilitate better maintenance.
+ * libgnarl/s-tasini.ads (Locked_Abort_To_Level): Update
+ signature to accept ATC_Level_Base.
+ * libgnarl/s-tasini.adb (Locked_Abort_To_Level): Update
+ signature to accept ATC_Level_Base. Use new ATC_Level_Base
+ constants and only modify the aborting task's Entry_Calls array
+ if any entry call is happening.
+ * libgnarl/s-tposen.adb (Protected_Single_Entry_Call): Reference
+ the first element of the task's Entry_Calls array via 'First
+ attribute to facilitate better maintenance.
+
2018-12-03 Eric Botcazou <ebotcazou@adacore.com>
* einfo.adb (Write_Entity_Info): Don't take Scope of Standard
-- for an async. select statement with delay statement as trigger. The
-- effect should be to remove the delay from the timer queue, and exit one
-- ATC nesting level.
+
-- The usage and logic are similar to Cancel_Protected_Entry_Call, but
-- simplified because this is not a true entry call.
Dsucc : Delay_Block_Access;
begin
- -- Note that we mark the delay as being cancelled
- -- using a level value that is reserved.
-
- -- make this operation idempotent
+ -- A delay block level of Level_No_Pending_Abort indicates the delay
+ -- has been cancelled. If the delay has already been canceled, there is
+ -- nothing more to be done.
- if D.Level = ATC_Level_Infinity then
+ if D.Level = Level_No_Pending_Abort then
return;
end if;
- D.Level := ATC_Level_Infinity;
+ D.Level := Level_No_Pending_Abort;
- -- remove self from timer queue
+ -- Remove self from timer queue
STI.Defer_Abort_Nestable (D.Self_Id);
Level : ATC_Level_Base;
-- Normally Level is the ATC nesting level of the asynchronous select
-- statement to which this delay belongs, but after a call has been
- -- dequeued we set it to ATC_Level_Infinity so that the Cancel operation
- -- can detect repeated calls, and act idempotently.
+ -- dequeued we set it to Level_No_Pending_Abort so that the Cancel
+ -- operation can detect repeated calls, and act idempotently.
Resume_Time : Duration;
-- The absolute wake up time, represented as Duration
Call : Entry_Call_Link)
is
begin
- pragma Assert (Self_ID.ATC_Nesting_Level > 0);
+ pragma Assert (Self_ID.ATC_Nesting_Level > Level_No_ATC_Occuring);
pragma Assert (Call.Mode = Asynchronous_Call);
STPO.Write_Lock (Self_ID);
raise Program_Error;
end if;
- Created_Task.Entry_Calls (1).Self := Created_Task;
+ -- Only the first element of the Entry_Calls array is used when the
+ -- Ravenscar Profile is active as no asynchronous transfer of control
+ -- is allowed.
+
+ Created_Task.Entry_Calls (Created_Task.Entry_Calls'First) :=
+ (Self => Created_Task,
+ Level => Created_Task.Entry_Calls'First,
+ others => <>);
+
+ -- Set task name
Len :=
Integer'Min (Created_Task.Common.Task_Image'Length, Task_Image'Length);
procedure Locked_Abort_To_Level
(Self_ID : Task_Id;
T : Task_Id;
- L : ATC_Level)
+ L : ATC_Level_Base)
is
begin
if not T.Aborting and then T /= Self_ID then
when Activating
| Runnable
=>
- -- This is needed to cancel an asynchronous protected entry
- -- call during a requeue with abort.
+ if T.ATC_Nesting_Level > Level_No_ATC_Occuring then
+ -- This scenario occurs when an asynchronous protected entry
+ -- call is canceld during a requeue with abort.
- T.Entry_Calls
- (T.ATC_Nesting_Level).Cancellation_Attempted := True;
+ T.Entry_Calls
+ (T.ATC_Nesting_Level).Cancellation_Attempted := True;
+ end if;
when Interrupt_Server_Blocked_On_Event_Flag =>
null;
Wakeup (T, T.Common.State);
when Entry_Caller_Sleep =>
+ pragma Assert (T.ATC_Nesting_Level > Level_No_ATC_Occuring);
+
T.Entry_Calls
(T.ATC_Nesting_Level).Cancellation_Attempted := True;
Wakeup (T, T.Common.State);
T.Pending_ATC_Level := L;
T.Pending_Action := True;
- if L = 0 then
+ if L = Level_Completed_Task then
T.Callable := False;
end if;
procedure Locked_Abort_To_Level
(Self_ID : Task_Id;
T : Task_Id;
- L : ATC_Level);
+ L : ATC_Level_Base);
pragma Inline (Locked_Abort_To_Level);
-- Abort a task to a specified ATC level. Call this only with T locked
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.
+ -- The full initialization of the environment task's Entry_Calls array
+ -- is deferred to Init_RTS because only the first element of the array
+ -- is used by the restricted Ravenscar runtime.
+
+ T.Entry_Calls (T.Entry_Calls'First).Self := T;
+ T.Entry_Calls (T.Entry_Calls'First).Level := T.Entry_Calls'First;
- T.Entry_Calls (1).Self := T;
end Initialize;
end System.Tasking;
--
-- Protection: Self.L. Self will modify this field when Self.Accepting
-- is False, and will not need the mutex to do so. Once a task sets
- -- Pending_ATC_Level = 0, no other task can access this field.
+ -- Pending_ATC_Level = Level_Completed_Task, no other task can access
+ -- this field.
LL : aliased Task_Primitives.Private_Data;
-- Control block used by the underlying low-level tasking service
-----------------------------------
Max_ATC_Nesting : constant Natural := 20;
+ -- The maximum number of nested asynchronous select statements supported
+ -- by the runtime.
- subtype ATC_Level_Base is Integer range 0 .. Max_ATC_Nesting;
+ subtype ATC_Level_Base is Integer range -1 .. Max_ATC_Nesting;
+ -- Indicates the number of nested asynchronous task control statements
+ -- or entries a task is in.
- ATC_Level_Infinity : constant ATC_Level_Base := ATC_Level_Base'Last;
+ Level_Completed_Task : constant ATC_Level_Base := -1;
+ -- ATC_Level of a task that has "completed". A task reaches the completed
+ -- state after an abort, exception propagation, or normal exit.
- subtype ATC_Level is ATC_Level_Base range 0 .. ATC_Level_Base'Last - 1;
+ Level_No_ATC_Occuring : constant ATC_Level_Base := 0;
+ -- ATC_Level of a task not executing a entry call or an asynchronous
+ -- select statement.
- subtype ATC_Level_Index is ATC_Level range 1 .. ATC_Level'Last;
+ Level_No_Pending_Abort : constant ATC_Level_Base := ATC_Level_Base'Last;
+ -- ATC_Level when there is no pending abort
+
+ subtype ATC_Level is ATC_Level_Base range
+ Level_No_ATC_Occuring .. Level_No_Pending_Abort - 1;
+ -- Nested ATC_Levels valid during the execution of a task
+
+ subtype ATC_Level_Index is ATC_Level range
+ Level_No_ATC_Occuring + 1 .. ATC_Level'Last;
+ -- ATC_Levels valid when a task is executing an entry call or asynchronous
+ -- task control statements.
----------------------------------
-- Entry_Call_Record definition --
-- Beginning of counts
- ATC_Nesting_Level : ATC_Level := 1;
+ ATC_Nesting_Level : ATC_Level := Level_No_ATC_Occuring;
-- The dynamic level of ATC nesting (currently executing nested
-- asynchronous select statements) in this task.
-- Protection: Only updated by Self; access assumed to be atomic
- Pending_ATC_Level : ATC_Level_Base := ATC_Level_Infinity;
- -- The ATC level to which this task is currently being aborted. If the
- -- value is zero, the entire task has "completed". That may be via
- -- abort, exception propagation, or normal exit. If the value is
- -- ATC_Level_Infinity, the task is not being aborted to any level. If
- -- the value is positive, the task has not completed. This should ONLY
- -- be modified by Abort_To_Level and Exit_One_ATC_Level.
+ Pending_ATC_Level : ATC_Level_Base := Level_No_Pending_Abort;
+ -- Indicates the ATC level to which this task is currently being
+ -- aborted. Two special values exist:
+ --
+ -- * Level_Completed_Task: the task has completed.
+ --
+ -- * Level_No_Pending_Abort: the task is not being aborted to any
+ -- level.
+ --
+ -- All other values indicate the task has not completed. This should
+ -- ONLY be modified by Abort_To_Level and Exit_One_ATC_Level.
--
-- Protection: Self.L
STPO.Write_Lock (Self_Id);
if not Self_Id.Callable then
- pragma Assert (Self_Id.Pending_ATC_Level = 0);
+ pragma Assert (Self_Id.Pending_ATC_Level = Level_Completed_Task);
pragma Assert (Self_Id.Pending_Action);
if Self_Id.Common.Call /= null then
Caller := Self_Id.Common.Call.Self;
+
+ pragma Assert (Caller.ATC_Nesting_Level > Level_No_ATC_Occuring);
+
Uninterpreted_Data :=
Caller.Entry_Calls (Caller.ATC_Nesting_Level).Uninterpreted_Data;
else
STPO.Write_Lock (Self_Id);
if not Self_Id.Callable then
- pragma Assert (Self_Id.Pending_ATC_Level = 0);
+ pragma Assert (Self_Id.Pending_ATC_Level = Level_Completed_Task);
pragma Assert (Self_Id.Pending_Action);
STPO.Write_Lock (Self_Id);
if not Self_Id.Callable then
- pragma Assert (Self_Id.Pending_ATC_Level = 0);
+ pragma Assert (Self_Id.Pending_ATC_Level = Level_Completed_Task);
pragma Assert (Self_Id.Pending_Action);
-- we do not need to cancel the terminate alternative. The
-- cleanup will be done in Complete_Master.
- pragma Assert (Self_Id.Pending_ATC_Level = 0);
+ pragma Assert
+ (Self_Id.Pending_ATC_Level = Level_Completed_Task);
pragma Assert (Self_Id.Awake_Count = 0);
STPO.Unlock (Self_Id);
STPO.Write_Lock (Self_Id);
if not Self_Id.Callable then
- pragma Assert (Self_Id.Pending_ATC_Level = 0);
+ pragma Assert (Self_Id.Pending_ATC_Level = Level_Completed_Task);
pragma Assert (Self_Id.Pending_Action);
-- give up on creating this task, and simply return.
if not Self_ID.Callable then
- pragma Assert (Self_ID.Pending_ATC_Level = 0);
+ pragma Assert (Self_ID.Pending_ATC_Level = Level_Completed_Task);
pragma Assert (Self_ID.Pending_Action);
pragma Assert
(Chain.T_ID = null or else Chain.T_ID.Common.State = Unactivated);
-- for the task completion is an abort, we do not raise an exception.
-- See RM 9.2(5).
- if not Self_ID.Callable and then Self_ID.Pending_ATC_Level /= 0 then
+ if not Self_ID.Callable
+ and then Self_ID.Pending_ATC_Level /= Level_Completed_Task
+ then
Activator.Common.Activation_Failed := True;
end if;
Self_ID.Master_Of_Task .. Self_ID.Master_Of_Task + 3);
pragma Assert (Self_ID.Common.Wait_Count = 0);
pragma Assert (Self_ID.Open_Accepts = null);
- pragma Assert (Self_ID.ATC_Nesting_Level = 1);
+ pragma Assert (Self_ID.ATC_Nesting_Level = Level_No_ATC_Occuring);
pragma Debug (Debug.Trace (Self_ID, "V_Complete_Task", 'C'));
-- Abort_One_Task --
--------------------
- -- Similar to Locked_Abort_To_Level (Self_ID, T, 0), but:
+ -- Similar to Locked_Abort_To_Level (Self_ID, T, Level_Completed_Task),
+ -- but:
-- (1) caller should be holding no locks except RTS_Lock when Single_Lock
-- (2) may be called for tasks that have not yet been activated
-- (3) always aborts whole task
Cancel_Queued_Entry_Calls (T);
elsif T.Common.State /= Terminated then
- Initialization.Locked_Abort_To_Level (Self_ID, T, 0);
+ Initialization.Locked_Abort_To_Level
+ (Self_ID, T, Level_Completed_Task);
end if;
Unlock (T);
C := All_Tasks_List;
while C /= null loop
- if C.Pending_ATC_Level > 0 then
+ if C.Pending_ATC_Level > Level_Completed_Task then
P := C.Common.Parent;
while P /= null loop
- if P.Pending_ATC_Level = 0 then
+ if P.Pending_ATC_Level = Level_Completed_Task then
Abort_One_Task (Self_Id, C);
exit;
end if;
procedure Exit_One_ATC_Level (Self_ID : Task_Id) is
begin
+ pragma Assert (Self_ID.ATC_Nesting_Level > Level_No_ATC_Occuring);
+
Self_ID.ATC_Nesting_Level := Self_ID.ATC_Nesting_Level - 1;
pragma Debug
(Debug.Trace (Self_ID, "EOAL: exited to ATC level: " &
ATC_Level'Image (Self_ID.ATC_Nesting_Level), 'A'));
- pragma Assert (Self_ID.ATC_Nesting_Level >= 1);
+ if Self_ID.Pending_ATC_Level < Level_No_Pending_Abort then
- if Self_ID.Pending_ATC_Level < ATC_Level_Infinity then
if Self_ID.Pending_ATC_Level = Self_ID.ATC_Nesting_Level then
- Self_ID.Pending_ATC_Level := ATC_Level_Infinity;
+ Self_ID.Pending_ATC_Level := Level_No_Pending_Abort;
Self_ID.Aborting := False;
else
-- Force the next Undefer_Abort to re-raise Abort_Signal
pragma Assert
- (Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level);
+ (Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level);
if Self_ID.Aborting then
Self_ID.ATC_Hack := True;
-- The effect is to exit one level of ATC nesting.
procedure Abort_One_Task (Self_ID : Task_Id; T : Task_Id);
- -- Similar to Locked_Abort_To_Level (Self_ID, T, 0), but:
+ -- Similar to Locked_Abort_To_Level (Self_ID, T, Level_Completed_Task),
+ -- but:
-- (1) caller should be holding no locks
-- (2) may be called for tasks that have not yet been activated
-- (3) always aborts whole task
Uninterpreted_Data : System.Address)
is
Self_Id : constant Task_Id := STPO.Self;
- Entry_Call : Entry_Call_Record renames Self_Id.Entry_Calls (1);
+ Entry_Call : Entry_Call_Record renames
+ Self_Id.Entry_Calls (Self_Id.Entry_Calls'First);
begin
-- If pragma Detect_Blocking is active then Program_Error must be
-- raised if this potentially blocking operation is called from a
projects / gcc.git / commitdiff