OSDN Git Service

Minor reformatting.
[pf3gnuchains/gcc-fork.git] / gcc / ada / s-tasren.adb
index 9002eee..35e0dd3 100644 (file)
@@ -1,88 +1,44 @@
 ------------------------------------------------------------------------------
 --                                                                          --
---               GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS                --
+--                GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                  --
 --                                                                          --
 --            S Y S T E M . T A S K I N G . R E N D E Z V O U S             --
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---         Copyright (C) 1992-2004, Free Software Foundation, Inc.          --
+--         Copyright (C) 1992-2009, Free Software Foundation, Inc.          --
 --                                                                          --
 -- GNARL is free software; you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
--- ware  Foundation;  either version 2,  or (at your option) any later ver- --
--- sion. GNARL is distributed in the hope that it will be useful, but WITH- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
--- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
--- for  more details.  You should have  received  a copy of the GNU General --
--- Public License  distributed with GNARL; see file COPYING.  If not, write --
--- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
--- MA 02111-1307, USA.                                                      --
+-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
 --                                                                          --
--- As a special exception,  if other files  instantiate  generics from this --
--- unit, or you link  this unit with other files  to produce an executable, --
--- this  unit  does not  by itself cause  the resulting  executable  to  be --
--- covered  by the  GNU  General  Public  License.  This exception does not --
--- however invalidate  any other reasons why  the executable file  might be --
--- covered by the  GNU Public License.                                      --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
 --                                                                          --
 -- GNARL was developed by the GNARL team at Florida State University.       --
 -- Extensive contributions were provided by Ada Core Technologies, Inc.     --
 --                                                                          --
 ------------------------------------------------------------------------------
 
-with Ada.Exceptions;
---  Used for Exception_ID
---           Null_Id
---           Transfer_Occurrence
---           Raise_Exception
-
 with System.Task_Primitives.Operations;
---  used for Get_Priority
---           Set_Priority
---           Write_Lock
---           Unlock
---           Sleep
---           Wakeup
---           Timed_Sleep
-
 with System.Tasking.Entry_Calls;
---  Used for Wait_For_Completion
---           Wait_For_Completion_With_Timeout
---           Wait_Until_Abortable
-
 with System.Tasking.Initialization;
---  used for Defer_Abort
---           Undefer_Abort
---           Poll_Base_Priority_Change
---           Do_Pending_Action
-
 with System.Tasking.Queuing;
---  used for Enqueue
---           Dequeue_Head
---           Select_Task_Entry_Call
---           Count_Waiting
-
 with System.Tasking.Utilities;
---  used for Check_Exception
---           Make_Passive
---           Wakeup_Entry_Caller
---           Exit_One_ATC_Level
-
 with System.Tasking.Protected_Objects.Operations;
---  used for PO_Do_Or_Queue
---           PO_Service_Entries
---           Lock_Entries
-
 with System.Tasking.Debug;
---  used for Trace
-
+with System.Restrictions;
 with System.Parameters;
---  used for Single_Lock
---           Runtime_Traces
-
 with System.Traces.Tasking;
---  used for Send_Trace_Info
 
 package body System.Tasking.Rendezvous is
 
@@ -154,7 +110,7 @@ package body System.Tasking.Rendezvous is
 
    procedure Boost_Priority (Call : Entry_Call_Link; Acceptor : Task_Id);
    pragma Inline (Boost_Priority);
-   --  Call this only with abort deferred and holding lock of Acceptor.
+   --  Call this only with abort deferred and holding lock of Acceptor
 
    procedure Call_Synchronous
      (Acceptor              : Task_Id;
@@ -255,7 +211,7 @@ package body System.Tasking.Rendezvous is
             Uninterpreted_Data :=
               Caller.Entry_Calls (Caller.ATC_Nesting_Level).Uninterpreted_Data;
          else
-            --  Case of an aborted task.
+            --  Case of an aborted task
 
             Uninterpreted_Data := System.Null_Address;
          end if;
@@ -396,6 +352,7 @@ package body System.Tasking.Rendezvous is
       Uninterpreted_Data : System.Address)
    is
       Rendezvous_Successful : Boolean;
