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             Entry_Call.State :=
 169               (if Entry_Call.Cancellation_Attempted then Cancelled else Done);
 170             Unlock_And_Update_Server (Self_ID, Entry_Call);
 171
 172          else
 173             Unlock_Server (Entry_Call);
 174          end if;
 175
 176          STPO.Write_Lock (Self_ID);
 177       end if;
 178    end Check_Pending_Actions_For_Entry_Call;
 179
 180    -----------------
 181    -- Lock_Server --
 182    -----------------
 183
 184    procedure Lock_Server (Entry_Call : Entry_Call_Link) is
 185       Test_Task         : Task_Id;
 186       Test_PO           : Protection_Entries_Access;
 187       Ceiling_Violation : Boolean;
 188       Failures          : Integer := 0;
 189
 190    begin
 191       Test_Task := Entry_Call.Called_Task;
 192
 193       loop
 194          if Test_Task = null then
 195
 196             --  Entry_Call was queued on a protected object, or in transition,
 197             --  when we last fetched Test_Task.
 198
 199             Test_PO := To_Protection (Entry_Call.Called_PO);
 200
 201             if Test_PO = null then
 202
 203                --  We had very bad luck, interleaving with TWO different
 204                --  requeue operations. Go around the loop and try again.
 205
 206                if Single_Lock then
 207                   STPO.Unlock_RTS;
 208                   STPO.Yield;
 209                   STPO.Lock_RTS;
 210                else
 211                   STPO.Yield;
 212                end if;
 213
 214             else
 215                if Single_Lock then
 216                   STPO.Unlock_RTS;
 217                end if;
 218
 219                Lock_Entries (Test_PO, Ceiling_Violation);
 220
 221                --  ???
 222
 223                --  The following code allows Lock_Server to be called when
 224                --  cancelling a call, to allow for the possibility that the
 225                --  priority of the caller has been raised beyond that of the
 226                --  protected entry call by Ada.Dynamic_Priorities.Set_Priority.
 227
 228                --  If the current task has a higher priority than the ceiling
 229                --  of the protected object, temporarily lower it. It will
 230                --  be reset in Unlock.
 231
 232                if Ceiling_Violation then
 233                   declare
 234                      Current_Task      : constant Task_Id := STPO.Self;
 235                      Old_Base_Priority : System.Any_Priority;
 236
 237                   begin
 238                      if Single_Lock then
 239                         STPO.Lock_RTS;
 240                      end if;
 241
 242                      STPO.Write_Lock (Current_Task);
 243                      Old_Base_Priority := Current_Task.Common.Base_Priority;
 244                      Current_Task.New_Base_Priority := Test_PO.Ceiling;
 245                      System.Tasking.Initialization.Change_Base_Priority
 246                        (Current_Task);
 247                      STPO.Unlock (Current_Task);
 248
 249                      if Single_Lock then
 250                         STPO.Unlock_RTS;
 251                      end if;
 252
 253                      --  Following lock should not fail
 254
 255                      Lock_Entries (Test_PO);
 256
 257                      Test_PO.Old_Base_Priority := Old_Base_Priority;
 258                      Test_PO.Pending_Action := True;
 259                   end;
 260                end if;
 261
 262                exit when To_Address (Test_PO) = Entry_Call.Called_PO;
 263                Unlock_Entries (Test_PO);
 264
 265                if Single_Lock then
 266                   STPO.Lock_RTS;
 267                end if;
 268             end if;
 269
 270          else
 271             STPO.Write_Lock (Test_Task);
 272             exit when Test_Task = Entry_Call.Called_Task;
 273             STPO.Unlock (Test_Task);
 274          end if;
 275
 276          Test_Task := Entry_Call.Called_Task;
 277          Failures := Failures + 1;
 278          pragma Assert (Failures <= 5);
 279       end loop;
 280    end Lock_Server;
 281
 282    ---------------------------------------------
 283    -- Poll_Base_Priority_Change_At_Entry_Call --
 284    ---------------------------------------------
 285
 286    procedure Poll_Base_Priority_Change_At_Entry_Call
 287      (Self_ID    : Task_Id;
 288       Entry_Call : Entry_Call_Link)
 289    is
 290    begin
 291       if Self_ID.Pending_Priority_Change then
 292
 293          --  Check for ceiling violations ???
 294
 295          Self_ID.Pending_Priority_Change := False;
 296
 297          --  Requeue the entry call at the new priority. We need to requeue
 298          --  even if the new priority is the same than the previous (see ACATS
 299          --  test cxd4006).
 300
 301          STPO.Unlock (Self_ID);
 302          Lock_Server (Entry_Call);
 303          Queuing.Requeue_Call_With_New_Prio
 304            (Entry_Call, STPO.Get_Priority (Self_ID));
 305          Unlock_And_Update_Server (Self_ID, Entry_Call);
 306          STPO.Write_Lock (Self_ID);
 307       end if;
 308    end Poll_Base_Priority_Change_At_Entry_Call;
 309
 310    --------------------
 311    -- Reset_Priority --
 312    --------------------
 313
 314    procedure Reset_Priority
 315      (Acceptor               : Task_Id;
 316       Acceptor_Prev_Priority : Rendezvous_Priority)
 317    is
 318    begin
 319       pragma Assert (Acceptor = STPO.Self);
 320
 321       --  Since we limit this kind of "active" priority change to be done
 322       --  by the task for itself, we don't need to lock Acceptor.
 323
 324       if Acceptor_Prev_Priority /= Priority_Not_Boosted then
 325          STPO.Set_Priority (Acceptor, Acceptor_Prev_Priority,
 326            Loss_Of_Inheritance => True);
 327       end if;
 328    end Reset_Priority;
 329
 330    ------------------------------
 331    -- Try_To_Cancel_Entry_Call --
 332    ------------------------------
 333
 334    procedure Try_To_Cancel_Entry_Call (Succeeded : out Boolean) is
 335       Entry_Call : Entry_Call_Link;
 336       Self_ID    : constant Task_Id := STPO.Self;
 337
 338       use type Ada.Exceptions.Exception_Id;
 339
 340    begin
 341       Entry_Call := Self_ID.Entry_Calls (Self_ID.ATC_Nesting_Level)'Access;
 342
 343       --  Experimentation has shown that abort is sometimes (but not
 344       --  always) already deferred when Cancel_xxx_Entry_Call is called.
 345       --  That may indicate an error. Find out what is going on. ???
 346
 347       pragma Assert (Entry_Call.Mode = Asynchronous_Call);
 348       Initialization.Defer_Abort_Nestable (Self_ID);
 349
 350       if Single_Lock then
 351          STPO.Lock_RTS;
 352       end if;
 353
 354       STPO.Write_Lock (Self_ID);
 355       Entry_Call.Cancellation_Attempted := True;
 356
 357       if Self_ID.Pending_ATC_Level >= Entry_Call.Level then
 358          Self_ID.Pending_ATC_Level := Entry_Call.Level - 1;
 359       end if;
 360
 361       Entry_Calls.Wait_For_Completion (Entry_Call);
 362       STPO.Unlock (Self_ID);
 363
 364       if Single_Lock then
 365          STPO.Unlock_RTS;
 366       end if;
 367
 368       Succeeded := Entry_Call.State = Cancelled;
 369
 370       Initialization.Undefer_Abort_Nestable (Self_ID);
 371
 372       --  Ideally, abort should no longer be deferred at this point, so we
 373       --  should be able to call Check_Exception. The loop below should be
 374       --  considered temporary, to work around the possibility that abort
 375       --  may be deferred more than one level deep ???
 376
 377       if Entry_Call.Exception_To_Raise /= Ada.Exceptions.Null_Id then
 378          while Self_ID.Deferral_Level > 0 loop
 379             System.Tasking.Initialization.Undefer_Abort_Nestable (Self_ID);
 380          end loop;
 381
 382          Entry_Calls.Check_Exception (Self_ID, Entry_Call);
 383       end if;
 384    end Try_To_Cancel_Entry_Call;
 385
 386    ------------------------------
 387    -- Unlock_And_Update_Server --
 388    ------------------------------
 389
 390    procedure Unlock_And_Update_Server
 391      (Self_ID    : Task_Id;
 392       Entry_Call : Entry_Call_Link)
 393    is
 394       Called_PO : Protection_Entries_Access;
 395       Caller    : Task_Id;
 396
 397    begin
 398       if Entry_Call.Called_Task /= null then
 399          STPO.Unlock (Entry_Call.Called_Task);
 400       else
 401          Called_PO := To_Protection (Entry_Call.Called_PO);
 402          PO_Service_Entries (Self_ID, Called_PO, False);
 403
 404          if Called_PO.Pending_Action then
 405             Called_PO.Pending_Action := False;
 406             Caller := STPO.Self;
 407
 408             if Single_Lock then
 409                STPO.Lock_RTS;
 410             end if;
 411
 412             STPO.Write_Lock (Caller);
 413             Caller.New_Base_Priority := Called_PO.Old_Base_Priority;
 414             Initialization.Change_Base_Priority (Caller);
 415             STPO.Unlock (Caller);
 416
 417             if Single_Lock then
 418                STPO.Unlock_RTS;
 419             end if;
 420          end if;
 421
 422          Unlock_Entries (Called_PO);
 423
 424          if Single_Lock then
 425             STPO.Lock_RTS;
 426          end if;
 427       end if;
 428    end Unlock_And_Update_Server;
 429
 430    -------------------
 431    -- Unlock_Server --
 432    -------------------
 433
 434    procedure Unlock_Server (Entry_Call : Entry_Call_Link) is
 435       Caller    : Task_Id;
 436       Called_PO : Protection_Entries_Access;
 437
 438    begin
 439       if Entry_Call.Called_Task /= null then
 440          STPO.Unlock (Entry_Call.Called_Task);
 441       else
 442          Called_PO := To_Protection (Entry_Call.Called_PO);
 443
 444          if Called_PO.Pending_Action then
 445             Called_PO.Pending_Action := False;
 446             Caller := STPO.Self;
 447
 448             if Single_Lock then
 449                STPO.Lock_RTS;
 450             end if;
 451
 452             STPO.Write_Lock (Caller);
 453             Caller.New_Base_Priority := Called_PO.Old_Base_Priority;
 454             Initialization.Change_Base_Priority (Caller);
 455             STPO.Unlock (Caller);
 456
 457             if Single_Lock then
 458                STPO.Unlock_RTS;
 459             end if;
 460          end if;
 461
 462          Unlock_Entries (Called_PO);
 463
 464          if Single_Lock then
 465             STPO.Lock_RTS;
 466          end if;
 467       end if;
 468    end Unlock_Server;
 469
 470    -------------------------
 471    -- Wait_For_Completion --
 472    -------------------------
 473
 474    procedure Wait_For_Completion (Entry_Call : Entry_Call_Link) is
 475       Self_Id : constant Task_Id := Entry_Call.Self;
 476
 477    begin
 478       --  If this is a conditional call, it should be cancelled when it
 479       --  becomes abortable. This is checked in the loop below.
 480
 481       if Parameters.Runtime_Traces then
 482          Send_Trace_Info (W_Completion);
 483       end if;
 484
 485       Self_Id.Common.State := Entry_Caller_Sleep;
 486
 487       --  Try to remove calls to Sleep in the loop below by letting the caller
 488       --  a chance of getting ready immediately, using Unlock & Yield.
 489       --  See similar action in Wait_For_Call & Timed_Selective_Wait.
 490
 491       if Single_Lock then
 492          STPO.Unlock_RTS;
 493       else
 494          STPO.Unlock (Self_Id);
 495       end if;
 496
 497       if Entry_Call.State < Done then
 498          STPO.Yield;
 499       end if;
 500
 501       if Single_Lock then
 502          STPO.Lock_RTS;
 503       else
 504          STPO.Write_Lock (Self_Id);
 505       end if;
 506
 507       loop
 508          Check_Pending_Actions_For_Entry_Call (Self_Id, Entry_Call);
 509
 510          exit when Entry_Call.State >= Done;
 511
 512          STPO.Sleep (Self_Id, Entry_Caller_Sleep);
 513       end loop;
 514
 515       Self_Id.Common.State := Runnable;
 516       Utilities.Exit_One_ATC_Level (Self_Id);
 517
 518       if Parameters.Runtime_Traces then
 519          Send_Trace_Info (M_Call_Complete);
 520       end if;
 521    end Wait_For_Completion;
 522
 523    --------------------------------------
 524    -- Wait_For_Completion_With_Timeout --
 525    --------------------------------------
 526
 527    procedure Wait_For_Completion_With_Timeout
 528      (Entry_Call  : Entry_Call_Link;
 529       Wakeup_Time : Duration;
 530       Mode        : Delay_Modes;
 531       Yielded     : out Boolean)
 532    is
 533       Self_Id  : constant Task_Id := Entry_Call.Self;
 534       Timedout : Boolean := False;
 535
 536       use type Ada.Exceptions.Exception_Id;
 537
 538    begin
 539       --  This procedure waits for the entry call to be served, with a timeout.
 540       --  It tries to cancel the call if the timeout expires before the call is
 541       --  served.
 542
 543       --  If we wake up from the timed sleep operation here, it may be for
 544       --  several possible reasons:
 545
 546       --  1) The entry call is done being served.
 547       --  2) There is an abort or priority change to be served.
 548       --  3) The timeout has expired (Timedout = True)
 549       --  4) There has been a spurious wakeup.
 550
 551       --  Once the timeout has expired we may need to continue to wait if the
 552       --  call is already being serviced. In that case, we want to go back to
 553       --  sleep, but without any timeout. The variable Timedout is used to
 554       --  control this. If the Timedout flag is set, we do not need to
 555       --  STPO.Sleep with a timeout. We just sleep until we get a wakeup for
 556       --  some status change.
 557
 558       --  The original call may have become abortable after waking up. We want
 559       --  to check Check_Pending_Actions_For_Entry_Call again in any case.
 560
 561       pragma Assert (Entry_Call.Mode = Timed_Call);
 562
 563       Yielded := False;
 564       Self_Id.Common.State := Entry_Caller_Sleep;
 565
 566       --  Looping is necessary in case the task wakes up early from the timed
 567       --  sleep, due to a "spurious wakeup". Spurious wakeups are a weakness of
 568       --  POSIX condition variables. A thread waiting for a condition variable
 569       --  is allowed to wake up at any time, not just when the condition is
 570       --  signaled. See same loop in the ordinary Wait_For_Completion, above.
 571
 572       if Parameters.Runtime_Traces then
 573          Send_Trace_Info (WT_Completion, Wakeup_Time);
 574       end if;
 575
 576       loop
 577          Check_Pending_Actions_For_Entry_Call (Self_Id, Entry_Call);
 578          exit when Entry_Call.State >= Done;
 579
 580          STPO.Timed_Sleep (Self_Id, Wakeup_Time, Mode,
 581            Entry_Caller_Sleep, Timedout, Yielded);
 582
 583          if Timedout then
 584             if Parameters.Runtime_Traces then
 585                Send_Trace_Info (E_Timeout);
 586             end if;
 587
 588             --  Try to cancel the call (see Try_To_Cancel_Entry_Call for
 589             --  corresponding code in the ATC case).
 590
 591             Entry_Call.Cancellation_Attempted := True;
 592
 593             if Self_Id.Pending_ATC_Level >= Entry_Call.Level then
 594                Self_Id.Pending_ATC_Level := Entry_Call.Level - 1;
 595             end if;
 596
 597             --  The following loop is the same as the loop and exit code
 598             --  from the ordinary Wait_For_Completion. If we get here, we
 599             --  have timed out but we need to keep waiting until the call
 600             --  has actually completed or been cancelled successfully.
 601
 602             loop
 603                Check_Pending_Actions_For_Entry_Call (Self_Id, Entry_Call);
 604                exit when Entry_Call.State >= Done;
 605                STPO.Sleep (Self_Id, Entry_Caller_Sleep);
 606             end loop;
 607
 608             Self_Id.Common.State := Runnable;
 609             Utilities.Exit_One_ATC_Level (Self_Id);
 610
 611             return;
 612          end if;
 613       end loop;
 614
 615       --  This last part is the same as ordinary Wait_For_Completion,
 616       --  and is only executed if the call completed without timing out.
 617
 618       if Parameters.Runtime_Traces then
 619          Send_Trace_Info (M_Call_Complete);
 620       end if;
 621
 622       Self_Id.Common.State := Runnable;
 623       Utilities.Exit_One_ATC_Level (Self_Id);
 624    end Wait_For_Completion_With_Timeout;
 625
 626    --------------------------
 627    -- Wait_Until_Abortable --
 628    --------------------------
 629
 630    procedure Wait_Until_Abortable
 631      (Self_ID : Task_Id;
 632       Call    : Entry_Call_Link)
 633    is
 634    begin
 635       pragma Assert (Self_ID.ATC_Nesting_Level > 0);
 636       pragma Assert (Call.Mode = Asynchronous_Call);
 637
 638       if Parameters.Runtime_Traces then
 639          Send_Trace_Info (W_Completion);
 640       end if;
 641
 642       STPO.Write_Lock (Self_ID);
 643       Self_ID.Common.State := Entry_Caller_Sleep;
 644
 645       loop
 646          Check_Pending_Actions_For_Entry_Call (Self_ID, Call);
 647          exit when Call.State >= Was_Abortable;
 648          STPO.Sleep (Self_ID, Async_Select_Sleep);
 649       end loop;
 650
 651       Self_ID.Common.State := Runnable;
 652       STPO.Unlock (Self_ID);
 653
 654       if Parameters.Runtime_Traces then
 655          Send_Trace_Info (M_Call_Complete);
 656       end if;
 657    end Wait_Until_Abortable;
 658
 659 end System.Tasking.Entry_Calls;