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