pragma Polling (Off);
with System.Tasking.Debug;
with System.Task_Primitives.Operations;
with System.Tasking.Initialization;
with System.Tasking.Queuing;
with System.Tasking.Debug;
with System.Parameters;
with System.Traces.Tasking;
with Unchecked_Conversion;
package body System.Tasking.Utilities is
package STPO renames System.Task_Primitives.Operations;
use Parameters;
use Tasking.Debug;
use Task_Primitives;
use Task_Primitives.Operations;
use System.Traces;
use System.Traces.Tasking;
procedure Abort_One_Task (Self_ID : Task_ID; T : Task_ID) is
begin
if Parameters.Runtime_Traces then
Send_Trace_Info (T_Abort, Self_ID, T);
end if;
Write_Lock (T);
if T.Common.State = Unactivated then
T.Common.Activator := null;
T.Common.State := Terminated;
T.Callable := False;
Cancel_Queued_Entry_Calls (T);
elsif T.Common.State /= Terminated then
Initialization.Locked_Abort_To_Level (Self_ID, T, 0);
end if;
Unlock (T);
end Abort_One_Task;
procedure Abort_Tasks (Tasks : Task_List) is
Self_Id : constant Task_ID := STPO.Self;
C : Task_ID;
P : Task_ID;
begin
Initialization.Defer_Abort_Nestable (Self_Id);
Lock_RTS;
for J in Tasks'Range loop
C := Tasks (J);
Abort_One_Task (Self_Id, C);
end loop;
C := All_Tasks_List;
while C /= null loop
if C.Pending_ATC_Level > 0 then
P := C.Common.Parent;
while P /= null loop
if P.Pending_ATC_Level = 0 then
Abort_One_Task (Self_Id, C);
exit;
end if;
P := P.Common.Parent;
end loop;
end if;
C := C.Common.All_Tasks_Link;
end loop;
Unlock_RTS;
Initialization.Undefer_Abort_Nestable (Self_Id);
end Abort_Tasks;
procedure Cancel_Queued_Entry_Calls (T : Task_ID) is
Next_Entry_Call : Entry_Call_Link;
Entry_Call : Entry_Call_Link;
Caller : Task_ID;
Level : Integer;
Self_Id : constant Task_ID := STPO.Self;
begin
pragma Assert (T = Self or else T.Common.State = Terminated);
for J in 1 .. T.Entry_Num loop
Queuing.Dequeue_Head (T.Entry_Queues (J), Entry_Call);
while Entry_Call /= null loop
Caller := Entry_Call.Self;
Entry_Call.Exception_To_Raise := Tasking_Error'Identity;
Queuing.Dequeue_Head (T.Entry_Queues (J), Next_Entry_Call);
Level := Entry_Call.Level - 1;
Unlock (T);
Write_Lock (Entry_Call.Self);
Initialization.Wakeup_Entry_Caller
(Self_Id, Entry_Call, Cancelled);
Unlock (Entry_Call.Self);
Write_Lock (T);
Entry_Call.State := Done;
Entry_Call := Next_Entry_Call;
end loop;
end loop;
end Cancel_Queued_Entry_Calls;
procedure Exit_One_ATC_Level (Self_ID : Task_ID) is
begin
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 < 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.Aborting := False;
else
pragma Assert
(Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level);
if Self_ID.Aborting then
Self_ID.ATC_Hack := True;
Self_ID.Pending_Action := True;
end if;
end if;
end if;
end Exit_One_ATC_Level;
procedure Make_Independent is
Self_Id : constant Task_ID := STPO.Self;
Environment_Task : constant Task_ID := STPO.Environment_Task;
Parent : constant Task_ID := Self_Id.Common.Parent;
Parent_Needs_Updating : Boolean := False;
begin
if Self_Id.Known_Tasks_Index /= -1 then
Known_Tasks (Self_Id.Known_Tasks_Index) := null;
end if;
Initialization.Defer_Abort (Self_Id);
if Single_Lock then
Lock_RTS;
end if;
Write_Lock (Environment_Task);
Write_Lock (Self_Id);
pragma Assert (Parent = Environment_Task
or else Self_Id.Master_of_Task = Library_Task_Level);
Self_Id.Master_of_Task := Independent_Task_Level;
if Parent /= Environment_Task then
Parent_Needs_Updating := True;
Self_Id.Common.Parent := Environment_Task;
end if;
Independent_Task_Count := Independent_Task_Count + 1;
Unlock (Self_Id);
if Parent_Needs_Updating then
Write_Lock (Parent);
Parent.Awake_Count := Parent.Awake_Count - 1;
Parent.Alive_Count := Parent.Alive_Count - 1;
Environment_Task.Awake_Count := Environment_Task.Awake_Count + 1;
Environment_Task.Alive_Count := Environment_Task.Alive_Count + 1;
Unlock (Parent);
end if;
Unlock (Environment_Task);
if Single_Lock then
Unlock_RTS;
end if;
Initialization.Undefer_Abort (Self_Id);
end Make_Independent;
procedure Make_Passive (Self_ID : Task_ID; Task_Completed : Boolean) is
C : Task_ID := Self_ID;
P : Task_ID := C.Common.Parent;
Master_Completion_Phase : Integer;
begin
if P /= null then
Write_Lock (P);
end if;
Write_Lock (C);
if Task_Completed then
Self_ID.Common.State := Terminated;
if Self_ID.Awake_Count = 0 then
Master_Completion_Phase := 2;
pragma Assert (Task_Completed);
pragma Assert (Self_ID.Terminate_Alternative);
pragma Assert (Self_ID.Alive_Count = 1);
else
Master_Completion_Phase := 1;
pragma Assert (Self_ID.Awake_Count = 1);
end if;
else
if Self_ID.Open_Accepts = null then
Unlock (C);
if P /= null then
Unlock (P);
end if;
return;
end if;
Self_ID.Terminate_Alternative := True;
Master_Completion_Phase := 0;
pragma Assert (Self_ID.Terminate_Alternative);
pragma Assert (Self_ID.Awake_Count >= 1);
end if;
if Master_Completion_Phase = 2 then
pragma Debug (Debug.Trace (Self_ID, "Make_Passive: Phase 2", 'M'));
pragma Assert (P /= null);
C.Alive_Count := C.Alive_Count - 1;
if C.Alive_Count > 0 then
Unlock (C);
Unlock (P);
return;
end if;
loop
P.Alive_Count := P.Alive_Count - 1;
exit when P.Alive_Count > 0;
Unlock (C);
Unlock (P);
C := P;
P := C.Common.Parent;
pragma Assert (P /= null);
Write_Lock (P);
Write_Lock (C);
end loop;
pragma Assert (P.Awake_Count /= 0);
if P.Common.State = Master_Phase_2_Sleep
and then C.Master_of_Task = P.Master_Within
then
pragma Assert (P.Common.Wait_Count > 0);
P.Common.Wait_Count := P.Common.Wait_Count - 1;
if P.Common.Wait_Count = 0 then
Wakeup (P, Master_Phase_2_Sleep);
end if;
end if;
Unlock (C);
Unlock (P);
return;
end if;
C.Awake_Count := C.Awake_Count - 1;
if Task_Completed then
pragma Assert (Self_ID.Awake_Count = 0);
C.Alive_Count := C.Alive_Count - 1;
end if;
if C.Awake_Count > 0 or else P = null then
Unlock (C);
if P /= null then
Unlock (P);
end if;
return;
end if;
loop
P.Awake_Count := P.Awake_Count - 1;
if Task_Completed and then C.Alive_Count = 0 then
P.Alive_Count := P.Alive_Count - 1;
end if;
exit when P.Awake_Count > 0;
Unlock (C);
Unlock (P);
C := P;
P := C.Common.Parent;
if P = null then
return;
end if;
Write_Lock (P);
Write_Lock (C);
end loop;
if P.Common.State = Master_Completion_Sleep
and then C.Master_of_Task = P.Master_Within
then
pragma Debug
(Debug.Trace
(Self_ID, "Make_Passive: Phase 1, parent waiting", 'M'));
pragma Assert (P.Common.Wait_Count > 0);
P.Common.Wait_Count := P.Common.Wait_Count - 1;
if P.Common.Wait_Count = 0 then
Wakeup (P, Master_Completion_Sleep);
end if;
else
pragma Debug
(Debug.Trace
(Self_ID, "Make_Passive: Phase 1, parent awake", 'M'));
null;
end if;
Unlock (C);
Unlock (P);
end Make_Passive;
end System.Tasking.Utilities;