+      pragma Unreferenced (Rendezvous_Successful);
 
    begin
       --  If pragma Detect_Blocking is active then Program_Error must be
@@ -405,8 +362,7 @@ package body System.Tasking.Rendezvous is
       if System.Tasking.Detect_Blocking
         and then STPO.Self.Common.Protected_Action_Nesting > 0
       then
-         Ada.Exceptions.Raise_Exception
-           (Program_Error'Identity, "potentially blocking operation");
+         raise Program_Error with "potentially blocking operation";
       end if;
 
       Call_Synchronous
@@ -449,17 +405,17 @@ package body System.Tasking.Rendezvous is
       --  If this is a call made inside of an abort deferred region,
       --  the call should be never abortable.
 
-      if Self_Id.Deferral_Level > 1 then
-         Entry_Call.State := Never_Abortable;
-      else
-         Entry_Call.State := Now_Abortable;
-      end if;
+      Entry_Call.State :=
+        (if Self_Id.Deferral_Level > 1
+         then Never_Abortable
+         else Now_Abortable);
 
       Entry_Call.E := Entry_Index (E);
       Entry_Call.Prio := Get_Priority (Self_Id);
       Entry_Call.Uninterpreted_Data := Uninterpreted_Data;
       Entry_Call.Called_Task := Acceptor;
       Entry_Call.Exception_To_Raise := Ada.Exceptions.Null_Id;
+      Entry_Call.With_Abort := True;
 
       --  Note: the caller will undefer abort on return (see WARNING above)
 
@@ -467,9 +423,7 @@ package body System.Tasking.Rendezvous is
          Lock_RTS;
       end if;
 
-      if not Task_Do_Or_Queue
-        (Self_Id, Entry_Call, With_Abort => True)
-      then
+      if not Task_Do_Or_Queue (Self_Id, Entry_Call) then
          STPO.Write_Lock (Self_Id);
          Utilities.Exit_One_ATC_Level (Self_Id);
          STPO.Unlock (Self_Id);
@@ -482,7 +436,7 @@ package body System.Tasking.Rendezvous is
             Send_Trace_Info (E_Missed, Acceptor);
          end if;
 
-         Initialization.Undefer_Abort (Self_Id);
+         Local_Undefer_Abort (Self_Id);
          raise Tasking_Error;
       end if;
 
@@ -512,7 +466,7 @@ package body System.Tasking.Rendezvous is
       Self_Id : constant Task_Id := STPO.Self;
 
    begin
-      Initialization.Defer_Abort (Self_Id);
+      Initialization.Defer_Abort_Nestable (Self_Id);
 
       if Single_Lock then
          Lock_RTS;
@@ -526,7 +480,7 @@ package body System.Tasking.Rendezvous is
          Unlock_RTS;
       end if;
 
-      Initialization.Undefer_Abort (Self_Id);
+      Initialization.Undefer_Abort_Nestable (Self_Id);
       return Result;
    end Callable;
 
@@ -555,10 +509,11 @@ package body System.Tasking.Rendezvous is
    procedure Exceptional_Complete_Rendezvous
      (Ex : Ada.Exceptions.Exception_Id)
    is
-      Self_Id    : constant Task_Id := STPO.Self;
-      Entry_Call : Entry_Call_Link := Self_Id.Common.Call;
-      Caller     : Task_Id;
-      Called_PO  : STPE.Protection_Entries_Access;
+      Self_Id                : constant Task_Id := STPO.Self;
+      Entry_Call             : Entry_Call_Link := Self_Id.Common.Call;
+      Caller                 : Task_Id;
+      Called_PO              : STPE.Protection_Entries_Access;
+      Acceptor_Prev_Priority : Integer;
 
       Exception_To_Raise : Ada.Exceptions.Exception_Id := Ex;
       Ceiling_Violation  : Boolean;
@@ -649,9 +604,7 @@ package body System.Tasking.Rendezvous is
                   Lock_RTS;
                end if;
 
-               if not Task_Do_Or_Queue
-                 (Self_Id, Entry_Call, Entry_Call.Requeue_With_Abort)
-               then
+               if not Task_Do_Or_Queue (Self_Id, Entry_Call) then
                   if Single_Lock then
                      Unlock_RTS;
                   end if;
@@ -690,9 +643,7 @@ package body System.Tasking.Rendezvous is
                   end if;
 
                else
-                  POO.PO_Do_Or_Queue
-                    (Self_Id, Called_PO, Entry_Call,
-                     Entry_Call.Requeue_With_Abort);
+                  POO.PO_Do_Or_Queue (Self_Id, Called_PO, Entry_Call);
                   POO.PO_Service_Entries (Self_Id, Called_PO);
                end if;
             end if;
@@ -701,7 +652,7 @@ package body System.Tasking.Rendezvous is
               (Self_Id, Entry_Call.Acceptor_Prev_Priority);
 
          else
-            --  The call does not need to be requeued.
+            --  The call does not need to be requeued
 
             Self_Id.Common.Call := Entry_Call.Acceptor_Prev_Call;
             Entry_Call.Exception_To_Raise := Ex;
@@ -712,7 +663,7 @@ package body System.Tasking.Rendezvous is
 
             STPO.Write_Lock (Caller);
 
-            --  Done with Caller locked to make sure that Wakeup is not lost.
+            --  Done with Caller locked to make sure that Wakeup is not lost
 
             if Ex /= Ada.Exceptions.Null_Id then
                Transfer_Occurrence
@@ -720,15 +671,16 @@ package body System.Tasking.Rendezvous is
                   Self_Id.Common.Compiler_Data.Current_Excep);
             end if;
 
