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