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-2011, 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;
40 with System.Parameters;
41 with System.Traces.Tasking;
43 package body System.Tasking.Rendezvous is
45 package STPO renames System.Task_Primitives.Operations;
46 package POO renames Protected_Objects.Operations;
47 package POE renames Protected_Objects.Entries;
50 use Task_Primitives.Operations;
52 use System.Traces.Tasking;
54 type Select_Treatment is (
55 Accept_Alternative_Selected, -- alternative with non-null body
56 Accept_Alternative_Completed, -- alternative with null body
59 Accept_Alternative_Open,
66 Default_Treatment : constant array (Select_Modes) of Select_Treatment :=
67 (Simple_Mode => No_Alternative_Open,
68 Else_Mode => Else_Selected,
69 Terminate_Mode => Terminate_Selected,
70 Delay_Mode => No_Alternative_Open);
72 New_State : constant array (Boolean, Entry_Call_State)
73 of Entry_Call_State :=
75 (Never_Abortable => Never_Abortable,
76 Not_Yet_Abortable => Now_Abortable,
77 Was_Abortable => Now_Abortable,
78 Now_Abortable => Now_Abortable,
80 Cancelled => Cancelled),
82 (Never_Abortable => Never_Abortable,
83 Not_Yet_Abortable => Not_Yet_Abortable,
84 Was_Abortable => Was_Abortable,
85 Now_Abortable => Now_Abortable,
87 Cancelled => Cancelled)
90 -----------------------
91 -- Local Subprograms --
92 -----------------------
94 procedure Local_Defer_Abort (Self_Id : Task_Id) renames
95 System.Tasking.Initialization.Defer_Abort_Nestable;
97 procedure Local_Undefer_Abort (Self_Id : Task_Id) renames
98 System.Tasking.Initialization.Undefer_Abort_Nestable;
100 -- Florist defers abort around critical sections that make entry calls
101 -- to the Interrupt_Manager task, which violates the general rule about
102 -- top-level runtime system calls from abort-deferred regions. It is not
103 -- that this is unsafe, but when it occurs in "normal" programs it usually
104 -- means either the user is trying to do a potentially blocking operation
105 -- from within a protected object, or there is a runtime system/compiler
106 -- error that has failed to undefer an earlier abort deferral. Thus, for
107 -- debugging it may be wise to modify the above renamings to the
108 -- non-nestable forms.
110 procedure Boost_Priority (Call : Entry_Call_Link; Acceptor : Task_Id);
111 pragma Inline (Boost_Priority);
112 -- Call this only with abort deferred and holding lock of Acceptor
114 procedure Call_Synchronous
116 E : Task_Entry_Index;
117 Uninterpreted_Data : System.Address;
119 Rendezvous_Successful : out Boolean);
120 pragma Inline (Call_Synchronous);
121 -- This call is used to make a simple or conditional entry call.
122 -- Called from Call_Simple and Task_Entry_Call.
124 procedure Setup_For_Rendezvous_With_Body
125 (Entry_Call : Entry_Call_Link;
127 pragma Inline (Setup_For_Rendezvous_With_Body);
128 -- Call this only with abort deferred and holding lock of Acceptor. When
129 -- a rendezvous selected (ready for rendezvous) we need to save previous
130 -- caller and adjust the priority. Also we need to make this call not
131 -- Abortable (Cancellable) since the rendezvous has already been started.
133 procedure Wait_For_Call (Self_Id : Task_Id);
134 pragma Inline (Wait_For_Call);
135 -- Call this only with abort deferred and holding lock of Self_Id. An
136 -- accepting task goes into Sleep by calling this routine waiting for a
137 -- call from the caller or waiting for an abort. Make sure Self_Id is
138 -- locked before calling this routine.
144 procedure Accept_Call
145 (E : Task_Entry_Index;
146 Uninterpreted_Data : out System.Address)
148 Self_Id : constant Task_Id := STPO.Self;
149 Caller : Task_Id := null;
150 Open_Accepts : aliased Accept_List (1 .. 1);
151 Entry_Call : Entry_Call_Link;
154 Initialization.Defer_Abort (Self_Id);
160 STPO.Write_Lock (Self_Id);
162 if not Self_Id.Callable then
163 pragma Assert (Self_Id.Pending_ATC_Level = 0);
165 pragma Assert (Self_Id.Pending_Action);
167 STPO.Unlock (Self_Id);
173 Initialization.Undefer_Abort (Self_Id);
175 -- Should never get here ???
177 pragma Assert (False);
178 raise Standard'Abort_Signal;
181 Queuing.Dequeue_Head (Self_Id.Entry_Queues (E), Entry_Call);
183 if Entry_Call /= null then
184 Caller := Entry_Call.Self;
185 Setup_For_Rendezvous_With_Body (Entry_Call, Self_Id);
186 Uninterpreted_Data := Entry_Call.Uninterpreted_Data;
191 Open_Accepts (1).Null_Body := False;
192 Open_Accepts (1).S := E;
193 Self_Id.Open_Accepts := Open_Accepts'Unrestricted_Access;
195 -- Wait for normal call
197 if Parameters.Runtime_Traces then
198 Send_Trace_Info (W_Accept, Self_Id, Integer (Open_Accepts'Length));
202 (Debug.Trace (Self_Id, "Accept_Call: wait", 'R'));
203 Wait_For_Call (Self_Id);
205 pragma Assert (Self_Id.Open_Accepts = null);
207 if Self_Id.Common.Call /= null then
208 Caller := Self_Id.Common.Call.Self;
209 Uninterpreted_Data :=
210 Caller.Entry_Calls (Caller.ATC_Nesting_Level).Uninterpreted_Data;
212 -- Case of an aborted task
214 Uninterpreted_Data := System.Null_Address;
218 -- Self_Id.Common.Call should already be updated by the Caller. On
219 -- return, we will start the rendezvous.
221 STPO.Unlock (Self_Id);
227 Initialization.Undefer_Abort (Self_Id);
229 if Parameters.Runtime_Traces then
230 Send_Trace_Info (M_Accept_Complete, Caller, Entry_Index (E));
238 procedure Accept_Trivial (E : Task_Entry_Index) is
239 Self_Id : constant Task_Id := STPO.Self;
240 Caller : Task_Id := null;
241 Open_Accepts : aliased Accept_List (1 .. 1);
242 Entry_Call : Entry_Call_Link;
245 Initialization.Defer_Abort_Nestable (Self_Id);
251 STPO.Write_Lock (Self_Id);
253 if not Self_Id.Callable then
254 pragma Assert (Self_Id.Pending_ATC_Level = 0);
256 pragma Assert (Self_Id.Pending_Action);
258 STPO.Unlock (Self_Id);
264 Initialization.Undefer_Abort_Nestable (Self_Id);
266 -- Should never get here ???
268 pragma Assert (False);
269 raise Standard'Abort_Signal;
272 Queuing.Dequeue_Head (Self_Id.Entry_Queues (E), Entry_Call);
274 if Entry_Call = null then
276 -- Need to wait for entry call
278 Open_Accepts (1).Null_Body := True;
279 Open_Accepts (1).S := E;
280 Self_Id.Open_Accepts := Open_Accepts'Unrestricted_Access;
282 if Parameters.Runtime_Traces then
283 Send_Trace_Info (W_Accept, Self_Id, Integer (Open_Accepts'Length));
287 (Debug.Trace (Self_Id, "Accept_Trivial: wait", 'R'));
289 Wait_For_Call (Self_Id);
291 pragma Assert (Self_Id.Open_Accepts = null);
293 -- No need to do anything special here for pending abort.
294 -- Abort_Signal will be raised by Undefer on exit.
296 STPO.Unlock (Self_Id);
298 -- Found caller already waiting
301 pragma Assert (Entry_Call.State < Done);
303 STPO.Unlock (Self_Id);
304 Caller := Entry_Call.Self;
306 STPO.Write_Lock (Caller);
307 Initialization.Wakeup_Entry_Caller (Self_Id, Entry_Call, Done);
308 STPO.Unlock (Caller);
311 if Parameters.Runtime_Traces then
312 Send_Trace_Info (M_Accept_Complete);
314 -- Fake one, since there is (???) no way to know that the rendezvous
317 Send_Trace_Info (M_RDV_Complete);
324 Initialization.Undefer_Abort_Nestable (Self_Id);
331 procedure Boost_Priority (Call : Entry_Call_Link; Acceptor : Task_Id) is
332 Caller : constant Task_Id := Call.Self;
333 Caller_Prio : constant System.Any_Priority := Get_Priority (Caller);
334 Acceptor_Prio : constant System.Any_Priority := Get_Priority (Acceptor);
336 if Caller_Prio > Acceptor_Prio then
337 Call.Acceptor_Prev_Priority := Acceptor_Prio;
338 Set_Priority (Acceptor, Caller_Prio);
340 Call.Acceptor_Prev_Priority := Priority_Not_Boosted;
348 procedure Call_Simple
350 E : Task_Entry_Index;
351 Uninterpreted_Data : System.Address)
353 Rendezvous_Successful : Boolean;
354 pragma Unreferenced (Rendezvous_Successful);
357 -- If pragma Detect_Blocking is active then Program_Error must be
358 -- raised if this potentially blocking operation is called from a
361 if System.Tasking.Detect_Blocking
362 and then STPO.Self.Common.Protected_Action_Nesting > 0
364 raise Program_Error with "potentially blocking operation";
368 (Acceptor, E, Uninterpreted_Data, Simple_Call, Rendezvous_Successful);
371 ----------------------
372 -- Call_Synchronous --
373 ----------------------
375 procedure Call_Synchronous
377 E : Task_Entry_Index;
378 Uninterpreted_Data : System.Address;
380 Rendezvous_Successful : out Boolean)
382 Self_Id : constant Task_Id := STPO.Self;
384 Entry_Call : Entry_Call_Link;
387 pragma Assert (Mode /= Asynchronous_Call);
389 Local_Defer_Abort (Self_Id);
390 Self_Id.ATC_Nesting_Level := Self_Id.ATC_Nesting_Level + 1;
392 (Debug.Trace (Self_Id, "CS: entered ATC level: " &
393 ATC_Level'Image (Self_Id.ATC_Nesting_Level), 'A'));
394 Level := Self_Id.ATC_Nesting_Level;
395 Entry_Call := Self_Id.Entry_Calls (Level)'Access;
396 Entry_Call.Next := null;
397 Entry_Call.Mode := Mode;
398 Entry_Call.Cancellation_Attempted := False;
400 if Parameters.Runtime_Traces then
401 Send_Trace_Info (W_Call, Acceptor, Entry_Index (E));
404 -- If this is a call made inside of an abort deferred region,
405 -- the call should be never abortable.
408 (if Self_Id.Deferral_Level > 1
412 Entry_Call.E := Entry_Index (E);
413 Entry_Call.Prio := Get_Priority (Self_Id);
414 Entry_Call.Uninterpreted_Data := Uninterpreted_Data;
415 Entry_Call.Called_Task := Acceptor;
416 Entry_Call.Exception_To_Raise := Ada.Exceptions.Null_Id;
417 Entry_Call.With_Abort := True;
419 -- Note: the caller will undefer abort on return (see WARNING above)
425 if not Task_Do_Or_Queue (Self_Id, Entry_Call) then
426 STPO.Write_Lock (Self_Id);
427 Utilities.Exit_One_ATC_Level (Self_Id);
428 STPO.Unlock (Self_Id);
434 if Parameters.Runtime_Traces then
435 Send_Trace_Info (E_Missed, Acceptor);
438 Local_Undefer_Abort (Self_Id);
442 STPO.Write_Lock (Self_Id);
444 (Debug.Trace (Self_Id, "Call_Synchronous: wait", 'R'));
445 Entry_Calls.Wait_For_Completion (Entry_Call);
447 (Debug.Trace (Self_Id, "Call_Synchronous: done waiting", 'R'));
448 Rendezvous_Successful := Entry_Call.State = Done;
449 STPO.Unlock (Self_Id);
455 Local_Undefer_Abort (Self_Id);
456 Entry_Calls.Check_Exception (Self_Id, Entry_Call);
457 end Call_Synchronous;
463 function Callable (T : Task_Id) return Boolean is
465 Self_Id : constant Task_Id := STPO.Self;
468 Initialization.Defer_Abort_Nestable (Self_Id);
475 Result := T.Callable;
482 Initialization.Undefer_Abort_Nestable (Self_Id);
486 ----------------------------
487 -- Cancel_Task_Entry_Call --
488 ----------------------------
490 procedure Cancel_Task_Entry_Call (Cancelled : out Boolean) is
492 Entry_Calls.Try_To_Cancel_Entry_Call (Cancelled);
493 end Cancel_Task_Entry_Call;
495 -------------------------
496 -- Complete_Rendezvous --
497 -------------------------
499 procedure Complete_Rendezvous is
501 Exceptional_Complete_Rendezvous (Ada.Exceptions.Null_Id);
502 end Complete_Rendezvous;
504 -------------------------------------
505 -- Exceptional_Complete_Rendezvous --
506 -------------------------------------
508 procedure Exceptional_Complete_Rendezvous
509 (Ex : Ada.Exceptions.Exception_Id)
511 Self_Id : constant Task_Id := STPO.Self;
512 Entry_Call : Entry_Call_Link := Self_Id.Common.Call;
514 Called_PO : STPE.Protection_Entries_Access;
515 Acceptor_Prev_Priority : Integer;
517 Exception_To_Raise : Ada.Exceptions.Exception_Id := Ex;
518 Ceiling_Violation : Boolean;
520 use type Ada.Exceptions.Exception_Id;
521 procedure Internal_Reraise;
522 pragma Import (C, Internal_Reraise, "__gnat_reraise");
524 procedure Transfer_Occurrence
525 (Target : Ada.Exceptions.Exception_Occurrence_Access;
526 Source : Ada.Exceptions.Exception_Occurrence);
527 pragma Import (C, Transfer_Occurrence, "__gnat_transfer_occurrence");
529 use type STPE.Protection_Entries_Access;
532 -- Consider phasing out Complete_Rendezvous in favor of direct call to
533 -- this with Ada.Exceptions.Null_ID. See code expansion examples for
534 -- Accept_Call and Selective_Wait. Also consider putting an explicit
535 -- re-raise after this call, in the generated code. That way we could
536 -- eliminate the code here that reraises the exception.
538 -- The deferral level is critical here, since we want to raise an
539 -- exception or allow abort to take place, if there is an exception or
543 (Debug.Trace (Self_Id, "Exceptional_Complete_Rendezvous", 'R'));
545 if Ex = Ada.Exceptions.Null_Id then
547 -- The call came from normal end-of-rendezvous, so abort is not yet
550 if Parameters.Runtime_Traces then
551 Send_Trace_Info (M_RDV_Complete, Entry_Call.Self);
554 Initialization.Defer_Abort_Nestable (Self_Id);
556 elsif ZCX_By_Default then
558 -- With ZCX, aborts are not automatically deferred in handlers
560 Initialization.Defer_Abort_Nestable (Self_Id);
563 -- We need to clean up any accepts which Self may have been serving when
566 if Ex = Standard'Abort_Signal'Identity then
571 while Entry_Call /= null loop
572 Entry_Call.Exception_To_Raise := Tasking_Error'Identity;
574 -- All forms of accept make sure that the acceptor is not
575 -- completed, before accepting further calls, so that we
576 -- can be sure that no further calls are made after the
577 -- current calls are purged.
579 Caller := Entry_Call.Self;
581 -- Take write lock. This follows the lock precedence rule that
582 -- Caller may be locked while holding lock of Acceptor. Complete
583 -- the call abnormally, with exception.
585 STPO.Write_Lock (Caller);
586 Initialization.Wakeup_Entry_Caller (Self_Id, Entry_Call, Done);
587 STPO.Unlock (Caller);
588 Entry_Call := Entry_Call.Acceptor_Prev_Call;
596 Caller := Entry_Call.Self;
598 if Entry_Call.Needs_Requeue then
600 -- We dare not lock Self_Id at the same time as Caller, for fear
603 Entry_Call.Needs_Requeue := False;
604 Self_Id.Common.Call := Entry_Call.Acceptor_Prev_Call;
606 if Entry_Call.Called_Task /= null then
608 -- Requeue to another task entry
614 if not Task_Do_Or_Queue (Self_Id, Entry_Call) then
619 Initialization.Undefer_Abort (Self_Id);
628 -- Requeue to a protected entry
630 Called_PO := POE.To_Protection (Entry_Call.Called_PO);
631 STPE.Lock_Entries_With_Status (Called_PO, Ceiling_Violation);
633 if Ceiling_Violation then
634 pragma Assert (Ex = Ada.Exceptions.Null_Id);
636 Exception_To_Raise := Program_Error'Identity;
637 Entry_Call.Exception_To_Raise := Exception_To_Raise;
643 STPO.Write_Lock (Caller);
644 Initialization.Wakeup_Entry_Caller
645 (Self_Id, Entry_Call, Done);
646 STPO.Unlock (Caller);
653 POO.PO_Do_Or_Queue (Self_Id, Called_PO, Entry_Call);
654 POO.PO_Service_Entries (Self_Id, Called_PO);
658 Entry_Calls.Reset_Priority
659 (Self_Id, Entry_Call.Acceptor_Prev_Priority);
662 -- The call does not need to be requeued
664 Self_Id.Common.Call := Entry_Call.Acceptor_Prev_Call;
665 Entry_Call.Exception_To_Raise := Ex;
671 STPO.Write_Lock (Caller);
673 -- Done with Caller locked to make sure that Wakeup is not lost
675 if Ex /= Ada.Exceptions.Null_Id then
677 (Caller.Common.Compiler_Data.Current_Excep'Access,
678 Self_Id.Common.Compiler_Data.Current_Excep);
681 Acceptor_Prev_Priority := Entry_Call.Acceptor_Prev_Priority;
682 Initialization.Wakeup_Entry_Caller (Self_Id, Entry_Call, Done);
684 STPO.Unlock (Caller);
690 Entry_Calls.Reset_Priority (Self_Id, Acceptor_Prev_Priority);
694 Initialization.Undefer_Abort (Self_Id);
696 if Exception_To_Raise /= Ada.Exceptions.Null_Id then
700 -- ??? Do we need to give precedence to Program_Error that might be
701 -- raised due to failure of finalization, over Tasking_Error from
702 -- failure of requeue?
704 end Exceptional_Complete_Rendezvous;
706 -------------------------------------
707 -- Requeue_Protected_To_Task_Entry --
708 -------------------------------------
710 procedure Requeue_Protected_To_Task_Entry
711 (Object : STPE.Protection_Entries_Access;
713 E : Task_Entry_Index;
714 With_Abort : Boolean)
716 Entry_Call : constant Entry_Call_Link := Object.Call_In_Progress;
718 pragma Assert (STPO.Self.Deferral_Level > 0);
720 Entry_Call.E := Entry_Index (E);
721 Entry_Call.Called_Task := Acceptor;
722 Entry_Call.Called_PO := Null_Address;
723 Entry_Call.With_Abort := With_Abort;
724 Object.Call_In_Progress := null;
725 end Requeue_Protected_To_Task_Entry;
727 ------------------------
728 -- Requeue_Task_Entry --
729 ------------------------
731 procedure Requeue_Task_Entry
733 E : Task_Entry_Index;
734 With_Abort : Boolean)
736 Self_Id : constant Task_Id := STPO.Self;
737 Entry_Call : constant Entry_Call_Link := Self_Id.Common.Call;
739 Initialization.Defer_Abort (Self_Id);
740 Entry_Call.Needs_Requeue := True;
741 Entry_Call.With_Abort := With_Abort;
742 Entry_Call.E := Entry_Index (E);
743 Entry_Call.Called_Task := Acceptor;
744 Initialization.Undefer_Abort (Self_Id);
745 end Requeue_Task_Entry;
751 procedure Selective_Wait
752 (Open_Accepts : Accept_List_Access;
753 Select_Mode : Select_Modes;
754 Uninterpreted_Data : out System.Address;
755 Index : out Select_Index)
757 Self_Id : constant Task_Id := STPO.Self;
758 Entry_Call : Entry_Call_Link;
759 Treatment : Select_Treatment;
761 Selection : Select_Index;
762 Open_Alternative : Boolean;
765 Initialization.Defer_Abort (Self_Id);
771 STPO.Write_Lock (Self_Id);
773 if not Self_Id.Callable then
774 pragma Assert (Self_Id.Pending_ATC_Level = 0);
776 pragma Assert (Self_Id.Pending_Action);
778 STPO.Unlock (Self_Id);
784 -- ??? In some cases abort is deferred more than once. Need to
785 -- figure out why this happens.
787 if Self_Id.Deferral_Level > 1 then
788 Self_Id.Deferral_Level := 1;
791 Initialization.Undefer_Abort (Self_Id);
793 -- Should never get here ???
795 pragma Assert (False);
796 raise Standard'Abort_Signal;
799 pragma Assert (Open_Accepts /= null);
801 Uninterpreted_Data := Null_Address;
803 Queuing.Select_Task_Entry_Call
804 (Self_Id, Open_Accepts, Entry_Call, Selection, Open_Alternative);
806 -- Determine the kind and disposition of the select
808 Treatment := Default_Treatment (Select_Mode);
809 Self_Id.Chosen_Index := No_Rendezvous;
811 if Open_Alternative then
812 if Entry_Call /= null then
813 if Open_Accepts (Selection).Null_Body then
814 Treatment := Accept_Alternative_Completed;
816 Setup_For_Rendezvous_With_Body (Entry_Call, Self_Id);
817 Treatment := Accept_Alternative_Selected;
820 Self_Id.Chosen_Index := Selection;
822 elsif Treatment = No_Alternative_Open then
823 Treatment := Accept_Alternative_Open;
827 -- Handle the select according to the disposition selected above
830 when Accept_Alternative_Selected =>
832 -- Ready to rendezvous
834 Uninterpreted_Data := Self_Id.Common.Call.Uninterpreted_Data;
836 -- In this case the accept body is not Null_Body. Defer abort
837 -- until it gets into the accept body.
839 pragma Assert (Self_Id.Deferral_Level = 1);
841 Initialization.Defer_Abort_Nestable (Self_Id);
842 STPO.Unlock (Self_Id);
844 when Accept_Alternative_Completed =>
846 -- Accept body is null, so rendezvous is over immediately
848 if Parameters.Runtime_Traces then
849 Send_Trace_Info (M_RDV_Complete, Entry_Call.Self);
852 STPO.Unlock (Self_Id);
853 Caller := Entry_Call.Self;
855 STPO.Write_Lock (Caller);
856 Initialization.Wakeup_Entry_Caller (Self_Id, Entry_Call, Done);
857 STPO.Unlock (Caller);
859 when Accept_Alternative_Open =>
863 Self_Id.Open_Accepts := Open_Accepts;
865 (Debug.Trace (Self_Id, "Selective_Wait: wait", 'R'));
867 if Parameters.Runtime_Traces then
868 Send_Trace_Info (W_Select, Self_Id,
869 Integer (Open_Accepts'Length));
872 Wait_For_Call (Self_Id);
874 pragma Assert (Self_Id.Open_Accepts = null);
876 -- Self_Id.Common.Call should already be updated by the Caller if
877 -- not aborted. It might also be ready to do rendezvous even if
878 -- this wakes up due to an abort. Therefore, if the call is not
879 -- empty we need to do the rendezvous if the accept body is not
882 -- Aren't the first two conditions below redundant???
884 if Self_Id.Chosen_Index /= No_Rendezvous
885 and then Self_Id.Common.Call /= null
886 and then not Open_Accepts (Self_Id.Chosen_Index).Null_Body
888 Uninterpreted_Data := Self_Id.Common.Call.Uninterpreted_Data;
891 (Self_Id.Deferral_Level = 1
893 (Self_Id.Deferral_Level = 0
894 and then not Restrictions.Abort_Allowed));
896 Initialization.Defer_Abort_Nestable (Self_Id);
898 -- Leave abort deferred until the accept body
901 STPO.Unlock (Self_Id);
903 when Else_Selected =>
904 pragma Assert (Self_Id.Open_Accepts = null);
906 if Parameters.Runtime_Traces then
907 Send_Trace_Info (M_Select_Else);
910 STPO.Unlock (Self_Id);
912 when Terminate_Selected =>
914 -- Terminate alternative is open
916 Self_Id.Open_Accepts := Open_Accepts;
917 Self_Id.Common.State := Acceptor_Sleep;
919 -- Notify ancestors that this task is on a terminate alternative
921 STPO.Unlock (Self_Id);
922 Utilities.Make_Passive (Self_Id, Task_Completed => False);
923 STPO.Write_Lock (Self_Id);
925 -- Wait for normal entry call or termination
927 Wait_For_Call (Self_Id);
929 pragma Assert (Self_Id.Open_Accepts = null);
931 if Self_Id.Terminate_Alternative then
933 -- An entry call should have reset this to False, so we must be
934 -- aborted. We cannot be in an async. select, since that is not
935 -- legal, so the abort must be of the entire task. Therefore,
936 -- we do not need to cancel the terminate alternative. The
937 -- cleanup will be done in Complete_Master.
939 pragma Assert (Self_Id.Pending_ATC_Level = 0);
940 pragma Assert (Self_Id.Awake_Count = 0);
942 STPO.Unlock (Self_Id);
948 Index := Self_Id.Chosen_Index;
949 Initialization.Undefer_Abort_Nestable (Self_Id);
951 if Self_Id.Pending_Action then
952 Initialization.Do_Pending_Action (Self_Id);
958 -- Self_Id.Common.Call and Self_Id.Chosen_Index
959 -- should already be updated by the Caller.
961 if Self_Id.Chosen_Index /= No_Rendezvous
962 and then not Open_Accepts (Self_Id.Chosen_Index).Null_Body
964 Uninterpreted_Data := Self_Id.Common.Call.Uninterpreted_Data;
966 pragma Assert (Self_Id.Deferral_Level = 1);
968 -- We need an extra defer here, to keep abort
969 -- deferred until we get into the accept body
971 Initialization.Defer_Abort_Nestable (Self_Id);
975 STPO.Unlock (Self_Id);
977 when No_Alternative_Open =>
979 -- In this case, Index will be No_Rendezvous on return, which
980 -- should cause a Program_Error if it is not a Delay_Mode.
982 -- If delay alternative exists (Delay_Mode) we should suspend
983 -- until the delay expires.
985 Self_Id.Open_Accepts := null;
987 if Select_Mode = Delay_Mode then
988 Self_Id.Common.State := Delay_Sleep;
992 Self_Id.Pending_ATC_Level < Self_Id.ATC_Nesting_Level;
993 Sleep (Self_Id, Delay_Sleep);
996 Self_Id.Common.State := Runnable;
997 STPO.Unlock (Self_Id);
1000 STPO.Unlock (Self_Id);
1006 Initialization.Undefer_Abort (Self_Id);
1007 raise Program_Error with "Entry call not a delay mode";
1015 -- Caller has been chosen
1017 -- Self_Id.Common.Call should already be updated by the Caller.
1019 -- Self_Id.Chosen_Index should either be updated by the Caller
1020 -- or by Test_Selective_Wait.
1022 -- On return, we sill start rendezvous unless the accept body is
1023 -- null. In the latter case, we will have already completed the RV.
1025 Index := Self_Id.Chosen_Index;
1026 Initialization.Undefer_Abort_Nestable (Self_Id);
1029 ------------------------------------
1030 -- Setup_For_Rendezvous_With_Body --
1031 ------------------------------------
1033 procedure Setup_For_Rendezvous_With_Body
1034 (Entry_Call : Entry_Call_Link;
1035 Acceptor : Task_Id) is
1037 Entry_Call.Acceptor_Prev_Call := Acceptor.Common.Call;
1038 Acceptor.Common.Call := Entry_Call;
1040 if Entry_Call.State = Now_Abortable then
1041 Entry_Call.State := Was_Abortable;
1044 Boost_Priority (Entry_Call, Acceptor);
1045 end Setup_For_Rendezvous_With_Body;
1051 function Task_Count (E : Task_Entry_Index) return Natural is
1052 Self_Id : constant Task_Id := STPO.Self;
1053 Return_Count : Natural;
1056 Initialization.Defer_Abort (Self_Id);
1062 STPO.Write_Lock (Self_Id);
1063 Return_Count := Queuing.Count_Waiting (Self_Id.Entry_Queues (E));
1064 STPO.Unlock (Self_Id);
1070 Initialization.Undefer_Abort (Self_Id);
1072 -- Call Yield to let other tasks get a chance to run as this is a
1073 -- potential dispatching point.
1075 Yield (Do_Yield => False);
1076 return Return_Count;
1079 ----------------------
1080 -- Task_Do_Or_Queue --
1081 ----------------------
1083 function Task_Do_Or_Queue
1085 Entry_Call : Entry_Call_Link) return Boolean
1087 E : constant Task_Entry_Index :=
1088 Task_Entry_Index (Entry_Call.E);
1089 Old_State : constant Entry_Call_State := Entry_Call.State;
1090 Acceptor : constant Task_Id := Entry_Call.Called_Task;
1091 Parent : constant Task_Id := Acceptor.Common.Parent;
1092 Null_Body : Boolean;
1095 -- Find out whether Entry_Call can be accepted immediately
1097 -- If the Acceptor is not callable, return False.
1098 -- If the rendezvous can start, initiate it.
1099 -- If the accept-body is trivial, also complete the rendezvous.
1100 -- If the acceptor is not ready, enqueue the call.
1102 -- This should have a special case for Accept_Call and Accept_Trivial,
1103 -- so that we don't have the loop setup overhead, below.
1105 -- The call state Done is used here and elsewhere to include both the
1106 -- case of normal successful completion, and the case of an exception
1107 -- being raised. The difference is that if an exception is raised no one
1108 -- will pay attention to the fact that State = Done. Instead the
1109 -- exception will be raised in Undefer_Abort, and control will skip past
1110 -- the place where we normally would resume from an entry call.
1112 pragma Assert (not Queuing.Onqueue (Entry_Call));
1114 -- We rely that the call is off-queue for protection, that the caller
1115 -- will not exit the Entry_Caller_Sleep, and so will not reuse the call
1116 -- record for another call. We rely on the Caller's lock for call State
1119 -- If Acceptor.Terminate_Alternative is True, we need to lock Parent and
1120 -- Acceptor, in that order; otherwise, we only need a lock on Acceptor.
1121 -- However, we can't check Acceptor.Terminate_Alternative until Acceptor
1122 -- is locked. Therefore, we need to lock both. Attempts to avoid locking
1123 -- Parent tend to result in race conditions. It would work to unlock
1124 -- Parent immediately upon finding Acceptor.Terminate_Alternative to be
1125 -- False, but that violates the rule of properly nested locking (see
1128 STPO.Write_Lock (Parent);
1129 STPO.Write_Lock (Acceptor);
1131 -- If the acceptor is not callable, abort the call and return False
1133 if not Acceptor.Callable then
1134 STPO.Unlock (Acceptor);
1135 STPO.Unlock (Parent);
1137 pragma Assert (Entry_Call.State < Done);
1139 -- In case we are not the caller, set up the caller
1140 -- to raise Tasking_Error when it wakes up.
1142 STPO.Write_Lock (Entry_Call.Self);
1143 Entry_Call.Exception_To_Raise := Tasking_Error'Identity;
1144 Initialization.Wakeup_Entry_Caller (Self_ID, Entry_Call, Done);
1145 STPO.Unlock (Entry_Call.Self);
1150 -- Try to serve the call immediately
1152 if Acceptor.Open_Accepts /= null then
1153 for J in Acceptor.Open_Accepts'Range loop
1154 if Entry_Call.E = Entry_Index (Acceptor.Open_Accepts (J).S) then
1156 -- Commit acceptor to rendezvous with us
1158 Acceptor.Chosen_Index := J;
1159 Null_Body := Acceptor.Open_Accepts (J).Null_Body;
1160 Acceptor.Open_Accepts := null;
1162 -- Prevent abort while call is being served
1164 if Entry_Call.State = Now_Abortable then
1165 Entry_Call.State := Was_Abortable;
1168 if Acceptor.Terminate_Alternative then
1170 -- Cancel terminate alternative. See matching code in
1171 -- Selective_Wait and Vulnerable_Complete_Master.
1173 Acceptor.Terminate_Alternative := False;
1174 Acceptor.Awake_Count := Acceptor.Awake_Count + 1;
1176 if Acceptor.Awake_Count = 1 then
1178 -- Notify parent that acceptor is awake
1180 pragma Assert (Parent.Awake_Count > 0);
1182 Parent.Awake_Count := Parent.Awake_Count + 1;
1184 if Parent.Common.State = Master_Completion_Sleep
1185 and then Acceptor.Master_of_Task = Parent.Master_Within
1187 Parent.Common.Wait_Count :=
1188 Parent.Common.Wait_Count + 1;
1195 -- Rendezvous is over immediately
1197 STPO.Wakeup (Acceptor, Acceptor_Sleep);
1198 STPO.Unlock (Acceptor);
1199 STPO.Unlock (Parent);
1201 STPO.Write_Lock (Entry_Call.Self);
1202 Initialization.Wakeup_Entry_Caller
1203 (Self_ID, Entry_Call, Done);
1204 STPO.Unlock (Entry_Call.Self);
1207 Setup_For_Rendezvous_With_Body (Entry_Call, Acceptor);
1209 -- For terminate_alternative, acceptor may not be asleep
1210 -- yet, so we skip the wakeup
1212 if Acceptor.Common.State /= Runnable then
1213 STPO.Wakeup (Acceptor, Acceptor_Sleep);
1216 STPO.Unlock (Acceptor);
1217 STPO.Unlock (Parent);
1224 -- The acceptor is accepting, but not this entry
1227 -- If the acceptor was ready to accept this call,
1228 -- we would not have gotten this far, so now we should
1229 -- (re)enqueue the call, if the mode permits that.
1231 -- If the call is timed, it may have timed out before the requeue,
1232 -- in the unusual case where the current accept has taken longer than
1233 -- the given delay. In that case the requeue is cancelled, and the
1234 -- outer timed call will be aborted.
1236 if Entry_Call.Mode = Conditional_Call
1238 (Entry_Call.Mode = Timed_Call
1239 and then Entry_Call.With_Abort
1240 and then Entry_Call.Cancellation_Attempted)
1242 STPO.Unlock (Acceptor);
1243 STPO.Unlock (Parent);
1245 STPO.Write_Lock (Entry_Call.Self);
1247 pragma Assert (Entry_Call.State >= Was_Abortable);
1249 Initialization.Wakeup_Entry_Caller (Self_ID, Entry_Call, Cancelled);
1250 STPO.Unlock (Entry_Call.Self);
1253 -- Timed_Call, Simple_Call, or Asynchronous_Call
1255 Queuing.Enqueue (Acceptor.Entry_Queues (E), Entry_Call);
1257 -- Update abortability of call
1259 pragma Assert (Old_State < Done);
1262 New_State (Entry_Call.With_Abort, Entry_Call.State);
1264 STPO.Unlock (Acceptor);
1265 STPO.Unlock (Parent);
1267 if Old_State /= Entry_Call.State
1268 and then Entry_Call.State = Now_Abortable
1269 and then Entry_Call.Mode /= Simple_Call
1270 and then Entry_Call.Self /= Self_ID
1272 -- Asynchronous_Call or Conditional_Call
1275 -- Because of ATCB lock ordering rule
1277 STPO.Write_Lock (Entry_Call.Self);
1279 if Entry_Call.Self.Common.State = Async_Select_Sleep then
1281 -- Caller may not yet have reached wait-point
1283 STPO.Wakeup (Entry_Call.Self, Async_Select_Sleep);
1286 STPO.Unlock (Entry_Call.Self);
1291 end Task_Do_Or_Queue;
1293 ---------------------
1294 -- Task_Entry_Call --
1295 ---------------------
1297 procedure Task_Entry_Call
1298 (Acceptor : Task_Id;
1299 E : Task_Entry_Index;
1300 Uninterpreted_Data : System.Address;
1302 Rendezvous_Successful : out Boolean)
1304 Self_Id : constant Task_Id := STPO.Self;
1305 Entry_Call : Entry_Call_Link;
1308 -- If pragma Detect_Blocking is active then Program_Error must be
1309 -- raised if this potentially blocking operation is called from a
1310 -- protected action.
1312 if System.Tasking.Detect_Blocking
1313 and then Self_Id.Common.Protected_Action_Nesting > 0
1315 raise Program_Error with "potentially blocking operation";
1318 if Parameters.Runtime_Traces then
1319 Send_Trace_Info (W_Call, Acceptor, Entry_Index (E));
1322 if Mode = Simple_Call or else Mode = Conditional_Call then
1324 (Acceptor, E, Uninterpreted_Data, Mode, Rendezvous_Successful);
1327 -- This is an asynchronous call
1329 -- Abort must already be deferred by the compiler-generated code.
1330 -- Without this, an abort that occurs between the time that this
1331 -- call is made and the time that the abortable part's cleanup
1332 -- handler is set up might miss the cleanup handler and leave the
1335 Self_Id.ATC_Nesting_Level := Self_Id.ATC_Nesting_Level + 1;
1337 (Debug.Trace (Self_Id, "TEC: entered ATC level: " &
1338 ATC_Level'Image (Self_Id.ATC_Nesting_Level), 'A'));
1339 Entry_Call := Self_Id.Entry_Calls (Self_Id.ATC_Nesting_Level)'Access;
1340 Entry_Call.Next := null;
1341 Entry_Call.Mode := Mode;
1342 Entry_Call.Cancellation_Attempted := False;
1343 Entry_Call.State := Not_Yet_Abortable;
1344 Entry_Call.E := Entry_Index (E);
1345 Entry_Call.Prio := Get_Priority (Self_Id);
1346 Entry_Call.Uninterpreted_Data := Uninterpreted_Data;
1347 Entry_Call.Called_Task := Acceptor;
1348 Entry_Call.Called_PO := Null_Address;
1349 Entry_Call.Exception_To_Raise := Ada.Exceptions.Null_Id;
1350 Entry_Call.With_Abort := True;
1356 if not Task_Do_Or_Queue (Self_Id, Entry_Call) then
1357 STPO.Write_Lock (Self_Id);
1358 Utilities.Exit_One_ATC_Level (Self_Id);
1359 STPO.Unlock (Self_Id);
1365 Initialization.Undefer_Abort (Self_Id);
1367 if Parameters.Runtime_Traces then
1368 Send_Trace_Info (E_Missed, Acceptor);
1371 raise Tasking_Error;
1374 -- The following is special for async. entry calls. If the call was
1375 -- not queued abortably, we need to wait until it is before
1376 -- proceeding with the abortable part.
1378 -- Wait_Until_Abortable can be called unconditionally here, but it is
1381 if Entry_Call.State < Was_Abortable then
1382 Entry_Calls.Wait_Until_Abortable (Self_Id, Entry_Call);
1389 -- Note: following assignment needs to be atomic
1391 Rendezvous_Successful := Entry_Call.State = Done;
1393 end Task_Entry_Call;
1395 -----------------------
1396 -- Task_Entry_Caller --
1397 -----------------------
1399 function Task_Entry_Caller (D : Task_Entry_Nesting_Depth) return Task_Id is
1400 Self_Id : constant Task_Id := STPO.Self;
1401 Entry_Call : Entry_Call_Link;
1404 Entry_Call := Self_Id.Common.Call;
1406 for Depth in 1 .. D loop
1407 Entry_Call := Entry_Call.Acceptor_Prev_Call;
1408 pragma Assert (Entry_Call /= null);
1411 return Entry_Call.Self;
1412 end Task_Entry_Caller;
1414 --------------------------
1415 -- Timed_Selective_Wait --
1416 --------------------------
1418 procedure Timed_Selective_Wait
1419 (Open_Accepts : Accept_List_Access;
1420 Select_Mode : Select_Modes;
1421 Uninterpreted_Data : out System.Address;
1424 Index : out Select_Index)
1426 Self_Id : constant Task_Id := STPO.Self;
1427 Treatment : Select_Treatment;
1428 Entry_Call : Entry_Call_Link;
1430 Selection : Select_Index;
1431 Open_Alternative : Boolean;
1432 Timedout : Boolean := False;
1433 Yielded : Boolean := True;
1436 pragma Assert (Select_Mode = Delay_Mode);
1438 Initialization.Defer_Abort (Self_Id);
1440 -- If we are aborted here, the effect will be pending
1446 STPO.Write_Lock (Self_Id);
1448 if not Self_Id.Callable then
1449 pragma Assert (Self_Id.Pending_ATC_Level = 0);
1451 pragma Assert (Self_Id.Pending_Action);
1453 STPO.Unlock (Self_Id);
1459 Initialization.Undefer_Abort (Self_Id);
1461 -- Should never get here ???
1463 pragma Assert (False);
1464 raise Standard'Abort_Signal;
1467 Uninterpreted_Data := Null_Address;
1469 pragma Assert (Open_Accepts /= null);
1471 Queuing.Select_Task_Entry_Call
1472 (Self_Id, Open_Accepts, Entry_Call, Selection, Open_Alternative);
1474 -- Determine the kind and disposition of the select
1476 Treatment := Default_Treatment (Select_Mode);
1477 Self_Id.Chosen_Index := No_Rendezvous;
1479 if Open_Alternative then
1480 if Entry_Call /= null then
1481 if Open_Accepts (Selection).Null_Body then
1482 Treatment := Accept_Alternative_Completed;
1485 Setup_For_Rendezvous_With_Body (Entry_Call, Self_Id);
1486 Treatment := Accept_Alternative_Selected;
1489 Self_Id.Chosen_Index := Selection;
1491 elsif Treatment = No_Alternative_Open then
1492 Treatment := Accept_Alternative_Open;
1496 -- Handle the select according to the disposition selected above
1499 when Accept_Alternative_Selected =>
1501 -- Ready to rendezvous. In this case the accept body is not
1502 -- Null_Body. Defer abort until it gets into the accept body.
1504 Uninterpreted_Data := Self_Id.Common.Call.Uninterpreted_Data;
1505 Initialization.Defer_Abort_Nestable (Self_Id);
1506 STPO.Unlock (Self_Id);
1508 when Accept_Alternative_Completed =>
1510 -- Rendezvous is over
1512 if Parameters.Runtime_Traces then
1513 Send_Trace_Info (M_RDV_Complete, Entry_Call.Self);
1516 STPO.Unlock (Self_Id);
1517 Caller := Entry_Call.Self;
1519 STPO.Write_Lock (Caller);
1520 Initialization.Wakeup_Entry_Caller (Self_Id, Entry_Call, Done);
1521 STPO.Unlock (Caller);
1523 when Accept_Alternative_Open =>
1527 Self_Id.Open_Accepts := Open_Accepts;
1529 -- Wait for a normal call and a pending action until the
1530 -- Wakeup_Time is reached.
1532 Self_Id.Common.State := Acceptor_Delay_Sleep;
1534 -- Try to remove calls to Sleep in the loop below by letting the
1535 -- caller a chance of getting ready immediately, using Unlock
1536 -- Yield. See similar action in Wait_For_Completion/Wait_For_Call.
1544 if Self_Id.Open_Accepts /= null then
1551 Write_Lock (Self_Id);
1554 -- Check if this task has been aborted while the lock was released
1556 if Self_Id.Pending_ATC_Level < Self_Id.ATC_Nesting_Level then
1557 Self_Id.Open_Accepts := null;
1561 exit when Self_Id.Open_Accepts = null;
1564 Sleep (Self_Id, Acceptor_Delay_Sleep);
1566 if Parameters.Runtime_Traces then
1567 Send_Trace_Info (WT_Select,
1569 Integer (Open_Accepts'Length),
1573 STPO.Timed_Sleep (Self_Id, Timeout, Mode,
1574 Acceptor_Delay_Sleep, Timedout, Yielded);
1578 Self_Id.Open_Accepts := null;
1580 if Parameters.Runtime_Traces then
1581 Send_Trace_Info (E_Timeout);
1586 Self_Id.Common.State := Runnable;
1588 -- Self_Id.Common.Call should already be updated by the Caller if
1589 -- not aborted. It might also be ready to do rendezvous even if
1590 -- this wakes up due to an abort. Therefore, if the call is not
1591 -- empty we need to do the rendezvous if the accept body is not
1594 if Self_Id.Chosen_Index /= No_Rendezvous
1595 and then Self_Id.Common.Call /= null
1596 and then not Open_Accepts (Self_Id.Chosen_Index).Null_Body
1598 Uninterpreted_Data := Self_Id.Common.Call.Uninterpreted_Data;
1600 pragma Assert (Self_Id.Deferral_Level = 1);
1602 Initialization.Defer_Abort_Nestable (Self_Id);
1604 -- Leave abort deferred until the accept body
1607 STPO.Unlock (Self_Id);
1609 when No_Alternative_Open =>
1611 -- In this case, Index will be No_Rendezvous on return. We sleep
1612 -- for the time we need to.
1614 -- Wait for a signal or timeout. A wakeup can be made
1615 -- for several reasons:
1616 -- 1) Delay is expired
1617 -- 2) Pending_Action needs to be checked
1618 -- (Abort, Priority change)
1619 -- 3) Spurious wakeup
1621 Self_Id.Open_Accepts := null;
1622 Self_Id.Common.State := Acceptor_Delay_Sleep;
1624 STPO.Timed_Sleep (Self_Id, Timeout, Mode, Acceptor_Delay_Sleep,
1627 Self_Id.Common.State := Runnable;
1629 STPO.Unlock (Self_Id);
1633 -- Should never get here
1635 pragma Assert (False);
1647 -- Caller has been chosen
1649 -- Self_Id.Common.Call should already be updated by the Caller
1651 -- Self_Id.Chosen_Index should either be updated by the Caller
1652 -- or by Test_Selective_Wait
1654 Index := Self_Id.Chosen_Index;
1655 Initialization.Undefer_Abort_Nestable (Self_Id);
1657 -- Start rendezvous, if not already completed
1658 end Timed_Selective_Wait;
1660 ---------------------------
1661 -- Timed_Task_Entry_Call --
1662 ---------------------------
1664 procedure Timed_Task_Entry_Call
1665 (Acceptor : Task_Id;
1666 E : Task_Entry_Index;
1667 Uninterpreted_Data : System.Address;
1670 Rendezvous_Successful : out Boolean)
1672 Self_Id : constant Task_Id := STPO.Self;
1674 Entry_Call : Entry_Call_Link;
1677 pragma Unreferenced (Yielded);
1680 -- If pragma Detect_Blocking is active then Program_Error must be
1681 -- raised if this potentially blocking operation is called from a
1682 -- protected action.
1684 if System.Tasking.Detect_Blocking
1685 and then Self_Id.Common.Protected_Action_Nesting > 0
1687 raise Program_Error with "potentially blocking operation";
1690 Initialization.Defer_Abort (Self_Id);
1691 Self_Id.ATC_Nesting_Level := Self_Id.ATC_Nesting_Level + 1;
1694 (Debug.Trace (Self_Id, "TTEC: entered ATC level: " &
1695 ATC_Level'Image (Self_Id.ATC_Nesting_Level), 'A'));
1697 if Parameters.Runtime_Traces then
1698 Send_Trace_Info (WT_Call, Acceptor,
1699 Entry_Index (E), Timeout);
1702 Level := Self_Id.ATC_Nesting_Level;
1703 Entry_Call := Self_Id.Entry_Calls (Level)'Access;
1704 Entry_Call.Next := null;
1705 Entry_Call.Mode := Timed_Call;
1706 Entry_Call.Cancellation_Attempted := False;
1708 -- If this is a call made inside of an abort deferred region,
1709 -- the call should be never abortable.
1712 (if Self_Id.Deferral_Level > 1
1713 then Never_Abortable
1714 else Now_Abortable);
1716 Entry_Call.E := Entry_Index (E);
1717 Entry_Call.Prio := Get_Priority (Self_Id);
1718 Entry_Call.Uninterpreted_Data := Uninterpreted_Data;
1719 Entry_Call.Called_Task := Acceptor;
1720 Entry_Call.Called_PO := Null_Address;
1721 Entry_Call.Exception_To_Raise := Ada.Exceptions.Null_Id;
1722 Entry_Call.With_Abort := True;
1724 -- Note: the caller will undefer abort on return (see WARNING above)
1730 if not Task_Do_Or_Queue (Self_Id, Entry_Call) then
1731 STPO.Write_Lock (Self_Id);
1732 Utilities.Exit_One_ATC_Level (Self_Id);
1733 STPO.Unlock (Self_Id);
1739 Initialization.Undefer_Abort (Self_Id);
1741 if Parameters.Runtime_Traces then
1742 Send_Trace_Info (E_Missed, Acceptor);
1744 raise Tasking_Error;
1747 Write_Lock (Self_Id);
1748 Entry_Calls.Wait_For_Completion_With_Timeout
1749 (Entry_Call, Timeout, Mode, Yielded);
1756 -- ??? Do we need to yield in case Yielded is False
1758 Rendezvous_Successful := Entry_Call.State = Done;
1759 Initialization.Undefer_Abort (Self_Id);
1760 Entry_Calls.Check_Exception (Self_Id, Entry_Call);
1761 end Timed_Task_Entry_Call;
1767 procedure Wait_For_Call (Self_Id : Task_Id) is
1769 Self_Id.Common.State := Acceptor_Sleep;
1771 -- Try to remove calls to Sleep in the loop below by letting the caller
1772 -- a chance of getting ready immediately, using Unlock & Yield.
1773 -- See similar action in Wait_For_Completion & Timed_Selective_Wait.
1781 if Self_Id.Open_Accepts /= null then
1788 Write_Lock (Self_Id);
1791 -- Check if this task has been aborted while the lock was released
1793 if Self_Id.Pending_ATC_Level < Self_Id.ATC_Nesting_Level then
1794 Self_Id.Open_Accepts := null;
1798 exit when Self_Id.Open_Accepts = null;
1799 Sleep (Self_Id, Acceptor_Sleep);
1802 Self_Id.Common.State := Runnable;
1805 end System.Tasking.Rendezvous;