+            Acceptor_Prev_Priority := Entry_Call.Acceptor_Prev_Priority;
             Initialization.Wakeup_Entry_Caller (Self_Id, Entry_Call, Done);
+
             STPO.Unlock (Caller);
 
             if Single_Lock then
                Unlock_RTS;
             end if;
 
-            Entry_Calls.Reset_Priority
-              (Self_Id, Entry_Call.Acceptor_Prev_Priority);
+            Entry_Calls.Reset_Priority (Self_Id, Acceptor_Prev_Priority);
          end if;
       end if;
 
@@ -760,7 +712,7 @@ package body System.Tasking.Rendezvous is
       Entry_Call.E := Entry_Index (E);
       Entry_Call.Called_Task := Acceptor;
       Entry_Call.Called_PO := Null_Address;
-      Entry_Call.Requeue_With_Abort := With_Abort;
+      Entry_Call.With_Abort := With_Abort;
       Object.Call_In_Progress := null;
    end Requeue_Protected_To_Task_Entry;
 
@@ -779,7 +731,7 @@ package body System.Tasking.Rendezvous is
    begin
       Initialization.Defer_Abort (Self_Id);
       Entry_Call.Needs_Requeue := True;
-      Entry_Call.Requeue_With_Abort := With_Abort;
+      Entry_Call.With_Abort := With_Abort;
       Entry_Call.E := Entry_Index (E);
       Entry_Call.Called_Task := Acceptor;
       Initialization.Undefer_Abort (Self_Id);
@@ -844,7 +796,7 @@ package body System.Tasking.Rendezvous is
       Queuing.Select_Task_Entry_Call
         (Self_Id, Open_Accepts, Entry_Call, Selection, Open_Alternative);
 
-      --  Determine the kind and disposition of the select.
+      --  Determine the kind and disposition of the select
 
       Treatment := Default_Treatment (Select_Mode);
       Self_Id.Chosen_Index := No_Rendezvous;
@@ -865,7 +817,7 @@ package body System.Tasking.Rendezvous is
          end if;
       end if;
 
