1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
5 -- S Y S T E M . T A S K I N G . R E N D E Z V O U S --
9 -- Copyright (C) 1992-2023, Free Software Foundation, Inc. --
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. --
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. --
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/>. --
27 -- GNARL was developed by the GNARL team at Florida State University. --
28 -- Extensive contributions were provided by Ada Core Technologies, Inc. --
30 ------------------------------------------------------------------------------
32 with System
.Task_Primitives
.Operations
;
33 with System
.Tasking
.Entry_Calls
;
34 with System
.Tasking
.Initialization
;
35 with System
.Tasking
.Queuing
;
36 with System
.Tasking
.Utilities
;
37 with System
.Tasking
.Protected_Objects
.Operations
;
38 with System
.Tasking
.Debug
;
39 with System
.Restrictions
;
41 package body System
.Tasking
.Rendezvous
is
43 package STPO
renames System
.Task_Primitives
.Operations
;
44 package POO
renames Protected_Objects
.Operations
;
45 package POE
renames Protected_Objects
.Entries
;
47 use Task_Primitives
.Operations
;
49 type Select_Treatment
is (
50 Accept_Alternative_Selected
, -- alternative with non-null body
51 Accept_Alternative_Completed
, -- alternative with null body
54 Accept_Alternative_Open
,
61 Default_Treatment
: constant array (Select_Modes
) of Select_Treatment
:=
62 [Simple_Mode
=> No_Alternative_Open
,
63 Else_Mode
=> Else_Selected
,
64 Terminate_Mode
=> Terminate_Selected
,
65 Delay_Mode
=> No_Alternative_Open
];
67 New_State
: constant array (Boolean, Entry_Call_State
)
68 of Entry_Call_State
:=
70 [Never_Abortable
=> Never_Abortable
,
71 Not_Yet_Abortable
=> Now_Abortable
,
72 Was_Abortable
=> Now_Abortable
,
73 Now_Abortable
=> Now_Abortable
,
75 Cancelled
=> Cancelled
],
77 [Never_Abortable
=> Never_Abortable
,
78 Not_Yet_Abortable
=> Not_Yet_Abortable
,
79 Was_Abortable
=> Was_Abortable
,
80 Now_Abortable
=> Now_Abortable
,
82 Cancelled
=> Cancelled
]
85 -----------------------
86 -- Local Subprograms --
87 -----------------------
89 procedure Local_Defer_Abort
(Self_Id
: Task_Id
) renames
90 System
.Tasking
.Initialization
.Defer_Abort_Nestable
;
92 procedure Local_Undefer_Abort
(Self_Id
: Task_Id
) renames
93 System
.Tasking
.Initialization
.Undefer_Abort_Nestable
;
95 -- Florist defers abort around critical sections that make entry calls
96 -- to the Interrupt_Manager task, which violates the general rule about
97 -- top-level runtime system calls from abort-deferred regions. It is not
98 -- that this is unsafe, but when it occurs in "normal" programs it usually
99 -- means either the user is trying to do a potentially blocking operation
100 -- from within a protected object, or there is a runtime system/compiler
101 -- error that has failed to undefer an earlier abort deferral. Thus, for
102 -- debugging it may be wise to modify the above renamings to the
103 -- non-nestable forms.
105 procedure Local_Complete_Rendezvous
(Ex
: Ada
.Exceptions
.Exception_Id
);
106 -- Internal version of Complete_Rendezvous, used to implement
107 -- Complete_Rendezvous and Exceptional_Complete_Rendezvous.
108 -- Should be called holding no locks, generally with abort
111 procedure Boost_Priority
(Call
: Entry_Call_Link
; Acceptor
: Task_Id
);
112 pragma Inline
(Boost_Priority
);
113 -- Call this only with abort deferred and holding lock of Acceptor
115 procedure Call_Synchronous
117 E
: Task_Entry_Index
;
118 Uninterpreted_Data
: System
.Address
;
120 Rendezvous_Successful
: out Boolean);
121 pragma Inline
(Call_Synchronous
);
122 -- This call is used to make a simple or conditional entry call.
123 -- Called from Call_Simple and Task_Entry_Call.
125 procedure Setup_For_Rendezvous_With_Body
126 (Entry_Call
: Entry_Call_Link
;
128 pragma Inline
(Setup_For_Rendezvous_With_Body
);
129 -- Call this only with abort deferred and holding lock of Acceptor. When
130 -- a rendezvous selected (ready for rendezvous) we need to save previous
131 -- caller and adjust the priority. Also we need to make this call not
132 -- Abortable (Cancellable) since the rendezvous has already been started.
134 procedure Wait_For_Call
(Self_Id
: Task_Id
);
135 pragma Inline
(Wait_For_Call
);
136 -- Call this only with abort deferred and holding lock of Self_Id. An
137 -- accepting task goes into Sleep by calling this routine waiting for a
138 -- call from the caller or waiting for an abort. Make sure Self_Id is
139 -- locked before calling this routine.
145 procedure Accept_Call
146 (E
: Task_Entry_Index
;
147 Uninterpreted_Data
: out System
.Address
)
149 Self_Id
: constant Task_Id
:= STPO
.Self
;
150 Caller
: Task_Id
:= null;
151 Open_Accepts
: aliased Accept_List
(1 .. 1);
152 Entry_Call
: Entry_Call_Link
;
155 Initialization
.Defer_Abort
(Self_Id
);
156 STPO
.Write_Lock
(Self_Id
);
158 if not Self_Id
.Callable
then
159 pragma Assert
(Self_Id
.Pending_ATC_Level
= Level_Completed_Task
);
161 pragma Assert
(Self_Id
.Pending_Action
);
163 STPO
.Unlock
(Self_Id
);
164 Initialization
.Undefer_Abort
(Self_Id
);
166 -- Should never get here ???
168 pragma Assert
(Standard
.False);
169 raise Standard
'Abort_Signal;
172 Queuing
.Dequeue_Head
(Self_Id
.Entry_Queues
(E
), Entry_Call
);
174 if Entry_Call
/= null then
175 Caller
:= Entry_Call
.Self
;
176 Setup_For_Rendezvous_With_Body
(Entry_Call
, Self_Id
);
177 Uninterpreted_Data
:= Entry_Call
.Uninterpreted_Data
;
182 Open_Accepts
(1).Null_Body
:= False;
183 Open_Accepts
(1).S
:= E
;
184 Self_Id
.Open_Accepts
:= Open_Accepts
'Unrestricted_Access;
186 -- Wait for normal call
189 (Debug
.Trace
(Self_Id
, "Accept_Call: wait", 'R'));
190 Wait_For_Call
(Self_Id
);
192 pragma Assert
(Self_Id
.Open_Accepts
= null);
194 if Self_Id
.Common
.Call
/= null then
195 Caller
:= Self_Id
.Common
.Call
.Self
;
197 pragma Assert
(Caller
.ATC_Nesting_Level
> Level_No_ATC_Occurring
);
199 Uninterpreted_Data
:=
200 Caller
.Entry_Calls
(Caller
.ATC_Nesting_Level
).Uninterpreted_Data
;
202 -- Case of an aborted task
204 Uninterpreted_Data
:= System
.Null_Address
;
208 -- Self_Id.Common.Call should already be updated by the Caller. On
209 -- return, we will start the rendezvous.
211 STPO
.Unlock
(Self_Id
);
212 Initialization
.Undefer_Abort
(Self_Id
);
219 procedure Accept_Trivial
(E
: Task_Entry_Index
) is
220 Self_Id
: constant Task_Id
:= STPO
.Self
;
221 Caller
: Task_Id
:= null;
222 Open_Accepts
: aliased Accept_List
(1 .. 1);
223 Entry_Call
: Entry_Call_Link
;
226 Initialization
.Defer_Abort_Nestable
(Self_Id
);
227 STPO
.Write_Lock
(Self_Id
);
229 if not Self_Id
.Callable
then
230 pragma Assert
(Self_Id
.Pending_ATC_Level
= Level_Completed_Task
);
232 pragma Assert
(Self_Id
.Pending_Action
);
234 STPO
.Unlock
(Self_Id
);
235 Initialization
.Undefer_Abort_Nestable
(Self_Id
);
237 -- Should never get here ???
239 pragma Assert
(Standard
.False);
240 raise Standard
'Abort_Signal;
243 Queuing
.Dequeue_Head
(Self_Id
.Entry_Queues
(E
), Entry_Call
);
245 if Entry_Call
= null then
247 -- Need to wait for entry call
249 Open_Accepts
(1).Null_Body
:= True;
250 Open_Accepts
(1).S
:= E
;
251 Self_Id
.Open_Accepts
:= Open_Accepts
'Unrestricted_Access;
254 (Debug
.Trace
(Self_Id
, "Accept_Trivial: wait", 'R'));
256 Wait_For_Call
(Self_Id
);
258 pragma Assert
(Self_Id
.Open_Accepts
= null);
260 -- No need to do anything special here for pending abort.
261 -- Abort_Signal will be raised by Undefer on exit.
263 STPO
.Unlock
(Self_Id
);
265 -- Found caller already waiting
268 pragma Assert
(Entry_Call
.State
< Done
);
270 STPO
.Unlock
(Self_Id
);
271 Caller
:= Entry_Call
.Self
;
273 STPO
.Write_Lock
(Caller
);
274 Initialization
.Wakeup_Entry_Caller
(Self_Id
, Entry_Call
, Done
);
275 STPO
.Unlock
(Caller
);
278 Initialization
.Undefer_Abort_Nestable
(Self_Id
);
285 procedure Boost_Priority
(Call
: Entry_Call_Link
; Acceptor
: Task_Id
) is
286 Caller
: constant Task_Id
:= Call
.Self
;
287 Caller_Prio
: constant System
.Any_Priority
:= Get_Priority
(Caller
);
288 Acceptor_Prio
: constant System
.Any_Priority
:= Get_Priority
(Acceptor
);
290 if Caller_Prio
> Acceptor_Prio
then
291 Call
.Acceptor_Prev_Priority
:= Acceptor_Prio
;
292 Set_Priority
(Acceptor
, Caller_Prio
);
294 Call
.Acceptor_Prev_Priority
:= Priority_Not_Boosted
;
302 procedure Call_Simple
304 E
: Task_Entry_Index
;
305 Uninterpreted_Data
: System
.Address
)
307 Rendezvous_Successful
: Boolean;
310 -- If pragma Detect_Blocking is active then Program_Error must be
311 -- raised if this potentially blocking operation is called from a
314 if System
.Tasking
.Detect_Blocking
315 and then STPO
.Self
.Common
.Protected_Action_Nesting
> 0
317 raise Program_Error
with
318 "potentially blocking operation";
322 (Acceptor
, E
, Uninterpreted_Data
, Simple_Call
, Rendezvous_Successful
);
325 ----------------------
326 -- Call_Synchronous --
327 ----------------------
329 procedure Call_Synchronous
331 E
: Task_Entry_Index
;
332 Uninterpreted_Data
: System
.Address
;
334 Rendezvous_Successful
: out Boolean)
336 Self_Id
: constant Task_Id
:= STPO
.Self
;
338 Entry_Call
: Entry_Call_Link
;
341 pragma Assert
(Mode
/= Asynchronous_Call
);
343 Local_Defer_Abort
(Self_Id
);
344 Self_Id
.ATC_Nesting_Level
:= Self_Id
.ATC_Nesting_Level
+ 1;
346 (Debug
.Trace
(Self_Id
, "CS: entered ATC level: " &
347 ATC_Level
'Image (Self_Id
.ATC_Nesting_Level
), 'A'));
348 Level
:= Self_Id
.ATC_Nesting_Level
;
349 Entry_Call
:= Self_Id
.Entry_Calls
(Level
)'Access;
350 Entry_Call
.Next
:= null;
351 Entry_Call
.Mode
:= Mode
;
352 Entry_Call
.Cancellation_Attempted
:= False;
354 -- If this is a call made inside of an abort deferred region,
355 -- the call should be never abortable.
358 (if Self_Id
.Deferral_Level
> 1
362 Entry_Call
.E
:= Entry_Index
(E
);
363 Entry_Call
.Prio
:= Get_Priority
(Self_Id
);
364 Entry_Call
.Uninterpreted_Data
:= Uninterpreted_Data
;
365 Entry_Call
.Called_Task
:= Acceptor
;
366 Entry_Call
.Exception_To_Raise
:= Ada
.Exceptions
.Null_Id
;
367 Entry_Call
.With_Abort
:= True;
369 -- Note: the caller will undefer abort on return (see WARNING above)
371 if not Task_Do_Or_Queue
(Self_Id
, Entry_Call
) then
372 STPO
.Write_Lock
(Self_Id
);
373 Utilities
.Exit_One_ATC_Level
(Self_Id
);
374 STPO
.Unlock
(Self_Id
);
375 Local_Undefer_Abort
(Self_Id
);
380 STPO
.Write_Lock
(Self_Id
);
382 (Debug
.Trace
(Self_Id
, "Call_Synchronous: wait", 'R'));
383 Entry_Calls
.Wait_For_Completion
(Entry_Call
);
385 (Debug
.Trace
(Self_Id
, "Call_Synchronous: done waiting", 'R'));
386 Rendezvous_Successful
:= Entry_Call
.State
= Done
;
387 STPO
.Unlock
(Self_Id
);
388 Local_Undefer_Abort
(Self_Id
);
389 Entry_Calls
.Check_Exception
(Self_Id
, Entry_Call
);
390 end Call_Synchronous
;
396 function Callable
(T
: Task_Id
) return Boolean is
398 Self_Id
: constant Task_Id
:= STPO
.Self
;
401 Initialization
.Defer_Abort_Nestable
(Self_Id
);
403 Result
:= T
.Callable
;
405 Initialization
.Undefer_Abort_Nestable
(Self_Id
);
410 ----------------------------
411 -- Cancel_Task_Entry_Call --
412 ----------------------------
414 procedure Cancel_Task_Entry_Call
(Cancelled
: out Boolean) is
416 Entry_Calls
.Try_To_Cancel_Entry_Call
(Cancelled
);
417 end Cancel_Task_Entry_Call
;
419 -------------------------
420 -- Complete_Rendezvous --
421 -------------------------
423 procedure Complete_Rendezvous
is
425 Local_Complete_Rendezvous
(Ada
.Exceptions
.Null_Id
);
426 end Complete_Rendezvous
;
428 -------------------------------------
429 -- Exceptional_Complete_Rendezvous --
430 -------------------------------------
432 procedure Exceptional_Complete_Rendezvous
433 (Ex
: Ada
.Exceptions
.Exception_Id
)
435 procedure Internal_Reraise
;
436 pragma No_Return
(Internal_Reraise
);
437 pragma Import
(C
, Internal_Reraise
, "__gnat_reraise");
440 Local_Complete_Rendezvous
(Ex
);
443 -- ??? Do we need to give precedence to Program_Error that might be
444 -- raised due to failure of finalization, over Tasking_Error from
445 -- failure of requeue?
446 end Exceptional_Complete_Rendezvous
;
448 -------------------------------
449 -- Local_Complete_Rendezvous --
450 -------------------------------
452 procedure Local_Complete_Rendezvous
(Ex
: Ada
.Exceptions
.Exception_Id
) is
453 Self_Id
: constant Task_Id
:= STPO
.Self
;
454 Entry_Call
: Entry_Call_Link
:= Self_Id
.Common
.Call
;
456 Called_PO
: STPE
.Protection_Entries_Access
;
457 Acceptor_Prev_Priority
: Integer;
459 Ceiling_Violation
: Boolean;
461 use type Ada
.Exceptions
.Exception_Id
;
462 procedure Transfer_Occurrence
463 (Target
: Ada
.Exceptions
.Exception_Occurrence_Access
;
464 Source
: Ada
.Exceptions
.Exception_Occurrence
);
465 pragma Import
(C
, Transfer_Occurrence
, "__gnat_transfer_occurrence");
468 -- The deferral level is critical here, since we want to raise an
469 -- exception or allow abort to take place, if there is an exception or
473 (Debug
.Trace
(Self_Id
, "Local_Complete_Rendezvous", 'R'));
475 Initialization
.Defer_Abort
(Self_Id
);
477 -- We need to clean up any accepts which Self may have been serving when
480 if Ex
= Standard
'Abort_Signal'Identity then
481 while Entry_Call /= null loop
482 Entry_Call.Exception_To_Raise := Tasking_Error'Identity;
484 -- All forms of accept make sure that the acceptor is not
485 -- completed, before accepting further calls, so that we
486 -- can be sure that no further calls are made after the
487 -- current calls are purged.
489 Caller := Entry_Call.Self;
491 -- Take write lock. This follows the lock precedence rule that
492 -- Caller may be locked while holding lock of Acceptor. Complete
493 -- the call abnormally, with exception.
495 STPO.Write_Lock (Caller);
496 Initialization.Wakeup_Entry_Caller (Self_Id, Entry_Call, Done);
497 STPO.Unlock (Caller);
498 Entry_Call := Entry_Call.Acceptor_Prev_Call;
501 Caller := Entry_Call.Self;
503 if Entry_Call.Needs_Requeue then
505 -- We dare not lock Self_Id at the same time as Caller, for fear
508 Entry_Call.Needs_Requeue := False;
509 Self_Id.Common.Call := Entry_Call.Acceptor_Prev_Call;
511 if Entry_Call.Called_Task /= null then
513 -- Requeue to another task entry
515 if not Task_Do_Or_Queue (Self_Id, Entry_Call) then
516 Initialization.Undefer_Abort (Self_Id);
520 -- Requeue to a protected entry
522 Called_PO := POE.To_Protection (Entry_Call.Called_PO);
523 STPE.Lock_Entries_With_Status (Called_PO, Ceiling_Violation);
525 if Ceiling_Violation then
526 pragma Assert (Ex = Ada.Exceptions.Null_Id);
527 Entry_Call.Exception_To_Raise := Program_Error'Identity;
528 STPO.Write_Lock (Caller);
529 Initialization.Wakeup_Entry_Caller
530 (Self_Id, Entry_Call, Done);
531 STPO.Unlock (Caller);
534 POO.PO_Do_Or_Queue (Self_Id, Called_PO, Entry_Call);
535 POO.PO_Service_Entries (Self_Id, Called_PO);
539 Entry_Calls.Reset_Priority
540 (Self_Id, Entry_Call.Acceptor_Prev_Priority);
543 -- The call does not need to be requeued
545 Self_Id.Common.Call := Entry_Call.Acceptor_Prev_Call;
546 Entry_Call.Exception_To_Raise := Ex;
547 STPO.Write_Lock (Caller);
549 -- Done with Caller locked to make sure that Wakeup is not lost
551 if Ex /= Ada.Exceptions.Null_Id then
553 (Caller.Common.Compiler_Data.Current_Excep'Access,
554 Self_Id.Common.Compiler_Data.Current_Excep);
557 Acceptor_Prev_Priority := Entry_Call.Acceptor_Prev_Priority;
558 Initialization.Wakeup_Entry_Caller (Self_Id, Entry_Call, Done);
560 STPO.Unlock (Caller);
561 Entry_Calls.Reset_Priority (Self_Id, Acceptor_Prev_Priority);
565 Initialization.Undefer_Abort (Self_Id);
566 end Local_Complete_Rendezvous;
568 -------------------------------------
569 -- Requeue_Protected_To_Task_Entry --
570 -------------------------------------
572 procedure Requeue_Protected_To_Task_Entry
573 (Object : STPE.Protection_Entries_Access;
575 E : Task_Entry_Index;
576 With_Abort : Boolean)
578 Entry_Call : constant Entry_Call_Link := Object.Call_In_Progress;
580 pragma Assert (STPO.Self.Deferral_Level > 0);
582 Entry_Call.E := Entry_Index (E);
583 Entry_Call.Called_Task := Acceptor;
584 Entry_Call.Called_PO := Null_Address;
585 Entry_Call.With_Abort := With_Abort;
586 Object.Call_In_Progress := null;
587 end Requeue_Protected_To_Task_Entry;
589 ------------------------
590 -- Requeue_Task_Entry --
591 ------------------------
593 procedure Requeue_Task_Entry
595 E : Task_Entry_Index;
596 With_Abort : Boolean)
598 Self_Id : constant Task_Id := STPO.Self;
599 Entry_Call : constant Entry_Call_Link := Self_Id.Common.Call;
601 Initialization.Defer_Abort (Self_Id);
602 Entry_Call.Needs_Requeue := True;
603 Entry_Call.With_Abort := With_Abort;
604 Entry_Call.E := Entry_Index (E);
605 Entry_Call.Called_Task := Acceptor;
606 Initialization.Undefer_Abort (Self_Id);
607 end Requeue_Task_Entry;
613 procedure Selective_Wait
614 (Open_Accepts : Accept_List_Access;
615 Select_Mode : Select_Modes;
616 Uninterpreted_Data : out System.Address;
617 Index : out Select_Index)
619 Self_Id : constant Task_Id := STPO.Self;
620 Entry_Call : Entry_Call_Link;
621 Treatment : Select_Treatment;
623 Selection : Select_Index;
624 Open_Alternative : Boolean;
627 Initialization.Defer_Abort (Self_Id);
628 STPO.Write_Lock (Self_Id);
630 if not Self_Id.Callable then
631 pragma Assert (Self_Id.Pending_ATC_Level = Level_Completed_Task);
633 pragma Assert (Self_Id.Pending_Action);
635 STPO.Unlock (Self_Id);
637 -- ??? In some cases abort is deferred more than once. Need to
638 -- figure out why this happens.
640 if Self_Id.Deferral_Level > 1 then
641 Self_Id.Deferral_Level := 1;
644 Initialization.Undefer_Abort (Self_Id);
646 -- Should never get here ???
648 pragma Assert (Standard.False);
649 raise Standard'Abort_Signal;
652 pragma Assert (Open_Accepts /= null);
654 Uninterpreted_Data := Null_Address;
656 Queuing.Select_Task_Entry_Call
657 (Self_Id, Open_Accepts, Entry_Call, Selection, Open_Alternative);
659 -- Determine the kind and disposition of the select
661 Treatment := Default_Treatment (Select_Mode);
662 Self_Id.Chosen_Index := No_Rendezvous;
664 if Open_Alternative then
665 if Entry_Call /= null then
666 if Open_Accepts (Selection).Null_Body then
667 Treatment := Accept_Alternative_Completed;
669 Setup_For_Rendezvous_With_Body (Entry_Call, Self_Id);
670 Treatment := Accept_Alternative_Selected;
673 Self_Id.Chosen_Index := Selection;
675 elsif Treatment = No_Alternative_Open then
676 Treatment := Accept_Alternative_Open;
680 -- Handle the select according to the disposition selected above
683 when Accept_Alternative_Selected =>
685 -- Ready to rendezvous
687 Uninterpreted_Data := Self_Id.Common.Call.Uninterpreted_Data;
689 -- In this case the accept body is not Null_Body. Defer abort
690 -- until it gets into the accept body. The compiler has inserted
691 -- a call to Abort_Undefer as part of the entry expansion.
693 pragma Assert (Self_Id.Deferral_Level = 1);
695 Initialization.Defer_Abort_Nestable (Self_Id);
696 STPO.Unlock (Self_Id);
698 when Accept_Alternative_Completed =>
700 -- Accept body is null, so rendezvous is over immediately
702 STPO.Unlock (Self_Id);
703 Caller := Entry_Call.Self;
705 STPO.Write_Lock (Caller);
706 Initialization.Wakeup_Entry_Caller (Self_Id, Entry_Call, Done);
707 STPO.Unlock (Caller);
709 when Accept_Alternative_Open =>
713 Self_Id.Open_Accepts := Open_Accepts;
715 (Debug.Trace (Self_Id, "Selective_Wait: wait", 'R
'));
717 Wait_For_Call (Self_Id);
719 pragma Assert (Self_Id.Open_Accepts = null);
721 -- Self_Id.Common.Call should already be updated by the Caller if
722 -- not aborted. It might also be ready to do rendezvous even if
723 -- this wakes up due to an abort. Therefore, if the call is not
724 -- empty we need to do the rendezvous if the accept body is not
727 -- Aren't the first two conditions below redundant???
729 if Self_Id.Chosen_Index /= No_Rendezvous
730 and then Self_Id.Common.Call /= null
731 and then not Open_Accepts (Self_Id.Chosen_Index).Null_Body
733 Uninterpreted_Data := Self_Id.Common.Call.Uninterpreted_Data;
736 (Self_Id.Deferral_Level = 1
738 (Self_Id.Deferral_Level = 0
739 and then not Restrictions.Abort_Allowed));
741 Initialization.Defer_Abort_Nestable (Self_Id);
743 -- Leave abort deferred until the accept body
744 -- The compiler has inserted a call to Abort_Undefer as part of
745 -- the entry expansion.
748 STPO.Unlock (Self_Id);
750 when Else_Selected =>
751 pragma Assert (Self_Id.Open_Accepts = null);
753 STPO.Unlock (Self_Id);
755 when Terminate_Selected =>
757 -- Terminate alternative is open
759 Self_Id.Open_Accepts := Open_Accepts;
760 Self_Id.Common.State := Acceptor_Sleep;
762 -- Notify ancestors that this task is on a terminate alternative
764 STPO.Unlock (Self_Id);
765 Utilities.Make_Passive (Self_Id, Task_Completed => False);
766 STPO.Write_Lock (Self_Id);
768 -- Wait for normal entry call or termination
770 Wait_For_Call (Self_Id);
772 pragma Assert (Self_Id.Open_Accepts = null);
774 if Self_Id.Terminate_Alternative then
776 -- An entry call should have reset this to False, so we must be
777 -- aborted. We cannot be in an async. select, since that is not
778 -- legal, so the abort must be of the entire task. Therefore,
779 -- we do not need to cancel the terminate alternative. The
780 -- cleanup will be done in Complete_Master.
783 (Self_Id.Pending_ATC_Level = Level_Completed_Task);
784 pragma Assert (Self_Id.Awake_Count = 0);
786 STPO.Unlock (Self_Id);
788 Index := Self_Id.Chosen_Index;
789 Initialization.Undefer_Abort_Nestable (Self_Id);
791 if Self_Id.Pending_Action then
792 Initialization.Do_Pending_Action (Self_Id);
798 -- Self_Id.Common.Call and Self_Id.Chosen_Index
799 -- should already be updated by the Caller.
801 if Self_Id.Chosen_Index /= No_Rendezvous
802 and then not Open_Accepts (Self_Id.Chosen_Index).Null_Body
804 Uninterpreted_Data := Self_Id.Common.Call.Uninterpreted_Data;
806 pragma Assert (Self_Id.Deferral_Level = 1);
808 -- We need an extra defer here, to keep abort
809 -- deferred until we get into the accept body
810 -- The compiler has inserted a call to Abort_Undefer as part
811 -- of the entry expansion.
813 Initialization.Defer_Abort_Nestable (Self_Id);
817 STPO.Unlock (Self_Id);
819 when No_Alternative_Open =>
821 -- In this case, Index will be No_Rendezvous on return, which
822 -- should cause a Program_Error if it is not a Delay_Mode.
824 -- If delay alternative exists (Delay_Mode) we should suspend
825 -- until the delay expires.
827 Self_Id.Open_Accepts := null;
829 if Select_Mode = Delay_Mode then
830 Self_Id.Common.State := Delay_Sleep;
834 Self_Id.Pending_ATC_Level < Self_Id.ATC_Nesting_Level;
835 Sleep (Self_Id, Delay_Sleep);
838 Self_Id.Common.State := Runnable;
839 STPO.Unlock (Self_Id);
842 STPO.Unlock (Self_Id);
843 Initialization.Undefer_Abort (Self_Id);
844 raise Program_Error with "entry call not a delay mode";
848 -- Caller has been chosen
850 -- Self_Id.Common.Call should already be updated by the Caller.
852 -- Self_Id.Chosen_Index should either be updated by the Caller
853 -- or by Test_Selective_Wait.
855 -- On return, we sill start rendezvous unless the accept body is
856 -- null. In the latter case, we will have already completed the RV.
858 Index := Self_Id.Chosen_Index;
859 Initialization.Undefer_Abort_Nestable (Self_Id);
862 ------------------------------------
863 -- Setup_For_Rendezvous_With_Body --
864 ------------------------------------
866 procedure Setup_For_Rendezvous_With_Body
867 (Entry_Call : Entry_Call_Link;
868 Acceptor : Task_Id) is
870 Entry_Call.Acceptor_Prev_Call := Acceptor.Common.Call;
871 Acceptor.Common.Call := Entry_Call;
873 if Entry_Call.State = Now_Abortable then
874 Entry_Call.State := Was_Abortable;
877 Boost_Priority (Entry_Call, Acceptor);
878 end Setup_For_Rendezvous_With_Body;
884 function Task_Count (E : Task_Entry_Index) return Natural is
885 Self_Id : constant Task_Id := STPO.Self;
886 Return_Count : Natural;
889 Initialization.Defer_Abort (Self_Id);
890 STPO.Write_Lock (Self_Id);
891 Return_Count := Queuing.Count_Waiting (Self_Id.Entry_Queues (E));
892 STPO.Unlock (Self_Id);
893 Initialization.Undefer_Abort (Self_Id);
898 ----------------------
899 -- Task_Do_Or_Queue --
900 ----------------------
902 function Task_Do_Or_Queue
904 Entry_Call : Entry_Call_Link) return Boolean
906 E : constant Task_Entry_Index :=
907 Task_Entry_Index (Entry_Call.E);
908 Old_State : constant Entry_Call_State := Entry_Call.State;
909 Acceptor : constant Task_Id := Entry_Call.Called_Task;
910 Parent : constant Task_Id := Acceptor.Common.Parent;
914 -- Find out whether Entry_Call can be accepted immediately
916 -- If the Acceptor is not callable, return False.
917 -- If the rendezvous can start, initiate it.
918 -- If the accept-body is trivial, also complete the rendezvous.
919 -- If the acceptor is not ready, enqueue the call.
921 -- This should have a special case for Accept_Call and Accept_Trivial,
922 -- so that we don't have the loop setup overhead, below.
924 -- The call state Done is used here and elsewhere to include both the
925 -- case of normal successful completion, and the case of an exception
926 -- being raised. The difference is that if an exception is raised no one
927 -- will pay attention to the fact that State = Done. Instead the
928 -- exception will be raised in Undefer_Abort, and control will skip past
929 -- the place where we normally would resume from an entry call.
931 pragma Assert (not Queuing.Onqueue (Entry_Call));
933 -- We rely that the call is off-queue for protection, that the caller
934 -- will not exit the Entry_Caller_Sleep, and so will not reuse the call
935 -- record for another call. We rely on the Caller's lock for call State
938 -- If Acceptor.Terminate_Alternative is True, we need to lock Parent and
939 -- Acceptor, in that order; otherwise, we only need a lock on Acceptor.
940 -- However, we can't check Acceptor.Terminate_Alternative until Acceptor
941 -- is locked. Therefore, we need to lock both. Attempts to avoid locking
942 -- Parent tend to result in race conditions. It would work to unlock
943 -- Parent immediately upon finding Acceptor.Terminate_Alternative to be
944 -- False, but that violates the rule of properly nested locking (see
947 STPO.Write_Lock (Parent);
948 STPO.Write_Lock (Acceptor);
950 -- If the acceptor is not callable, abort the call and return False
952 if not Acceptor.Callable then
953 STPO.Unlock (Acceptor);
954 STPO.Unlock (Parent);
956 pragma Assert (Entry_Call.State < Done);
958 -- In case we are not the caller, set up the caller
959 -- to raise Tasking_Error when it wakes up.
961 STPO.Write_Lock (Entry_Call.Self);
962 Entry_Call.Exception_To_Raise := Tasking_Error'Identity;
963 Initialization.Wakeup_Entry_Caller (Self_ID, Entry_Call, Done);
964 STPO.Unlock (Entry_Call.Self);
969 -- Try to serve the call immediately
971 if Acceptor.Open_Accepts /= null then
972 for J in Acceptor.Open_Accepts'Range loop
973 if Entry_Call.E = Entry_Index (Acceptor.Open_Accepts (J).S) then
975 -- Commit acceptor to rendezvous with us
977 Acceptor.Chosen_Index := J;
978 Null_Body := Acceptor.Open_Accepts (J).Null_Body;
979 Acceptor.Open_Accepts := null;
981 -- Prevent abort while call is being served
983 if Entry_Call.State = Now_Abortable then
984 Entry_Call.State := Was_Abortable;
987 if Acceptor.Terminate_Alternative then
989 -- Cancel terminate alternative. See matching code in
990 -- Selective_Wait and Vulnerable_Complete_Master.
992 Acceptor.Terminate_Alternative := False;
993 Acceptor.Awake_Count := Acceptor.Awake_Count + 1;
995 if Acceptor.Awake_Count = 1 then
997 -- Notify parent that acceptor is awake
999 pragma Assert (Parent.Awake_Count > 0);
1001 Parent.Awake_Count := Parent.Awake_Count + 1;
1003 if Parent.Common.State = Master_Completion_Sleep
1004 and then Acceptor.Master_Of_Task = Parent.Master_Within
1006 Parent.Common.Wait_Count :=
1007 Parent.Common.Wait_Count + 1;
1014 -- Rendezvous is over immediately
1016 STPO.Wakeup (Acceptor, Acceptor_Sleep);
1017 STPO.Unlock (Acceptor);
1018 STPO.Unlock (Parent);
1020 STPO.Write_Lock (Entry_Call.Self);
1021 Initialization.Wakeup_Entry_Caller
1022 (Self_ID, Entry_Call, Done);
1023 STPO.Unlock (Entry_Call.Self);
1026 Setup_For_Rendezvous_With_Body (Entry_Call, Acceptor);
1028 -- For terminate_alternative, acceptor may not be asleep
1029 -- yet, so we skip the wakeup
1031 if Acceptor.Common.State /= Runnable then
1032 STPO.Wakeup (Acceptor, Acceptor_Sleep);
1035 STPO.Unlock (Acceptor);
1036 STPO.Unlock (Parent);
1043 -- The acceptor is accepting, but not this entry
1046 -- If the acceptor was ready to accept this call,
1047 -- we would not have gotten this far, so now we should
1048 -- (re)enqueue the call, if the mode permits that.
1050 -- If the call is timed, it may have timed out before the requeue,
1051 -- in the unusual case where the current accept has taken longer than
1052 -- the given delay. In that case the requeue is cancelled, and the
1053 -- outer timed call will be aborted.
1055 if Entry_Call.Mode = Conditional_Call
1057 (Entry_Call.Mode = Timed_Call
1058 and then Entry_Call.With_Abort
1059 and then Entry_Call.Cancellation_Attempted)
1061 STPO.Unlock (Acceptor);
1062 STPO.Unlock (Parent);
1064 STPO.Write_Lock (Entry_Call.Self);
1066 pragma Assert (Entry_Call.State >= Was_Abortable);
1068 Initialization.Wakeup_Entry_Caller (Self_ID, Entry_Call, Cancelled);
1069 STPO.Unlock (Entry_Call.Self);
1072 -- Timed_Call, Simple_Call, or Asynchronous_Call
1074 Queuing.Enqueue (Acceptor.Entry_Queues (E), Entry_Call);
1076 -- Update abortability of call
1078 pragma Assert (Old_State < Done);
1081 New_State (Entry_Call.With_Abort, Entry_Call.State);
1083 STPO.Unlock (Acceptor);
1084 STPO.Unlock (Parent);
1086 if Old_State /= Entry_Call.State
1087 and then Entry_Call.State = Now_Abortable
1088 and then Entry_Call.Mode /= Simple_Call
1089 and then Entry_Call.Self /= Self_ID
1091 -- Asynchronous_Call or Conditional_Call
1094 -- Because of ATCB lock ordering rule
1096 STPO.Write_Lock (Entry_Call.Self);
1098 if Entry_Call.Self.Common.State = Async_Select_Sleep then
1100 -- Caller may not yet have reached wait-point
1102 STPO.Wakeup (Entry_Call.Self, Async_Select_Sleep);
1105 STPO.Unlock (Entry_Call.Self);
1110 end Task_Do_Or_Queue;
1112 ---------------------
1113 -- Task_Entry_Call --
1114 ---------------------
1116 procedure Task_Entry_Call
1117 (Acceptor : Task_Id;
1118 E : Task_Entry_Index;
1119 Uninterpreted_Data : System.Address;
1121 Rendezvous_Successful : out Boolean)
1123 Self_Id : constant Task_Id := STPO.Self;
1124 Entry_Call : Entry_Call_Link;
1127 -- If pragma Detect_Blocking is active then Program_Error must be
1128 -- raised if this potentially blocking operation is called from a
1129 -- protected action.
1131 if System.Tasking.Detect_Blocking
1132 and then Self_Id.Common.Protected_Action_Nesting > 0
1134 raise Program_Error with
1135 "potentially blocking operation";
1138 if Mode = Simple_Call or else Mode = Conditional_Call then
1140 (Acceptor, E, Uninterpreted_Data, Mode, Rendezvous_Successful);
1143 -- This is an asynchronous call
1145 -- Abort must already be deferred by the compiler-generated code.
1146 -- Without this, an abort that occurs between the time that this
1147 -- call is made and the time that the abortable part's cleanup
1148 -- handler is set up might miss the cleanup handler and leave the
1151 Self_Id.ATC_Nesting_Level := Self_Id.ATC_Nesting_Level + 1;
1153 (Debug.Trace (Self_Id, "TEC: entered ATC level: " &
1154 ATC_Level'Image (Self_Id.ATC_Nesting_Level), 'A
'));
1155 Entry_Call := Self_Id.Entry_Calls (Self_Id.ATC_Nesting_Level)'Access;
1156 Entry_Call.Next := null;
1157 Entry_Call.Mode := Mode;
1158 Entry_Call.Cancellation_Attempted := False;
1159 Entry_Call.State := Not_Yet_Abortable;
1160 Entry_Call.E := Entry_Index (E);
1161 Entry_Call.Prio := Get_Priority (Self_Id);
1162 Entry_Call.Uninterpreted_Data := Uninterpreted_Data;
1163 Entry_Call.Called_Task := Acceptor;
1164 Entry_Call.Called_PO := Null_Address;
1165 Entry_Call.Exception_To_Raise := Ada.Exceptions.Null_Id;
1166 Entry_Call.With_Abort := True;
1168 if not Task_Do_Or_Queue (Self_Id, Entry_Call) then
1169 STPO.Write_Lock (Self_Id);
1170 Utilities.Exit_One_ATC_Level (Self_Id);
1171 STPO.Unlock (Self_Id);
1172 Initialization.Undefer_Abort (Self_Id);
1174 raise Tasking_Error;
1177 -- The following is special for async. entry calls. If the call was
1178 -- not queued abortably, we need to wait until it is before
1179 -- proceeding with the abortable part.
1181 -- Wait_Until_Abortable can be called unconditionally here, but it is
1184 if Entry_Call.State < Was_Abortable then
1185 Entry_Calls.Wait_Until_Abortable (Self_Id, Entry_Call);
1188 -- Note: following assignment needs to be atomic
1190 Rendezvous_Successful := Entry_Call.State = Done;
1192 end Task_Entry_Call;
1194 -----------------------
1195 -- Task_Entry_Caller --
1196 -----------------------
1198 function Task_Entry_Caller (D : Task_Entry_Nesting_Depth) return Task_Id is
1199 Self_Id : constant Task_Id := STPO.Self;
1200 Entry_Call : Entry_Call_Link;
1203 Entry_Call := Self_Id.Common.Call;
1205 for Depth in 1 .. D loop
1206 Entry_Call := Entry_Call.Acceptor_Prev_Call;
1207 pragma Assert (Entry_Call /= null);
1210 return Entry_Call.Self;
1211 end Task_Entry_Caller;
1213 --------------------------
1214 -- Timed_Selective_Wait --
1215 --------------------------
1217 procedure Timed_Selective_Wait
1218 (Open_Accepts : Accept_List_Access;
1219 Select_Mode : Select_Modes;
1220 Uninterpreted_Data : out System.Address;
1223 Index : out Select_Index)
1225 Self_Id : constant Task_Id := STPO.Self;
1226 Treatment : Select_Treatment;
1227 Entry_Call : Entry_Call_Link;
1229 Selection : Select_Index;
1230 Open_Alternative : Boolean;
1231 Timedout : Boolean := False;
1232 Yielded : Boolean := True;
1235 pragma Assert (Select_Mode = Delay_Mode);
1237 Initialization.Defer_Abort (Self_Id);
1239 -- If we are aborted here, the effect will be pending
1241 STPO.Write_Lock (Self_Id);
1243 if not Self_Id.Callable then
1244 pragma Assert (Self_Id.Pending_ATC_Level = Level_Completed_Task);
1246 pragma Assert (Self_Id.Pending_Action);
1248 STPO.Unlock (Self_Id);
1249 Initialization.Undefer_Abort (Self_Id);
1251 -- Should never get here ???
1253 pragma Assert (Standard.False);
1254 raise Standard'Abort_Signal;
1257 Uninterpreted_Data := Null_Address;
1259 pragma Assert (Open_Accepts /= null);
1261 Queuing.Select_Task_Entry_Call
1262 (Self_Id, Open_Accepts, Entry_Call, Selection, Open_Alternative);
1264 -- Determine the kind and disposition of the select
1266 Treatment := Default_Treatment (Select_Mode);
1267 Self_Id.Chosen_Index := No_Rendezvous;
1269 if Open_Alternative then
1270 if Entry_Call /= null then
1271 if Open_Accepts (Selection).Null_Body then
1272 Treatment := Accept_Alternative_Completed;
1275 Setup_For_Rendezvous_With_Body (Entry_Call, Self_Id);
1276 Treatment := Accept_Alternative_Selected;
1279 Self_Id.Chosen_Index := Selection;
1281 elsif Treatment = No_Alternative_Open then
1282 Treatment := Accept_Alternative_Open;
1286 -- Handle the select according to the disposition selected above
1289 when Accept_Alternative_Selected =>
1291 -- Ready to rendezvous. In this case the accept body is not
1292 -- Null_Body. Defer abort until it gets into the accept body.
1294 Uninterpreted_Data := Self_Id.Common.Call.Uninterpreted_Data;
1295 Initialization.Defer_Abort_Nestable (Self_Id);
1296 STPO.Unlock (Self_Id);
1298 when Accept_Alternative_Completed =>
1300 -- Rendezvous is over
1302 STPO.Unlock (Self_Id);
1303 Caller := Entry_Call.Self;
1305 STPO.Write_Lock (Caller);
1306 Initialization.Wakeup_Entry_Caller (Self_Id, Entry_Call, Done);
1307 STPO.Unlock (Caller);
1309 when Accept_Alternative_Open =>
1313 Self_Id.Open_Accepts := Open_Accepts;
1315 -- Wait for a normal call and a pending action until the
1316 -- Wakeup_Time is reached.
1318 Self_Id.Common.State := Acceptor_Delay_Sleep;
1320 -- Try to remove calls to Sleep in the loop below by letting the
1321 -- caller a chance of getting ready immediately, using Unlock
1322 -- Yield. See similar action in Wait_For_Completion/Wait_For_Call.
1326 if Self_Id.Open_Accepts /= null then
1330 Write_Lock (Self_Id);
1332 -- Check if this task has been aborted while the lock was released
1334 if Self_Id.Pending_ATC_Level < Self_Id.ATC_Nesting_Level then
1335 Self_Id.Open_Accepts := null;
1339 exit when Self_Id.Open_Accepts = null;
1342 Sleep (Self_Id, Acceptor_Delay_Sleep);
1344 STPO.Timed_Sleep (Self_Id, Timeout, Mode,
1345 Acceptor_Delay_Sleep, Timedout, Yielded);
1349 Self_Id.Open_Accepts := null;
1353 Self_Id.Common.State := Runnable;
1355 -- Self_Id.Common.Call should already be updated by the Caller if
1356 -- not aborted. It might also be ready to do rendezvous even if
1357 -- this wakes up due to an abort. Therefore, if the call is not
1358 -- empty we need to do the rendezvous if the accept body is not
1361 if Self_Id.Chosen_Index /= No_Rendezvous
1362 and then Self_Id.Common.Call /= null
1363 and then not Open_Accepts (Self_Id.Chosen_Index).Null_Body
1365 Uninterpreted_Data := Self_Id.Common.Call.Uninterpreted_Data;
1367 pragma Assert (Self_Id.Deferral_Level = 1);
1369 Initialization.Defer_Abort_Nestable (Self_Id);
1371 -- Leave abort deferred until the accept body
1374 STPO.Unlock (Self_Id);
1376 when No_Alternative_Open =>
1378 -- In this case, Index will be No_Rendezvous on return. We sleep
1379 -- for the time we need to.
1381 -- Wait for a signal or timeout. A wakeup can be made
1382 -- for several reasons:
1383 -- 1) Delay is expired
1384 -- 2) Pending_Action needs to be checked
1385 -- (Abort, Priority change)
1386 -- 3) Spurious wakeup
1388 Self_Id.Open_Accepts := null;
1389 Self_Id.Common.State := Acceptor_Delay_Sleep;
1391 STPO.Timed_Sleep (Self_Id, Timeout, Mode, Acceptor_Delay_Sleep,
1394 Self_Id.Common.State := Runnable;
1396 STPO.Unlock (Self_Id);
1400 -- Should never get here
1402 pragma Assert (Standard.False);
1410 -- Caller has been chosen
1412 -- Self_Id.Common.Call should already be updated by the Caller
1414 -- Self_Id.Chosen_Index should either be updated by the Caller
1415 -- or by Test_Selective_Wait
1417 Index := Self_Id.Chosen_Index;
1418 Initialization.Undefer_Abort_Nestable (Self_Id);
1420 -- Start rendezvous, if not already completed
1421 end Timed_Selective_Wait;
1423 ---------------------------
1424 -- Timed_Task_Entry_Call --
1425 ---------------------------
1427 procedure Timed_Task_Entry_Call
1428 (Acceptor : Task_Id;
1429 E : Task_Entry_Index;
1430 Uninterpreted_Data : System.Address;
1433 Rendezvous_Successful : out Boolean)
1435 Self_Id : constant Task_Id := STPO.Self;
1437 Entry_Call : Entry_Call_Link;
1442 -- If pragma Detect_Blocking is active then Program_Error must be
1443 -- raised if this potentially blocking operation is called from a
1444 -- protected action.
1446 if System.Tasking.Detect_Blocking
1447 and then Self_Id.Common.Protected_Action_Nesting > 0
1449 raise Program_Error with
1450 "potentially blocking operation";
1453 Initialization.Defer_Abort_Nestable (Self_Id);
1454 Self_Id.ATC_Nesting_Level := Self_Id.ATC_Nesting_Level + 1;
1457 (Debug.Trace (Self_Id, "TTEC: entered ATC level: " &
1458 ATC_Level'Image (Self_Id.ATC_Nesting_Level), 'A
'));
1460 Level := Self_Id.ATC_Nesting_Level;
1461 Entry_Call := Self_Id.Entry_Calls (Level)'Access;
1462 Entry_Call.Next := null;
1463 Entry_Call.Mode := Timed_Call;
1464 Entry_Call.Cancellation_Attempted := False;
1466 -- If this is a call made inside of an abort deferred region,
1467 -- the call should be never abortable.
1470 (if Self_Id.Deferral_Level > 1
1471 then Never_Abortable
1472 else Now_Abortable);
1474 Entry_Call.E := Entry_Index (E);
1475 Entry_Call.Prio := Get_Priority (Self_Id);
1476 Entry_Call.Uninterpreted_Data := Uninterpreted_Data;
1477 Entry_Call.Called_Task := Acceptor;
1478 Entry_Call.Called_PO := Null_Address;
1479 Entry_Call.Exception_To_Raise := Ada.Exceptions.Null_Id;
1480 Entry_Call.With_Abort := True;
1482 -- Note: the caller will undefer abort on return (see WARNING above)
1484 if not Task_Do_Or_Queue (Self_Id, Entry_Call) then
1485 STPO.Write_Lock (Self_Id);
1486 Utilities.Exit_One_ATC_Level (Self_Id);
1487 STPO.Unlock (Self_Id);
1488 Initialization.Undefer_Abort_Nestable (Self_Id);
1490 raise Tasking_Error;
1493 Write_Lock (Self_Id);
1494 Entry_Calls.Wait_For_Completion_With_Timeout
1495 (Entry_Call, Timeout, Mode, Yielded);
1498 -- ??? Do we need to yield in case Yielded is False
1500 Rendezvous_Successful := Entry_Call.State = Done;
1501 Initialization.Undefer_Abort_Nestable (Self_Id);
1502 Entry_Calls.Check_Exception (Self_Id, Entry_Call);
1503 end Timed_Task_Entry_Call;
1509 procedure Wait_For_Call (Self_Id : Task_Id) is
1511 Self_Id.Common.State := Acceptor_Sleep;
1513 -- Try to remove calls to Sleep in the loop below by letting the caller
1514 -- a chance of getting ready immediately, using Unlock & Yield.
1515 -- See similar action in Wait_For_Completion & Timed_Selective_Wait.
1519 if Self_Id.Open_Accepts /= null then
1523 Write_Lock (Self_Id);
1525 -- Check if this task has been aborted while the lock was released
1527 if Self_Id.Pending_ATC_Level < Self_Id.ATC_Nesting_Level then
1528 Self_Id.Open_Accepts := null;
1532 exit when Self_Id.Open_Accepts = null;
1533 Sleep (Self_Id, Acceptor_Sleep);
1536 Self_Id.Common.State := Runnable;
1539 end System.Tasking.Rendezvous;