]>
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 . U T I L I T I E S -- | |
6 | -- -- | |
7 | -- B o d y -- | |
8 | -- -- | |
07fc65c4 | 9 | -- Copyright (C) 1992-2002, 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 | ||
34 | -- This package provides RTS Internal Declarations. | |
35 | -- These declarations are not part of the GNARLI | |
36 | ||
37 | pragma Polling (Off); | |
38 | -- Turn off polling, we do not want ATC polling to take place during | |
39 | -- tasking operations. It causes infinite loops and other problems. | |
40 | ||
41 | with System.Tasking.Debug; | |
42 | -- used for Known_Tasks | |
43 | ||
44 | with System.Task_Primitives.Operations; | |
45 | -- used for Write_Lock | |
46 | -- Set_Priority | |
47 | -- Wakeup | |
48 | -- Unlock | |
49 | -- Sleep | |
50 | -- Abort_Task | |
07fc65c4 | 51 | -- Lock/Unlock_RTS |
cacbc350 RK |
52 | |
53 | with System.Tasking.Initialization; | |
54 | -- Used for Defer_Abort | |
55 | -- Undefer_Abort | |
56 | -- Locked_Abort_To_Level | |
57 | ||
58 | with System.Tasking.Queuing; | |
59 | -- used for Dequeue_Call | |
60 | -- Dequeue_Head | |
61 | ||
62 | with System.Tasking.Debug; | |
63 | -- used for Trace | |
64 | ||
07fc65c4 GB |
65 | with System.Parameters; |
66 | -- used for Single_Lock | |
67 | -- Runtime_Traces | |
68 | ||
69 | with System.Traces.Tasking; | |
70 | -- used for Send_Trace_Info | |
71 | ||
cacbc350 RK |
72 | with Unchecked_Conversion; |
73 | ||
74 | package body System.Tasking.Utilities is | |
75 | ||
76 | package STPO renames System.Task_Primitives.Operations; | |
77 | ||
07fc65c4 GB |
78 | use Parameters; |
79 | use Tasking.Debug; | |
80 | use Task_Primitives; | |
81 | use Task_Primitives.Operations; | |
cacbc350 | 82 | |
07fc65c4 GB |
83 | use System.Traces; |
84 | use System.Traces.Tasking; | |
cacbc350 | 85 | |
07fc65c4 GB |
86 | -------------------- |
87 | -- Abort_One_Task -- | |
88 | -------------------- | |
cacbc350 RK |
89 | |
90 | -- Similar to Locked_Abort_To_Level (Self_ID, T, 0), but: | |
07fc65c4 | 91 | -- (1) caller should be holding no locks except RTS_Lock when Single_Lock |
cacbc350 RK |
92 | -- (2) may be called for tasks that have not yet been activated |
93 | -- (3) always aborts whole task | |
94 | ||
07fc65c4 | 95 | procedure Abort_One_Task (Self_ID : Task_ID; T : Task_ID) is |
cacbc350 | 96 | begin |
07fc65c4 GB |
97 | if Parameters.Runtime_Traces then |
98 | Send_Trace_Info (T_Abort, Self_ID, T); | |
99 | end if; | |
100 | ||
cacbc350 RK |
101 | Write_Lock (T); |
102 | ||
103 | if T.Common.State = Unactivated then | |
104 | T.Common.Activator := null; | |
105 | T.Common.State := Terminated; | |
106 | T.Callable := False; | |
107 | Cancel_Queued_Entry_Calls (T); | |
108 | ||
109 | elsif T.Common.State /= Terminated then | |
07fc65c4 | 110 | Initialization.Locked_Abort_To_Level (Self_ID, T, 0); |
cacbc350 RK |
111 | end if; |
112 | ||
113 | Unlock (T); | |
114 | end Abort_One_Task; | |
115 | ||
116 | ----------------- | |
117 | -- Abort_Tasks -- | |
118 | ----------------- | |
119 | ||
120 | -- Compiler interface only: Do not call from within the RTS, | |
121 | ||
122 | -- except in the implementation of Ada.Task_Identification. | |
123 | -- This must be called to implement the abort statement. | |
124 | -- Much of the actual work of the abort is done by the abortee, | |
125 | -- via the Abort_Handler signal handler, and propagation of the | |
126 | -- Abort_Signal special exception. | |
127 | ||
128 | procedure Abort_Tasks (Tasks : Task_List) is | |
129 | Self_Id : constant Task_ID := STPO.Self; | |
130 | C : Task_ID; | |
131 | P : Task_ID; | |
132 | ||
133 | begin | |
07fc65c4 | 134 | Initialization.Defer_Abort_Nestable (Self_Id); |
cacbc350 RK |
135 | |
136 | -- ????? | |
137 | -- Really should not be nested deferral here. | |
138 | -- Patch for code generation error that defers abort before | |
139 | -- evaluating parameters of an entry call (at least, timed entry | |
140 | -- calls), and so may propagate an exception that causes abort | |
07fc65c4 | 141 | -- to remain undeferred indefinitely. See C97404B. When all |
cacbc350 RK |
142 | -- such bugs are fixed, this patch can be removed. |
143 | ||
07fc65c4 GB |
144 | Lock_RTS; |
145 | ||
cacbc350 RK |
146 | for J in Tasks'Range loop |
147 | C := Tasks (J); | |
148 | Abort_One_Task (Self_Id, C); | |
149 | end loop; | |
150 | ||
cacbc350 RK |
151 | C := All_Tasks_List; |
152 | ||
153 | while C /= null loop | |
154 | if C.Pending_ATC_Level > 0 then | |
155 | P := C.Common.Parent; | |
156 | ||
157 | while P /= null loop | |
158 | if P.Pending_ATC_Level = 0 then | |
159 | Abort_One_Task (Self_Id, C); | |
160 | exit; | |
161 | end if; | |
162 | ||
163 | P := P.Common.Parent; | |
164 | end loop; | |
165 | end if; | |
166 | ||
167 | C := C.Common.All_Tasks_Link; | |
168 | end loop; | |
169 | ||
07fc65c4 GB |
170 | Unlock_RTS; |
171 | Initialization.Undefer_Abort_Nestable (Self_Id); | |
cacbc350 RK |
172 | end Abort_Tasks; |
173 | ||
174 | ------------------------------- | |
175 | -- Cancel_Queued_Entry_Calls -- | |
176 | ------------------------------- | |
177 | ||
07fc65c4 GB |
178 | -- This should only be called by T, unless T is a terminated previously |
179 | -- unactivated task. | |
cacbc350 RK |
180 | |
181 | procedure Cancel_Queued_Entry_Calls (T : Task_ID) is | |
182 | Next_Entry_Call : Entry_Call_Link; | |
183 | Entry_Call : Entry_Call_Link; | |
cacbc350 RK |
184 | Self_Id : constant Task_ID := STPO.Self; |
185 | ||
fbf5a39b AC |
186 | Caller : Task_ID; |
187 | pragma Unreferenced (Caller); | |
188 | -- Should this be removed ??? | |
189 | ||
190 | Level : Integer; | |
191 | pragma Unreferenced (Level); | |
192 | -- Should this be removed ??? | |
193 | ||
cacbc350 RK |
194 | begin |
195 | pragma Assert (T = Self or else T.Common.State = Terminated); | |
196 | ||
197 | for J in 1 .. T.Entry_Num loop | |
198 | Queuing.Dequeue_Head (T.Entry_Queues (J), Entry_Call); | |
199 | ||
200 | while Entry_Call /= null loop | |
fbf5a39b | 201 | |
cacbc350 RK |
202 | -- Leave Entry_Call.Done = False, since this is cancelled |
203 | ||
204 | Caller := Entry_Call.Self; | |
205 | Entry_Call.Exception_To_Raise := Tasking_Error'Identity; | |
206 | Queuing.Dequeue_Head (T.Entry_Queues (J), Next_Entry_Call); | |
207 | Level := Entry_Call.Level - 1; | |
208 | Unlock (T); | |
209 | Write_Lock (Entry_Call.Self); | |
07fc65c4 GB |
210 | Initialization.Wakeup_Entry_Caller |
211 | (Self_Id, Entry_Call, Cancelled); | |
cacbc350 RK |
212 | Unlock (Entry_Call.Self); |
213 | Write_Lock (T); | |
214 | Entry_Call.State := Done; | |
215 | Entry_Call := Next_Entry_Call; | |
216 | end loop; | |
217 | end loop; | |
218 | end Cancel_Queued_Entry_Calls; | |
219 | ||
220 | ------------------------ | |
221 | -- Exit_One_ATC_Level -- | |
222 | ------------------------ | |
223 | ||
224 | -- Call only with abort deferred and holding lock of Self_Id. | |
225 | -- This is a bit of common code for all entry calls. | |
226 | -- The effect is to exit one level of ATC nesting. | |
227 | ||
228 | -- If we have reached the desired ATC nesting level, reset the | |
229 | -- requested level to effective infinity, to allow further calls. | |
230 | -- In any case, reset Self_Id.Aborting, to allow re-raising of | |
231 | -- Abort_Signal. | |
232 | ||
233 | procedure Exit_One_ATC_Level (Self_ID : Task_ID) is | |
234 | begin | |
235 | Self_ID.ATC_Nesting_Level := Self_ID.ATC_Nesting_Level - 1; | |
236 | ||
237 | pragma Debug | |
238 | (Debug.Trace (Self_ID, "EOAL: exited to ATC level: " & | |
239 | ATC_Level'Image (Self_ID.ATC_Nesting_Level), 'A')); | |
240 | ||
241 | pragma Assert (Self_ID.ATC_Nesting_Level >= 1); | |
242 | ||
243 | if Self_ID.Pending_ATC_Level < ATC_Level_Infinity then | |
244 | if Self_ID.Pending_ATC_Level = Self_ID.ATC_Nesting_Level then | |
245 | Self_ID.Pending_ATC_Level := ATC_Level_Infinity; | |
246 | Self_ID.Aborting := False; | |
247 | else | |
248 | -- Force the next Undefer_Abort to re-raise Abort_Signal | |
249 | ||
250 | pragma Assert | |
251 | (Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level); | |
252 | ||
253 | if Self_ID.Aborting then | |
254 | Self_ID.ATC_Hack := True; | |
255 | Self_ID.Pending_Action := True; | |
256 | end if; | |
257 | end if; | |
258 | end if; | |
259 | end Exit_One_ATC_Level; | |
260 | ||
261 | ---------------------- | |
262 | -- Make_Independent -- | |
263 | ---------------------- | |
264 | ||
cacbc350 RK |
265 | procedure Make_Independent is |
266 | Self_Id : constant Task_ID := STPO.Self; | |
267 | Environment_Task : constant Task_ID := STPO.Environment_Task; | |
268 | Parent : constant Task_ID := Self_Id.Common.Parent; | |
269 | Parent_Needs_Updating : Boolean := False; | |
fbf5a39b | 270 | Master_of_Task : Integer; |
cacbc350 RK |
271 | |
272 | begin | |
273 | if Self_Id.Known_Tasks_Index /= -1 then | |
274 | Known_Tasks (Self_Id.Known_Tasks_Index) := null; | |
275 | end if; | |
276 | ||
07fc65c4 GB |
277 | Initialization.Defer_Abort (Self_Id); |
278 | ||
279 | if Single_Lock then | |
280 | Lock_RTS; | |
281 | end if; | |
282 | ||
cacbc350 RK |
283 | Write_Lock (Environment_Task); |
284 | Write_Lock (Self_Id); | |
285 | ||
286 | pragma Assert (Parent = Environment_Task | |
287 | or else Self_Id.Master_of_Task = Library_Task_Level); | |
288 | ||
fbf5a39b | 289 | Master_of_Task := Self_Id.Master_of_Task; |
cacbc350 RK |
290 | Self_Id.Master_of_Task := Independent_Task_Level; |
291 | ||
292 | -- The run time assumes that the parent of an independent task is the | |
293 | -- environment task. | |
294 | ||
295 | if Parent /= Environment_Task then | |
296 | ||
297 | -- We can not lock three tasks at the same time, so defer the | |
298 | -- operations on the parent. | |
299 | ||
300 | Parent_Needs_Updating := True; | |
301 | Self_Id.Common.Parent := Environment_Task; | |
302 | end if; | |
303 | ||
304 | -- Update Independent_Task_Count that is needed for the GLADE | |
305 | -- termination rule. See also pending update in | |
306 | -- System.Tasking.Stages.Check_Independent | |
307 | ||
308 | Independent_Task_Count := Independent_Task_Count + 1; | |
309 | ||
310 | Unlock (Self_Id); | |
311 | ||
312 | -- Changing the parent after creation is not trivial. Do not forget | |
313 | -- to update the old parent counts, and the new parent (i.e. the | |
314 | -- Environment_Task) counts. | |
315 | ||
316 | if Parent_Needs_Updating then | |
317 | Write_Lock (Parent); | |
318 | Parent.Awake_Count := Parent.Awake_Count - 1; | |
319 | Parent.Alive_Count := Parent.Alive_Count - 1; | |
320 | Environment_Task.Awake_Count := Environment_Task.Awake_Count + 1; | |
321 | Environment_Task.Alive_Count := Environment_Task.Alive_Count + 1; | |
322 | Unlock (Parent); | |
323 | end if; | |
324 | ||
fbf5a39b AC |
325 | -- In case the environment task is already waiting for children to |
326 | -- complete. | |
327 | -- ??? There may be a race condition if the environment task was not in | |
328 | -- master completion sleep when this task was created, but now is | |
329 | ||
330 | if Environment_Task.Common.State = Master_Completion_Sleep and then | |
331 | Master_of_Task = Environment_Task.Master_Within | |
332 | then | |
333 | Environment_Task.Common.Wait_Count := | |
334 | Environment_Task.Common.Wait_Count - 1; | |
335 | end if; | |
336 | ||
cacbc350 | 337 | Unlock (Environment_Task); |
07fc65c4 GB |
338 | |
339 | if Single_Lock then | |
340 | Unlock_RTS; | |
341 | end if; | |
342 | ||
343 | Initialization.Undefer_Abort (Self_Id); | |
cacbc350 RK |
344 | end Make_Independent; |
345 | ||
346 | ------------------ | |
347 | -- Make_Passive -- | |
348 | ------------------ | |
349 | ||
07fc65c4 | 350 | procedure Make_Passive (Self_ID : Task_ID; Task_Completed : Boolean) is |
cacbc350 RK |
351 | C : Task_ID := Self_ID; |
352 | P : Task_ID := C.Common.Parent; | |
353 | ||
354 | Master_Completion_Phase : Integer; | |
355 | ||
356 | begin | |
357 | if P /= null then | |
358 | Write_Lock (P); | |
359 | end if; | |
360 | ||
361 | Write_Lock (C); | |
362 | ||
363 | if Task_Completed then | |
364 | Self_ID.Common.State := Terminated; | |
365 | ||
366 | if Self_ID.Awake_Count = 0 then | |
367 | ||
368 | -- We are completing via a terminate alternative. | |
369 | -- Our parent should wait in Phase 2 of Complete_Master. | |
370 | ||
371 | Master_Completion_Phase := 2; | |
372 | ||
373 | pragma Assert (Task_Completed); | |
374 | pragma Assert (Self_ID.Terminate_Alternative); | |
375 | pragma Assert (Self_ID.Alive_Count = 1); | |
376 | ||
377 | else | |
378 | -- We are NOT on a terminate alternative. | |
379 | -- Our parent should wait in Phase 1 of Complete_Master. | |
380 | ||
381 | Master_Completion_Phase := 1; | |
382 | pragma Assert (Self_ID.Awake_Count = 1); | |
383 | end if; | |
384 | ||
385 | -- We are accepting with a terminate alternative. | |
386 | ||
387 | else | |
388 | if Self_ID.Open_Accepts = null then | |
389 | ||
390 | -- Somebody started a rendezvous while we had our lock open. | |
391 | -- Skip the terminate alternative. | |
392 | ||
393 | Unlock (C); | |
394 | ||
395 | if P /= null then | |
396 | Unlock (P); | |
397 | end if; | |
398 | ||
399 | return; | |
400 | end if; | |
401 | ||
402 | Self_ID.Terminate_Alternative := True; | |
403 | Master_Completion_Phase := 0; | |
404 | ||
405 | pragma Assert (Self_ID.Terminate_Alternative); | |
406 | pragma Assert (Self_ID.Awake_Count >= 1); | |
407 | end if; | |
408 | ||
409 | if Master_Completion_Phase = 2 then | |
410 | ||
411 | -- Since our Awake_Count is zero but our Alive_Count | |
412 | -- is nonzero, we have been accepting with a terminate | |
413 | -- alternative, and we now have been told to terminate | |
414 | -- by a completed master (in some ancestor task) that | |
415 | -- is waiting (with zero Awake_Count) in Phase 2 of | |
416 | -- Complete_Master. | |
417 | ||
07fc65c4 | 418 | pragma Debug (Debug.Trace (Self_ID, "Make_Passive: Phase 2", 'M')); |
cacbc350 RK |
419 | |
420 | pragma Assert (P /= null); | |
421 | ||
422 | C.Alive_Count := C.Alive_Count - 1; | |
423 | ||
424 | if C.Alive_Count > 0 then | |
425 | Unlock (C); | |
426 | Unlock (P); | |
427 | return; | |
428 | end if; | |
429 | ||
430 | -- C's count just went to zero, indicating that | |
431 | -- all of C's dependents are terminated. | |
432 | -- C has a parent, P. | |
433 | ||
434 | loop | |
435 | -- C's count just went to zero, indicating that all of C's | |
436 | -- dependents are terminated. C has a parent, P. Notify P that | |
437 | -- C and its dependents have all terminated. | |
438 | ||
439 | P.Alive_Count := P.Alive_Count - 1; | |
440 | exit when P.Alive_Count > 0; | |
441 | Unlock (C); | |
442 | Unlock (P); | |
443 | C := P; | |
444 | P := C.Common.Parent; | |
445 | ||
446 | -- Environment task cannot have terminated yet | |
447 | ||
448 | pragma Assert (P /= null); | |
449 | ||
450 | Write_Lock (P); | |
451 | Write_Lock (C); | |
452 | end loop; | |
453 | ||
454 | pragma Assert (P.Awake_Count /= 0); | |
455 | ||
456 | if P.Common.State = Master_Phase_2_Sleep | |
457 | and then C.Master_of_Task = P.Master_Within | |
cacbc350 RK |
458 | then |
459 | pragma Assert (P.Common.Wait_Count > 0); | |
460 | P.Common.Wait_Count := P.Common.Wait_Count - 1; | |
461 | ||
462 | if P.Common.Wait_Count = 0 then | |
463 | Wakeup (P, Master_Phase_2_Sleep); | |
464 | end if; | |
465 | end if; | |
466 | ||
467 | Unlock (C); | |
468 | Unlock (P); | |
469 | return; | |
470 | end if; | |
471 | ||
472 | -- We are terminating in Phase 1 or Complete_Master, | |
473 | -- or are accepting on a terminate alternative. | |
474 | ||
475 | C.Awake_Count := C.Awake_Count - 1; | |
476 | ||
477 | if Task_Completed then | |
478 | pragma Assert (Self_ID.Awake_Count = 0); | |
479 | C.Alive_Count := C.Alive_Count - 1; | |
480 | end if; | |
481 | ||
482 | if C.Awake_Count > 0 or else P = null then | |
483 | Unlock (C); | |
484 | ||
485 | if P /= null then | |
486 | Unlock (P); | |
487 | end if; | |
488 | ||
489 | return; | |
490 | end if; | |
491 | ||
492 | -- C's count just went to zero, indicating that all of C's | |
493 | -- dependents are terminated or accepting with terminate alt. | |
494 | -- C has a parent, P. | |
495 | ||
496 | loop | |
497 | -- Notify P that C has gone passive. | |
498 | ||
499 | P.Awake_Count := P.Awake_Count - 1; | |
500 | ||
501 | if Task_Completed and then C.Alive_Count = 0 then | |
502 | P.Alive_Count := P.Alive_Count - 1; | |
503 | end if; | |
504 | ||
505 | exit when P.Awake_Count > 0; | |
506 | Unlock (C); | |
507 | Unlock (P); | |
508 | C := P; | |
509 | P := C.Common.Parent; | |
510 | ||
511 | if P = null then | |
512 | return; | |
513 | end if; | |
514 | ||
515 | Write_Lock (P); | |
516 | Write_Lock (C); | |
517 | end loop; | |
518 | ||
519 | -- P has non-passive dependents. | |
520 | ||
07fc65c4 GB |
521 | if P.Common.State = Master_Completion_Sleep |
522 | and then C.Master_of_Task = P.Master_Within | |
cacbc350 RK |
523 | then |
524 | pragma Debug | |
525 | (Debug.Trace | |
526 | (Self_ID, "Make_Passive: Phase 1, parent waiting", 'M')); | |
527 | ||
528 | -- If parent is in Master_Completion_Sleep, it | |
529 | -- cannot be on a terminate alternative, hence | |
530 | -- it cannot have Awake_Count of zero. | |
531 | ||
532 | pragma Assert (P.Common.Wait_Count > 0); | |
533 | P.Common.Wait_Count := P.Common.Wait_Count - 1; | |
534 | ||
535 | if P.Common.Wait_Count = 0 then | |
536 | Wakeup (P, Master_Completion_Sleep); | |
537 | end if; | |
538 | ||
539 | else | |
540 | pragma Debug | |
541 | (Debug.Trace | |
542 | (Self_ID, "Make_Passive: Phase 1, parent awake", 'M')); | |
543 | null; | |
544 | end if; | |
545 | ||
546 | Unlock (C); | |
547 | Unlock (P); | |
548 | end Make_Passive; | |
549 | ||
550 | end System.Tasking.Utilities; |