-      --  Handle the select according to the disposition selected above.
+      --  Handle the select according to the disposition selected above
 
       case Treatment is
          when Accept_Alternative_Selected =>
@@ -882,7 +834,8 @@ package body System.Tasking.Rendezvous is
             STPO.Unlock (Self_Id);
 
          when Accept_Alternative_Completed =>
-            --  Accept body is null, so rendezvous is over immediately.
+
+            --  Accept body is null, so rendezvous is over immediately
 
             if Parameters.Runtime_Traces then
                Send_Trace_Info (M_RDV_Complete, Entry_Call.Self);
@@ -896,7 +849,8 @@ package body System.Tasking.Rendezvous is
             STPO.Unlock (Caller);
 
          when Accept_Alternative_Open =>
-            --  Wait for caller.
+
+            --  Wait for caller
 
             Self_Id.Open_Accepts := Open_Accepts;
             pragma Debug
@@ -913,9 +867,9 @@ package body System.Tasking.Rendezvous is
 
             --  Self_Id.Common.Call should already be updated by the Caller if
             --  not aborted. It might also be ready to do rendezvous even if
-            --  this wakes up due to an abortion.
-            --  Therefore, if the call is not empty we need to do the
-            --  rendezvous if the accept body is not Null_Body.
+            --  this wakes up due to an abort. Therefore, if the call is not
+            --  empty we need to do the rendezvous if the accept body is not
+            --  Null_Body.
 
             --  Aren't the first two conditions below redundant???
 
@@ -925,7 +879,11 @@ package body System.Tasking.Rendezvous is
             then
                Uninterpreted_Data := Self_Id.Common.Call.Uninterpreted_Data;
 
-               pragma Assert (Self_Id.Deferral_Level = 1);
+               pragma Assert
+                 (Self_Id.Deferral_Level = 1
+                   or else
+                     (Self_Id.Deferral_Level = 0
+                       and then not Restrictions.Abort_Allowed));
 
                Initialization.Defer_Abort_Nestable (Self_Id);
 
@@ -949,7 +907,7 @@ package body System.Tasking.Rendezvous is
             Self_Id.Open_Accepts := Open_Accepts;
             Self_Id.Common.State := Acceptor_Sleep;
 
-            --  Notify ancestors that this task is on a terminate alternative.
+            --  Notify ancestors that this task is on a terminate alternative
 
             STPO.Unlock (Self_Id);
             Utilities.Make_Passive (Self_Id, Task_Completed => False);
@@ -1021,7 +979,6 @@ package body System.Tasking.Rendezvous is
                Self_Id.Common.State := Delay_Sleep;
 
                loop
-                  Initialization.Poll_Base_Priority_Change (Self_Id);
                   exit when
                     Self_Id.Pending_ATC_Level < Self_Id.ATC_Nesting_Level;
                   Sleep (Self_Id, Delay_Sleep);
@@ -1038,8 +995,7 @@ package body System.Tasking.Rendezvous is
                end if;
 
                Initialization.Undefer_Abort (Self_Id);
-               Ada.Exceptions.Raise_Exception
-                 (Program_Error'Identity, "Entry call not a delay mode");
+               raise Program_Error with "Entry call not a delay mode";
             end if;
       end case;
 
@@ -1100,6 +1056,11 @@ package body System.Tasking.Rendezvous is
       end if;
 
       Initialization.Undefer_Abort (Self_Id);
+
+      --  Call Yield to let other tasks get a chance to run as this is a
+      --  potential dispatching point.
+
+      Yield (Do_Yield => False);
       return Return_Count;
    end Task_Count;
 
@@ -1109,11 +1070,10 @@ package body System.Tasking.Rendezvous is
 
    function Task_Do_Or_Queue
      (Self_ID    : Task_Id;
-      Entry_Call : Entry_Call_Link;
-      With_Abort : Boolean) return Boolean
+      Entry_Call : Entry_Call_Link) return Boolean
    is
       E             : constant Task_Entry_Index :=
