------------------------------------------------------------------------------
-- --
--- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS --
+-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
-- --
-- S Y S T E M . T A S K I N G . U T I L I T I E S --
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2002, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
-- --
-- GNARL is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNARL; see file COPYING. If not, write --
--- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
--- MA 02111-1307, USA. --
+-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
+-- Boston, MA 02110-1301, USA. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
-- --
--- GNARL was developed by the GNARL team at Florida State University. It is --
--- now maintained by Ada Core Technologies, Inc. (http://www.gnat.com). --
+-- GNARL was developed by the GNARL team at Florida State University. --
+-- Extensive contributions were provided by Ada Core Technologies, Inc. --
-- --
------------------------------------------------------------------------------
with System.Task_Primitives.Operations;
-- used for Write_Lock
--- Set_Priority
-- Wakeup
-- Unlock
-- Sleep
-- used for Dequeue_Call
-- Dequeue_Head
-with System.Tasking.Debug;
--- used for Trace
-
with System.Parameters;
-- used for Single_Lock
-- Runtime_Traces
with System.Traces.Tasking;
-- used for Send_Trace_Info
-with Unchecked_Conversion;
-
package body System.Tasking.Utilities is
package STPO renames System.Task_Primitives.Operations;
-- (2) may be called for tasks that have not yet been activated
-- (3) always aborts whole task
- procedure Abort_One_Task (Self_ID : Task_ID; T : Task_ID) is
+ 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);
-- Abort_Tasks --
-----------------
- -- Compiler interface only: Do not call from within the RTS,
-
- -- except in the implementation of Ada.Task_Identification.
-- This must be called to implement the abort statement.
-- Much of the actual work of the abort is done by the abortee,
-- via the Abort_Handler signal handler, and propagation of the
-- Abort_Signal special exception.
procedure Abort_Tasks (Tasks : Task_List) is
- Self_Id : constant Task_ID := STPO.Self;
- C : Task_ID;
- P : Task_ID;
+ Self_Id : constant Task_Id := STPO.Self;
+ C : Task_Id;
+ P : Task_Id;
begin
+ -- If pragma Detect_Blocking is active then Program_Error must be
+ -- raised if this potentially blocking operation is called from a
+ -- protected action.
+
+ if System.Tasking.Detect_Blocking
+ and then Self_Id.Common.Protected_Action_Nesting > 0
+ then
+ Ada.Exceptions.Raise_Exception
+ (Program_Error'Identity, "potentially blocking operation");
+ end if;
+
Initialization.Defer_Abort_Nestable (Self_Id);
-- ?????
-- This should only be called by T, unless T is a terminated previously
-- unactivated task.
- procedure Cancel_Queued_Entry_Calls (T : Task_ID) is
+ 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;
+ Self_Id : constant Task_Id := STPO.Self;
+
+ Caller : Task_Id;
+ pragma Unreferenced (Caller);
+ -- Should this be removed ???
+
+ Level : Integer;
+ pragma Unreferenced (Level);
+ -- Should this be removed ???
begin
pragma Assert (T = Self or else T.Common.State = Terminated);
Queuing.Dequeue_Head (T.Entry_Queues (J), Entry_Call);
while Entry_Call /= null loop
+
-- Leave Entry_Call.Done = False, since this is cancelled
Caller := Entry_Call.Self;
-- In any case, reset Self_Id.Aborting, to allow re-raising of
-- Abort_Signal.
- procedure Exit_One_ATC_Level (Self_ID : Task_ID) is
+ procedure Exit_One_ATC_Level (Self_ID : Task_Id) is
begin
Self_ID.ATC_Nesting_Level := Self_ID.ATC_Nesting_Level - 1;
----------------------
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;
+ 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;
+ Master_of_Task : Integer;
begin
if Self_Id.Known_Tasks_Index /= -1 then
pragma Assert (Parent = Environment_Task
or else Self_Id.Master_of_Task = Library_Task_Level);
+ Master_of_Task := Self_Id.Master_of_Task;
Self_Id.Master_of_Task := Independent_Task_Level;
-- The run time assumes that the parent of an independent task is the
if Parent /= Environment_Task then
- -- We can not lock three tasks at the same time, so defer the
+ -- We cannot lock three tasks at the same time, so defer the
-- operations on the parent.
Parent_Needs_Updating := True;
Unlock (Parent);
end if;
+ -- In case the environment task is already waiting for children to
+ -- complete.
+ -- ??? There may be a race condition if the environment task was not in
+ -- master completion sleep when this task was created, but now is
+
+ if Environment_Task.Common.State = Master_Completion_Sleep and then
+ Master_of_Task = Environment_Task.Master_Within
+ then
+ Environment_Task.Common.Wait_Count :=
+ Environment_Task.Common.Wait_Count - 1;
+ end if;
+
Unlock (Environment_Task);
if Single_Lock then
-- Make_Passive --
------------------
- procedure Make_Passive (Self_ID : Task_ID; Task_Completed : Boolean) is
- C : Task_ID := Self_ID;
- P : Task_ID := C.Common.Parent;
+ 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;
-- Our parent should wait in Phase 1 of Complete_Master.
Master_Completion_Phase := 1;
- pragma Assert (Self_ID.Awake_Count = 1);
+ pragma Assert (Self_ID.Awake_Count >= 1);
end if;
- -- We are accepting with a terminate alternative.
+ -- We are accepting with a terminate alternative
else
if Self_ID.Open_Accepts = null then
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
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;
-- C has a parent, P.
loop
- -- Notify P that C has gone passive.
+ -- Notify P that C has gone passive
- P.Awake_Count := P.Awake_Count - 1;
+ if P.Awake_Count > 0 then
+ P.Awake_Count := P.Awake_Count - 1;
+ end if;
if Task_Completed and then C.Alive_Count = 0 then
P.Alive_Count := P.Alive_Count - 1;
Write_Lock (C);
end loop;
- -- P has non-passive dependents.
+ -- P has non-passive dependents
if P.Common.State = Master_Completion_Sleep
and then C.Master_of_Task = P.Master_Within
OSDN Git Service
