gcc/ada/s-taenca.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
   4 --                                                                          --
   5 --             S Y S T E M . T A S K I N G . E N T R Y _ C A L L S          --
   6 --                                                                          --
   7 --                                  B o d y                                 --
   8 --                                                                          --
   9 --         Copyright (C) 1992-2008, Free Software Foundation, Inc.          --
  10 --                                                                          --
  11 -- GNARL is free software; you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  14 -- sion. GNARL is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNARL; see file COPYING.  If not, write --
  19 -- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
  20 -- Boston, MA 02110-1301, USA.                                              --
  21 --                                                                          --
  22 -- As a special exception,  if other files  instantiate  generics from this --
  23 -- unit, or you link  this unit with other files  to produce an executable, --
  24 -- this  unit  does not  by itself cause  the resulting  executable  to  be --
  25 -- covered  by the  GNU  General  Public  License.  This exception does not --
  26 -- however invalidate  any other reasons why  the executable file  might be --
  27 -- covered by the  GNU Public License.                                      --
  28 --                                                                          --
  29 -- GNARL was developed by the GNARL team at Florida State University.       --
  30 -- Extensive contributions were provided by Ada Core Technologies, Inc.     --
  31 --                                                                          --
  32 ------------------------------------------------------------------------------
  33
  34 with System.Task_Primitives.Operations;
  35 with System.Tasking.Initialization;
  36 with System.Tasking.Protected_Objects.Entries;
  37 with System.Tasking.Protected_Objects.Operations;
  38 with System.Tasking.Queuing;
  39 with System.Tasking.Utilities;
  40 with System.Parameters;
  41 with System.Traces;
  42
  43 package body System.Tasking.Entry_Calls is
  44
  45    package STPO renames System.Task_Primitives.Operations;
  46
  47    use Parameters;
  48    use Task_Primitives;
  49    use Protected_Objects.Entries;
  50    use Protected_Objects.Operations;
  51    use System.Traces;
  52
  53    --  DO NOT use Protected_Objects.Lock or Protected_Objects.Unlock
  54    --  internally. Those operations will raise Program_Error, which
  55    --  we are not prepared to handle inside the RTS. Instead, use
  56    --  System.Task_Primitives lock operations directly on Protection.L.
  57
  58    -----------------------
  59    -- Local Subprograms --
  60    -----------------------
  61
  62    procedure Lock_Server (Entry_Call : Entry_Call_Link);
  63
  64    --  This locks the server targeted by Entry_Call
  65    --
  66    --  This may be a task or a protected object, depending on the target of the
  67    --  original call or any subsequent requeues.
  68    --
  69    --  This routine is needed because the field specifying the server for this
  70    --  call must be protected by the server's mutex. If it were protected by
  71    --  the caller's mutex, accessing the server's queues would require locking
  72    --  the caller to get the server, locking the server, and then accessing the
  73    --  queues. This involves holding two ATCB locks at once, something which we
  74    --  can guarantee that it will always be done in the same order, or locking
  75    --  a protected object while we hold an ATCB lock, something which is not
  76    --  permitted. Since the server cannot be obtained reliably, it must be
  77    --  obtained unreliably and then checked again once it has been locked.
  78    --
  79    --  If Single_Lock and server is a PO, release RTS_Lock
  80    --
  81    --  This should only be called by the Entry_Call.Self.
  82    --  It should be holding no other ATCB locks at the time.
  83
  84    procedure Unlock_Server (Entry_Call : Entry_Call_Link);
  85    --  STPO.Unlock the server targeted by Entry_Call. The server must
  86    --  be locked before calling this.
  87    --
  88    --  If Single_Lock and server is a PO, take RTS_Lock on exit.
  89
  90    procedure Unlock_And_Update_Server
  91      (Self_ID    : Task_Id;
  92       Entry_Call : Entry_Call_Link);
  93    --  Similar to Unlock_Server, but services entry calls if the
  94    --  server is a protected object.
  95    --
  96    --  If Single_Lock and server is a PO, take RTS_Lock on exit.
  97
  98    procedure Check_Pending_Actions_For_Entry_Call
  99      (Self_ID    : Task_Id;
 100       Entry_Call : Entry_Call_Link);
 101    --  This procedure performs priority change of a queued call and dequeuing
 102    --  of an entry call when the call is cancelled. If the call is dequeued the
 103    --  state should be set to Cancelled. Call only with abort deferred and
 104    --  holding lock of Self_ID. This is a bit of common code for all entry
 105    --  calls. The effect is to do any deferred base priority change operation,
 106    --  in case some other task called STPO.Set_Priority while the current task
 107    --  had abort deferred, and to dequeue the call if the call has been
 108    --  aborted.
 109
 110    procedure Poll_Base_Priority_Change_At_Entry_Call
 111      (Self_ID    : Task_Id;
 112       Entry_Call : Entry_Call_Link);
 113    pragma Inline (Poll_Base_Priority_Change_At_Entry_Call);
 114    --  A specialized version of Poll_Base_Priority_Change, that does the
 115    --  optional entry queue reordering. Has to be called with the Self_ID's
 116    --  ATCB write-locked. May temporariliy release the lock.
 117
 118    ---------------------
 119    -- Check_Exception --
 120    ---------------------
 121
 122    procedure Check_Exception
 123      (Self_ID    : Task_Id;
 124       Entry_Call : Entry_Call_Link)
 125    is
 126       pragma Warnings (Off, Self_ID);
 127
 128       use type Ada.Exceptions.Exception_Id;
 129
 130       procedure Internal_Raise (X : Ada.Exceptions.Exception_Id);
 131       pragma Import (C, Internal_Raise, "__gnat_raise_with_msg");
 132
 133       E : constant Ada.Exceptions.Exception_Id :=
 134             Entry_Call.Exception_To_Raise;
 135    begin
 136       --  pragma Assert (Self_ID.Deferral_Level = 0);
 137
 138       --  The above may be useful for debugging, but the Florist packages
 139       --  contain critical sections that defer abort and then do entry calls,
 140       --  which causes the above Assert to trip.
 141
 142       if E /= Ada.Exceptions.Null_Id then
 143          Internal_Raise (E);
 144       end if;
 145    end Check_Exception;
 146
 147    ------------------------------------------
 148    -- Check_Pending_Actions_For_Entry_Call --
 149    ------------------------------------------
 150
 151    procedure Check_Pending_Actions_For_Entry_Call
 152      (Self_ID    : Task_Id;
 153       Entry_Call : Entry_Call_Link)
 154    is
 155    begin
 156       pragma Assert (Self_ID = Entry_Call.Self);
 157
 158       Poll_Base_Priority_Change_At_Entry_Call (Self_ID, Entry_Call);
 159
 160       if Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level
 161         and then Entry_Call.State = Now_Abortable
 162       then
 163          STPO.Unlock (Self_ID);
 164          Lock_Server (Entry_Call);
 165
 166          if Queuing.Onqueue (Entry_Call)
 167            and then Entry_Call.State = Now_Abortable
 168          then
 169             Queuing.Dequeue_Call (Entry_Call);
 170
 171             if Entry_Call.Cancellation_Attempted then
 172                Entry_Call.State := Cancelled;
 173             else
 174                Entry_Call.State := Done;
 175             end if;
 176
 177             Unlock_And_Update_Server (Self_ID, Entry_Call);
 178
 179          else
 180             Unlock_Server (Entry_Call);
 181          end if;
 182
 183          STPO.Write_Lock (Self_ID);
 184       end if;
 185    end Check_Pending_Actions_For_Entry_Call;
 186
 187    -----------------
 188    -- Lock_Server --
 189    -----------------
 190
 191    procedure Lock_Server (Entry_Call : Entry_Call_Link) is
 192       Test_Task         : Task_Id;
 193       Test_PO           : Protection_Entries_Access;
 194       Ceiling_Violation : Boolean;
 195       Failures          : Integer := 0;
 196
 197    begin
 198       Test_Task := Entry_Call.Called_Task;
 199
 200       loop
 201          if Test_Task = null then
 202
 203             --  Entry_Call was queued on a protected object, or in transition,
 204             --  when we last fetched Test_Task.
 205
 206             Test_PO := To_Protection (Entry_Call.Called_PO);
 207
 208             if Test_PO = null then
 209
 210                --  We had very bad luck, interleaving with TWO different
 211                --  requeue operations. Go around the loop and try again.
 212
 213                if Single_Lock then
 214                   STPO.Unlock_RTS;
 215                   STPO.Yield;
 216                   STPO.Lock_RTS;
 217                else
 218                   STPO.Yield;
 219                end if;
 220
 221             else
 222                if Single_Lock then
 223                   STPO.Unlock_RTS;
 224                end if;
 225
 226                Lock_Entries (Test_PO, Ceiling_Violation);
 227
 228                --  ???
 229
 230                --  The following code allows Lock_Server to be called when
 231                --  cancelling a call, to allow for the possibility that the
 232                --  priority of the caller has been raised beyond that of the
 233                --  protected entry call by Ada.Dynamic_Priorities.Set_Priority.
 234
 235                --  If the current task has a higher priority than the ceiling
 236                --  of the protected object, temporarily lower it. It will
 237                --  be reset in Unlock.
 238
 239                if Ceiling_Violation then
 240                   declare
 241                      Current_Task      : constant Task_Id := STPO.Self;
 242                      Old_Base_Priority : System.Any_Priority;
 243
 244                   begin
 245                      if Single_Lock then
 246                         STPO.Lock_RTS;
 247                      end if;
 248
 249                      STPO.Write_Lock (Current_Task);
 250                      Old_Base_Priority := Current_Task.Common.Base_Priority;
 251                      Current_Task.New_Base_Priority := Test_PO.Ceiling;
 252                      System.Tasking.Initialization.Change_Base_Priority
 253                        (Current_Task);
 254                      STPO.Unlock (Current_Task);
 255
 256                      if Single_Lock then
 257                         STPO.Unlock_RTS;
 258                      end if;
 259
 260                      --  Following lock should not fail
 261
 262                      Lock_Entries (Test_PO);
 263
 264                      Test_PO.Old_Base_Priority := Old_Base_Priority;
 265                      Test_PO.Pending_Action := True;
 266                   end;
 267                end if;
 268
 269                exit when To_Address (Test_PO) = Entry_Call.Called_PO;
 270                Unlock_Entries (Test_PO);
 271
 272                if Single_Lock then
 273                   STPO.Lock_RTS;
 274                end if;
 275             end if;
 276
 277          else
 278             STPO.Write_Lock (Test_Task);
 279             exit when Test_Task = Entry_Call.Called_Task;
 280             STPO.Unlock (Test_Task);
 281          end if;
 282
 283          Test_Task := Entry_Call.Called_Task;
 284          Failures := Failures + 1;
 285          pragma Assert (Failures <= 5);
 286       end loop;
 287    end Lock_Server;
 288
 289    ---------------------------------------------
 290    -- Poll_Base_Priority_Change_At_Entry_Call --
 291    ---------------------------------------------
 292
 293    procedure Poll_Base_Priority_Change_At_Entry_Call
 294      (Self_ID    : Task_Id;
 295       Entry_Call : Entry_Call_Link)
 296    is
 297    begin
 298       if Self_ID.Pending_Priority_Change then
 299
 300          --  Check for ceiling violations ???
 301
 302          Self_ID.Pending_Priority_Change := False;
 303
 304          --  Requeue the entry call at the new priority. We need to requeue
 305          --  even if the new priority is the same than the previous (see ACATS
 306          --  test cxd4006).
 307
 308          STPO.Unlock (Self_ID);
 309          Lock_Server (Entry_Call);
 310          Queuing.Requeue_Call_With_New_Prio
 311            (Entry_Call, STPO.Get_Priority (Self_ID));
 312          Unlock_And_Update_Server (Self_ID, Entry_Call);
 313          STPO.Write_Lock (Self_ID);
 314       end if;
 315    end Poll_Base_Priority_Change_At_Entry_Call;
 316
 317    --------------------
 318    -- Reset_Priority --
 319    --------------------
 320
 321    procedure Reset_Priority
 322      (Acceptor               : Task_Id;
 323       Acceptor_Prev_Priority : Rendezvous_Priority)
 324    is
 325    begin
 326       pragma Assert (Acceptor = STPO.Self);
 327
 328       --  Since we limit this kind of "active" priority change to be done
 329       --  by the task for itself, we don't need to lock Acceptor.
 330
 331       if Acceptor_Prev_Priority /= Priority_Not_Boosted then
 332          STPO.Set_Priority (Acceptor, Acceptor_Prev_Priority,
 333            Loss_Of_Inheritance => True);
 334       end if;
 335    end Reset_Priority;
 336
 337    ------------------------------
 338    -- Try_To_Cancel_Entry_Call --
 339    ------------------------------
 340
 341    procedure Try_To_Cancel_Entry_Call (Succeeded : out Boolean) is
 342       Entry_Call : Entry_Call_Link;
 343       Self_ID    : constant Task_Id := STPO.Self;
 344
 345       use type Ada.Exceptions.Exception_Id;
 346
 347    begin
 348       Entry_Call := Self_ID.Entry_Calls (Self_ID.ATC_Nesting_Level)'Access;
 349
 350       --  Experimentation has shown that abort is sometimes (but not
 351       --  always) already deferred when Cancel_xxx_Entry_Call is called.
 352       --  That may indicate an error. Find out what is going on. ???
 353
 354       pragma Assert (Entry_Call.Mode = Asynchronous_Call);
 355       Initialization.Defer_Abort_Nestable (Self_ID);
 356
 357       if Single_Lock then
 358          STPO.Lock_RTS;
 359       end if;
 360
 361       STPO.Write_Lock (Self_ID);
 362       Entry_Call.Cancellation_Attempted := True;
 363
 364       if Self_ID.Pending_ATC_Level >= Entry_Call.Level then
 365          Self_ID.Pending_ATC_Level := Entry_Call.Level - 1;
 366       end if;
 367
 368       Entry_Calls.Wait_For_Completion (Entry_Call);
 369       STPO.Unlock (Self_ID);
 370
 371       if Single_Lock then
 372          STPO.Unlock_RTS;
 373       end if;
 374
 375       Succeeded := Entry_Call.State = Cancelled;
 376
 377       Initialization.Undefer_Abort_Nestable (Self_ID);
 378
 379       --  Ideally, abort should no longer be deferred at this point, so we
 380       --  should be able to call Check_Exception. The loop below should be
 381       --  considered temporary, to work around the possibility that abort
 382       --  may be deferred more than one level deep ???
 383
 384       if Entry_Call.Exception_To_Raise /= Ada.Exceptions.Null_Id then
 385          while Self_ID.Deferral_Level > 0 loop
 386             System.Tasking.Initialization.Undefer_Abort_Nestable (Self_ID);
 387          end loop;
 388
 389          Entry_Calls.Check_Exception (Self_ID, Entry_Call);
 390       end if;
 391    end Try_To_Cancel_Entry_Call;
 392
 393    ------------------------------
 394    -- Unlock_And_Update_Server --
 395    ------------------------------
 396
 397    procedure Unlock_And_Update_Server
 398      (Self_ID    : Task_Id;
 399       Entry_Call : Entry_Call_Link)
 400    is
 401       Called_PO : Protection_Entries_Access;
 402       Caller    : Task_Id;
 403
 404    begin
 405       if Entry_Call.Called_Task /= null then
 406          STPO.Unlock (Entry_Call.Called_Task);
 407       else
 408          Called_PO := To_Protection (Entry_Call.Called_PO);
 409          PO_Service_Entries (Self_ID, Called_PO, False);
 410
 411          if Called_PO.Pending_Action then
 412             Called_PO.Pending_Action := False;
 413             Caller := STPO.Self;
 414
 415             if Single_Lock then
 416                STPO.Lock_RTS;
 417             end if;
 418
 419             STPO.Write_Lock (Caller);
 420             Caller.New_Base_Priority := Called_PO.Old_Base_Priority;
 421             Initialization.Change_Base_Priority (Caller);
 422             STPO.Unlock (Caller);
 423
 424             if Single_Lock then
 425                STPO.Unlock_RTS;
 426             end if;
 427          end if;
 428
 429          Unlock_Entries (Called_PO);
 430
 431          if Single_Lock then
 432             STPO.Lock_RTS;
 433          end if;
 434       end if;
 435    end Unlock_And_Update_Server;
 436
 437    -------------------
 438    -- Unlock_Server --
 439    -------------------
 440
 441    procedure Unlock_Server (Entry_Call : Entry_Call_Link) is
 442       Caller    : Task_Id;
 443       Called_PO : Protection_Entries_Access;
 444
 445    begin
 446       if Entry_Call.Called_Task /= null then
 447          STPO.Unlock (Entry_Call.Called_Task);
 448       else
 449          Called_PO := To_Protection (Entry_Call.Called_PO);
 450
 451          if Called_PO.Pending_Action then
 452             Called_PO.Pending_Action := False;
 453             Caller := STPO.Self;
 454
 455             if Single_Lock then
 456                STPO.Lock_RTS;
 457             end if;
 458
 459             STPO.Write_Lock (Caller);
 460             Caller.New_Base_Priority := Called_PO.Old_Base_Priority;
 461             Initialization.Change_Base_Priority (Caller);
 462             STPO.Unlock (Caller);
 463
 464             if Single_Lock then
 465                STPO.Unlock_RTS;
 466             end if;
 467          end if;
 468
 469          Unlock_Entries (Called_PO);
 470
 471          if Single_Lock then
 472             STPO.Lock_RTS;
 473          end if;
 474       end if;
 475    end Unlock_Server;
 476
 477    -------------------------
 478    -- Wait_For_Completion --
 479    -------------------------
 480
 481    procedure Wait_For_Completion (Entry_Call : Entry_Call_Link) is
 482       Self_Id : constant Task_Id := Entry_Call.Self;
 483
 484    begin
 485       --  If this is a conditional call, it should be cancelled when it
 486       --  becomes abortable. This is checked in the loop below.
 487
 488       if Parameters.Runtime_Traces then
 489          Send_Trace_Info (W_Completion);
 490       end if;
 491
 492       Self_Id.Common.State := Entry_Caller_Sleep;
 493
 494       --  Try to remove calls to Sleep in the loop below by letting the caller
 495       --  a chance of getting ready immediately, using Unlock & Yield.
 496       --  See similar action in Wait_For_Call & Timed_Selective_Wait.
 497
 498       if Single_Lock then
 499          STPO.Unlock_RTS;
 500       else
 501          STPO.Unlock (Self_Id);
 502       end if;
 503
 504       if Entry_Call.State < Done then
 505          STPO.Yield;
 506       end if;
 507
 508       if Single_Lock then
 509          STPO.Lock_RTS;
 510       else
 511          STPO.Write_Lock (Self_Id);
 512       end if;
 513
 514       loop
 515          Check_Pending_Actions_For_Entry_Call (Self_Id, Entry_Call);
 516
 517          exit when Entry_Call.State >= Done;
 518
 519          STPO.Sleep (Self_Id, Entry_Caller_Sleep);
 520       end loop;
 521
 522       Self_Id.Common.State := Runnable;
 523       Utilities.Exit_One_ATC_Level (Self_Id);
 524
 525       if Parameters.Runtime_Traces then
 526          Send_Trace_Info (M_Call_Complete);
 527       end if;
 528    end Wait_For_Completion;
 529
 530    --------------------------------------
 531    -- Wait_For_Completion_With_Timeout --
 532    --------------------------------------
 533
 534    procedure Wait_For_Completion_With_Timeout
 535      (Entry_Call  : Entry_Call_Link;
 536       Wakeup_Time : Duration;
 537       Mode        : Delay_Modes;
 538       Yielded     : out Boolean)
 539    is
 540       Self_Id  : constant Task_Id := Entry_Call.Self;
 541       Timedout : Boolean := False;
 542
 543       use type Ada.Exceptions.Exception_Id;
 544
 545    begin
 546       --  This procedure waits for the entry call to be served, with a timeout.
 547       --  It tries to cancel the call if the timeout expires before the call is
 548       --  served.
 549
 550       --  If we wake up from the timed sleep operation here, it may be for
 551       --  several possible reasons:
 552
 553       --  1) The entry call is done being served.
 554       --  2) There is an abort or priority change to be served.
 555       --  3) The timeout has expired (Timedout = True)
 556       --  4) There has been a spurious wakeup.
 557
 558       --  Once the timeout has expired we may need to continue to wait if the
 559       --  call is already being serviced. In that case, we want to go back to
 560       --  sleep, but without any timeout. The variable Timedout is used to
 561       --  control this. If the Timedout flag is set, we do not need to
 562       --  STPO.Sleep with a timeout. We just sleep until we get a wakeup for
 563       --  some status change.
 564
 565       --  The original call may have become abortable after waking up. We want
 566       --  to check Check_Pending_Actions_For_Entry_Call again in any case.
 567
 568       pragma Assert (Entry_Call.Mode = Timed_Call);
 569
 570       Yielded := False;
 571       Self_Id.Common.State := Entry_Caller_Sleep;
 572
 573       --  Looping is necessary in case the task wakes up early from the timed
 574       --  sleep, due to a "spurious wakeup". Spurious wakeups are a weakness of
 575       --  POSIX condition variables. A thread waiting for a condition variable
 576       --  is allowed to wake up at any time, not just when the condition is
 577       --  signaled. See same loop in the ordinary Wait_For_Completion, above.
 578
 579       if Parameters.Runtime_Traces then
 580          Send_Trace_Info (WT_Completion, Wakeup_Time);
 581       end if;
 582
 583       loop
 584          Check_Pending_Actions_For_Entry_Call (Self_Id, Entry_Call);
 585          exit when Entry_Call.State >= Done;
 586
 587          STPO.Timed_Sleep (Self_Id, Wakeup_Time, Mode,
 588            Entry_Caller_Sleep, Timedout, Yielded);
 589
 590          if Timedout then
 591             if Parameters.Runtime_Traces then
 592                Send_Trace_Info (E_Timeout);
 593             end if;
 594
 595             --  Try to cancel the call (see Try_To_Cancel_Entry_Call for
 596             --  corresponding code in the ATC case).
 597
 598             Entry_Call.Cancellation_Attempted := True;
 599
 600             if Self_Id.Pending_ATC_Level >= Entry_Call.Level then
 601                Self_Id.Pending_ATC_Level := Entry_Call.Level - 1;
 602             end if;
 603
 604             --  The following loop is the same as the loop and exit code
 605             --  from the ordinary Wait_For_Completion. If we get here, we
 606             --  have timed out but we need to keep waiting until the call
 607             --  has actually completed or been cancelled successfully.
 608
 609             loop
 610                Check_Pending_Actions_For_Entry_Call (Self_Id, Entry_Call);
 611                exit when Entry_Call.State >= Done;
 612                STPO.Sleep (Self_Id, Entry_Caller_Sleep);
 613             end loop;
 614
 615             Self_Id.Common.State := Runnable;
 616             Utilities.Exit_One_ATC_Level (Self_Id);
 617
 618             return;
 619          end if;
 620       end loop;
 621
 622       --  This last part is the same as ordinary Wait_For_Completion,
 623       --  and is only executed if the call completed without timing out.
 624
 625       if Parameters.Runtime_Traces then
 626          Send_Trace_Info (M_Call_Complete);
 627       end if;
 628
 629       Self_Id.Common.State := Runnable;
 630       Utilities.Exit_One_ATC_Level (Self_Id);
 631    end Wait_For_Completion_With_Timeout;
 632
 633    --------------------------
 634    -- Wait_Until_Abortable --
 635    --------------------------
 636
 637    procedure Wait_Until_Abortable
 638      (Self_ID : Task_Id;
 639       Call    : Entry_Call_Link)
 640    is
 641    begin
 642       pragma Assert (Self_ID.ATC_Nesting_Level > 0);
 643       pragma Assert (Call.Mode = Asynchronous_Call);
 644
 645       if Parameters.Runtime_Traces then
 646          Send_Trace_Info (W_Completion);
 647       end if;
 648
 649       STPO.Write_Lock (Self_ID);
 650       Self_ID.Common.State := Entry_Caller_Sleep;
 651
 652       loop
 653          Check_Pending_Actions_For_Entry_Call (Self_ID, Call);
 654          exit when Call.State >= Was_Abortable;
 655          STPO.Sleep (Self_ID, Async_Select_Sleep);
 656       end loop;
 657
 658       Self_ID.Common.State := Runnable;
 659       STPO.Unlock (Self_ID);
 660
 661       if Parameters.Runtime_Traces then
 662          Send_Trace_Info (M_Call_Complete);
 663       end if;
 664    end Wait_Until_Abortable;
 665
 666 end System.Tasking.Entry_Calls;