-        Task_Entry_Index (Entry_Call.E);
+                        Task_Entry_Index (Entry_Call.E);
       Old_State     : constant Entry_Call_State := Entry_Call.State;
       Acceptor      : constant Task_Id := Entry_Call.Called_Task;
       Parent        : constant Task_Id := Acceptor.Common.Parent;
@@ -1121,7 +1081,8 @@ package body System.Tasking.Rendezvous is
       Null_Body     : Boolean;
 
    begin
-      --  Find out whether Entry_Call can be accepted immediately.
+      --  Find out whether Entry_Call can be accepted immediately
+
       --  If the Acceptor is not callable, return False.
       --  If the rendezvous can start, initiate it.
       --  If the accept-body is trivial, also complete the rendezvous.
@@ -1154,7 +1115,7 @@ package body System.Tasking.Rendezvous is
 
       STPO.Write_Lock (Acceptor);
 
-      --  If the acceptor is not callable, abort the call and return False.
+      --  If the acceptor is not callable, abort the call and return False
 
       if not Acceptor.Callable then
          STPO.Unlock (Acceptor);
@@ -1176,35 +1137,35 @@ package body System.Tasking.Rendezvous is
          return False;
       end if;
 
-      --  Try to serve the call immediately.
+      --  Try to serve the call immediately
 
       if Acceptor.Open_Accepts /= null then
          for J in Acceptor.Open_Accepts'Range loop
             if Entry_Call.E = Entry_Index (Acceptor.Open_Accepts (J).S) then
 
-               --  Commit acceptor to rendezvous with us.
+               --  Commit acceptor to rendezvous with us
 
                Acceptor.Chosen_Index := J;
                Null_Body := Acceptor.Open_Accepts (J).Null_Body;
                Acceptor.Open_Accepts := null;
 
-               --  Prevent abort while call is being served.
+               --  Prevent abort while call is being served
 
                if Entry_Call.State = Now_Abortable then
                   Entry_Call.State := Was_Abortable;
                end if;
 
                if Acceptor.Terminate_Alternative then
-                  --  Cancel terminate alternative.
-                  --  See matching code in Selective_Wait and
-                  --  Vulnerable_Complete_Master.
+
+                  --  Cancel terminate alternative. See matching code in
+                  --  Selective_Wait and Vulnerable_Complete_Master.
 
                   Acceptor.Terminate_Alternative := False;
                   Acceptor.Awake_Count := Acceptor.Awake_Count + 1;
 
                   if Acceptor.Awake_Count = 1 then
 
-                     --  Notify parent that acceptor is awake.
+                     --  Notify parent that acceptor is awake
 
                      pragma Assert (Parent.Awake_Count > 0);
 
@@ -1220,7 +1181,8 @@ package body System.Tasking.Rendezvous is
                end if;
 
                if Null_Body then
-                  --  Rendezvous is over immediately.
+
+                  --  Rendezvous is over immediately
 
                   STPO.Wakeup (Acceptor, Acceptor_Sleep);
                   STPO.Unlock (Acceptor);
@@ -1237,8 +1199,8 @@ package body System.Tasking.Rendezvous is
                else
                   Setup_For_Rendezvous_With_Body (Entry_Call, Acceptor);
 
-                  --  For terminate_alternative, acceptor may not be
-                  --  asleep yet, so we skip the wakeup
+                  --  For terminate_alternative, acceptor may not be asleep
+                  --  yet, so we skip the wakeup
 
                   if Acceptor.Common.State /= Runnable then
                      STPO.Wakeup (Acceptor, Acceptor_Sleep);
@@ -1255,16 +1217,38 @@ package body System.Tasking.Rendezvous is
             end if;
          end loop;
 
-         --  The acceptor is accepting, but not this entry.
+         --  The acceptor is accepting, but not this entry
       end if;
 
       --  If the acceptor was ready to accept this call,
       --  we would not have gotten this far, so now we should
       --  (re)enqueue the call, if the mode permits that.
 
