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