------------------------------------------------------------------------------
-- --
--- 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 . E N T R Y _ C A L L S --
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2003, 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, 59 Temple Place - Suite 330, Boston, --
--- MA 02111-1307, 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. --
------------------------------------------------------------------------------
with System.Task_Primitives.Operations;
--- used for STPO.Write_Lock
--- Unlock
--- STPO.Get_Priority
--- Sleep
--- Timed_Sleep
-
with System.Tasking.Initialization;
--- used for Change_Base_Priority
--- Dynamic_Priority_Support
--- Defer_Abort/Undefer_Abort
-
with System.Tasking.Protected_Objects.Entries;
--- used for To_Protection
-
with System.Tasking.Protected_Objects.Operations;
--- used for PO_Service_Entries
-
with System.Tasking.Queuing;
--- used for Requeue_Call_With_New_Prio
--- Onqueue
--- Dequeue_Call
-
with System.Tasking.Utilities;
--- used for Exit_One_ATC_Level
-
with System.Parameters;
--- used for Single_Lock
--- Runtime_Traces
-
with System.Traces;
--- used for Send_Trace_Info
package body System.Tasking.Entry_Calls is
-----------------------
procedure Lock_Server (Entry_Call : Entry_Call_Link);
- -- This locks the server targeted by Entry_Call.
+
+ -- This locks the server targeted by Entry_Call
--
- -- This may be a task or a protected object,
- -- depending on the target of the original call or any subsequent
- -- requeues.
+ -- This may be a task or a protected object, depending on the target of the
+ -- original call or any subsequent requeues.
--
- -- This routine is needed because the field specifying the server
- -- for this call must be protected by the server's mutex. If it were
- -- protected by the caller's mutex, accessing the server's queues would
- -- require locking the caller to get the server, locking the server,
- -- and then accessing the queues. This involves holding two ATCB
- -- locks at once, something which we can guarantee that it will always
- -- be done in the same order, or locking a protected object while we
- -- hold an ATCB lock, something which is not permitted. Since
- -- the server cannot be obtained reliably, it must be obtained unreliably
- -- and then checked again once it has been locked.
+ -- This routine is needed because the field specifying the server for this
+ -- call must be protected by the server's mutex. If it were protected by
+ -- the caller's mutex, accessing the server's queues would require locking
+ -- the caller to get the server, locking the server, and then accessing the
+ -- queues. This involves holding two ATCB locks at once, something which we
+ -- can guarantee that it will always be done in the same order, or locking
+ -- a protected object while we hold an ATCB lock, something which is not
+ -- permitted. Since the server cannot be obtained reliably, it must be
+ -- obtained unreliably and then checked again once it has been locked.
--
- -- If Single_Lock and server is a PO, release RTS_Lock.
+ -- If Single_Lock and server is a PO, release RTS_Lock
--
-- This should only be called by the Entry_Call.Self.
-- It should be holding no other ATCB locks at the time.
-- If Single_Lock and server is a PO, take RTS_Lock on exit.
procedure Unlock_And_Update_Server
- (Self_ID : Task_ID;
+ (Self_ID : Task_Id;
Entry_Call : Entry_Call_Link);
-- Similar to Unlock_Server, but services entry calls if the
-- server is a protected object.
-- If Single_Lock and server is a PO, take RTS_Lock on exit.
procedure Check_Pending_Actions_For_Entry_Call
- (Self_ID : Task_ID;
+ (Self_ID : Task_Id;
Entry_Call : Entry_Call_Link);
- -- This procedure performs priority change of a queued call and
- -- dequeuing of an entry call when the call is cancelled.
- -- If the call is dequeued the state should be set to Cancelled.
- -- Call only with abort deferred and holding lock of Self_ID. This
- -- is a bit of common code for all entry calls. The effect is to do
- -- any deferred base priority change operation, in case some other
- -- task called STPO.Set_Priority while the current task had abort deferred,
- -- and to dequeue the call if the call has been aborted.
+ -- This procedure performs priority change of a queued call and dequeuing
+ -- of an entry call when the call is cancelled. If the call is dequeued the
+ -- state should be set to Cancelled. Call only with abort deferred and
+ -- holding lock of Self_ID. This is a bit of common code for all entry
+ -- calls. The effect is to do any deferred base priority change operation,
+ -- in case some other task called STPO.Set_Priority while the current task
+ -- had abort deferred, and to dequeue the call if the call has been
+ -- aborted.
procedure Poll_Base_Priority_Change_At_Entry_Call
- (Self_ID : Task_ID;
+ (Self_ID : Task_Id;
Entry_Call : Entry_Call_Link);
pragma Inline (Poll_Base_Priority_Change_At_Entry_Call);
- -- A specialized version of Poll_Base_Priority_Change,
- -- that does the optional entry queue reordering.
- -- Has to be called with the Self_ID's ATCB write-locked.
- -- May temporariliy release the lock.
+ -- A specialized version of Poll_Base_Priority_Change, that does the
+ -- optional entry queue reordering. Has to be called with the Self_ID's
+ -- ATCB write-locked. May temporarily release the lock.
---------------------
-- Check_Exception --
---------------------
procedure Check_Exception
- (Self_ID : Task_ID;
+ (Self_ID : Task_Id;
Entry_Call : Entry_Call_Link)
is
pragma Warnings (Off, Self_ID);
use type Ada.Exceptions.Exception_Id;
procedure Internal_Raise (X : Ada.Exceptions.Exception_Id);
- pragma Import (C, Internal_Raise, "__gnat_raise_after_setup");
+ pragma Import (C, Internal_Raise, "__gnat_raise_with_msg");
E : constant Ada.Exceptions.Exception_Id :=
Entry_Call.Exception_To_Raise;
begin
-- pragma Assert (Self_ID.Deferral_Level = 0);
+
-- The above may be useful for debugging, but the Florist packages
-- contain critical sections that defer abort and then do entry calls,
-- which causes the above Assert to trip.
------------------------------------------
procedure Check_Pending_Actions_For_Entry_Call
- (Self_ID : Task_ID;
- Entry_Call : Entry_Call_Link) is
+ (Self_ID : Task_Id;
+ Entry_Call : Entry_Call_Link)
+ is
begin
pragma Assert (Self_ID = Entry_Call.Self);
-----------------
procedure Lock_Server (Entry_Call : Entry_Call_Link) is
- Test_Task : Task_ID;
+ Test_Task : Task_Id;
Test_PO : Protection_Entries_Access;
Ceiling_Violation : Boolean;
Failures : Integer := 0;
loop
if Test_Task = null then
- -- Entry_Call was queued on a protected object,
- -- or in transition, when we last fetched Test_Task.
+ -- Entry_Call was queued on a protected object, or in transition,
+ -- when we last fetched Test_Task.
Test_PO := To_Protection (Entry_Call.Called_PO);
Lock_Entries (Test_PO, Ceiling_Violation);
- -- ????
- -- The following code allows Lock_Server to be called
- -- when cancelling a call, to allow for the possibility
- -- that the priority of the caller has been raised
- -- beyond that of the protected entry call by
- -- Ada.Dynamic_Priorities.Set_Priority.
+ -- ???
+
+ -- The following code allows Lock_Server to be called when
+ -- cancelling a call, to allow for the possibility that the
+ -- priority of the caller has been raised beyond that of the
+ -- protected entry call by Ada.Dynamic_Priorities.Set_Priority.
-- If the current task has a higher priority than the ceiling
-- of the protected object, temporarily lower it. It will
if Ceiling_Violation then
declare
- Current_Task : constant Task_ID := STPO.Self;
+ Current_Task : constant Task_Id := STPO.Self;
Old_Base_Priority : System.Any_Priority;
begin
---------------------------------------------
procedure Poll_Base_Priority_Change_At_Entry_Call
- (Self_ID : Task_ID;
- Entry_Call : Entry_Call_Link) is
+ (Self_ID : Task_Id;
+ Entry_Call : Entry_Call_Link)
+ is
begin
- if Dynamic_Priority_Support and then Self_ID.Pending_Priority_Change then
+ if Self_ID.Pending_Priority_Change then
+
-- Check for ceiling violations ???
Self_ID.Pending_Priority_Change := False;
- if Self_ID.Common.Base_Priority = Self_ID.New_Base_Priority then
- if Single_Lock then
- STPO.Unlock_RTS;
- STPO.Yield;
- STPO.Lock_RTS;
- else
- STPO.Unlock (Self_ID);
- STPO.Yield;
- STPO.Write_Lock (Self_ID);
- end if;
-
- else
- if Self_ID.Common.Base_Priority < Self_ID.New_Base_Priority then
- -- Raising priority
-
- Self_ID.Common.Base_Priority := Self_ID.New_Base_Priority;
- STPO.Set_Priority (Self_ID, Self_ID.Common.Base_Priority);
-
- else
- -- Lowering priority
-
- Self_ID.Common.Base_Priority := Self_ID.New_Base_Priority;
- STPO.Set_Priority (Self_ID, Self_ID.Common.Base_Priority);
-
- if Single_Lock then
- STPO.Unlock_RTS;
- STPO.Yield;
- STPO.Lock_RTS;
- else
- STPO.Unlock (Self_ID);
- STPO.Yield;
- STPO.Write_Lock (Self_ID);
- end if;
- end if;
- end if;
-
- -- Requeue the entry call at the new priority.
- -- We need to requeue even if the new priority is the same than
- -- the previous (see ACVC cxd4006).
+ -- Requeue the entry call at the new priority. We need to requeue
+ -- even if the new priority is the same than the previous (see ACATS
+ -- test cxd4006).
STPO.Unlock (Self_ID);
Lock_Server (Entry_Call);
--------------------
procedure Reset_Priority
- (Acceptor : Task_ID;
- Acceptor_Prev_Priority : Rendezvous_Priority) is
+ (Acceptor : Task_Id;
+ Acceptor_Prev_Priority : Rendezvous_Priority)
+ is
begin
pragma Assert (Acceptor = STPO.Self);
procedure Try_To_Cancel_Entry_Call (Succeeded : out Boolean) is
Entry_Call : Entry_Call_Link;
- Self_ID : constant Task_ID := STPO.Self;
+ Self_ID : constant Task_Id := STPO.Self;
use type Ada.Exceptions.Exception_Id;
Succeeded := Entry_Call.State = Cancelled;
- if Succeeded then
- Initialization.Undefer_Abort_Nestable (Self_ID);
- else
- -- ???
-
- Initialization.Undefer_Abort_Nestable (Self_ID);
+ Initialization.Undefer_Abort_Nestable (Self_ID);
- -- Ideally, abort should no longer be deferred at this
- -- point, so we should be able to call Check_Exception.
- -- The loop below should be considered temporary,
- -- to work around the possiblility that abort may be deferred
- -- more than one level deep.
+ -- Ideally, abort should no longer be deferred at this point, so we
+ -- should be able to call Check_Exception. The loop below should be
+ -- considered temporary, to work around the possibility that abort
+ -- may be deferred more than one level deep ???
- if Entry_Call.Exception_To_Raise /= Ada.Exceptions.Null_Id then
- while Self_ID.Deferral_Level > 0 loop
- System.Tasking.Initialization.Undefer_Abort_Nestable (Self_ID);
- end loop;
+ if Entry_Call.Exception_To_Raise /= Ada.Exceptions.Null_Id then
+ while Self_ID.Deferral_Level > 0 loop
+ System.Tasking.Initialization.Undefer_Abort_Nestable (Self_ID);
+ end loop;
- Entry_Calls.Check_Exception (Self_ID, Entry_Call);
- end if;
+ Entry_Calls.Check_Exception (Self_ID, Entry_Call);
end if;
end Try_To_Cancel_Entry_Call;
------------------------------
procedure Unlock_And_Update_Server
- (Self_ID : Task_ID;
+ (Self_ID : Task_Id;
Entry_Call : Entry_Call_Link)
is
Called_PO : Protection_Entries_Access;
- Caller : Task_ID;
+ Caller : Task_Id;
begin
if Entry_Call.Called_Task /= null then
STPO.Unlock (Entry_Call.Called_Task);
else
Called_PO := To_Protection (Entry_Call.Called_PO);
- PO_Service_Entries (Self_ID, Called_PO);
+ PO_Service_Entries (Self_ID, Called_PO, False);
if Called_PO.Pending_Action then
Called_PO.Pending_Action := False;
-------------------
procedure Unlock_Server (Entry_Call : Entry_Call_Link) is
- Caller : Task_ID;
+ Caller : Task_Id;
Called_PO : Protection_Entries_Access;
begin
-------------------------
procedure Wait_For_Completion (Entry_Call : Entry_Call_Link) is
- Self_Id : constant Task_ID := Entry_Call.Self;
+ Self_Id : constant Task_Id := Entry_Call.Self;
+
begin
-- If this is a conditional call, it should be cancelled when it
-- becomes abortable. This is checked in the loop below.
Send_Trace_Info (W_Completion);
end if;
+ Self_Id.Common.State := Entry_Caller_Sleep;
+
-- Try to remove calls to Sleep in the loop below by letting the caller
-- a chance of getting ready immediately, using Unlock & Yield.
- -- See similar action in Wait_For_Call & Selective_Wait.
+ -- See similar action in Wait_For_Call & Timed_Selective_Wait.
if Single_Lock then
STPO.Unlock_RTS;
STPO.Write_Lock (Self_Id);
end if;
- Self_Id.Common.State := Entry_Caller_Sleep;
-
loop
Check_Pending_Actions_For_Entry_Call (Self_Id, Entry_Call);
Mode : Delay_Modes;
Yielded : out Boolean)
is
- Self_Id : constant Task_ID := Entry_Call.Self;
+ Self_Id : constant Task_Id := Entry_Call.Self;
Timedout : Boolean := False;
use type Ada.Exceptions.Exception_Id;
Yielded := False;
Self_Id.Common.State := Entry_Caller_Sleep;
- -- Looping is necessary in case the task wakes up early from the
- -- timed sleep, due to a "spurious wakeup". Spurious wakeups are
- -- a weakness of POSIX condition variables. A thread waiting for
- -- a condition variable is allowed to wake up at any time, not just
- -- when the condition is signaled. See the same loop in the
- -- ordinary Wait_For_Completion, above.
+ -- Looping is necessary in case the task wakes up early from the timed
+ -- sleep, due to a "spurious wakeup". Spurious wakeups are a weakness of
+ -- POSIX condition variables. A thread waiting for a condition variable
+ -- is allowed to wake up at any time, not just when the condition is
+ -- signaled. See same loop in the ordinary Wait_For_Completion, above.
if Parameters.Runtime_Traces then
Send_Trace_Info (WT_Completion, Wakeup_Time);
--------------------------
procedure Wait_Until_Abortable
- (Self_ID : Task_ID;
- Call : Entry_Call_Link) is
+ (Self_ID : Task_Id;
+ Call : Entry_Call_Link)
+ is
begin
pragma Assert (Self_ID.ATC_Nesting_Level > 0);
pragma Assert (Call.Mode = Asynchronous_Call);
OSDN Git Service
