-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2009, 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- --
--- ware Foundation; either version 2, or (at your option) any later ver- --
--- sion. GNARL is distributed in the hope that it will be useful, but WITH- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
--- 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, 51 Franklin Street, Fifth Floor, --
--- Boston, MA 02110-1301, USA. --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
--- As a special exception, if other files instantiate generics from this --
--- unit, or you link this unit with other files to produce an executable, --
--- this unit does not by itself cause the resulting executable to be --
--- covered by the GNU General Public License. This exception does not --
--- however invalidate any other reasons why the executable file might be --
--- covered by the GNU Public License. --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
-- --
-- GNARL was developed by the GNARL team at Florida State University. --
-- Extensive contributions were provided by Ada Core Technologies, Inc. --
use Task_Primitives.Operations;
Global_Task_Lock : aliased System.Task_Primitives.RTS_Lock;
- -- This is a global lock; it is used to execute in mutual exclusion
- -- from all other tasks. It is only used by Task_Lock,
- -- Task_Unlock, and Final_Task_Unlock.
+ -- This is a global lock; it is used to execute in mutual exclusion from
+ -- all other tasks. It is only used by Task_Lock, Task_Unlock, and
+ -- Final_Task_Unlock.
----------------------------------------------------------------------
-- Tasking versions of some services needed by non-tasking programs --
----------------------------
procedure Init_RTS;
- -- This procedure completes the initialization of the GNARL. The first
- -- part of the initialization is done in the body of System.Tasking.
- -- It consists of initializing global locks, and installing tasking
- -- versions of certain operations used by the compiler. Init_RTS is called
- -- during elaboration.
+ -- This procedure completes the initialization of the GNARL. The first part
+ -- of the initialization is done in the body of System.Tasking. It consists
+ -- of initializing global locks, and installing tasking versions of certain
+ -- operations used by the compiler. Init_RTS is called during elaboration.
--------------------------
-- Change_Base_Priority --
function Check_Abort_Status return Integer is
Self_ID : constant Task_Id := Self;
begin
- if Self_ID /= null and then Self_ID.Deferral_Level = 0
+ if Self_ID /= null
+ and then Self_ID.Deferral_Level = 0
and then Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level
then
return 1;
return;
end if;
- -- pragma Assert
- -- ((Self_ID.Pending_ATC_Level >= Self_ID.ATC_Nesting_Level or else
- -- Self_ID.Deferral_Level > 0));
+ -- The following assertion is by default disabled. See the comment in
+ -- Defer_Abort on the situations in which it may be useful to uncomment
+ -- this assertion and enable the test.
- -- See comment in Defer_Abort on the situations in which it may be
- -- useful to uncomment the above assertion.
+ -- pragma Assert
+ -- (Self_ID.Pending_ATC_Level >= Self_ID.ATC_Nesting_Level or else
+ -- Self_ID.Deferral_Level > 0);
Self_ID.Deferral_Level := Self_ID.Deferral_Level + 1;
end Defer_Abort_Nestable;
pragma Assert (not Self_ID.ATC_Hack);
elsif Self_ID.ATC_Hack then
+
-- The solution really belongs in the Abort_Signal handler
-- for async. entry calls. The present hack is very
-- fragile. It relies that the very next point after
-- Final_Task_Unlock --
-----------------------
- -- This version is only for use in Terminate_Task, when the task
- -- is relinquishing further rights to its own ATCB.
- -- There is a very interesting potential race condition there, where
- -- the old task may run concurrently with a new task that is allocated
- -- the old tasks (now reused) ATCB. The critical thing here is to
- -- not make any reference to the ATCB after the lock is released.
- -- See also comments on Terminate_Task and Unlock.
+ -- This version is only for use in Terminate_Task, when the task is
+ -- relinquishing further rights to its own ATCB.
+
+ -- There is a very interesting potential race condition there, where the
+ -- old task may run concurrently with a new task that is allocated the old
+ -- tasks (now reused) ATCB. The critical thing here is to not make any
+ -- reference to the ATCB after the lock is released. See also comments on
+ -- Terminate_Task and Unlock.
procedure Final_Task_Unlock (Self_ID : Task_Id) is
begin
Self_Id.Awake_Count := 1;
Self_Id.Alive_Count := 1;
- Self_Id.Master_Within := Library_Task_Level;
- -- Normally, a task starts out with internal master nesting level
- -- one larger than external master nesting level. It is incremented
- -- to one by Enter_Master, which is called in the task body only if
- -- the compiler thinks the task may have dependent tasks. There is no
+ -- Normally, a task starts out with internal master nesting level one
+ -- larger than external master nesting level. It is incremented to one
+ -- by Enter_Master, which is called in the task body only if the
+ -- compiler thinks the task may have dependent tasks. There is no
-- corresponding call to Enter_Master for the environment task, so we
- -- would need to increment it to 2 here. Instead, we set it to 3.
- -- By doing this we reserve the level 2 for server tasks of the runtime
+ -- would need to increment it to 2 here. Instead, we set it to 3. By
+ -- doing this we reserve the level 2 for server tasks of the runtime
-- system. The environment task does not need to wait for these server
+ Self_Id.Master_Within := Library_Task_Level;
+
-- Initialize lock used to implement mutual exclusion between all tasks
Initialize_Lock (Global_Task_Lock'Access, STPO.Global_Task_Level);
SSL.Tasking.Init_Tasking_Soft_Links;
- -- Abort is deferred in a new ATCB, so we need to undefer abort
- -- at this stage to make the environment task abortable.
+ -- Abort is deferred in a new ATCB, so we need to undefer abort at this
+ -- stage to make the environment task abortable.
Undefer_Abort (Environment_Task);
end Init_RTS;
-- Abort a task to the specified ATC nesting level.
-- Call this only with T locked.
- -- An earlier version of this code contained a call to Wakeup. That
- -- should not be necessary here, if Abort_Task is implemented correctly,
- -- since Abort_Task should include the effect of Wakeup. However, the
- -- above call was in earlier versions of this file, and at least for
- -- some targets Abort_Task has not been doing Wakeup. It should not
- -- hurt to uncomment the above call, until the error is corrected for
- -- all targets.
+ -- An earlier version of this code contained a call to Wakeup. That should
+ -- not be necessary here, if Abort_Task is implemented correctly, since
+ -- Abort_Task should include the effect of Wakeup. However, the above call
+ -- was in earlier versions of this file, and at least for some targets
+ -- Abort_Task has not been doing Wakeup. It should not hurt to uncomment
+ -- the above call, until the error is corrected for all targets.
-- See extended comments in package body System.Tasking.Abort for the
-- overall design of the implementation of task abort.
-- ??? there is no such package ???
- -- If the task is sleeping it will be in an abort-deferred region, and
- -- will not have Abort_Signal raised by Abort_Task. Such an "abort
- -- deferral" is just to protect the RTS internals, and not necessarily
- -- required to enforce Ada semantics. Abort_Task should wake the task up
- -- and let it decide if it wants to complete the aborted construct
- -- immediately.
+ -- If the task is sleeping it will be in an abort-deferred region, and will
+ -- not have Abort_Signal raised by Abort_Task. Such an "abort deferral" is
+ -- just to protect the RTS internals, and not necessarily required to
+ -- enforce Ada semantics. Abort_Task should wake the task up and let it
+ -- decide if it wants to complete the aborted construct immediately.
-- Note that the effect of the low-level Abort_Task is not persistent.
-- If the target task is not blocked, this wakeup will be missed.
-- We don't bother calling Abort_Task if this task is aborting itself,
- -- since we are inside the RTS and have abort deferred. Similarly, We
- -- don't bother to call Abort_Task if T is terminated, since there is
- -- no need to abort a terminated task, and it could be dangerous to try
- -- if the task has stopped executing.
-
- -- Note that an earlier version of this code had some false reasoning
- -- about being able to reliably wake up a task that had suspended on
- -- a blocking system call that does not atomically release the task's
- -- lock (e.g., UNIX nanosleep, which we once thought could be used to
- -- implement delays). That still left the possibility of missed
- -- wakeups.
+ -- since we are inside the RTS and have abort deferred. Similarly, We don't
+ -- bother to call Abort_Task if T is terminated, since there is no need to
+ -- abort a terminated task, and it could be dangerous to try if the task
+ -- has stopped executing.
+
+ -- Note that an earlier version of this code had some false reasoning about
+ -- being able to reliably wake up a task that had suspended on a blocking
+ -- system call that does not atomically release the task's lock (e.g., UNIX
+ -- nanosleep, which we once thought could be used to implement delays).
+ -- That still left the possibility of missed wakeups.
-- We cannot safely call Vulnerable_Complete_Activation here, since that
-- requires locking Self_ID.Parent. The anti-deadlock lock ordering rules
pragma Assert (False);
null;
- when Runnable =>
+ when Activating | Runnable =>
+
-- This is needed to cancel an asynchronous protected entry
-- call during a requeue with abort.
AST_Server_Sleep =>
Wakeup (T, T.Common.State);
- when Acceptor_Sleep =>
+ when Acceptor_Sleep | Acceptor_Delay_Sleep =>
T.Open_Accepts := null;
Wakeup (T, T.Common.State);
-- value will not be set to False except with T also locked,
-- inside Exit_One_ATC_Level, so we should not miss wakeups.
- if T.Common.State = Acceptor_Sleep then
+ if T.Common.State = Acceptor_Sleep
+ or else
+ T.Common.State = Acceptor_Delay_Sleep
+ then
T.Open_Accepts := null;
end if;
elsif T /= Self_ID and then
(T.Common.State = Runnable
- or else T.Common.State = Interrupt_Server_Blocked_On_Event_Flag)
+ or else T.Common.State = Interrupt_Server_Blocked_On_Event_Flag)
+
-- The task is blocked on a system call waiting for the
-- completion event. In this case Abort_Task may need to take
-- special action in order to succeed. Example system: VMS.
Previous := Null_Task;
C := All_Tasks_List;
-
while C /= Null_Task loop
if C = T then
if Previous = Null_Task then
- All_Tasks_List :=
- All_Tasks_List.Common.All_Tasks_Link;
+ All_Tasks_List := All_Tasks_List.Common.All_Tasks_Link;
else
Previous.Common.All_Tasks_Link := C.Common.All_Tasks_Link;
end if;
function Task_Name return String is
Self_Id : constant Task_Id := STPO.Self;
-
begin
return Self_Id.Common.Task_Image (1 .. Self_Id.Common.Task_Image_Len);
end Task_Name;
New_State : Entry_Call_State)
is
Caller : constant Task_Id := Entry_Call.Self;
+
begin
pragma Debug (Debug.Trace
(Self_ID, "Wakeup_Entry_Caller", 'E', Caller));
if Entry_Call.Mode = Asynchronous_Call then
- -- Abort the caller in his abortable part,
- -- but do so only if call has been queued abortably
+ -- Abort the caller in his abortable part, but do so only if call has
+ -- been queued abortably.
if Entry_Call.State >= Was_Abortable or else New_State = Done then
Locked_Abort_To_Level (Self_ID, Caller, Entry_Call.Level - 1);
-----------------------
-- These are dummies for subprograms that are only needed by certain
- -- optional run-time system packages. If they are needed, the soft
- -- links will be redirected to the real subprogram by elaboration of
- -- the subprogram body where the real subprogram is declared.
+ -- optional run-time system packages. If they are needed, the soft links
+ -- will be redirected to the real subprogram by elaboration of the
+ -- subprogram body where the real subprogram is declared.
procedure Finalize_Attributes (T : Task_Id) is
pragma Unreferenced (T);
OSDN Git Service
