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-2008, 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 2, or (at your option) any later ver- --
14 -- sion. GNARL is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNARL; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, USA. --
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. --
29 -- GNARL was developed by the GNARL team at Florida State University. --
30 -- Extensive contributions were provided by Ada Core Technologies, Inc. --
32 ------------------------------------------------------------------------------
34 with System.Task_Primitives.Operations;
35 with System.Tasking.Entry_Calls;
36 with System.Tasking.Initialization;
37 with System.Tasking.Queuing;
38 with System.Tasking.Utilities;
39 with System.Tasking.Protected_Objects.Operations;
40 with System.Tasking.Debug;
41 with System.Restrictions;
42 with System.Parameters;
43 with System.Traces.Tasking;
45 package body System.Tasking.Rendezvous is
47 package STPO renames System.Task_Primitives.Operations;
48 package POO renames Protected_Objects.Operations;
49 package POE renames Protected_Objects.Entries;
52 use Task_Primitives.Operations;
54 use System.Traces.Tasking;
56 type Select_Treatment is (
57 Accept_Alternative_Selected, -- alternative with non-null body
58 Accept_Alternative_Completed, -- alternative with null body
61 Accept_Alternative_Open,
68 Default_Treatment : constant array (Select_Modes) of Select_Treatment :=
69 (Simple_Mode => No_Alternative_Open,
70 Else_Mode => Else_Selected,
71 Terminate_Mode => Terminate_Selected,
72 Delay_Mode => No_Alternative_Open);
74 New_State : constant array (Boolean, Entry_Call_State)
75 of Entry_Call_State :=
77 (Never_Abortable => Never_Abortable,
78 Not_Yet_Abortable => Now_Abortable,
79 Was_Abortable => Now_Abortable,
80 Now_Abortable => Now_Abortable,
82 Cancelled => Cancelled),
84 (Never_Abortable => Never_Abortable,
85 Not_Yet_Abortable => Not_Yet_Abortable,
86 Was_Abortable => Was_Abortable,
87 Now_Abortable => Now_Abortable,
89 Cancelled => Cancelled)
92 -----------------------
93 -- Local Subprograms --
94 -----------------------
96 procedure Local_Defer_Abort (Self_Id : Task_Id) renames
97 System.Tasking.Initialization.Defer_Abort_Nestable;
99 procedure Local_Undefer_Abort (Self_Id : Task_Id) renames
100 System.Tasking.Initialization.Undefer_Abort_Nestable;
102 -- Florist defers abort around critical sections that
103 -- make entry calls to the Interrupt_Manager task, which
104 -- violates the general rule about top-level runtime system
105 -- calls from abort-deferred regions. It is not that this is
106 -- unsafe, but when it occurs in "normal" programs it usually
107 -- means either the user is trying to do a potentially blocking
108 -- operation from within a protected object, or there is a
109 -- runtime system/compiler error that has failed to undefer
110 -- an earlier abort deferral. Thus, for debugging it may be
111 -- wise to modify the above renamings to the non-nestable forms.
113 procedure Boost_Priority (Call : Entry_Call_Link; Acceptor : Task_Id);
114 pragma Inline (Boost_Priority);
115 -- Call this only with abort deferred and holding lock of Acceptor
117 procedure Call_Synchronous
119 E : Task_Entry_Index;
120 Uninterpreted_Data : System.Address;
122 Rendezvous_Successful : out Boolean);
123 pragma Inline (Call_Synchronous);
124 -- This call is used to make a simple or conditional entry call.
125 -- Called from Call_Simple and Task_Entry_Call.
127 procedure Setup_For_Rendezvous_With_Body
128 (Entry_Call : Entry_Call_Link;
130 pragma Inline (Setup_For_Rendezvous_With_Body);
131 -- Call this only with abort deferred and holding lock of Acceptor.
132 -- When a rendezvous selected (ready for rendezvous) we need to save
133 -- previous caller and adjust the priority. Also we need to make
134 -- this call not Abortable (Cancellable) since the rendezvous has
135 -- already been started.
137 procedure Wait_For_Call (Self_Id : Task_Id);
138 pragma Inline (Wait_For_Call);
139 -- Call this only with abort deferred and holding lock of Self_Id.
140 -- An accepting task goes into Sleep by calling this routine
141 -- waiting for a call from the caller or waiting for an abort.
142 -- Make sure Self_Id is locked before calling this routine.
148 procedure Accept_Call
149 (E : Task_Entry_Index;
150 Uninterpreted_Data : out System.Address)
152 Self_Id : constant Task_Id := STPO.Self;
153 Caller : Task_Id := null;
154 Open_Accepts : aliased Accept_List (1 .. 1);
155 Entry_Call : Entry_Call_Link;
158 Initialization.Defer_Abort (Self_Id);
164 STPO.Write_Lock (Self_Id);
166 if not Self_Id.Callable then
167 pragma Assert (Self_Id.Pending_ATC_Level = 0);
169 pragma Assert (Self_Id.Pending_Action);
171 STPO.Unlock (Self_Id);
177 Initialization.Undefer_Abort (Self_Id);
179 -- Should never get here ???
181 pragma Assert (False);
182 raise Standard'Abort_Signal;
185 Queuing.Dequeue_Head (Self_Id.Entry_Queues (E), Entry_Call);
187 if Entry_Call /= null then
188 Caller := Entry_Call.Self;
189 Setup_For_Rendezvous_With_Body (Entry_Call, Self_Id);
190 Uninterpreted_Data := Entry_Call.Uninterpreted_Data;
195 Open_Accepts (1).Null_Body := False;
196 Open_Accepts (1).S := E;
197 Self_Id.Open_Accepts := Open_Accepts'Unrestricted_Access;
199 -- Wait for normal call
201 if Parameters.Runtime_Traces then
202 Send_Trace_Info (W_Accept, Self_Id, Integer (Open_Accepts'Length));
206 (Debug.Trace (Self_Id, "Accept_Call: wait", 'R'));
207 Wait_For_Call (Self_Id);
209 pragma Assert (Self_Id.Open_Accepts = null);
211 if Self_Id.Common.Call /= null then
212 Caller := Self_Id.Common.Call.Self;
213 Uninterpreted_Data :=
214 Caller.Entry_Calls (Caller.ATC_Nesting_Level).Uninterpreted_Data;
216 -- Case of an aborted task
218 Uninterpreted_Data := System.Null_Address;
222 -- Self_Id.Common.Call should already be updated by the Caller
223 -- On return, we will start the rendezvous.
225 STPO.Unlock (Self_Id);
231 Initialization.Undefer_Abort (Self_Id);
233 if Parameters.Runtime_Traces then
234 Send_Trace_Info (M_Accept_Complete, Caller, Entry_Index (E));
242 procedure Accept_Trivial (E : Task_Entry_Index) is
243 Self_Id : constant Task_Id := STPO.Self;
244 Caller : Task_Id := null;
245 Open_Accepts : aliased Accept_List (1 .. 1);
246 Entry_Call : Entry_Call_Link;
249 Initialization.Defer_Abort_Nestable (Self_Id);
255 STPO.Write_Lock (Self_Id);
257 if not Self_Id.Callable then
258 pragma Assert (Self_Id.Pending_ATC_Level = 0);
260 pragma Assert (Self_Id.Pending_Action);
262 STPO.Unlock (Self_Id);
268 Initialization.Undefer_Abort_Nestable (Self_Id);
270 -- Should never get here ???
272 pragma Assert (False);
273 raise Standard'Abort_Signal;
276 Queuing.Dequeue_Head (Self_Id.Entry_Queues (E), Entry_Call);
278 if Entry_Call = null then
279 -- Need to wait for entry call
281 Open_Accepts (1).Null_Body := True;
282 Open_Accepts (1).S := E;
283 Self_Id.Open_Accepts := Open_Accepts'Unrestricted_Access;
285 if Parameters.Runtime_Traces then
286 Send_Trace_Info (W_Accept, Self_Id, Integer (Open_Accepts'Length));
290 (Debug.Trace (Self_Id, "Accept_Trivial: wait", 'R'));
292 Wait_For_Call (Self_Id);
294 pragma Assert (Self_Id.Open_Accepts = null);
296 -- No need to do anything special here for pending abort.
297 -- Abort_Signal will be raised by Undefer on exit.
299 STPO.Unlock (Self_Id);
301 else -- found caller already waiting
302 pragma Assert (Entry_Call.State < Done);
304 STPO.Unlock (Self_Id);
305 Caller := Entry_Call.Self;
307 STPO.Write_Lock (Caller);
308 Initialization.Wakeup_Entry_Caller (Self_Id, Entry_Call, Done);
309 STPO.Unlock (Caller);
312 if Parameters.Runtime_Traces then
313 Send_Trace_Info (M_Accept_Complete);
315 -- Fake one, since there is (???) no way
316 -- to know that the rendezvous is over
318 Send_Trace_Info (M_RDV_Complete);
325 Initialization.Undefer_Abort_Nestable (Self_Id);
332 procedure Boost_Priority (Call : Entry_Call_Link; Acceptor : Task_Id) is
333 Caller : constant Task_Id := Call.Self;
334 Caller_Prio : constant System.Any_Priority := Get_Priority (Caller);
335 Acceptor_Prio : constant System.Any_Priority := Get_Priority (Acceptor);
338 if Caller_Prio > Acceptor_Prio then
339 Call.Acceptor_Prev_Priority := Acceptor_Prio;
340 Set_Priority (Acceptor, Caller_Prio);
343 Call.Acceptor_Prev_Priority := Priority_Not_Boosted;
351 procedure Call_Simple
353 E : Task_Entry_Index;
354 Uninterpreted_Data : System.Address)
356 Rendezvous_Successful : Boolean;
357 pragma Unreferenced (Rendezvous_Successful);
360 -- If pragma Detect_Blocking is active then Program_Error must be
361 -- raised if this potentially blocking operation is called from a
364 if System.Tasking.Detect_Blocking
365 and then STPO.Self.Common.Protected_Action_Nesting > 0
367 raise Program_Error with "potentially blocking operation";
371 (Acceptor, E, Uninterpreted_Data, Simple_Call, Rendezvous_Successful);
374 ----------------------
375 -- Call_Synchronous --
376 ----------------------
378 procedure Call_Synchronous
380 E : Task_Entry_Index;
381 Uninterpreted_Data : System.Address;
383 Rendezvous_Successful : out Boolean)
385 Self_Id : constant Task_Id := STPO.Self;
387 Entry_Call : Entry_Call_Link;
390 pragma Assert (Mode /= Asynchronous_Call);
392 Local_Defer_Abort (Self_Id);
393 Self_Id.ATC_Nesting_Level := Self_Id.ATC_Nesting_Level + 1;
395 (Debug.Trace (Self_Id, "CS: entered ATC level: " &
396 ATC_Level'Image (Self_Id.ATC_Nesting_Level), 'A'));
397 Level := Self_Id.ATC_Nesting_Level;
398 Entry_Call := Self_Id.Entry_Calls (Level)'Access;
399 Entry_Call.Next := null;
400 Entry_Call.Mode := Mode;
401 Entry_Call.Cancellation_Attempted := False;
403 if Parameters.Runtime_Traces then
404 Send_Trace_Info (W_Call, Acceptor, Entry_Index (E));
407 -- If this is a call made inside of an abort deferred region,
408 -- the call should be never abortable.
410 if Self_Id.Deferral_Level > 1 then
411 Entry_Call.State := Never_Abortable;
413 Entry_Call.State := Now_Abortable;
416 Entry_Call.E := Entry_Index (E);
417 Entry_Call.Prio := Get_Priority (Self_Id);
418 Entry_Call.Uninterpreted_Data := Uninterpreted_Data;
419 Entry_Call.Called_Task := Acceptor;
420 Entry_Call.Exception_To_Raise := Ada.Exceptions.Null_Id;
421 Entry_Call.With_Abort := True;
423 -- Note: the caller will undefer abort on return (see WARNING above)
429 if not Task_Do_Or_Queue (Self_Id, Entry_Call) then
430 STPO.Write_Lock (Self_Id);
431 Utilities.Exit_One_ATC_Level (Self_Id);
432 STPO.Unlock (Self_Id);
438 if Parameters.Runtime_Traces then
439 Send_Trace_Info (E_Missed, Acceptor);
442 Local_Undefer_Abort (Self_Id);
446 STPO.Write_Lock (Self_Id);
448 (Debug.Trace (Self_Id, "Call_Synchronous: wait", 'R'));
449 Entry_Calls.Wait_For_Completion (Entry_Call);
451 (Debug.Trace (Self_Id, "Call_Synchronous: done waiting", 'R'));
452 Rendezvous_Successful := Entry_Call.State = Done;
453 STPO.Unlock (Self_Id);
459 Local_Undefer_Abort (Self_Id);
460 Entry_Calls.Check_Exception (Self_Id, Entry_Call);
461 end Call_Synchronous;
467 function Callable (T : Task_Id) return Boolean is
469 Self_Id : constant Task_Id := STPO.Self;
472 Initialization.Defer_Abort_Nestable (Self_Id);
479 Result := T.Callable;
486 Initialization.Undefer_Abort_Nestable (Self_Id);
490 ----------------------------
491 -- Cancel_Task_Entry_Call --
492 ----------------------------
494 procedure Cancel_Task_Entry_Call (Cancelled : out Boolean) is
496 Entry_Calls.Try_To_Cancel_Entry_Call (Cancelled);
497 end Cancel_Task_Entry_Call;
499 -------------------------
500 -- Complete_Rendezvous --
501 -------------------------
503 procedure Complete_Rendezvous is
505 Exceptional_Complete_Rendezvous (Ada.Exceptions.Null_Id);
506 end Complete_Rendezvous;
508 -------------------------------------
509 -- Exceptional_Complete_Rendezvous --
510 -------------------------------------
512 procedure Exceptional_Complete_Rendezvous
513 (Ex : Ada.Exceptions.Exception_Id)
515 Self_Id : constant Task_Id := STPO.Self;
516 Entry_Call : Entry_Call_Link := Self_Id.Common.Call;
518 Called_PO : STPE.Protection_Entries_Access;
519 Acceptor_Prev_Priority : Integer;
521 Exception_To_Raise : Ada.Exceptions.Exception_Id := Ex;
522 Ceiling_Violation : Boolean;
524 use type Ada.Exceptions.Exception_Id;
525 procedure Internal_Reraise;
526 pragma Import (C, Internal_Reraise, "__gnat_reraise");
528 procedure Transfer_Occurrence
529 (Target : Ada.Exceptions.Exception_Occurrence_Access;
530 Source : Ada.Exceptions.Exception_Occurrence);
531 pragma Import (C, Transfer_Occurrence, "__gnat_transfer_occurrence");
533 use type STPE.Protection_Entries_Access;
536 -- Consider phasing out Complete_Rendezvous in favor
537 -- of direct call to this with Ada.Exceptions.Null_ID.
538 -- See code expansion examples for Accept_Call and Selective_Wait.
539 -- Also consider putting an explicit re-raise after this call, in
540 -- the generated code. That way we could eliminate the
541 -- code here that reraises the exception.
543 -- The deferral level is critical here,
544 -- since we want to raise an exception or allow abort to take
545 -- place, if there is an exception or abort pending.
548 (Debug.Trace (Self_Id, "Exceptional_Complete_Rendezvous", 'R'));
550 if Ex = Ada.Exceptions.Null_Id then
551 -- The call came from normal end-of-rendezvous,
552 -- so abort is not yet deferred.
554 if Parameters.Runtime_Traces then
555 Send_Trace_Info (M_RDV_Complete, Entry_Call.Self);
558 Initialization.Defer_Abort_Nestable (Self_Id);
561 -- We need to clean up any accepts which Self may have
562 -- been serving when it was aborted.
564 if Ex = Standard'Abort_Signal'Identity then
569 while Entry_Call /= null loop
570 Entry_Call.Exception_To_Raise := Tasking_Error'Identity;
572 -- All forms of accept make sure that the acceptor is not
573 -- completed, before accepting further calls, so that we
574 -- can be sure that no further calls are made after the
575 -- current calls are purged.
577 Caller := Entry_Call.Self;
579 -- Take write lock. This follows the lock precedence rule that
580 -- Caller may be locked while holding lock of Acceptor.
581 -- Complete the call abnormally, with exception.
583 STPO.Write_Lock (Caller);
584 Initialization.Wakeup_Entry_Caller (Self_Id, Entry_Call, Done);
585 STPO.Unlock (Caller);
586 Entry_Call := Entry_Call.Acceptor_Prev_Call;
594 Caller := Entry_Call.Self;
596 if Entry_Call.Needs_Requeue then
597 -- We dare not lock Self_Id at the same time as Caller,
598 -- for fear of deadlock.
600 Entry_Call.Needs_Requeue := False;
601 Self_Id.Common.Call := Entry_Call.Acceptor_Prev_Call;
603 if Entry_Call.Called_Task /= null then
604 -- Requeue to another task entry
610 if not Task_Do_Or_Queue (Self_Id, Entry_Call) then
615 Initialization.Undefer_Abort (Self_Id);
624 -- Requeue to a protected entry
626 Called_PO := POE.To_Protection (Entry_Call.Called_PO);
627 STPE.Lock_Entries (Called_PO, Ceiling_Violation);
629 if Ceiling_Violation then
630 pragma Assert (Ex = Ada.Exceptions.Null_Id);
632 Exception_To_Raise := Program_Error'Identity;
633 Entry_Call.Exception_To_Raise := Exception_To_Raise;
639 STPO.Write_Lock (Caller);
640 Initialization.Wakeup_Entry_Caller
641 (Self_Id, Entry_Call, Done);
642 STPO.Unlock (Caller);
649 POO.PO_Do_Or_Queue (Self_Id, Called_PO, Entry_Call);
650 POO.PO_Service_Entries (Self_Id, Called_PO);
654 Entry_Calls.Reset_Priority
655 (Self_Id, Entry_Call.Acceptor_Prev_Priority);
658 -- The call does not need to be requeued
660 Self_Id.Common.Call := Entry_Call.Acceptor_Prev_Call;
661 Entry_Call.Exception_To_Raise := Ex;
667 STPO.Write_Lock (Caller);
669 -- Done with Caller locked to make sure that Wakeup is not lost
671 if Ex /= Ada.Exceptions.Null_Id then
673 (Caller.Common.Compiler_Data.Current_Excep'Access,
674 Self_Id.Common.Compiler_Data.Current_Excep);
677 Acceptor_Prev_Priority := Entry_Call.Acceptor_Prev_Priority;
678 Initialization.Wakeup_Entry_Caller (Self_Id, Entry_Call, Done);
680 STPO.Unlock (Caller);
686 Entry_Calls.Reset_Priority (Self_Id, Acceptor_Prev_Priority);
690 Initialization.Undefer_Abort (Self_Id);
692 if Exception_To_Raise /= Ada.Exceptions.Null_Id then
696 -- ??? Do we need to give precedence to Program_Error that might be
697 -- raised due to failure of finalization, over Tasking_Error from
698 -- failure of requeue?
699 end Exceptional_Complete_Rendezvous;
701 -------------------------------------
702 -- Requeue_Protected_To_Task_Entry --
703 -------------------------------------
705 procedure Requeue_Protected_To_Task_Entry
706 (Object : STPE.Protection_Entries_Access;
708 E : Task_Entry_Index;
709 With_Abort : Boolean)
711 Entry_Call : constant Entry_Call_Link := Object.Call_In_Progress;
713 pragma Assert (STPO.Self.Deferral_Level > 0);
715 Entry_Call.E := Entry_Index (E);
716 Entry_Call.Called_Task := Acceptor;
717 Entry_Call.Called_PO := Null_Address;
718 Entry_Call.With_Abort := With_Abort;
719 Object.Call_In_Progress := null;
720 end Requeue_Protected_To_Task_Entry;
722 ------------------------
723 -- Requeue_Task_Entry --
724 ------------------------
726 procedure Requeue_Task_Entry
728 E : Task_Entry_Index;
729 With_Abort : Boolean)
731 Self_Id : constant Task_Id := STPO.Self;
732 Entry_Call : constant Entry_Call_Link := Self_Id.Common.Call;
735 Initialization.Defer_Abort (Self_Id);
736 Entry_Call.Needs_Requeue := True;
737 Entry_Call.With_Abort := With_Abort;
738 Entry_Call.E := Entry_Index (E);
739 Entry_Call.Called_Task := Acceptor;
740 Initialization.Undefer_Abort (Self_Id);
741 end Requeue_Task_Entry;
747 procedure Selective_Wait
748 (Open_Accepts : Accept_List_Access;
749 Select_Mode : Select_Modes;
750 Uninterpreted_Data : out System.Address;
751 Index : out Select_Index)
753 Self_Id : constant Task_Id := STPO.Self;
754 Entry_Call : Entry_Call_Link;
755 Treatment : Select_Treatment;
757 Selection : Select_Index;
758 Open_Alternative : Boolean;
761 Initialization.Defer_Abort (Self_Id);
767 STPO.Write_Lock (Self_Id);
769 if not Self_Id.Callable then
770 pragma Assert (Self_Id.Pending_ATC_Level = 0);
772 pragma Assert (Self_Id.Pending_Action);
774 STPO.Unlock (Self_Id);
780 -- ??? In some cases abort is deferred more than once. Need to
781 -- figure out why this happens.
783 if Self_Id.Deferral_Level > 1 then
784 Self_Id.Deferral_Level := 1;
787 Initialization.Undefer_Abort (Self_Id);
789 -- Should never get here ???
791 pragma Assert (False);
792 raise Standard'Abort_Signal;
795 pragma Assert (Open_Accepts /= null);
797 Uninterpreted_Data := Null_Address;
799 Queuing.Select_Task_Entry_Call
800 (Self_Id, Open_Accepts, Entry_Call, Selection, Open_Alternative);
802 -- Determine the kind and disposition of the select
804 Treatment := Default_Treatment (Select_Mode);
805 Self_Id.Chosen_Index := No_Rendezvous;
807 if Open_Alternative then
808 if Entry_Call /= null then
809 if Open_Accepts (Selection).Null_Body then
810 Treatment := Accept_Alternative_Completed;
812 Setup_For_Rendezvous_With_Body (Entry_Call, Self_Id);
813 Treatment := Accept_Alternative_Selected;
816 Self_Id.Chosen_Index := Selection;
818 elsif Treatment = No_Alternative_Open then
819 Treatment := Accept_Alternative_Open;
823 -- Handle the select according to the disposition selected above
826 when Accept_Alternative_Selected =>
827 -- Ready to rendezvous
829 Uninterpreted_Data := Self_Id.Common.Call.Uninterpreted_Data;
831 -- In this case the accept body is not Null_Body. Defer abort
832 -- until it gets into the accept body.
834 pragma Assert (Self_Id.Deferral_Level = 1);
836 Initialization.Defer_Abort_Nestable (Self_Id);
837 STPO.Unlock (Self_Id);
839 when Accept_Alternative_Completed =>
841 -- Accept body is null, so rendezvous is over immediately
843 if Parameters.Runtime_Traces then
844 Send_Trace_Info (M_RDV_Complete, Entry_Call.Self);
847 STPO.Unlock (Self_Id);
848 Caller := Entry_Call.Self;
850 STPO.Write_Lock (Caller);
851 Initialization.Wakeup_Entry_Caller (Self_Id, Entry_Call, Done);
852 STPO.Unlock (Caller);
854 when Accept_Alternative_Open =>
858 Self_Id.Open_Accepts := Open_Accepts;
860 (Debug.Trace (Self_Id, "Selective_Wait: wait", 'R'));
862 if Parameters.Runtime_Traces then
863 Send_Trace_Info (W_Select, Self_Id,
864 Integer (Open_Accepts'Length));
867 Wait_For_Call (Self_Id);
869 pragma Assert (Self_Id.Open_Accepts = null);
871 -- Self_Id.Common.Call should already be updated by the Caller if
872 -- not aborted. It might also be ready to do rendezvous even if
873 -- this wakes up due to an abort. Therefore, if the call is not
874 -- empty we need to do the rendezvous if the accept body is not
877 -- Aren't the first two conditions below redundant???
879 if Self_Id.Chosen_Index /= No_Rendezvous
880 and then Self_Id.Common.Call /= null
881 and then not Open_Accepts (Self_Id.Chosen_Index).Null_Body
883 Uninterpreted_Data := Self_Id.Common.Call.Uninterpreted_Data;
886 (Self_Id.Deferral_Level = 1
888 (Self_Id.Deferral_Level = 0
889 and then not Restrictions.Abort_Allowed));
891 Initialization.Defer_Abort_Nestable (Self_Id);
893 -- Leave abort deferred until the accept body
896 STPO.Unlock (Self_Id);
898 when Else_Selected =>
899 pragma Assert (Self_Id.Open_Accepts = null);
901 if Parameters.Runtime_Traces then
902 Send_Trace_Info (M_Select_Else);
905 STPO.Unlock (Self_Id);
907 when Terminate_Selected =>
908 -- Terminate alternative is open
910 Self_Id.Open_Accepts := Open_Accepts;
911 Self_Id.Common.State := Acceptor_Sleep;
913 -- Notify ancestors that this task is on a terminate alternative
915 STPO.Unlock (Self_Id);
916 Utilities.Make_Passive (Self_Id, Task_Completed => False);
917 STPO.Write_Lock (Self_Id);
919 -- Wait for normal entry call or termination
921 Wait_For_Call (Self_Id);
923 pragma Assert (Self_Id.Open_Accepts = null);
925 if Self_Id.Terminate_Alternative then
926 -- An entry call should have reset this to False,
927 -- so we must be aborted.
928 -- We cannot be in an async. select, since that
929 -- is not legal, so the abort must be of the entire
930 -- task. Therefore, we do not need to cancel the
931 -- terminate alternative. The cleanup will be done
932 -- in Complete_Master.
934 pragma Assert (Self_Id.Pending_ATC_Level = 0);
935 pragma Assert (Self_Id.Awake_Count = 0);
937 STPO.Unlock (Self_Id);
943 Index := Self_Id.Chosen_Index;
944 Initialization.Undefer_Abort_Nestable (Self_Id);
946 if Self_Id.Pending_Action then
947 Initialization.Do_Pending_Action (Self_Id);
953 -- Self_Id.Common.Call and Self_Id.Chosen_Index
954 -- should already be updated by the Caller.
956 if Self_Id.Chosen_Index /= No_Rendezvous
957 and then not Open_Accepts (Self_Id.Chosen_Index).Null_Body
959 Uninterpreted_Data := Self_Id.Common.Call.Uninterpreted_Data;
961 pragma Assert (Self_Id.Deferral_Level = 1);
963 -- We need an extra defer here, to keep abort
964 -- deferred until we get into the accept body
966 Initialization.Defer_Abort_Nestable (Self_Id);
970 STPO.Unlock (Self_Id);
972 when No_Alternative_Open =>
973 -- In this case, Index will be No_Rendezvous on return, which
974 -- should cause a Program_Error if it is not a Delay_Mode.
976 -- If delay alternative exists (Delay_Mode) we should suspend
977 -- until the delay expires.
979 Self_Id.Open_Accepts := null;
981 if Select_Mode = Delay_Mode then
982 Self_Id.Common.State := Delay_Sleep;
986 Self_Id.Pending_ATC_Level < Self_Id.ATC_Nesting_Level;
987 Sleep (Self_Id, Delay_Sleep);
990 Self_Id.Common.State := Runnable;
991 STPO.Unlock (Self_Id);
994 STPO.Unlock (Self_Id);
1000 Initialization.Undefer_Abort (Self_Id);
1001 raise Program_Error with "Entry call not a delay mode";
1009 -- Caller has been chosen.
1010 -- Self_Id.Common.Call should already be updated by the Caller.
1011 -- Self_Id.Chosen_Index should either be updated by the Caller
1012 -- or by Test_Selective_Wait.
1013 -- On return, we sill start rendezvous unless the accept body is
1014 -- null. In the latter case, we will have already completed the RV.
1016 Index := Self_Id.Chosen_Index;
1017 Initialization.Undefer_Abort_Nestable (Self_Id);
1020 ------------------------------------
1021 -- Setup_For_Rendezvous_With_Body --
1022 ------------------------------------
1024 procedure Setup_For_Rendezvous_With_Body
1025 (Entry_Call : Entry_Call_Link;
1026 Acceptor : Task_Id) is
1028 Entry_Call.Acceptor_Prev_Call := Acceptor.Common.Call;
1029 Acceptor.Common.Call := Entry_Call;
1031 if Entry_Call.State = Now_Abortable then
1032 Entry_Call.State := Was_Abortable;
1035 Boost_Priority (Entry_Call, Acceptor);
1036 end Setup_For_Rendezvous_With_Body;
1042 function Task_Count (E : Task_Entry_Index) return Natural is
1043 Self_Id : constant Task_Id := STPO.Self;
1044 Return_Count : Natural;
1047 Initialization.Defer_Abort (Self_Id);
1053 STPO.Write_Lock (Self_Id);
1054 Return_Count := Queuing.Count_Waiting (Self_Id.Entry_Queues (E));
1055 STPO.Unlock (Self_Id);
1061 Initialization.Undefer_Abort (Self_Id);
1063 -- Call Yield to let other tasks get a chance to run as this is a
1064 -- potential dispatching point.
1066 Yield (Do_Yield => False);
1067 return Return_Count;
1070 ----------------------
1071 -- Task_Do_Or_Queue --
1072 ----------------------
1074 function Task_Do_Or_Queue
1076 Entry_Call : Entry_Call_Link) return Boolean
1078 E : constant Task_Entry_Index :=
1079 Task_Entry_Index (Entry_Call.E);
1080 Old_State : constant Entry_Call_State := Entry_Call.State;
1081 Acceptor : constant Task_Id := Entry_Call.Called_Task;
1082 Parent : constant Task_Id := Acceptor.Common.Parent;
1083 Parent_Locked : Boolean := False;
1084 Null_Body : Boolean;
1087 -- Find out whether Entry_Call can be accepted immediately
1089 -- If the Acceptor is not callable, return False.
1090 -- If the rendezvous can start, initiate it.
1091 -- If the accept-body is trivial, also complete the rendezvous.
1092 -- If the acceptor is not ready, enqueue the call.
1094 -- This should have a special case for Accept_Call and Accept_Trivial,
1095 -- so that we don't have the loop setup overhead, below.
1097 -- The call state Done is used here and elsewhere to include both the
1098 -- case of normal successful completion, and the case of an exception
1099 -- being raised. The difference is that if an exception is raised no one
1100 -- will pay attention to the fact that State = Done. Instead the
1101 -- exception will be raised in Undefer_Abort, and control will skip past
1102 -- the place where we normally would resume from an entry call.
1104 pragma Assert (not Queuing.Onqueue (Entry_Call));
1106 -- We rely that the call is off-queue for protection, that the caller
1107 -- will not exit the Entry_Caller_Sleep, and so will not reuse the call
1108 -- record for another call.
1109 -- We rely on the Caller's lock for call State mod's.
1111 -- We can't lock Acceptor.Parent while holding Acceptor,
1112 -- so lock it in advance if we expect to need to lock it.
1114 if Acceptor.Terminate_Alternative then
1115 STPO.Write_Lock (Parent);
1116 Parent_Locked := True;
1119 STPO.Write_Lock (Acceptor);
1121 -- If the acceptor is not callable, abort the call and return False
1123 if not Acceptor.Callable then
1124 STPO.Unlock (Acceptor);
1126 if Parent_Locked then
1127 STPO.Unlock (Parent);
1130 pragma Assert (Entry_Call.State < Done);
1132 -- In case we are not the caller, set up the caller
1133 -- to raise Tasking_Error when it wakes up.
1135 STPO.Write_Lock (Entry_Call.Self);
1136 Entry_Call.Exception_To_Raise := Tasking_Error'Identity;
1137 Initialization.Wakeup_Entry_Caller (Self_ID, Entry_Call, Done);
1138 STPO.Unlock (Entry_Call.Self);
1143 -- Try to serve the call immediately
1145 if Acceptor.Open_Accepts /= null then
1146 for J in Acceptor.Open_Accepts'Range loop
1147 if Entry_Call.E = Entry_Index (Acceptor.Open_Accepts (J).S) then
1149 -- Commit acceptor to rendezvous with us
1151 Acceptor.Chosen_Index := J;
1152 Null_Body := Acceptor.Open_Accepts (J).Null_Body;
1153 Acceptor.Open_Accepts := null;
1155 -- Prevent abort while call is being served
1157 if Entry_Call.State = Now_Abortable then
1158 Entry_Call.State := Was_Abortable;
1161 if Acceptor.Terminate_Alternative then
1163 -- Cancel terminate alternative. See matching code in
1164 -- Selective_Wait and Vulnerable_Complete_Master.
1166 Acceptor.Terminate_Alternative := False;
1167 Acceptor.Awake_Count := Acceptor.Awake_Count + 1;
1169 if Acceptor.Awake_Count = 1 then
1171 -- Notify parent that acceptor is awake
1173 pragma Assert (Parent.Awake_Count > 0);
1175 Parent.Awake_Count := Parent.Awake_Count + 1;
1177 if Parent.Common.State = Master_Completion_Sleep
1178 and then Acceptor.Master_of_Task = Parent.Master_Within
1180 Parent.Common.Wait_Count :=
1181 Parent.Common.Wait_Count + 1;
1188 -- Rendezvous is over immediately
1190 STPO.Wakeup (Acceptor, Acceptor_Sleep);
1191 STPO.Unlock (Acceptor);
1193 if Parent_Locked then
1194 STPO.Unlock (Parent);
1197 STPO.Write_Lock (Entry_Call.Self);
1198 Initialization.Wakeup_Entry_Caller
1199 (Self_ID, Entry_Call, Done);
1200 STPO.Unlock (Entry_Call.Self);
1203 Setup_For_Rendezvous_With_Body (Entry_Call, Acceptor);
1205 -- For terminate_alternative, acceptor may not be asleep
1206 -- yet, so we skip the wakeup
1208 if Acceptor.Common.State /= Runnable then
1209 STPO.Wakeup (Acceptor, Acceptor_Sleep);
1212 STPO.Unlock (Acceptor);
1214 if Parent_Locked then
1215 STPO.Unlock (Parent);
1223 -- The acceptor is accepting, but not this entry
1226 -- If the acceptor was ready to accept this call,
1227 -- we would not have gotten this far, so now we should
1228 -- (re)enqueue the call, if the mode permits that.
1230 if Entry_Call.Mode /= Conditional_Call
1231 or else not Entry_Call.With_Abort
1233 -- Timed_Call, Simple_Call, or Asynchronous_Call
1235 Queuing.Enqueue (Acceptor.Entry_Queues (E), Entry_Call);
1237 -- Update abortability of call
1239 pragma Assert (Old_State < Done);
1242 New_State (Entry_Call.With_Abort, Entry_Call.State);
1244 STPO.Unlock (Acceptor);
1246 if Parent_Locked then
1247 STPO.Unlock (Parent);
1250 if Old_State /= Entry_Call.State
1251 and then Entry_Call.State = Now_Abortable
1252 and then Entry_Call.Mode > Simple_Call
1253 and then Entry_Call.Self /= Self_ID
1255 -- Asynchronous_Call or Conditional_Call
1258 -- Because of ATCB lock ordering rule
1260 STPO.Write_Lock (Entry_Call.Self);
1262 if Entry_Call.Self.Common.State = Async_Select_Sleep then
1264 -- Caller may not yet have reached wait-point
1266 STPO.Wakeup (Entry_Call.Self, Async_Select_Sleep);
1269 STPO.Unlock (Entry_Call.Self);
1273 -- Conditional_Call and With_Abort
1275 STPO.Unlock (Acceptor);
1277 if Parent_Locked then
1278 STPO.Unlock (Parent);
1281 STPO.Write_Lock (Entry_Call.Self);
1283 pragma Assert (Entry_Call.State >= Was_Abortable);
1285 Initialization.Wakeup_Entry_Caller (Self_ID, Entry_Call, Cancelled);
1286 STPO.Unlock (Entry_Call.Self);
1290 end Task_Do_Or_Queue;
1292 ---------------------
1293 -- Task_Entry_Call --
1294 ---------------------
1296 procedure Task_Entry_Call
1297 (Acceptor : Task_Id;
1298 E : Task_Entry_Index;
1299 Uninterpreted_Data : System.Address;
1301 Rendezvous_Successful : out Boolean)
1303 Self_Id : constant Task_Id := STPO.Self;
1304 Entry_Call : Entry_Call_Link;
1307 -- If pragma Detect_Blocking is active then Program_Error must be
1308 -- raised if this potentially blocking operation is called from a
1309 -- protected action.
1311 if System.Tasking.Detect_Blocking
1312 and then Self_Id.Common.Protected_Action_Nesting > 0
1314 raise Program_Error with "potentially blocking operation";
1317 if Parameters.Runtime_Traces then
1318 Send_Trace_Info (W_Call, Acceptor, Entry_Index (E));
1321 if Mode = Simple_Call or else Mode = Conditional_Call then
1323 (Acceptor, E, Uninterpreted_Data, Mode, Rendezvous_Successful);
1326 -- This is an asynchronous call
1328 -- Abort must already be deferred by the compiler-generated code.
1329 -- Without this, an abort that occurs between the time that this
1330 -- call is made and the time that the abortable part's cleanup
1331 -- handler is set up might miss the cleanup handler and leave the
1334 Self_Id.ATC_Nesting_Level := Self_Id.ATC_Nesting_Level + 1;
1336 (Debug.Trace (Self_Id, "TEC: entered ATC level: " &
1337 ATC_Level'Image (Self_Id.ATC_Nesting_Level), 'A'));
1338 Entry_Call := Self_Id.Entry_Calls (Self_Id.ATC_Nesting_Level)'Access;
1339 Entry_Call.Next := null;
1340 Entry_Call.Mode := Mode;
1341 Entry_Call.Cancellation_Attempted := False;
1342 Entry_Call.State := Not_Yet_Abortable;
1343 Entry_Call.E := Entry_Index (E);
1344 Entry_Call.Prio := Get_Priority (Self_Id);
1345 Entry_Call.Uninterpreted_Data := Uninterpreted_Data;
1346 Entry_Call.Called_Task := Acceptor;
1347 Entry_Call.Called_PO := Null_Address;
1348 Entry_Call.Exception_To_Raise := Ada.Exceptions.Null_Id;
1349 Entry_Call.With_Abort := True;
1355 if not Task_Do_Or_Queue (Self_Id, Entry_Call) then
1356 STPO.Write_Lock (Self_Id);
1357 Utilities.Exit_One_ATC_Level (Self_Id);
1358 STPO.Unlock (Self_Id);
1364 Initialization.Undefer_Abort (Self_Id);
1366 if Parameters.Runtime_Traces then
1367 Send_Trace_Info (E_Missed, Acceptor);
1370 raise Tasking_Error;
1373 -- The following is special for async. entry calls.
1374 -- If the call was not queued abortably, we need to wait until
1375 -- it is before proceeding with the abortable part.
1377 -- Wait_Until_Abortable can be called unconditionally here,
1378 -- but it is expensive.
1380 if Entry_Call.State < Was_Abortable then
1381 Entry_Calls.Wait_Until_Abortable (Self_Id, Entry_Call);
1388 -- Note: following assignment needs to be atomic
1390 Rendezvous_Successful := Entry_Call.State = Done;
1392 end Task_Entry_Call;
1394 -----------------------
1395 -- Task_Entry_Caller --
1396 -----------------------
1398 function Task_Entry_Caller (D : Task_Entry_Nesting_Depth) return Task_Id is
1399 Self_Id : constant Task_Id := STPO.Self;
1400 Entry_Call : Entry_Call_Link;
1403 Entry_Call := Self_Id.Common.Call;
1405 for Depth in 1 .. D loop
1406 Entry_Call := Entry_Call.Acceptor_Prev_Call;
1407 pragma Assert (Entry_Call /= null);
1410 return Entry_Call.Self;
1411 end Task_Entry_Caller;
1413 --------------------------
1414 -- Timed_Selective_Wait --
1415 --------------------------
1417 procedure Timed_Selective_Wait
1418 (Open_Accepts : Accept_List_Access;
1419 Select_Mode : Select_Modes;
1420 Uninterpreted_Data : out System.Address;
1423 Index : out Select_Index)
1425 Self_Id : constant Task_Id := STPO.Self;
1426 Treatment : Select_Treatment;
1427 Entry_Call : Entry_Call_Link;
1429 Selection : Select_Index;
1430 Open_Alternative : Boolean;
1431 Timedout : Boolean := False;
1432 Yielded : Boolean := True;
1435 pragma Assert (Select_Mode = Delay_Mode);
1437 Initialization.Defer_Abort (Self_Id);
1439 -- If we are aborted here, the effect will be pending
1445 STPO.Write_Lock (Self_Id);
1447 if not Self_Id.Callable then
1448 pragma Assert (Self_Id.Pending_ATC_Level = 0);
1450 pragma Assert (Self_Id.Pending_Action);
1452 STPO.Unlock (Self_Id);
1458 Initialization.Undefer_Abort (Self_Id);
1460 -- Should never get here ???
1462 pragma Assert (False);
1463 raise Standard'Abort_Signal;
1466 Uninterpreted_Data := Null_Address;
1468 pragma Assert (Open_Accepts /= null);
1470 Queuing.Select_Task_Entry_Call
1471 (Self_Id, Open_Accepts, Entry_Call, Selection, Open_Alternative);
1473 -- Determine the kind and disposition of the select
1475 Treatment := Default_Treatment (Select_Mode);
1476 Self_Id.Chosen_Index := No_Rendezvous;
1478 if Open_Alternative then
1479 if Entry_Call /= null then
1480 if Open_Accepts (Selection).Null_Body then
1481 Treatment := Accept_Alternative_Completed;
1484 Setup_For_Rendezvous_With_Body (Entry_Call, Self_Id);
1485 Treatment := Accept_Alternative_Selected;
1488 Self_Id.Chosen_Index := Selection;
1490 elsif Treatment = No_Alternative_Open then
1491 Treatment := Accept_Alternative_Open;
1495 -- Handle the select according to the disposition selected above
1498 when Accept_Alternative_Selected =>
1499 -- Ready to rendezvous
1500 -- In this case the accept body is not Null_Body. Defer abort
1501 -- until it gets into the accept body.
1503 Uninterpreted_Data := Self_Id.Common.Call.Uninterpreted_Data;
1504 Initialization.Defer_Abort (Self_Id);
1505 STPO.Unlock (Self_Id);
1507 when Accept_Alternative_Completed =>
1508 -- Rendezvous is over
1510 if Parameters.Runtime_Traces then
1511 Send_Trace_Info (M_RDV_Complete, Entry_Call.Self);
1514 STPO.Unlock (Self_Id);
1515 Caller := Entry_Call.Self;
1517 STPO.Write_Lock (Caller);
1518 Initialization.Wakeup_Entry_Caller (Self_Id, Entry_Call, Done);
1519 STPO.Unlock (Caller);
1521 when Accept_Alternative_Open =>
1525 Self_Id.Open_Accepts := Open_Accepts;
1527 -- Wait for a normal call and a pending action until the
1528 -- Wakeup_Time is reached.
1530 Self_Id.Common.State := Acceptor_Sleep;
1532 -- Try to remove calls to Sleep in the loop below by letting the
1533 -- caller a chance of getting ready immediately, using Unlock
1534 -- Yield. See similar action in Wait_For_Completion/Wait_For_Call.
1542 if Self_Id.Open_Accepts /= null then
1549 Write_Lock (Self_Id);
1552 -- Check if this task has been aborted while the lock was released
1554 if Self_Id.Pending_ATC_Level < Self_Id.ATC_Nesting_Level then
1555 Self_Id.Open_Accepts := null;
1559 exit when Self_Id.Open_Accepts = null;
1562 Sleep (Self_Id, Acceptor_Sleep);
1564 if Parameters.Runtime_Traces then
1565 Send_Trace_Info (WT_Select,
1567 Integer (Open_Accepts'Length),
1571 STPO.Timed_Sleep (Self_Id, Timeout, Mode,
1572 Acceptor_Sleep, Timedout, Yielded);
1576 Self_Id.Open_Accepts := null;
1578 if Parameters.Runtime_Traces then
1579 Send_Trace_Info (E_Timeout);
1584 Self_Id.Common.State := Runnable;
1586 -- Self_Id.Common.Call should already be updated by the Caller if
1587 -- not aborted. It might also be ready to do rendezvous even if
1588 -- this wakes up due to an abort. Therefore, if the call is not
1589 -- empty we need to do the rendezvous if the accept body is not
1592 if Self_Id.Chosen_Index /= No_Rendezvous
1593 and then Self_Id.Common.Call /= null
1594 and then not Open_Accepts (Self_Id.Chosen_Index).Null_Body
1596 Uninterpreted_Data := Self_Id.Common.Call.Uninterpreted_Data;
1598 pragma Assert (Self_Id.Deferral_Level = 1);
1600 Initialization.Defer_Abort_Nestable (Self_Id);
1602 -- Leave abort deferred until the accept body
1605 STPO.Unlock (Self_Id);
1607 when No_Alternative_Open =>
1608 -- In this case, Index will be No_Rendezvous on return. We sleep
1609 -- for the time we need to.
1610 -- Wait for a signal or timeout. A wakeup can be made
1611 -- for several reasons:
1612 -- 1) Delay is expired
1613 -- 2) Pending_Action needs to be checked
1614 -- (Abort, Priority change)
1615 -- 3) Spurious wakeup
1617 Self_Id.Open_Accepts := null;
1618 Self_Id.Common.State := Acceptor_Sleep;
1620 STPO.Timed_Sleep (Self_Id, Timeout, Mode, Acceptor_Sleep,
1623 Self_Id.Common.State := Runnable;
1625 STPO.Unlock (Self_Id);
1628 -- Should never get here
1629 pragma Assert (False);
1641 -- Caller has been chosen
1643 -- Self_Id.Common.Call should already be updated by the Caller
1645 -- Self_Id.Chosen_Index should either be updated by the Caller
1646 -- or by Test_Selective_Wait
1648 Index := Self_Id.Chosen_Index;
1649 Initialization.Undefer_Abort_Nestable (Self_Id);
1651 -- Start rendezvous, if not already completed
1652 end Timed_Selective_Wait;
1654 ---------------------------
1655 -- Timed_Task_Entry_Call --
1656 ---------------------------
1658 procedure Timed_Task_Entry_Call
1659 (Acceptor : Task_Id;
1660 E : Task_Entry_Index;
1661 Uninterpreted_Data : System.Address;
1664 Rendezvous_Successful : out Boolean)
1666 Self_Id : constant Task_Id := STPO.Self;
1668 Entry_Call : Entry_Call_Link;
1671 pragma Unreferenced (Yielded);
1674 -- If pragma Detect_Blocking is active then Program_Error must be
1675 -- raised if this potentially blocking operation is called from a
1676 -- protected action.
1678 if System.Tasking.Detect_Blocking
1679 and then Self_Id.Common.Protected_Action_Nesting > 0
1681 raise Program_Error with "potentially blocking operation";
1684 Initialization.Defer_Abort (Self_Id);
1685 Self_Id.ATC_Nesting_Level := Self_Id.ATC_Nesting_Level + 1;
1688 (Debug.Trace (Self_Id, "TTEC: entered ATC level: " &
1689 ATC_Level'Image (Self_Id.ATC_Nesting_Level), 'A'));
1691 if Parameters.Runtime_Traces then
1692 Send_Trace_Info (WT_Call, Acceptor,
1693 Entry_Index (E), Timeout);
1696 Level := Self_Id.ATC_Nesting_Level;
1697 Entry_Call := Self_Id.Entry_Calls (Level)'Access;
1698 Entry_Call.Next := null;
1699 Entry_Call.Mode := Timed_Call;
1700 Entry_Call.Cancellation_Attempted := False;
1702 -- If this is a call made inside of an abort deferred region,
1703 -- the call should be never abortable.
1705 if Self_Id.Deferral_Level > 1 then
1706 Entry_Call.State := Never_Abortable;
1708 Entry_Call.State := Now_Abortable;
1711 Entry_Call.E := Entry_Index (E);
1712 Entry_Call.Prio := Get_Priority (Self_Id);
1713 Entry_Call.Uninterpreted_Data := Uninterpreted_Data;
1714 Entry_Call.Called_Task := Acceptor;
1715 Entry_Call.Called_PO := Null_Address;
1716 Entry_Call.Exception_To_Raise := Ada.Exceptions.Null_Id;
1717 Entry_Call.With_Abort := True;
1719 -- Note: the caller will undefer abort on return (see WARNING above)
1725 if not Task_Do_Or_Queue (Self_Id, Entry_Call) then
1726 STPO.Write_Lock (Self_Id);
1727 Utilities.Exit_One_ATC_Level (Self_Id);
1728 STPO.Unlock (Self_Id);
1734 Initialization.Undefer_Abort (Self_Id);
1736 if Parameters.Runtime_Traces then
1737 Send_Trace_Info (E_Missed, Acceptor);
1739 raise Tasking_Error;
1742 Write_Lock (Self_Id);
1743 Entry_Calls.Wait_For_Completion_With_Timeout
1744 (Entry_Call, Timeout, Mode, Yielded);
1751 -- ??? Do we need to yield in case Yielded is False
1753 Rendezvous_Successful := Entry_Call.State = Done;
1754 Initialization.Undefer_Abort (Self_Id);
1755 Entry_Calls.Check_Exception (Self_Id, Entry_Call);
1756 end Timed_Task_Entry_Call;
1762 procedure Wait_For_Call (Self_Id : Task_Id) is
1764 Self_Id.Common.State := Acceptor_Sleep;
1766 -- Try to remove calls to Sleep in the loop below by letting the caller
1767 -- a chance of getting ready immediately, using Unlock & Yield.
1768 -- See similar action in Wait_For_Completion & Timed_Selective_Wait.
1776 if Self_Id.Open_Accepts /= null then
1783 Write_Lock (Self_Id);
1786 -- Check if this task has been aborted while the lock was released
1788 if Self_Id.Pending_ATC_Level < Self_Id.ATC_Nesting_Level then
1789 Self_Id.Open_Accepts := null;
1793 exit when Self_Id.Open_Accepts = null;
1794 Sleep (Self_Id, Acceptor_Sleep);
1797 Self_Id.Common.State := Runnable;
1800 end System.Tasking.Rendezvous;