-----------------------------------------------------------------------------
--                                                                         --
--                GNU ADA RUNTIME LIBRARY (GNARL) COMPONENTS               --
--                                                                         --
--            S Y S T E M . T A S K I N G . R E N D E Z V O U S            --
--                                                                         --
--                                 B o d y                                 --
--                                                                         --
--                            $Revision: 1.9 $                             --
--                                                                         --
--          Copyright (c) 1991,1992,1993, FSU, All Rights Reserved         --
--                                                                         --
-- GNARL is free software; you can redistribute it and/or modify it  under --
-- terms  of  the  GNU  Library General Public License as published by the --
-- Free Software Foundation; either version 2,  or (at  your  option)  any --
-- later  version.   GNARL is distributed in the hope that it will be use- --
-- ful, but but WITHOUT ANY WARRANTY; without even the implied warranty of --
-- MERCHANTABILITY  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Gen- --
-- eral Library Public License for more details.  You should have received --
-- a  copy of the GNU Library General Public License along with GNARL; see --
-- file COPYING. If not, write to the Free Software Foundation,  675  Mass --
-- Ave, Cambridge, MA 02139, USA.                                          --
--                                                                         --
-----------------------------------------------------------------------------

with System.Task_Primitives; use System.Task_Primitives;

with System.Tasking.Abortion;
--  Used for Abortion.Defer_Abortion,
--           Abortion.Undefer_Abortion
--           Abortion.Abort_To_Level

with System.Tasking.Protected_Objects;
--  Used for Protected_Objects.Check_Exception

with System.Error_Reporting;
--  Used for Error_Reporting.Assert

--  with System.Tasking.Queuing; use System.Tasking.Queuing;
--  Temporary. (queuing is in Tasking)

with System.Tasking.Runtime_Types;
--  Used for Runtime_Types.ATCB_Ptr,
--           Runtime_Types.ATCB_To_ID,
--           Runtime_Types.ID_To_ATCB,
--           Runtime_Types.Null_PO;
--           Runtime_Types."<",
--           Runtime_Types.">=",
--           Runtime_Types."=",
--           Runtime_Types.Task_Stage
--           Runtime_Types.Accepting_State
--           Runtime_Types.Vulnerable_Complete_Activation

with System.Compiler_Exceptions;
--  Used for Compiler_Exceptions."="