-      if Entry_Call.Mode /= Conditional_Call
-        or else not With_Abort
+      --  If the call is timed, it may have timed out before the requeue,
+      --  in the unusual case where the current accept has taken longer than
+      --  the given delay. In that case the requeue is cancelled, and the
+      --  outer timed call will be aborted.
+
+      if Entry_Call.Mode = Conditional_Call
+        or else
+          (Entry_Call.Mode = Timed_Call
+            and then Entry_Call.With_Abort
+            and then Entry_Call.Cancellation_Attempted)
       then
+         STPO.Unlock (Acceptor);
+
+         if Parent_Locked then
+            STPO.Unlock (Parent);
+         end if;
+
+         STPO.Write_Lock (Entry_Call.Self);
+
+         pragma Assert (Entry_Call.State >= Was_Abortable);
+
+         Initialization.Wakeup_Entry_Caller (Self_ID, Entry_Call, Cancelled);
+         STPO.Unlock (Entry_Call.Self);
+
+      else
          --  Timed_Call, Simple_Call, or Asynchronous_Call
 
          Queuing.Enqueue (Acceptor.Entry_Queues (E), Entry_Call);
@@ -1273,7 +1257,8 @@ package body System.Tasking.Rendezvous is
 
          pragma Assert (Old_State < Done);
 
-         Entry_Call.State := New_State (With_Abort, Entry_Call.State);
+         Entry_Call.State :=
+           New_State (Entry_Call.With_Abort, Entry_Call.State);
 
          STPO.Unlock (Acceptor);
 
@@ -1302,22 +1287,6 @@ package body System.Tasking.Rendezvous is
 
             STPO.Unlock (Entry_Call.Self);
          end if;
-
-      else
-         --  Conditional_Call and With_Abort
-
-         STPO.Unlock (Acceptor);
-
-         if Parent_Locked then
-            STPO.Unlock (Parent);
-         end if;
-
-         STPO.Write_Lock (Entry_Call.Self);
-
-         pragma Assert (Entry_Call.State >= Was_Abortable);
-
-         Initialization.Wakeup_Entry_Caller (Self_ID, Entry_Call, Cancelled);
-         STPO.Unlock (Entry_Call.Self);
       end if;
 
       return True;
@@ -1345,8 +1314,7 @@ package body System.Tasking.Rendezvous is
       if System.Tasking.Detect_Blocking
         and then Self_Id.Common.Protected_Action_Nesting > 0
       then
