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