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