package body System.Tasking.Rendezvous is

   function ID_To_ATCB (ID : Task_ID) return Runtime_Types.ATCB_Ptr
     renames Tasking.Runtime_Types.ID_To_ATCB;

   function ATCB_To_ID (Ptr : Runtime_Types.ATCB_Ptr) return Task_ID
     renames Runtime_Types.ATCB_To_ID;

   procedure Assert (B : Boolean; M : String)
     renames Error_Reporting.Assert;

   procedure Defer_Abortion
     renames Abortion.Defer_Abortion;

   procedure Undefer_Abortion renames
     Abortion.Undefer_Abortion;

   --  Following should be replaced by use type ???

   function "<" (L, R : Runtime_Types.Task_Stage) return Boolean
     renames Runtime_Types."<";

   function ">=" (L, R : Runtime_Types.Task_Stage) return Boolean
     renames Runtime_Types.">=";

   function "=" (L, R : Runtime_Types.Accepting_State) return Boolean
     renames Runtime_Types."=";

   function "=" (L, R : Exception_ID)
     return Boolean renames Compiler_Exceptions."=";

   type Select_Treatment is (
     Accept_Alternative_Selected,
     Else_Selected,
     Terminate_Selected,
     Accept_Alternative_Open,
     No_Alternative_Open);

   Default_Treatment : constant array (Select_Modes) of Select_Treatment :=
     (Simple_Mode         => No_Alternative_Open,
      Else_Mode           => Else_Selected,
      Terminate_Mode      => Terminate_Selected);

   -----------------------
   -- Local Subprograms --
   -----------------------

   procedure Make_Passive
     (T : Runtime_Types.ATCB_Ptr);
   --  Record that task T is passive.

   procedure Boost_Priority
     (Call     : Entry_Call_Link;
      Acceptor : Runtime_Types.ATCB_Ptr);
   pragma Inline (Boost_Priority);

   procedure Test_Call
     (Entry_Call           : in out Entry_Call_Link;
      Rendezvous_Completed : out Boolean);
   --  Test if a rendezvous can be made right away. Returns True if the
   --  rendezvous has occurred (and finished).
   --  Problem: Try not to call this when the acceptor is not accepting.
   --  What does problem mean??? advice??? why??? absolute rule???

   function Test_Selective_Wait
     (Acceptor     : Runtime_Types.ATCB_Ptr;
      Open_Accepts : Accept_List_Access;
      Select_Mode  : Select_Modes)
      return         Select_Treatment;
   pragma Inline (Test_Selective_Wait);
   --  Test if there is a call waiting on any entry, and whether any selects
   --  are open. Set Acceptor.Chosen_Index to selected alternative if an
   --  accept alternative can be selected.

   procedure Universal_Complete_Rendezvous (Ex : Exception_ID);
   pragma Inline (Universal_Complete_Rendezvous);
   --  Called by acceptor to wake up caller and optionally propagate exception

   ------------------
   -- Make_Passive --
   ------------------

   --  If T is the last dependent of some master in task P to become passive,
   --  then release P. A special case of this is when T has no dependents
   --  and is completed. In this case, T itself should be released.

   --  If the parent is made passive, this is repeated recursively, with C
   --  being the previous parent and P being the next parent up.

   --  Note that we have to hold the locks of both P and C (locked in that
   --  order) so that the Awake_Count of C and the Awaited_Dependent_Count of
   --  P will be synchronized.  Otherwise, an attempt by P to terminate can
   --  preempt this routine after C's Awake_Count has been decremented to zero
   --  but before C has checked the Awaited_Dependent_Count of P.  P would not
   --  count C in its Awaited_Dependent_Count since it is not awake, but it
   --  might count other awake dependents.  When C gained control again, it
   --  would decrement P's Awaited_Dependent_Count to indicate that it is
   --  passive, even though it was never counted as active.  This would cause
   --  P to wake up before all of its dependents are passive.

   --  Note : Any task with an interrupt entry should never become passive.
   --  Support for this feature needs to be added here.

   procedure Make_Passive (T : Runtime_Types.ATCB_Ptr) is
      P : Runtime_Types.ATCB_Ptr;
      --  Task whose Awaited_Dependent_Count may be decremented.

      C : Runtime_Types.ATCB_Ptr;
      --  Task whose awake-count gets decremented.

      H : Runtime_Types.ATCB_Ptr;
      --  Highest task that is ready to terminate dependents.

      Taken     : Boolean;
      Activator : Runtime_Types.ATCB_Ptr;

   begin
      Runtime_Types.Vulnerable_Complete_Activation (T);

      Write_Lock (T.L);

      if T.Stage >= Runtime_Types.Passive then
         Unlock (T.L);
         return;
      else
         T.Stage := Runtime_Types.Passive;
         Unlock (T.L);
      end if;

      H := null;
      P := T.Parent;
      C := T;

      while C /= null loop

         if P /= null then
            Write_Lock (P.L);
            Write_Lock (C.L);

            C.Awake_Count := C.Awake_Count - 1;

            if C.Awake_Count /= 0 then

               --  C is not passive; we cannot make anything above this point
               --  passive.

               Unlock (C.L);
               Unlock (P.L);
               exit;
            end if;

            if P.Awaited_Dependent_Count /= 0 then

               --  We have hit a non-task master; we will not be able to make
               --  anything above this point passive.

               P.Awake_Count := P.Awake_Count - 1;

               if C.Master_of_Task = P.Master_Within then
                  P.Awaited_Dependent_Count := P.Awaited_Dependent_Count - 1;

                  if P.Awaited_Dependent_Count = 0 then
                     H := P;
                  end if;
               end if;

               Unlock (C.L);
               Unlock (P.L);
               exit;
            end if;

            if C.Stage = Runtime_Types.Complete then

               --  C is both passive (Awake_Count = 0) and complete; wake it
               --  up to await termination of its dependents.  It will not be
               --  complete if it is waiting on a terminate alternative. Such
               --  a task is not ready to wait for its dependents to terminate,
               --  though one of its ancestors may be.

               H := C;
            end if;

            Unlock (C.L);
            Unlock (P.L);
            C := P;
            P := C.Parent;

         else
            Write_Lock (C.L);
            C.Awake_Count := C.Awake_Count - 1;

            if C.Awake_Count /= 0 then

               --  C is not passive; we cannot make anything above
               --  this point passive.

               Unlock (C.L);
               exit;
            end if;

            if C.Stage = Runtime_Types.Complete then

               --  C is both passive (Awake_Count = 0) and complete; wake it
               --  up to await termination of its dependents.  It will not be
               --  complete if it is waiting on a terminate alternative. Such
               --  a task is not ready to wait for its dependents to terminate,
               --  though one of its ancestors may be.

               H := C;
            end if;

            Unlock (C.L);
            C := P;
         end if;

      end loop;

      if H /= null then
         Cond_Signal (H.Cond);
      end if;

   end Make_Passive;

   --------------------
   -- Boost_Priority --
   --------------------

   procedure Boost_Priority
     (Call     : Entry_Call_Link;
      Acceptor : Runtime_Types.ATCB_Ptr)
   is
      Caller : Runtime_Types.ATCB_Ptr := ID_To_ATCB (Call.Self);

   begin
      if Get_Priority (Caller.LL_TCB'access) >
         Get_Priority (Acceptor.LL_TCB'access)
      then
         Call.Acceptor_Prev_Priority := Acceptor.Current_Priority;
         Acceptor.Current_Priority := Caller.Current_Priority;
         Set_Priority (Acceptor.LL_TCB'access, Acceptor.Current_Priority);
      end if;
   end Boost_Priority;

   --------------------
   -- Reset_Priority --
   --------------------

   procedure Reset_Priority
     (Acceptor_Prev_Priority : Rendezvous_Priority;
       Acceptor              : Task_ID)
   is
      Acceptor_ATCB : Runtime_Types.ATCB_Ptr := ID_To_ATCB (Acceptor);

   begin
      if Acceptor_Prev_Priority /= Priority_Not_Boosted then
         Acceptor_ATCB.Current_Priority := Acceptor_Prev_Priority;
         Set_Priority
           (Acceptor_ATCB.LL_TCB'access, Acceptor_ATCB.Current_Priority);
      end if;
   end Reset_Priority;

   ---------------
   -- Test_Call --
   ---------------

   procedure Test_Call
     (Entry_Call           : in out Entry_Call_Link;
      Rendezvous_Completed : out Boolean)
   is
      Temp_Entry  : Entry_Index;
      TAS_Result  : Boolean;
      Acceptor_ID : Task_ID;
      Acceptor    : Runtime_Types.ATCB_Ptr;
      Caller      : Runtime_Types.ATCB_Ptr := ID_To_ATCB (Entry_Call.Self);

   begin
      Acceptor := ID_To_ATCB (Entry_Call.Called_Task);

      if Acceptor.Accepting = Runtime_Types.Trivial_Accept then
         Temp_Entry := Entry_Index (Acceptor.Open_Accepts (1).S);

         --  Case of rendezvous accepted

         if Entry_Call.E = Temp_Entry then
            Acceptor.Accepting := Runtime_Types.Not_Accepting;
            Entry_Call.Acceptor_Prev_Call := Acceptor.Call;
            Acceptor.Call := Entry_Call;
            Entry_Call.Done := True;
            Rendezvous_Completed := True;
            Cond_Signal (Acceptor.Cond); -- Inefficient ???

         --  Case of wait for acceptor

         else
            Rendezvous_Completed := False;
         end if;

      elsif Acceptor.Accepting = Runtime_Types.Not_Accepting then
         if Callable (ATCB_To_ID (Acceptor)) then

            --  Wait for acceptor

            Rendezvous_Completed := False;

         else
            if Entry_Call.Mode /= Asynchronous_Call then
               Caller.ATC_Nesting_Level := Caller.ATC_Nesting_Level - 1;
            end if;

            Unlock (Acceptor.L);
            Undefer_Abortion;
            raise Tasking_Error;
         end if;

      else
         --  Try to do immediate rendezvous

         for J in Acceptor.Open_Accepts'range loop
            Temp_Entry := Entry_Index (Acceptor.Open_Accepts (J).S);

            if Entry_Call.E = Temp_Entry then --  do rendezvous
               Test_And_Set (Entry_Call.Call_Claimed'Address, TAS_Result);

               if not TAS_Result then

                  --  This task has been aborted

                  Unlock (Acceptor.L);
                  Write_Lock (Caller.L);
                  Caller.Suspended_Abortably := True;

                  while
                    Caller.Pending_ATC_Level >= Caller.ATC_Nesting_Level
                  loop
                     Cond_Wait (Caller.Rend_Cond, Caller.L);
                  end loop;

                  Caller.Suspended_Abortably := False;
                  Unlock (Caller.L);
                  Write_Lock (Acceptor.L);

               end if;

               Entry_Call.Acceptor_Prev_Call := Acceptor.Call;
               Acceptor.Call := Entry_Call;
               Acceptor.Chosen_Index := J;
               Acceptor.Accepting := Runtime_Types.Not_Accepting;
               Boost_Priority (Entry_Call, Acceptor);
               Cond_Signal (Acceptor.Cond);

               --  This needs to be protected by the caller's mutex, not the
               --  acceptor's.  Otherwise, there is a risk of loosing a
               --  signal.  This is dumb code, and probably could be fixed to
               --  some extent by getting rid of Test_Call. ???

               Unlock (Acceptor.L);
               Write_Lock (Caller.L);
               Caller.Suspended_Abortably := True;

               while not Entry_Call.Done loop
                  Cond_Wait (Caller.Rend_Cond, Caller.L);
               end loop;

               Caller.Suspended_Abortably := False;
               Unlock (Caller.L);
               Write_Lock (Acceptor.L);
               Rendezvous_Completed := True;
               return;
            end if;
         end loop;

         Rendezvous_Completed := False;
      end if;
   end Test_Call;

   ---------------------------------------
   -- Vulnerable_Cancel_Task_Entry_Call --
   ---------------------------------------

   procedure Vulnerable_Cancel_Task_Entry_Call
     (Call                  : Entry_Call_Link;
      Cancel_Was_Successful : out Boolean)
   is
      TAS_Result : Boolean;
      Caller     : Runtime_Types.ATCB_Ptr := ID_To_ATCB (Call.Self);
      Acceptor   : Runtime_Types.ATCB_Ptr := ID_To_ATCB (Call.Called_Task);

   begin
      Cancel_Was_Successful := False;
      Test_And_Set (Call.Call_Claimed'Address, TAS_Result);

      if TAS_Result then
         if not Call.Done then

         --  We should be able to check this flag at this point; we have
         --  claimed the call, so no one will be able to service this call,
         --  so no one else should be able to change the Call.Done flag.

            Write_Lock (Acceptor.L);
            Dequeue (Acceptor.Entry_Queues (Task_Entry_Index (Call.E)), Call);
            Unlock (Acceptor.L);
            Cancel_Was_Successful := True;

            --  Note: this will indicate failure to cancel if the acceptor has
            --  canceled the call due to completion.  Of course, we are going
            --  to raise an exception in that case, so I think that this is
            --  OK; the flag retuned to the application code should never be
            --  used.
         end if;

      else
         Write_Lock (Caller.L);

         while not Call.Done loop
            Cond_Wait (Caller.Rend_Cond, Caller.L);
         end loop;

         Unlock (Caller.L);
      end if;

      Caller.ATC_Nesting_Level := Caller.ATC_Nesting_Level - 1;

      Write_Lock (Caller.L);

      if Caller.Pending_ATC_Level = Caller.ATC_Nesting_Level then
         Caller.Pending_ATC_Level := ATC_Level_Infinity;
         Caller.Aborting := False;
      end if;

      Unlock (Caller.L);

      --  If we have reached the desired ATC nesting level, reset the
      --  requested level to effective infinity, to allow further calls.

      Caller.Exception_To_Raise := Call.Exception_To_Raise;

   end Vulnerable_Cancel_Task_Entry_Call;

   -----------------
   -- Call_Simple --
   -----------------

   procedure Call_Simple
     (Acceptor  : Task_ID;
      E         : Task_Entry_Index;
      Uninterpreted_Data : System.Address)
   is
      Caller : constant Runtime_Types.ATCB_Ptr := ID_To_ATCB (Self);

      Acceptor_ATCB         : Runtime_Types.ATCB_Ptr := ID_To_ATCB (Acceptor);
      Rendezvous_Completed  : Boolean;
      Level                 : ATC_Level;
      Entry_Call            : Entry_Call_Link;
      Cancel_Was_Successful : Boolean;

   begin
      Defer_Abortion;
      Write_Lock (Acceptor_ATCB.L);
      Caller.ATC_Nesting_Level := Caller.ATC_Nesting_Level + 1;
      Level := Caller.ATC_Nesting_Level;

      Entry_Call := Caller.Entry_Calls (Level)'access;

      Entry_Call.Next := null;
      Entry_Call.Call_Claimed := False;
      Entry_Call.Mode := Simple_Call;
      Entry_Call.Abortable := True;
      Entry_Call.Done := False;
      Entry_Call.E := Entry_Index (E);
      Entry_Call.Prio := Caller.Current_Priority;
      Entry_Call.Uninterpreted_Data := Uninterpreted_Data;
      Entry_Call.Called_Task := Acceptor;
      Entry_Call.Exception_To_Raise := Null_Exception;

      Test_Call (Entry_Call, Rendezvous_Completed);

      if not Rendezvous_Completed then
         Enqueue (Acceptor_ATCB.Entry_Queues (E), Entry_Call);
         Unlock (Acceptor_ATCB.L);
         Write_Lock (Caller.L);
         Caller.Suspended_Abortably := True;

         while not Entry_Call.Done
           and then (Caller.Pending_ATC_Level >= Caller.ATC_Nesting_Level
                       or else Entry_Call.Call_Claimed)
         loop
            Cond_Wait (Caller.Rend_Cond, Caller.L);
         end loop;

         Caller.Suspended_Abortably := False;
         Unlock (Caller.L);

      else
         Unlock (Acceptor_ATCB.L);
      end if;

      --  WARNING:
      --  Is this right???  In the original runtime, abortion would decrement
      --  the nesting level as part of completing the task.  Now I'm not
      --  so sure; there is a distinction made between
      --  asynchronous calls and the rest that I think I may come to regret;
      --  the asynchronous calls are always cleaned up by
      --  Cancel_Task_Entry_Call, but the others get cleaned up by
      --  Task_Entry_Call or its equivalent.
      --  Complete no longer does a decrement, so who does if this task is
      --  aborted at this point?  I think that the decrement should take
      --  place before undeferring abortion, and that this should include
      --  taking the call off any queue it might be on.
      --  Problem: What if it is claimed in the meantime by an acceptor?  The
      --  test for Call_Claimed in the wait loop is really vulnerable to race
      --  conditions on this point.  We can't get out of the loop until
      --  Call_Claimed is false, but there is nothing to keep it from
      --  staying false.  By the time we get here, rendezvous could be in
      --  progress.  The only solution is to claim the call here in order
      --  to cancel it.  However, what do we do if we loose?  Wait again?
      --  I think so.  I also think that that works: wait until done or
      --  aborted; if aborted, attempt to cancel the call; if that fails, wait
      --  until the call (now well and truly started) completes, without
      --  benefit of Suspended_Abortably.
      --  Problem: The acceptor might also claim the call on completion, to
      --  cancel it.  In that case, it has already awakened us, and won't do it
      --  again.
      --  I think this is OK.  Close_Entries already pretends that the
      --  call has been completed, and has already set the exception at that
      --  point. Needs final resolution ??

      Vulnerable_Cancel_Task_Entry_Call (Entry_Call, Cancel_Was_Successful);
      Undefer_Abortion;

      Assert (Caller.Pending_ATC_Level >= Caller.ATC_Nesting_Level,
        "Continuing after aborting self!");

      Protected_Objects.Check_Exception;
   end Call_Simple;

   ----------------------------
   -- Cancel_Task_Entry_Call --
   ----------------------------

   procedure Cancel_Task_Entry_Call (Cancelled : out Boolean) is
      Caller   : Runtime_Types.ATCB_Ptr := ID_To_ATCB (Self);
      Call     : Entry_Call_Link;
      Acceptor : Runtime_Types.ATCB_Ptr;

   begin
      Assert (Caller.ATC_Nesting_Level > ATC_Level_Base'First,
        "Attempt to cancel nonexistant task entry call.");

      Call := Caller.Entry_Calls (Caller.ATC_Nesting_Level)'access;

      Assert (Call.Mode = Asynchronous_Call,
        "Attempt to perform ATC on a non-asynchronous task entry call");
      Assert (Call.Called_PO = Runtime_Types.Null_PO,
        "Attempt to use Cancel_Task_Entry_Call on protected entry call.");

      Acceptor := ID_To_ATCB (Call.Called_Task);
      Defer_Abortion;
      Vulnerable_Cancel_Task_Entry_Call (Call, Cancelled);
      Undefer_Abortion;
      Protected_Objects.Check_Exception;
   end Cancel_Task_Entry_Call;

   ------------------------
   -- Requeue_Task_Entry --
   ------------------------

   procedure Requeue_Task_Entry
     (Acceptor   : Task_ID;
      E          : Task_Entry_Index;
      With_Abort : Boolean)
   is
      Old_Acceptor  : Runtime_Types.ATCB_Ptr := ID_To_ATCB (Self);
      Entry_Call    : Entry_Call_Link;
      Acceptor_ATCB : Runtime_Types.ATCB_Ptr := ID_To_ATCB (Acceptor);

   begin
      Write_Lock (Old_Acceptor.L);
      Entry_Call := Old_Acceptor.Call;
      Old_Acceptor.Call := null;
      Unlock (Old_Acceptor.L);

      Entry_Call.Abortable := With_Abort;
      Entry_Call.E := Entry_Index (E);

      if With_Abort then
         Entry_Call.Call_Claimed := False;
      end if;

      Write_Lock (Acceptor_ATCB.L);
      Enqueue (Acceptor_ATCB.Entry_Queues (E), Entry_Call);
      Unlock (Acceptor_ATCB.L);
   end Requeue_Task_Entry;

   -------------------------------------
   -- Requeue_Protected_To_Task_Entry --
   -------------------------------------

   procedure Requeue_Protected_To_Task_Entry
     (Object     : Protection_Access;
      Acceptor   : Task_ID;
      E          : Task_Entry_Index;
      With_Abort : Boolean)
   is
      Old_Acceptor  : Runtime_Types.ATCB_Ptr := ID_To_ATCB (Self);
      Entry_Call    : Entry_Call_Link;
      Acceptor_ATCB : Runtime_Types.ATCB_Ptr := ID_To_ATCB (Acceptor);

   begin
      Object.Call_In_Progress.Abortable := With_Abort;
      Object.Call_In_Progress.E := Entry_Index (E);

      if With_Abort then
         Object.Call_In_Progress.Call_Claimed := False;
      end if;

      Write_Lock (Acceptor_ATCB.L);
      Enqueue (Acceptor_ATCB.Entry_Queues (E), Object.Call_In_Progress);
      Unlock (Acceptor_ATCB.L);
   end Requeue_Protected_To_Task_Entry;

   ---------------------
   -- Task_Entry_Call --
   ---------------------

   procedure Task_Entry_Call
     (Acceptor              : Task_ID;
      E                     : Task_Entry_Index;
      Uninterpreted_Data             : System.Address;
      Mode                  : Call_Modes;
      Rendezvous_Successful : out Boolean)
   is
      Caller        : constant Runtime_Types.ATCB_Ptr := ID_To_ATCB (Self);
      Acceptor_ATCB : Runtime_Types.ATCB_Ptr := ID_To_ATCB (Acceptor);

      Rendezvous_Completed  : Boolean;
      Entry_Call            : Entry_Call_Link;
      Cancel_Was_Successful : Boolean;

   begin
      --  Simple call

      if Mode = Simple_Call then
         Call_Simple (Acceptor, E, Uninterpreted_Data);
         Rendezvous_Successful := True;
         return;

      --  Conditional call

      elsif Mode = Conditional_Call then
         Defer_Abortion;
         Caller.ATC_Nesting_Level := Caller.ATC_Nesting_Level + 1;

         Entry_Call := Caller.Entry_Calls (Caller.ATC_Nesting_Level)'access;

         Entry_Call.Next := null;
         Entry_Call.Call_Claimed := False;
         Entry_Call.Mode := Mode;
         Entry_Call.Abortable := True;
         Entry_Call.Done := False;
         Entry_Call.E := Entry_Index (E);
         Entry_Call.Prio := Caller.Current_Priority;
         Entry_Call.Uninterpreted_Data := Uninterpreted_Data;
         Entry_Call.Called_Task := Acceptor;
         Entry_Call.Exception_To_Raise := Null_Exception;
         Write_Lock (Acceptor_ATCB.L);
         Test_Call (Entry_Call, Rendezvous_Completed);
         Unlock (Acceptor_ATCB.L);

         if not Rendezvous_Completed then

            --  This is real junk code???.  If the acceptor wasn't ready, the
            --  call shouldn't be queued at all.  Since it is, the acceptor can
            --  accept it while before we get here to check for failed
            --  rendezvous.  The code below breaks the race, but it would
            --  be better if it never arose.  Think about dumping Test_Call.

            Vulnerable_Cancel_Task_Entry_Call
              (Entry_Call, Cancel_Was_Successful);
         end if;

         Undefer_Abortion;

         Assert (Caller.Pending_ATC_Level >= Caller.ATC_Nesting_Level,
           "Continuing after aborting self!");

         Protected_Objects.Check_Exception;
         Rendezvous_Successful := Entry_Call.Done;
         return;

      --  Asynchronous call

      else
         Defer_Abortion;
         Caller.ATC_Nesting_Level := Caller.ATC_Nesting_Level + 1;

         Entry_Call := Caller.Entry_Calls (Caller.ATC_Nesting_Level)'access;

         Entry_Call.Next := null;
         Entry_Call.Call_Claimed := False;
         Entry_Call.Mode := Mode;
         Entry_Call.Abortable := True;
         Entry_Call.Done := False;
         Entry_Call.E := Entry_Index (E);
         Entry_Call.Prio := Caller.Current_Priority;
         Entry_Call.Uninterpreted_Data := Uninterpreted_Data;
         Entry_Call.Called_Task := Acceptor;
         Entry_Call.Called_PO := Runtime_Types.Null_PO;
         Entry_Call.Exception_To_Raise := Null_Exception;

         Write_Lock (Acceptor_ATCB.L);
         Test_Call (Entry_Call, Rendezvous_Completed);

         if not Rendezvous_Completed then
            Enqueue (Acceptor_ATCB.Entry_Queues (E), Entry_Call);
         end if;

         Unlock (Acceptor_ATCB.L);
         Undefer_Abortion;
         Rendezvous_Successful := Entry_Call.Done;

         --  Amazingly, this seems to be all the work that is needed.

         --  Asynchronous calls are set up so that they are always explicitly
         --  canceled in in the compiled code. It might be worth considering
         --  unifying the various calls, and explitely cancelling all of them.
         --  This is not very efficiant, unfortunately.  Perhaps this call
         --  should unify them, with other calls for optimization?  Then who
         --  would want to use this call???

      end if;
   end Task_Entry_Call;

   -----------------
   -- Accept_Call --
   -----------------

   procedure Accept_Call
     (E         : Task_Entry_Index;
      Uninterpreted_Data : out System.Address)
   is
      Acceptor     : constant Runtime_Types.ATCB_Ptr := ID_To_ATCB (Self);
      Caller       : Runtime_Types.ATCB_Ptr := null;
      TAS_Result   : Boolean;
      Open_Accepts : aliased Accept_List (1 .. 1);
      Entry_Call   : Entry_Call_Link;

   begin
      Defer_Abortion;
      Write_Lock (Acceptor.L);

      --  If someone is completing this task, it must be because they plan
      --  to abort it.  This task should not try to access its pending entry
      --  calls or queues in this case, as they are being emptied.  Wait for
      --  abortion to kill us.

      if Acceptor.Stage >= Runtime_Types.Completing then

         while Acceptor.Pending_ATC_Level >= Acceptor.ATC_Nesting_Level loop
            Cond_Wait (Acceptor.Cond, Acceptor.L);
         end loop;

         Unlock (Acceptor.L);
         Undefer_Abortion;
         Assert (False, "Continuing execution after being aborted.");
      end if;

      loop
         Dequeue_Head (Acceptor.Entry_Queues (E), Entry_Call);

         if Entry_Call /= null then
            Test_And_Set (Entry_Call.Call_Claimed'Address, TAS_Result);
            exit when TAS_Result;

            --  TAS_Result = False only when the caller is already aborted or
            --  timed out; in that case, go on to the next caller on the queue
         else
            exit;
         end if;
      end loop;

      if Entry_Call /= null then
         Caller := ID_To_ATCB (Entry_Call.Self);
         Boost_Priority (Entry_Call, Acceptor);
         Entry_Call.Acceptor_Prev_Call := Acceptor.Call;
         Acceptor.Call := Entry_Call;
         Uninterpreted_Data := Entry_Call.Uninterpreted_Data;

      else
         --  Wait for a caller

         Open_Accepts (1).Null_Body := false;
         Open_Accepts (1).S := E;
         Acceptor.Open_Accepts := Open_Accepts'access;

         Acceptor.Accepting := Runtime_Types.Simple_Accept;

         --  Wait for normal call

         Acceptor.Suspended_Abortably := True;

         while Acceptor.Accepting /= Runtime_Types.Not_Accepting
           and then Acceptor.Pending_ATC_Level >= Acceptor.ATC_Nesting_Level
         loop
            Cond_Wait (Acceptor.Cond, Acceptor.L);
         end loop;

         Acceptor.Suspended_Abortably := False;

         if Acceptor.Pending_ATC_Level >= Acceptor.ATC_Nesting_Level then
            Caller := ID_To_ATCB (Acceptor.Call.Self);
            Uninterpreted_Data :=
              Caller.Entry_Calls (Caller.ATC_Nesting_Level).Uninterpreted_Data;
         end if;

         --  If this task has been aborted, skip the Uninterpreted_Data load
         --  (Caller will not be reliable) and fall through to
         --  Undefer_Abortion which will allow the task to be killed.
      end if;

      --  At this point, the call has been claimed, either by the acceptor
      --  or by the caller on behalf of the acceptor.

      --  Acceptor.Call should already be updated by the Caller

      Unlock (Acceptor.L);
      Undefer_Abortion;

      --  Start rendezvous
   end Accept_Call;

   --------------------
   -- Accept_Trivial --
   --------------------

   procedure Accept_Trivial (E : Task_Entry_Index) is
      Acceptor     : constant Runtime_Types.ATCB_Ptr := ID_To_ATCB (Self);
      Caller       : Runtime_Types.ATCB_Ptr := null;
      TAS_Result   : Boolean;
      Open_Accepts : aliased Accept_List (1 .. 1);
      Entry_Call   : Entry_Call_Link;

   begin
      Defer_Abortion;
      Write_Lock (Acceptor.L);

      --  If someone is completing this task, it must be because they plan
      --  to abort it.  This task should not try to access its pending entry
      --  calls or queues in this case, as they are being emptied.  Wait for
      --  abortion to kill us.

      if Acceptor.Stage >= Runtime_Types.Completing then

         while Acceptor.Pending_ATC_Level >= Acceptor.ATC_Nesting_Level loop
            Cond_Wait (Acceptor.Cond, Acceptor.L);
         end loop;

         Unlock (Acceptor.L);
         Undefer_Abortion;
         Assert (False, "Continuing execution after being aborted.");
      end if;

      loop
         Dequeue_Head (Acceptor.Entry_Queues (E), Entry_Call);

         if Entry_Call = null then

            --  Need to wait for call

            Open_Accepts (1).Null_Body := False;
            Open_Accepts (1).S := E;
            Acceptor.Open_Accepts := Open_Accepts'access;

            Acceptor.Accepting := Runtime_Types.Trivial_Accept;

            --  Wait for normal entry call

            Acceptor.Suspended_Abortably := True;

            while Acceptor.Accepting /= Runtime_Types.Not_Accepting
              and then Acceptor.Pending_ATC_Level >= Acceptor.ATC_Nesting_Level
            loop
               Cond_Wait (Acceptor.Cond, Acceptor.L);
            end loop;


            if Acceptor.Pending_ATC_Level < Acceptor.ATC_Nesting_Level then
               Unlock (Acceptor.L);
               Undefer_Abortion;
               Assert (False, "Continuing after being aborted!");
            else
               Acceptor.Suspended_Abortably := False;
               Entry_Call := Acceptor.Call;
               Acceptor.Call := Entry_Call.Acceptor_Prev_Call;
               Caller := ID_To_ATCB (Entry_Call.Self);

               if Entry_Call.Mode = Asynchronous_Call then
                  Abortion.Abort_To_Level
                   (ATCB_To_ID (Caller),
                    Entry_Call.Level);
               end if;

               Unlock (Acceptor.L);
            end if;

            exit;
         end if;

         Test_And_Set (Entry_Call.Call_Claimed'Address, TAS_Result);

         if TAS_Result then

            --  Caller is waiting; there is no accept body

            Caller := ID_To_ATCB (Entry_Call.Self);
            Unlock (Acceptor.L);
            Write_Lock (Caller.L);
            Entry_Call.Done := True;

            --  Done with mutex locked to make sure that signal is not lost.

            Unlock (Caller.L);
            Entry_Call.Call_Claimed := False;

            if Entry_Call.Mode = Asynchronous_Call then
               Abortion.Abort_To_Level (ATCB_To_ID (Caller), Entry_Call.Level);
            else
               Cond_Signal (Caller.Rend_Cond);
            end if;

            exit;
         end if;

         --  TAS_Result = False only when the caller is already aborted or has
         --  timed out; in that case, we go on to the next caller on the queue

      end loop;

      Undefer_Abortion;
   end Accept_Trivial;

   -----------------------------------
   -- Universal_Complete_Rendezvous --
   -----------------------------------

   procedure Universal_Complete_Rendezvous (Ex : Exception_ID) is
      Acceptor      : constant Runtime_Types.ATCB_Ptr := ID_To_ATCB (Self);
      Caller        : Runtime_Types.ATCB_Ptr;
      Call          : Entry_Call_Link;
      Prev_Priority : Rendezvous_Priority;

   begin
      Defer_Abortion;
      Call := Acceptor.Call;
      Acceptor.Call := Call.Acceptor_Prev_Call;
      Prev_Priority := Call.Acceptor_Prev_Priority;
      Call.Exception_To_Raise := Ex;
      Caller := ID_To_ATCB (Call.Self);
      Call.Call_Claimed := False;
      Write_Lock (Caller.L);
      Call.Done := True;
      Unlock (Caller.L);

      if Call.Mode = Asynchronous_Call then
         Abortion.Abort_To_Level (ATCB_To_ID (Caller), Call.Level);
      else
         Cond_Signal (Caller.Rend_Cond);
      end if;

      Reset_Priority (Prev_Priority, ATCB_To_ID (Acceptor));

      Acceptor.Exception_To_Raise := Ex;

      --  Save the exception for Complete_Rendezvous.

      Undefer_Abortion;
   end Universal_Complete_Rendezvous;

   -------------------------
   -- Complete_Rendezvous --
   -------------------------

   procedure Complete_Rendezvous is
   begin
      Universal_Complete_Rendezvous (Null_Exception);
   end Complete_Rendezvous;

   -------------------------------------
   -- Exceptional_Complete_Rendezvous --
   -------------------------------------

   procedure Exceptional_Complete_Rendezvous (Ex : Exception_ID) is
   begin
      Universal_Complete_Rendezvous (Ex);
   end Exceptional_Complete_Rendezvous;

   -------------------------
   -- Test_Selective_Wait --
   -------------------------


   function Test_Selective_Wait
     (Acceptor     : Runtime_Types.ATCB_Ptr;
      Open_Accepts : Accept_List_Access;
      Select_Mode  : Select_Modes) return Select_Treatment
   is
      Temp_Entry : Task_Entry_Index;
      Caller     : Runtime_Types.ATCB_Ptr := null;
      TAS_Result : Boolean;
      Treatment  : Select_Treatment;
      Entry_Call : Entry_Call_Link;

   begin
      Treatment := Default_Treatment (Select_Mode);
      Acceptor.Chosen_Index := No_Rendezvous;

      for J in Open_Accepts'range loop
         Temp_Entry := Open_Accepts (J).S;

         if Temp_Entry /= Null_Task_Entry then

            --  Guard is open

            loop
               Dequeue_Head (Acceptor.Entry_Queues (Temp_Entry), Entry_Call);

               if Entry_Call /= null then
                  Test_And_Set (Entry_Call.Call_Claimed'Address, TAS_Result);
                  exit when TAS_Result;

                  --  TAS_Result = False only when the call is already canceled
                  --  in that case, we go on to the next call on the queue

               else
                  exit;
               end if;

            end loop;

            if Entry_Call /= null then
               Caller := ID_To_ATCB (Entry_Call.Self);
               Boost_Priority (Entry_Call, Acceptor);
               Acceptor.Chosen_Index := J;
               Entry_Call.Acceptor_Prev_Call := Acceptor.Call;
               Acceptor.Call := Entry_Call;
               Treatment := Accept_Alternative_Selected;
               exit;

            elsif Treatment = No_Alternative_Open then
               Treatment := Accept_Alternative_Open;
            end if;

            --  Do rendezvous

         end if;
      end loop;

      return Treatment;

   end Test_Selective_Wait;

   --------------------
   -- Selective_Wait --
   --------------------

   procedure Selective_Wait
     (Open_Accepts : Accept_List_Access;
      Select_Mode  : Select_Modes;
      Uninterpreted_Data    : out System.Address;
      Index        : out Select_Index)
   is
      Acceptor  : constant Runtime_Types.ATCB_Ptr := ID_To_ATCB (Self);
      Treatment : Select_Treatment;
      I_Result  : Integer;

   begin
      Defer_Abortion;
      Write_Lock (Acceptor.L);

      --  If someone is completing this task, it must be because they plan
      --  to abort it.  This task should not try to access its pending entry
      --  calls or queues in this case, as they are being emptied.  Wait for
      --  abortion to kill us.

      if Acceptor.Stage >= Runtime_Types.Completing then

         while Acceptor.Pending_ATC_Level >= Acceptor.ATC_Nesting_Level loop
            Cond_Wait (Acceptor.Cond, Acceptor.L);
         end loop;

         Undefer_Abortion;
         Assert (False, "Continuing execution after being aborted.");
      end if;

      Treatment := Test_Selective_Wait (Acceptor, Open_Accepts, Select_Mode);

      case Treatment is

      when Accept_Alternative_Selected =>

         --  Ready to rendezvous already

         Uninterpreted_Data := Acceptor.Call.Uninterpreted_Data;

      when Accept_Alternative_Open =>

         --  Wait for caller.

         Acceptor.Open_Accepts := Open_Accepts;

         Acceptor.Accepting := Runtime_Types.Select_Wait;
         Acceptor.Suspended_Abortably := True;

         while Acceptor.Accepting /= Runtime_Types.Not_Accepting
           and then Acceptor.Pending_ATC_Level >= Acceptor.ATC_Nesting_Level
         loop
            Cond_Wait (Acceptor.Cond, Acceptor.L);
         end loop;

         Acceptor.Suspended_Abortably := False;

         if Acceptor.Pending_ATC_Level >= Acceptor.ATC_Nesting_Level then
            Uninterpreted_Data := Acceptor.Call.Uninterpreted_Data;
         end if;

         --  Acceptor.Call should already be updated by the Caller if
         --  not aborted.

      when Else_Selected =>
         Acceptor.Accepting := Runtime_Types.Not_Accepting;

      when Terminate_Selected =>

         --  Terminate alternative is open

         Acceptor.Open_Accepts := Open_Accepts;

         Acceptor.Accepting := Runtime_Types.Select_Wait;

         --  We need to check if a signal is pending on an open interrupt
         --  entry. Otherwise this task would become passive (since terminate
         --  alternative is open) and, if none of the siblings are active
         --  anymore, the task could not wake up anymore, even though a
         --  signal might be pending on an open interrupt entry.

         Unlock (Acceptor.L);
         Terminate_Alternative;

         --  Wait for normal entry call or termination

         --  consider letting Terminate_Alternative assume mutex L
         --  is already locked, and return with it locked, so
         --  this code could be simplified???

         --  No return here if Acceptor completes, otherwise
         --  Acceptor.Call should already be updated by the Caller

         Index := Acceptor.Chosen_Index;
         Uninterpreted_Data := Acceptor.Call.Uninterpreted_Data;
         Undefer_Abortion;
         return;

      when No_Alternative_Open =>

         --  Acceptor.Chosen_Index := No_Rendezvous; => Program_Error ???

         null;

      end case;

      --  Caller has been chosen

      --  Acceptor.Call should already be updated by the Caller

      --  Acceptor.Chosen_Index should either be updated by the Caller
      --  or by Test_Selective_Wait

      Index := Acceptor.Chosen_Index;
      Unlock (Acceptor.L);
      Undefer_Abortion;

      --  Start rendezvous

   end Selective_Wait;

   ----------------
   -- Task_Count --
   ----------------

   function Task_Count (E : Task_Entry_Index) return Natural is
      T            : constant Runtime_Types.ATCB_Ptr := ID_To_ATCB (Self);
      Return_Count : Natural;

   begin
      Write_Lock (T.L);
      Return_Count := Count_Waiting (T.Entry_Queues (E));
      Unlock (T.L);
      return Return_Count;
   end Task_Count;

   --------------
   -- Callable --
   --------------

   function Callable (T : Task_ID) return Boolean is
   begin
      return     ID_To_ATCB (T).Stage < Runtime_Types.Complete
        and then ID_To_ATCB (T).Pending_ATC_Level > ATC_Level_Base'First;
   end Callable;

   -------------------
   -- Close_Entries --
   -------------------

   procedure Close_Entries (Target : Task_ID) is
      T           : Runtime_Types.ATCB_Ptr := ID_To_ATCB (Target);
      Temp_Call   : Entry_Call_Link;
      Null_Call   : Entry_Call_Link := null;
      Temp_Caller : Runtime_Types.ATCB_Ptr;
      TAS_Result  : Boolean;

   begin
      --  Purging pending callers that are in the middle of rendezvous

      Temp_Call := T.Call;

      while Temp_Call /= null loop
         Temp_Call.Exception_To_Raise := Tasking_Error_ID;

         Temp_Caller := ID_To_ATCB (Temp_Call.Self);

         --  Problem: Once this lock is unlocked, the target gan go on to
         --  accept other calls, which will be missed by loop.  The question
         --  is, is there something else that will prevent this???
         --  If the target is in an abortion deferred region at this point,
         --  I don't know what it would be.

         --  By the time we get here, we do know that the target is complete
         --  and not callable.  Callable is unprotected, but Stage is protected
         --  by T.L.  If all forms of accept made sure under the protection of
         --  T.L that they were not complete before accepting a call, then it
         --  should be safe to unlock this here.

         --  Problem: what about multiple aborters?  If two tasks are in this
         --  routine at once, then there could contention if this mutex is
         --  unlocked.  We need some other form of claim mechanism to prevent
         --  this.  I think that the mechanism outlined in the implementation
         --  sketch, where an aborter waits for a previous aborter to finish
         --  its work, might solve this.

         --  What if T itself is at exactly this point and gets aborted?  In
         --  that case, I think that the aborter has to wait for T to finish
         --  completing itself.  This was previously done by contending for the
         --  mutex; it might now have to be done with some kind of flag, or
         --  maybe another stage.  Perhaps we are setting Stage=Complete too
         --  soon, and abortion should wait on that.  That would require
         --  some other flag to claim the right to complete, however.  This
         --  flag could probably be protected by T.L; there should not be
         --  any need for a TAS or global mutex.  Perhaps the Aborting flag
         --  could do this, though right now all it means is that an abortion
         --  exception has been sent.  We really need a separate Completing
         --  flag (ugh).  On the bright side, this might mean that completion
         --  can be treated as once-and-once-only, and need not be reentrant.

         --  Problem: What does an acceptor do when it finds that it is being
         --  completed?  I guess it should wait until completion is finished,
         --  just like a second aborter.  Otherwise, it might continue on
         --  with a rendezvous that it never really accepted.

         Write_Lock (Temp_Caller.L);
         Temp_Call.Done := True;
         Unlock (Temp_Caller.L);

         --  The caller can break out of its loop at this point, and never
         --  notice the abortion.

--       Temp_Call.Call_Claimed:= False;
--  Wrong, I think.  This should look like a completed call to everyone. ???

         Abortion.Abort_To_Level
           (ATCB_To_ID (Temp_Caller), Temp_Call.Level - 1);

         --  I think this might be wrong; Abortion takes precedence over
         --  exceptions in the call block. ???
         --  Not true; the last call to be canceled won't raise Abortion again;
         --  it raises the chosen exception instead.  This is true of leaf
         --  (suspending) calls as well; they decrement the nesting level
         --  before undeferring abortion, which will prevent further abortion
         --  (providing that abortion is not to an outer level).
         --  Final resolution and removal of these comments, or replacement
         --  by comments saying what is happening without speculation
         --  is needed (RBKD) ???

         Temp_Call := Temp_Call.Acceptor_Prev_Call;
      end loop;

      --  Purging entry queues

      for J in 1 .. T.Entry_Num loop
         Dequeue_Head (T.Entry_Queues (J), Temp_Call);

         if Temp_Call /= Null_Call then
            loop
               Test_And_Set (Temp_Call.Call_Claimed'Address, TAS_Result);

               if TAS_Result then
                  Temp_Caller := ID_To_ATCB (Temp_Call.Self);
                  Temp_Call.Exception_To_Raise := Tasking_Error_ID;
                  Temp_Call.Done := True;

                  Abortion.Abort_To_Level
                    (ATCB_To_ID (Temp_Caller), Temp_Call.Level - 1);

               else
                  null;

                  --  Someone else claimed this call.  It must be to cancel it,
                  --  since the acceptor can't have accepted it at this point.
                  --  So far as we are concerned, this call is not on the
                  --  queue, and we don't have to raise tasking error in the
                  --  caller.
               end if;

               Dequeue_Head (T.Entry_Queues (J), Temp_Call);
               exit when Temp_Call = Null_Call;
            end loop;
         end if;
      end loop;

   end Close_Entries;

   ----------------------------
   -- Complete_On_Sync_Point --
   ----------------------------

   procedure Complete_on_Sync_Point (T : Task_ID) is
      Target     : Runtime_Types.ATCB_Ptr := ID_To_ATCB (T);
      Call       : Entry_Call_Link;
      TAS_Result : Boolean;

   begin
      Write_Lock (Target.L);

      if Target.Suspended_Abortably then

         if Target.Accepting /= Runtime_Types.Not_Accepting then
            Unlock (Target.L);
            Complete (T);

         else
            --  Hopefully suspended on an entry call by elimination.

            if Target.ATC_Nesting_Level > ATC_Level_Base'First then
               Call := Target.Entry_Calls (Target.ATC_Nesting_Level)'access;
               Test_And_Set (Call.Call_Claimed'Address, TAS_Result);

               if TAS_Result then
                  Unlock (Target.L);
                  Complete (T);
                  Call.Call_Claimed := False;

                  --  To allow abortion to claim it.

               else
                  Unlock (Target.L);
               end if;
            end if;
         end if;

      else
         Unlock (Target.L);
      end if;
   end Complete_on_Sync_Point;

   ---------------------------
   -- Terminate_Alternative --
   ---------------------------

   --  WARNING : Only call this procedure with abortion deferred. This
   --  procedure needs to have abortion deferred while it has the current
   --  task's lock locked. Since it is called from two procedures which
   --  also need abortion deferred, it is left controlled on entry to
   --  this procedure.

   procedure Terminate_Alternative is
      P, T  : Runtime_Types.ATCB_Ptr := ID_To_ATCB (Self);
      Taken : Boolean;

   begin
      Make_Passive (T);

      --  Note that abortion is deferred here (see WARNING above)

      Write_Lock (T.L);

      while T.Accepting /= Runtime_Types.Not_Accepting
        and then T.Stage /= Runtime_Types.Complete
        and then T.Pending_ATC_Level >= T.ATC_Nesting_Level
      loop
         Cond_Wait (T.Cond, T.L);
      end loop;

      if T.Stage = Runtime_Types.Complete then
         Unlock (T.L);

         if T.Pending_ATC_Level < T.ATC_Nesting_Level then
            Undefer_Abortion;
            Assert (False, "Continuing after being aborted!");
         end if;

         Abortion.Abort_To_Level (ATCB_To_ID (T), 0);
         Undefer_Abortion;
         Assert (False, "Continuing after being aborted!");
      end if;

      T.Stage := Runtime_Types.Active;
      T.Awake_Count := T.Awake_Count + 1;

      --  At this point, T.Awake_Count and P.Awaited_Dependent_Count could be
      --  out of synchronization.  However, we know that
      --  P.Awaited_Dependent_Count cannot be zero, and cannot go to zero,
      --  since some other dependent must have just called us.  There should
      --  therefore be no danger of the parent terminating before we increment
      --  P.Awaited_Dependent_Count below.

      if T.Awake_Count = 1 then
         Unlock (T.L);

         if T.Pending_ATC_Level < T.ATC_Nesting_Level then
            Undefer_Abortion;
            Assert (False, "Continuing after being aborted!");
         end if;

         P := T.Parent;
         Write_Lock (P.L);

         if P.Awake_Count /= 0 then
            P.Awake_Count := P.Awake_Count + 1;

         else
            Unlock (P.L);
            Abortion.Abort_To_Level (ATCB_To_ID (T), 0);
            Undefer_Abortion;
            Assert (False, "Continuing after being aborted!");
         end if;

         --  Conservative checks which should only matter when an interrupt
         --  entry was chosen. In this case, the current task completes if the
         --  parent has already been signaled that all children have
         --  terminated.

         if T.Master_of_Task = P.Master_Within then
            if P.Awaited_Dependent_Count /= 0 then
               P.Awaited_Dependent_Count := P.Awaited_Dependent_Count + 1;

            elsif P.Stage = Runtime_Types.Await_Dependents then
               Unlock (P.L);
               Abortion.Abort_To_Level (ATCB_To_ID (T), 0);
               Undefer_Abortion;
               Assert (False, "Continuing after being aborted!");
            end if;
         end if;

         Unlock (P.L);

      else
         Unlock (T.L);

         if T.Pending_ATC_Level < T.ATC_Nesting_Level then
            Undefer_Abortion;
            Assert (False, "Continuing after being aborted!");
         end if;
      end if;

      --  Note: the caller will undefer abortion on return (see WARNING above)

   end Terminate_Alternative;

   --------------
   -- Complete --
   --------------

   procedure Complete (Target : Task_ID) is
      T      : Runtime_Types.ATCB_Ptr := ID_To_ATCB (Target);
      Caller : Runtime_Types.ATCB_Ptr := ID_To_ATCB (Self);
      Task1  : Runtime_Types.ATCB_Ptr;
      Task2  : Runtime_Types.ATCB_Ptr;

   begin
      --  Make_Passive used to be the last thing done in this routine in the
      --  original MRTSI code.  Make_Passive was modified not to process a
      --  completed task, so setting the complete flag conflicted with this.
      --  I don't see any reason why the task cannot be made passive before
      --  it is marked as completed, but I may find out. ???

      Make_Passive (T);
      Write_Lock (T.L);

      if T.Stage < Runtime_Types.Completing then
         T.Stage := Runtime_Types.Completing;
         T.Accepting := Runtime_Types.Not_Accepting;

         --  *LATER* consider new value of this type  ???

         T.Awaited_Dependent_Count := 0;
         Unlock (T.L);
         Rendezvous.Close_Entries (ATCB_To_ID (T));
         T.Stage := Runtime_Types.Complete;

         --  Wake up all the pending calls on Aborter_Link list

         Task1 := T.Aborter_Link;
         T.Aborter_Link := null;

         while (Task1 /= null) loop
            Task2 := Task1;
            Task1 := Task1.Aborter_Link;
            Task2.Aborter_Link := null;
            Cond_Signal (Task2.Cond);
         end loop;

      else
         --  Some other task is completing this task. So just wait until
         --  the completion is done. A list of such waiting tasks is
         --  maintained by Aborter_Link in ATCB.

         while T.Stage < Runtime_Types.Complete loop
            if T.Aborter_Link /= null then
               Caller.Aborter_Link := T.Aborter_Link;
            end if;

            T.Aborter_Link := Caller;
            Cond_Wait (Caller.Cond, T.L);
         end loop;

         Unlock (T.L);
      end if;
   end Complete;

end System.Tasking.Rendezvous;