-         Ada.Exceptions.Raise_Exception
-           (Program_Error'Identity, "potentially blocking operation");
+         raise Program_Error with "potentially blocking operation";
       end if;
 
       if Parameters.Runtime_Traces then
@@ -1360,11 +1328,11 @@ package body System.Tasking.Rendezvous is
       else
          --  This is an asynchronous call
 
-         --  Abortion must already be deferred by the compiler-generated
-         --  code.  Without this, an abortion that occurs between the time
-         --  that this call is made and the time that the abortable part's
-         --  cleanup handler is set up might miss the cleanup handler and
-         --  leave the call pending.
+         --  Abort must already be deferred by the compiler-generated code.
+         --  Without this, an abort that occurs between the time that this
+         --  call is made and the time that the abortable part's cleanup
+         --  handler is set up might miss the cleanup handler and leave the
+         --  call pending.
 
          Self_Id.ATC_Nesting_Level := Self_Id.ATC_Nesting_Level + 1;
          pragma Debug
@@ -1381,14 +1349,13 @@ package body System.Tasking.Rendezvous is
          Entry_Call.Called_Task := Acceptor;
          Entry_Call.Called_PO := Null_Address;
          Entry_Call.Exception_To_Raise := Ada.Exceptions.Null_Id;
+         Entry_Call.With_Abort := True;
 
          if Single_Lock then
             Lock_RTS;
          end if;
 
-         if not Task_Do_Or_Queue
-           (Self_Id, Entry_Call, With_Abort => True)
-         then
+         if not Task_Do_Or_Queue (Self_Id, Entry_Call) then
             STPO.Write_Lock (Self_Id);
             Utilities.Exit_One_ATC_Level (Self_Id);
             STPO.Unlock (Self_Id);
@@ -1421,7 +1388,7 @@ package body System.Tasking.Rendezvous is
             Unlock_RTS;
          end if;
 
-         --  Note: following assignment needs to be atomic.
+         --  Note: following assignment needs to be atomic
 
          Rendezvous_Successful := Entry_Call.State = Done;
       end if;
@@ -1506,7 +1473,7 @@ package body System.Tasking.Rendezvous is
       Queuing.Select_Task_Entry_Call
         (Self_Id, Open_Accepts, Entry_Call, Selection, Open_Alternative);
 
-      --  Determine the kind and disposition of the select.
+      --  Determine the kind and disposition of the select
 
       Treatment := Default_Treatment (Select_Mode);
       Self_Id.Chosen_Index := No_Rendezvous;
@@ -1528,7 +1495,7 @@ package body System.Tasking.Rendezvous is
          end if;
       end if;
 
-      --  Handle the select according to the disposition selected above.
+      --  Handle the select according to the disposition selected above
 
       case Treatment is
          when Accept_Alternative_Selected =>
@@ -1555,17 +1522,19 @@ package body System.Tasking.Rendezvous is
             STPO.Unlock (Caller);
 
          when Accept_Alternative_Open =>
-            --  Wait for caller.
+
+            --  Wait for caller
 
             Self_Id.Open_Accepts := Open_Accepts;
 
             --  Wait for a normal call and a pending action until the
             --  Wakeup_Time is reached.
 
+            Self_Id.Common.State := Acceptor_Delay_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_Completion & Wait_For_Call.
+            --  caller a chance of getting ready immediately, using Unlock
+            --  Yield. See similar action in Wait_For_Completion/Wait_For_Call.
 
             if Single_Lock then
                Unlock_RTS;
@@ -1589,14 +1558,11 @@ package body System.Tasking.Rendezvous is
                Self_Id.Open_Accepts := null;
             end if;
 
-            Self_Id.Common.State := Acceptor_Sleep;
-
             loop
-               Initialization.Poll_Base_Priority_Change (Self_Id);
                exit when Self_Id.Open_Accepts = null;
 
                if Timedout then
-                  Sleep (Self_Id, Acceptor_Sleep);
+                  Sleep (Self_Id, Acceptor_Delay_Sleep);
                else
                   if Parameters.Runtime_Traces then
                      Send_Trace_Info (WT_Select,
@@ -1606,7 +1572,7 @@ package body System.Tasking.Rendezvous is
                   end if;
 
                   STPO.Timed_Sleep (Self_Id, Timeout, Mode,
-                    Acceptor_Sleep, Timedout, Yielded);
+                    Acceptor_Delay_Sleep, Timedout, Yielded);
                end if;
 
                if Timedout then
@@ -1622,9 +1588,9 @@ package body System.Tasking.Rendezvous is
 
             --  Self_Id.Common.Call should already be updated by the Caller if
             --  not aborted. It might also be ready to do rendezvous even if
-            --  this wakes up due to an abortion.
-            --  Therefore, if the call is not empty we need to do the
-            --  rendezvous if the accept body is not Null_Body.
+            --  this wakes up due to an abort. Therefore, if the call is not
+            --  empty we need to do the rendezvous if the accept body is not
+            --  Null_Body.
 
             if Self_Id.Chosen_Index /= No_Rendezvous
               and then Self_Id.Common.Call /= null
@@ -1648,15 +1614,13 @@ package body System.Tasking.Rendezvous is
             --  for several reasons:
             --  1) Delay is expired
             --  2) Pending_Action needs to be checked
-            --     (Abortion, Priority change)
+            --     (Abort, Priority change)
             --  3) Spurious wakeup
 
             Self_Id.Open_Accepts := null;
