667 lines
23 KiB
Ada
667 lines
23 KiB
Ada
------------------------------------------------------------------------------
|
|
-- --
|
|
-- 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-2011, 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 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. --
|
|
-- --
|
|
-- 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;
|
|
with System.Tasking.Initialization;
|
|
with System.Tasking.Protected_Objects.Entries;
|
|
with System.Tasking.Protected_Objects.Operations;
|
|
with System.Tasking.Queuing;
|
|
with System.Tasking.Utilities;
|
|
with System.Parameters;
|
|
with System.Traces;
|
|
|
|
package body System.Tasking.Entry_Calls is
|
|
|
|
package STPO renames System.Task_Primitives.Operations;
|
|
|
|
use Parameters;
|
|
use Task_Primitives;
|
|
use Protected_Objects.Entries;
|
|
use Protected_Objects.Operations;
|
|
use System.Traces;
|
|
|
|
-- DO NOT use Protected_Objects.Lock or Protected_Objects.Unlock
|
|
-- internally. Those operations will raise Program_Error, which
|
|
-- we are not prepared to handle inside the RTS. Instead, use
|
|
-- System.Task_Primitives lock operations directly on Protection.L.
|
|
|
|
-----------------------
|
|
-- Local Subprograms --
|
|
-----------------------
|
|
|
|
procedure Lock_Server (Entry_Call : Entry_Call_Link);
|
|
|
|
-- 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 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
|
|
--
|
|
-- This should only be called by the Entry_Call.Self.
|
|
-- It should be holding no other ATCB locks at the time.
|
|
|
|
procedure Unlock_Server (Entry_Call : Entry_Call_Link);
|
|
-- STPO.Unlock the server targeted by Entry_Call. The server must
|
|
-- be locked before calling this.
|
|
--
|
|
-- If Single_Lock and server is a PO, take RTS_Lock on exit.
|
|
|
|
procedure Unlock_And_Update_Server
|
|
(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;
|
|
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.
|
|
|
|
procedure Poll_Base_Priority_Change_At_Entry_Call
|
|
(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 temporarily release the lock.
|
|
|
|
---------------------
|
|
-- Check_Exception --
|
|
---------------------
|
|
|
|
procedure Check_Exception
|
|
(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_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.
|
|
|
|
if E /= Ada.Exceptions.Null_Id then
|
|
Internal_Raise (E);
|
|
end if;
|
|
end Check_Exception;
|
|
|
|
------------------------------------------
|
|
-- Check_Pending_Actions_For_Entry_Call --
|
|
------------------------------------------
|
|
|
|
procedure Check_Pending_Actions_For_Entry_Call
|
|
(Self_ID : Task_Id;
|
|
Entry_Call : Entry_Call_Link)
|
|
is
|
|
begin
|
|
pragma Assert (Self_ID = Entry_Call.Self);
|
|
|
|
Poll_Base_Priority_Change_At_Entry_Call (Self_ID, Entry_Call);
|
|
|
|
if Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level
|
|
and then Entry_Call.State = Now_Abortable
|
|
then
|
|
STPO.Unlock (Self_ID);
|
|
Lock_Server (Entry_Call);
|
|
|
|
if Queuing.Onqueue (Entry_Call)
|
|
and then Entry_Call.State = Now_Abortable
|
|
then
|
|
Queuing.Dequeue_Call (Entry_Call);
|
|
Entry_Call.State :=
|
|
(if Entry_Call.Cancellation_Attempted then Cancelled else Done);
|
|
Unlock_And_Update_Server (Self_ID, Entry_Call);
|
|
|
|
else
|
|
Unlock_Server (Entry_Call);
|
|
end if;
|
|
|
|
STPO.Write_Lock (Self_ID);
|
|
end if;
|
|
end Check_Pending_Actions_For_Entry_Call;
|
|
|
|
-----------------
|
|
-- Lock_Server --
|
|
-----------------
|
|
|
|
procedure Lock_Server (Entry_Call : Entry_Call_Link) is
|
|
Test_Task : Task_Id;
|
|
Test_PO : Protection_Entries_Access;
|
|
Ceiling_Violation : Boolean;
|
|
Failures : Integer := 0;
|
|
|
|
begin
|
|
Test_Task := Entry_Call.Called_Task;
|
|
|
|
loop
|
|
if Test_Task = null then
|
|
|
|
-- 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);
|
|
|
|
if Test_PO = null then
|
|
|
|
-- We had very bad luck, interleaving with TWO different
|
|
-- requeue operations. Go around the loop and try again.
|
|
|
|
if Single_Lock then
|
|
STPO.Unlock_RTS;
|
|
STPO.Yield;
|
|
STPO.Lock_RTS;
|
|
else
|
|
STPO.Yield;
|
|
end if;
|
|
|
|
else
|
|
if Single_Lock then
|
|
STPO.Unlock_RTS;
|
|
end if;
|
|
|
|
Lock_Entries_With_Status (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.
|
|
|
|
-- If the current task has a higher priority than the ceiling
|
|
-- of the protected object, temporarily lower it. It will
|
|
-- be reset in Unlock.
|
|
|
|
if Ceiling_Violation then
|
|
declare
|
|
Current_Task : constant Task_Id := STPO.Self;
|
|
Old_Base_Priority : System.Any_Priority;
|
|
|
|
begin
|
|
if Single_Lock then
|
|
STPO.Lock_RTS;
|
|
end if;
|
|
|
|
STPO.Write_Lock (Current_Task);
|
|
Old_Base_Priority := Current_Task.Common.Base_Priority;
|
|
Current_Task.New_Base_Priority := Test_PO.Ceiling;
|
|
System.Tasking.Initialization.Change_Base_Priority
|
|
(Current_Task);
|
|
STPO.Unlock (Current_Task);
|
|
|
|
if Single_Lock then
|
|
STPO.Unlock_RTS;
|
|
end if;
|
|
|
|
-- Following lock should not fail
|
|
|
|
Lock_Entries (Test_PO);
|
|
|
|
Test_PO.Old_Base_Priority := Old_Base_Priority;
|
|
Test_PO.Pending_Action := True;
|
|
end;
|
|
end if;
|
|
|
|
exit when To_Address (Test_PO) = Entry_Call.Called_PO;
|
|
Unlock_Entries (Test_PO);
|
|
|
|
if Single_Lock then
|
|
STPO.Lock_RTS;
|
|
end if;
|
|
end if;
|
|
|
|
else
|
|
STPO.Write_Lock (Test_Task);
|
|
exit when Test_Task = Entry_Call.Called_Task;
|
|
STPO.Unlock (Test_Task);
|
|
end if;
|
|
|
|
Test_Task := Entry_Call.Called_Task;
|
|
Failures := Failures + 1;
|
|
pragma Assert (Failures <= 5);
|
|
end loop;
|
|
end Lock_Server;
|
|
|
|
---------------------------------------------
|
|
-- Poll_Base_Priority_Change_At_Entry_Call --
|
|
---------------------------------------------
|
|
|
|
procedure Poll_Base_Priority_Change_At_Entry_Call
|
|
(Self_ID : Task_Id;
|
|
Entry_Call : Entry_Call_Link)
|
|
is
|
|
begin
|
|
if Self_ID.Pending_Priority_Change then
|
|
|
|
-- Check for ceiling violations ???
|
|
|
|
Self_ID.Pending_Priority_Change := False;
|
|
|
|
-- 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);
|
|
Queuing.Requeue_Call_With_New_Prio
|
|
(Entry_Call, STPO.Get_Priority (Self_ID));
|
|
Unlock_And_Update_Server (Self_ID, Entry_Call);
|
|
STPO.Write_Lock (Self_ID);
|
|
end if;
|
|
end Poll_Base_Priority_Change_At_Entry_Call;
|
|
|
|
--------------------
|
|
-- Reset_Priority --
|
|
--------------------
|
|
|
|
procedure Reset_Priority
|
|
(Acceptor : Task_Id;
|
|
Acceptor_Prev_Priority : Rendezvous_Priority)
|
|
is
|
|
begin
|
|
pragma Assert (Acceptor = STPO.Self);
|
|
|
|
-- Since we limit this kind of "active" priority change to be done
|
|
-- by the task for itself, we don't need to lock Acceptor.
|
|
|
|
if Acceptor_Prev_Priority /= Priority_Not_Boosted then
|
|
STPO.Set_Priority (Acceptor, Acceptor_Prev_Priority,
|
|
Loss_Of_Inheritance => True);
|
|
end if;
|
|
end Reset_Priority;
|
|
|
|
------------------------------
|
|
-- Try_To_Cancel_Entry_Call --
|
|
------------------------------
|
|
|
|
procedure Try_To_Cancel_Entry_Call (Succeeded : out Boolean) is
|
|
Entry_Call : Entry_Call_Link;
|
|
Self_ID : constant Task_Id := STPO.Self;
|
|
|
|
use type Ada.Exceptions.Exception_Id;
|
|
|
|
begin
|
|
Entry_Call := Self_ID.Entry_Calls (Self_ID.ATC_Nesting_Level)'Access;
|
|
|
|
-- Experimentation has shown that abort is sometimes (but not
|
|
-- always) already deferred when Cancel_xxx_Entry_Call is called.
|
|
-- That may indicate an error. Find out what is going on. ???
|
|
|
|
pragma Assert (Entry_Call.Mode = Asynchronous_Call);
|
|
Initialization.Defer_Abort_Nestable (Self_ID);
|
|
|
|
if Single_Lock then
|
|
STPO.Lock_RTS;
|
|
end if;
|
|
|
|
STPO.Write_Lock (Self_ID);
|
|
Entry_Call.Cancellation_Attempted := True;
|
|
|
|
if Self_ID.Pending_ATC_Level >= Entry_Call.Level then
|
|
Self_ID.Pending_ATC_Level := Entry_Call.Level - 1;
|
|
end if;
|
|
|
|
Entry_Calls.Wait_For_Completion (Entry_Call);
|
|
STPO.Unlock (Self_ID);
|
|
|
|
if Single_Lock then
|
|
STPO.Unlock_RTS;
|
|
end if;
|
|
|
|
Succeeded := Entry_Call.State = Cancelled;
|
|
|
|
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 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;
|
|
|
|
Entry_Calls.Check_Exception (Self_ID, Entry_Call);
|
|
end if;
|
|
end Try_To_Cancel_Entry_Call;
|
|
|
|
------------------------------
|
|
-- Unlock_And_Update_Server --
|
|
------------------------------
|
|
|
|
procedure Unlock_And_Update_Server
|
|
(Self_ID : Task_Id;
|
|
Entry_Call : Entry_Call_Link)
|
|
is
|
|
Called_PO : Protection_Entries_Access;
|
|
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, False);
|
|
|
|
if Called_PO.Pending_Action then
|
|
Called_PO.Pending_Action := False;
|
|
Caller := STPO.Self;
|
|
|
|
if Single_Lock then
|
|
STPO.Lock_RTS;
|
|
end if;
|
|
|
|
STPO.Write_Lock (Caller);
|
|
Caller.New_Base_Priority := Called_PO.Old_Base_Priority;
|
|
Initialization.Change_Base_Priority (Caller);
|
|
STPO.Unlock (Caller);
|
|
|
|
if Single_Lock then
|
|
STPO.Unlock_RTS;
|
|
end if;
|
|
end if;
|
|
|
|
Unlock_Entries (Called_PO);
|
|
|
|
if Single_Lock then
|
|
STPO.Lock_RTS;
|
|
end if;
|
|
end if;
|
|
end Unlock_And_Update_Server;
|
|
|
|
-------------------
|
|
-- Unlock_Server --
|
|
-------------------
|
|
|
|
procedure Unlock_Server (Entry_Call : Entry_Call_Link) is
|
|
Caller : Task_Id;
|
|
Called_PO : Protection_Entries_Access;
|
|
|
|
begin
|
|
if Entry_Call.Called_Task /= null then
|
|
STPO.Unlock (Entry_Call.Called_Task);
|
|
else
|
|
Called_PO := To_Protection (Entry_Call.Called_PO);
|
|
|
|
if Called_PO.Pending_Action then
|
|
Called_PO.Pending_Action := False;
|
|
Caller := STPO.Self;
|
|
|
|
if Single_Lock then
|
|
STPO.Lock_RTS;
|
|
end if;
|
|
|
|
STPO.Write_Lock (Caller);
|
|
Caller.New_Base_Priority := Called_PO.Old_Base_Priority;
|
|
Initialization.Change_Base_Priority (Caller);
|
|
STPO.Unlock (Caller);
|
|
|
|
if Single_Lock then
|
|
STPO.Unlock_RTS;
|
|
end if;
|
|
end if;
|
|
|
|
Unlock_Entries (Called_PO);
|
|
|
|
if Single_Lock then
|
|
STPO.Lock_RTS;
|
|
end if;
|
|
end if;
|
|
end Unlock_Server;
|
|
|
|
-------------------------
|
|
-- Wait_For_Completion --
|
|
-------------------------
|
|
|
|
procedure Wait_For_Completion (Entry_Call : Entry_Call_Link) is
|
|
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.
|
|
|
|
if Parameters.Runtime_Traces then
|
|
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 & Timed_Selective_Wait.
|
|
|
|
if Single_Lock then
|
|
STPO.Unlock_RTS;
|
|
else
|
|
STPO.Unlock (Self_Id);
|
|
end if;
|
|
|
|
if Entry_Call.State < Done then
|
|
STPO.Yield;
|
|
end if;
|
|
|
|
if Single_Lock then
|
|
STPO.Lock_RTS;
|
|
else
|
|
STPO.Write_Lock (Self_Id);
|
|
end if;
|
|
|
|
loop
|
|
Check_Pending_Actions_For_Entry_Call (Self_Id, Entry_Call);
|
|
|
|
exit when Entry_Call.State >= Done;
|
|
|
|
STPO.Sleep (Self_Id, Entry_Caller_Sleep);
|
|
end loop;
|
|
|
|
Self_Id.Common.State := Runnable;
|
|
Utilities.Exit_One_ATC_Level (Self_Id);
|
|
|
|
if Parameters.Runtime_Traces then
|
|
Send_Trace_Info (M_Call_Complete);
|
|
end if;
|
|
end Wait_For_Completion;
|
|
|
|
--------------------------------------
|
|
-- Wait_For_Completion_With_Timeout --
|
|
--------------------------------------
|
|
|
|
procedure Wait_For_Completion_With_Timeout
|
|
(Entry_Call : Entry_Call_Link;
|
|
Wakeup_Time : Duration;
|
|
Mode : Delay_Modes;
|
|
Yielded : out Boolean)
|
|
is
|
|
Self_Id : constant Task_Id := Entry_Call.Self;
|
|
Timedout : Boolean := False;
|
|
|
|
use type Ada.Exceptions.Exception_Id;
|
|
|
|
begin
|
|
-- This procedure waits for the entry call to be served, with a timeout.
|
|
-- It tries to cancel the call if the timeout expires before the call is
|
|
-- served.
|
|
|
|
-- If we wake up from the timed sleep operation here, it may be for
|
|
-- several possible reasons:
|
|
|
|
-- 1) The entry call is done being served.
|
|
-- 2) There is an abort or priority change to be served.
|
|
-- 3) The timeout has expired (Timedout = True)
|
|
-- 4) There has been a spurious wakeup.
|
|
|
|
-- Once the timeout has expired we may need to continue to wait if the
|
|
-- call is already being serviced. In that case, we want to go back to
|
|
-- sleep, but without any timeout. The variable Timedout is used to
|
|
-- control this. If the Timedout flag is set, we do not need to
|
|
-- STPO.Sleep with a timeout. We just sleep until we get a wakeup for
|
|
-- some status change.
|
|
|
|
-- The original call may have become abortable after waking up. We want
|
|
-- to check Check_Pending_Actions_For_Entry_Call again in any case.
|
|
|
|
pragma Assert (Entry_Call.Mode = Timed_Call);
|
|
|
|
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 same loop in the ordinary Wait_For_Completion, above.
|
|
|
|
if Parameters.Runtime_Traces then
|
|
Send_Trace_Info (WT_Completion, Wakeup_Time);
|
|
end if;
|
|
|
|
loop
|
|
Check_Pending_Actions_For_Entry_Call (Self_Id, Entry_Call);
|
|
exit when Entry_Call.State >= Done;
|
|
|
|
STPO.Timed_Sleep (Self_Id, Wakeup_Time, Mode,
|
|
Entry_Caller_Sleep, Timedout, Yielded);
|
|
|
|
if Timedout then
|
|
if Parameters.Runtime_Traces then
|
|
Send_Trace_Info (E_Timeout);
|
|
end if;
|
|
|
|
-- Try to cancel the call (see Try_To_Cancel_Entry_Call for
|
|
-- corresponding code in the ATC case).
|
|
|
|
Entry_Call.Cancellation_Attempted := True;
|
|
|
|
-- Reset Entry_Call.State so that the call is marked as cancelled
|
|
-- by Check_Pending_Actions_For_Entry_Call below.
|
|
|
|
if Entry_Call.State < Was_Abortable then
|
|
Entry_Call.State := Now_Abortable;
|
|
end if;
|
|
|
|
if Self_Id.Pending_ATC_Level >= Entry_Call.Level then
|
|
Self_Id.Pending_ATC_Level := Entry_Call.Level - 1;
|
|
end if;
|
|
|
|
-- The following loop is the same as the loop and exit code
|
|
-- from the ordinary Wait_For_Completion. If we get here, we
|
|
-- have timed out but we need to keep waiting until the call
|
|
-- has actually completed or been cancelled successfully.
|
|
|
|
loop
|
|
Check_Pending_Actions_For_Entry_Call (Self_Id, Entry_Call);
|
|
exit when Entry_Call.State >= Done;
|
|
STPO.Sleep (Self_Id, Entry_Caller_Sleep);
|
|
end loop;
|
|
|
|
Self_Id.Common.State := Runnable;
|
|
Utilities.Exit_One_ATC_Level (Self_Id);
|
|
|
|
return;
|
|
end if;
|
|
end loop;
|
|
|
|
-- This last part is the same as ordinary Wait_For_Completion,
|
|
-- and is only executed if the call completed without timing out.
|
|
|
|
if Parameters.Runtime_Traces then
|
|
Send_Trace_Info (M_Call_Complete);
|
|
end if;
|
|
|
|
Self_Id.Common.State := Runnable;
|
|
Utilities.Exit_One_ATC_Level (Self_Id);
|
|
end Wait_For_Completion_With_Timeout;
|
|
|
|
--------------------------
|
|
-- Wait_Until_Abortable --
|
|
--------------------------
|
|
|
|
procedure Wait_Until_Abortable
|
|
(Self_ID : Task_Id;
|
|
Call : Entry_Call_Link)
|
|
is
|
|
begin
|
|
pragma Assert (Self_ID.ATC_Nesting_Level > 0);
|
|
pragma Assert (Call.Mode = Asynchronous_Call);
|
|
|
|
if Parameters.Runtime_Traces then
|
|
Send_Trace_Info (W_Completion);
|
|
end if;
|
|
|
|
STPO.Write_Lock (Self_ID);
|
|
Self_ID.Common.State := Entry_Caller_Sleep;
|
|
|
|
loop
|
|
Check_Pending_Actions_For_Entry_Call (Self_ID, Call);
|
|
exit when Call.State >= Was_Abortable;
|
|
STPO.Sleep (Self_ID, Async_Select_Sleep);
|
|
end loop;
|
|
|
|
Self_ID.Common.State := Runnable;
|
|
STPO.Unlock (Self_ID);
|
|
|
|
if Parameters.Runtime_Traces then
|
|
Send_Trace_Info (M_Call_Complete);
|
|
end if;
|
|
end Wait_Until_Abortable;
|
|
|
|
end System.Tasking.Entry_Calls;
|