New Language: Ada

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@45957 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 713 insertions, 0 deletions

diff --git a/gcc/ada/s-taenca.adb b/gcc/ada/s-taenca.adb
new file mode 100644
index 00000000000..bf9afbaedad
--- /dev/null
+++ b/gcc/ada/s-taenca.adb
@@ -0,0 +1,713 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                GNU ADA 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                                 --
+--                                                                          --
+--                             $Revision: 1.36 $
+--                                                                          --
+--            Copyright (C) 1991-2001, Florida State University             --
+--                                                                          --
+-- 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- --
+-- 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.                                                      --
+--                                                                          --
+-- 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.                                      --
+--                                                                          --
+-- GNARL was developed by the GNARL team at Florida State University. It is --
+-- now maintained by Ada Core Technologies Inc. in cooperation with Florida --
+-- State University (http://www.gnat.com).                                  --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  This package provides internal RTS calls implementing operations
+--  that apply to general entry calls, that is, calls to either
+--  protected or task entries.
+
+--  These declarations are not part of the GNARL interface
+
+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
+--           Poll_Base_Priority_Change_At_Entry_Call
+--           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
+
+package body System.Tasking.Entry_Calls is
+
+   package STPO renames System.Task_Primitives.Operations;
+
+   use System.Task_Primitives;
+   use System.Tasking.Protected_Objects.Entries;
+   use System.Tasking.Protected_Objects.Operations;
+
+   --  DO NOT use Protected_Objects.Lock or Protected_Objects.Unlock
+   --  internally. Those operations will raise Program_Error, which
+   --  we do 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.
+
+   procedure Unlock_Server (Entry_Call : Entry_Call_Link);
+   --  STPO.Unlock the server targeted by Entry_Call. The server must
+   --  be locked before calling this.
+
+   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.
+
+   procedure Check_Pending_Actions_For_Entry_Call
+     (Self_ID    : Task_ID;
+      Entry_Call : Entry_Call_Link);
+   pragma Inline (Check_Pending_Actions_For_Entry_Call);
+   --  This procedure performs priority change of a queued call and
+   --  dequeuing of an entry call when an the call is cancelled.
+   --  If the call is dequeued the state should be set to Cancelled.
+
+   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);
+   --  Has to be called with the Self_ID's ATCB write-locked.
+   --  May temporariliy release the lock.
+
+   ---------------------
+   -- Check_Exception --
+   ---------------------
+
+   --  Raise any pending exception from the Entry_Call.
+
+   --  This should be called at the end of every compiler interface
+   --  procedure that implements an entry call.
+
+   --  In principle, the caller should not be abort-deferred (unless
+   --  the application program violates the Ada language rules by doing
+   --  entry calls from within protected operations -- an erroneous practice
+   --  apparently followed with success by some adventurous GNAT users).
+   --  Absolutely, the caller should not be holding any locks, or there
+   --  will be deadlock.
+
+   procedure Check_Exception
+     (Self_ID    : Task_ID;
+      Entry_Call : Entry_Call_Link)
+   is
+      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 --
+   -----------------------------------------
+
+   --  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 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);
+
+            if Entry_Call.Cancellation_Attempted then
+               Entry_Call.State := Cancelled;
+            else
+               Entry_Call.State := Done;
+            end if;
+
+            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 --
+   -----------------
+
+   --  This should only be called by the Entry_Call.Self.
+   --  It should be holding no other ATCB locks at the time.
+
+   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.
+
+               STPO.Yield;
+
+            else
+               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.STPO.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      : Task_ID := STPO.Self;
+                     Old_Base_Priority : System.Any_Priority;
+
+                  begin
+                     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);
+
+                     --  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);
+            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 --
+   ---------------------------------------------
+
+   --  A specialized version of Poll_Base_Priority_Change,
+   --  that does the optional entry queue reordering.
+
+   procedure Poll_Base_Priority_Change_At_Entry_Call
+     (Self_ID    : Task_ID;
+      Entry_Call : Entry_Call_Link)
+   is
+   begin
+      if Initialization.Dynamic_Priority_Support
+        and then 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
+            STPO.Unlock (Self_ID);
+            STPO.Yield;
+            STPO.Write_Lock (Self_ID);
+
+         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);
+               STPO.Unlock (Self_ID);
+               STPO.Yield;
+               STPO.Write_Lock (Self_ID);
+            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).
+
+         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 --
+   --------------------
+
+   --  Reset the priority of a task completing an accept statement to
+   --  the value it had before the call.
+
+   procedure Reset_Priority
+     (Acceptor_Prev_Priority : Rendezvous_Priority;
+      Acceptor               : Task_ID) is
+   begin
+      if Acceptor_Prev_Priority /= Priority_Not_Boosted then
+         STPO.Set_Priority (Acceptor, Acceptor_Prev_Priority,
+           Loss_Of_Inheritance => True);
+      end if;
+   end Reset_Priority;
+
+   --  ???
+   --  Check why we don't need any kind of lock to do this.
+   --  Do we limit this kind of "active" priority change to be done
+   --  by the task for itself only?
+
+   ------------------------------
+   -- Try_To_Cancel_Entry_Call --
+   ------------------------------
+
+   --  This is used to implement the Cancel_Task_Entry_Call and
+   --  Cancel_Protected_Entry_Call.
+   --  Try to cancel async. entry call.
+   --  Effect includes Abort_To_Level and Wait_For_Completion.
+   --  Cancelled = True iff the cancelation was successful, i.e.,
+   --  the call was not Done before this call.
+   --  On return, the call is off-queue and the ATC level is reduced by one.
+
+   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_X_Entry_Call is called.
+      --  That may indicate an error. Find out what is going on. ???
+
+      pragma Assert (Entry_Call.Mode = Asynchronous_Call);
+      pragma Assert (Self_ID = Self);
+
+      Initialization.Defer_Abort_Nestable (Self_ID);
+      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 (Self_ID, Entry_Call);
+      STPO.Unlock (Self_ID);
+      Succeeded := Entry_Call.State = Cancelled;
+
+      if Succeeded then
+         Initialization.Undefer_Abort_Nestable (Self_ID);
+      else
+         --  ????
+
+         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.
+
+         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 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);
+
+         if Called_PO.Pending_Action then
+            Called_PO.Pending_Action := False;
+            Caller := STPO.Self;
+            STPO.Write_Lock (Caller);
+            Caller.New_Base_Priority := Called_PO.Old_Base_Priority;
+            Initialization.Change_Base_Priority (Caller);
+            STPO.Unlock (Caller);
+         end if;
+
+         Unlock_Entries (Called_PO);
+      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;
+            STPO.Write_Lock (Caller);
+            Caller.New_Base_Priority := Called_PO.Old_Base_Priority;
+            Initialization.Change_Base_Priority (Caller);
+            STPO.Unlock (Caller);
+         end if;
+
+         Unlock_Entries (Called_PO);
+      end if;
+   end Unlock_Server;
+
+   -------------------------
+   -- Wait_For_Completion--
+   -------------------------
+
+   --  Call this only when holding Self_ID locked
+
+   --  If this is a conditional call, it should be cancelled when it
+   --  becomes abortable. This is checked in the loop below.
+
+   --  We do the same thing for Asynchronous_Call. Executing the following
+   --  loop will clear the Pending_Action field if there is no
+   --  Pending_Action. We want the call made from Cancel_Task_Entry_Call
+   --  to check the abortion level so that we make sure that the Cancelled
+   --  field reflect the status of an Asynchronous_Call properly.
+   --  This problem came up when the triggered statement and the abortable
+   --  part depend on entries of the same task. When a cancellation is
+   --  delivered, Undefer_Abort in the call made from abortable part
+   --  sets the Pending_Action bit to false. However, the call is actually
+   --  made to cancel the Asynchronous Call so that we need to check its
+   --  status here again. Otherwise we may end up waiting for a cancelled
+   --  call forever.
+
+   --  ????? .........
+   --  Recheck the logic of the above old comment.  It may be stale.
+
+   procedure Wait_For_Completion
+     (Self_ID    : Task_ID;
+      Entry_Call : Entry_Call_Link)
+   is
+   begin
+      pragma Assert (Self_ID = Entry_Call.Self);
+      Self_ID.Common.State := Entry_Caller_Sleep;
+
+      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);
+   end Wait_For_Completion;
+
+   --------------------------------------
+   -- Wait_For_Completion_With_Timeout --
+   --------------------------------------
+
+   --  This routine will lock Self_ID.
+
+   --  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.
+
+   procedure Wait_For_Completion_With_Timeout
+     (Self_ID     : Task_ID;
+      Entry_Call  : Entry_Call_Link;
+      Wakeup_Time : Duration;
+      Mode        : Delay_Modes)
+   is
+      Timedout : Boolean := False;
+      Yielded  : Boolean := False;
+
+      use type Ada.Exceptions.Exception_Id;
+
+   begin
+      Initialization.Defer_Abort_Nestable (Self_ID);
+      STPO.Write_Lock (Self_ID);
+
+      pragma Assert (Entry_Call.Self = Self_ID);
+      pragma Assert (Entry_Call.Mode = Timed_Call);
+      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.
+
+      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
+
+            --  Try to cancel the call (see Try_To_Cancel_Entry_Call for
+            --  corresponding code in the ATC case).
+
+            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;
+
+            --  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);
+
+            STPO.Unlock (Self_ID);
+
+            if Entry_Call.State = Cancelled then
+               Initialization.Undefer_Abort_Nestable (Self_ID);
+            else
+               --  ????
+
+               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.
+
+               if Entry_Call.Exception_To_Raise /=
+                 Ada.Exceptions.Null_Id then
+
+                  while Self_ID.Deferral_Level > 0 loop
+                     Initialization.Undefer_Abort_Nestable (Self_ID);
+                  end loop;
+
+                  Entry_Calls.Check_Exception (Self_ID, Entry_Call);
+               end if;
+            end if;
+
+            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.
+
+      Self_ID.Common.State := Runnable;
+      Utilities.Exit_One_ATC_Level (Self_ID);
+      STPO.Unlock (Self_ID);
+
+      Initialization.Undefer_Abort_Nestable (Self_ID);
+
+      if not Yielded then
+         STPO.Yield;
+      end if;
+   end Wait_For_Completion_With_Timeout;
+
+   --------------------------
+   -- Wait_Until_Abortable --
+   --------------------------
+
+   --  Wait to start the abortable part of an async. select statement
+   --  until the trigger entry call becomes 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);
+
+      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);
+   end Wait_Until_Abortable;
+
+   --  It might seem that we should be holding the server's lock when
+   --  we test Call.State above.
+
+   --  In an earlier version, the code above temporarily unlocked the
+   --  caller and locked the server just for checking Call.State.
+   --  The unlocking of the caller risked missing a wakeup
+   --  (an error) and locking the server had no apparent value.
+   --  We should not need the server's lock, since once Call.State
+   --  is set to Was_Abortable or beyond, it never goes back below
+   --  Was_Abortable until this task starts another entry call.
+
+   --  ????
+   --  It seems that other calls to Lock_Server may also risk missing
+   --  wakeups.  We need to check that they do not have this problem.
+
+end System.Tasking.Entry_Calls;