-            Self_Id.Common.State := Acceptor_Sleep;
+            Self_Id.Common.State := Acceptor_Delay_Sleep;
 
-            Initialization.Poll_Base_Priority_Change (Self_Id);
-
-            STPO.Timed_Sleep (Self_Id, Timeout, Mode, Acceptor_Sleep,
+            STPO.Timed_Sleep (Self_Id, Timeout, Mode, Acceptor_Delay_Sleep,
               Timedout, Yielded);
 
             Self_Id.Common.State := Runnable;
@@ -1705,7 +1669,9 @@ package body System.Tasking.Rendezvous is
       Self_Id    : constant Task_Id := STPO.Self;
       Level      : ATC_Level;
       Entry_Call : Entry_Call_Link;
-      Yielded    : Boolean;
+
+      Yielded : Boolean;
+      pragma Unreferenced (Yielded);
 
    begin
       --  If pragma Detect_Blocking is active then Program_Error must be
@@ -1715,8 +1681,7 @@ package body System.Tasking.Rendezvous is
       if System.Tasking.Detect_Blocking
         and then Self_Id.Common.Protected_Action_Nesting > 0
       then
-         Ada.Exceptions.Raise_Exception
-           (Program_Error'Identity, "potentially blocking operation");
+         raise Program_Error with "potentially blocking operation";
       end if;
 
       Initialization.Defer_Abort (Self_Id);
@@ -1740,11 +1705,10 @@ package body System.Tasking.Rendezvous is
       --  If this is a call made inside of an abort deferred region,
       --  the call should be never abortable.
 
-      if Self_Id.Deferral_Level > 1 then
-         Entry_Call.State := Never_Abortable;
-      else
-         Entry_Call.State := Now_Abortable;
-      end if;
+      Entry_Call.State :=
+        (if Self_Id.Deferral_Level > 1
+         then Never_Abortable
+         else Now_Abortable);
 
       Entry_Call.E := Entry_Index (E);
       Entry_Call.Prio := Get_Priority (Self_Id);
@@ -1752,16 +1716,15 @@ package body System.Tasking.Rendezvous is
       Entry_Call.Called_Task := Acceptor;
       Entry_Call.Called_PO := Null_Address;
       Entry_Call.Exception_To_Raise := Ada.Exceptions.Null_Id;
+      Entry_Call.With_Abort := True;
 
-      --  Note: the caller will undefer abortion on return (see WARNING above)
+      --  Note: the caller will undefer abort on return (see WARNING above)
 
       if Single_Lock then
          Lock_RTS;
       end if;
 
-      if not Task_Do_Or_Queue
-       (Self_Id, Entry_Call, With_Abort => True)
-      then
+      if not Task_Do_Or_Queue (Self_Id, Entry_Call) then
          STPO.Write_Lock (Self_Id);
          Utilities.Exit_One_ATC_Level (Self_Id);
          STPO.Unlock (Self_Id);
@@ -1800,9 +1763,11 @@ package body System.Tasking.Rendezvous is
 
    procedure Wait_For_Call (Self_Id : Task_Id) is
    begin
+      Self_Id.Common.State := Acceptor_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_Completion & Selective_Wait.
+      --  See similar action in Wait_For_Completion & Timed_Selective_Wait.
 
       if Single_Lock then
          Unlock_RTS;
@@ -1820,19 +1785,14 @@ package body System.Tasking.Rendezvous is
          Write_Lock (Self_Id);
       end if;
 
-      --  Check if this task has been aborted while the lock was released.
+      --  Check if this task has been aborted while the lock was released
 
       if Self_Id.Pending_ATC_Level < Self_Id.ATC_Nesting_Level then
          Self_Id.Open_Accepts := null;
       end if;
 
-      Self_Id.Common.State := Acceptor_Sleep;
-
       loop
-         Initialization.Poll_Base_Priority_Change (Self_Id);
-
          exit when Self_Id.Open_Accepts = null;
-
          Sleep (Self_Id, Acceptor_Sleep);
       end loop;