1 ------------------------------------------------------------------------------
3 -- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS --
5 -- S Y S T E M . T A S K I N G . S T A G E S --
9 -- Copyright (C) 1992-2004, Free Software Foundation, Inc. --
11 -- GNARL is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 2, or (at your option) any later ver- --
14 -- sion. GNARL is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNARL; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, USA. --
22 -- As a special exception, if other files instantiate generics from this --
23 -- unit, or you link this unit with other files to produce an executable, --
24 -- this unit does not by itself cause the resulting executable to be --
25 -- covered by the GNU General Public License. This exception does not --
26 -- however invalidate any other reasons why the executable file might be --
27 -- covered by the GNU Public License. --
29 -- GNARL was developed by the GNARL team at Florida State University. --
30 -- Extensive contributions were provided by Ada Core Technologies, Inc. --
32 ------------------------------------------------------------------------------
35 -- Turn off polling, we do not want ATC polling to take place during
36 -- tasking operations. It causes infinite loops and other problems.
39 -- used for Raise_Exception
41 with System
.Tasking
.Debug
;
42 -- used for enabling tasking facilities with gdb
44 with System
.Address_Image
;
45 -- used for the function itself.
47 with System
.Parameters
;
52 with System
.Task_Info
;
53 -- used for Task_Info_Type
55 with System
.Task_Primitives
.Operations
;
56 -- used for Finalize_Lock
66 with System
.Soft_Links
;
67 -- These are procedure pointers to non-tasking routines that use
68 -- task specific data. In the absence of tasking, these routines
69 -- refer to global data. In the presense of tasking, they must be
70 -- replaced with pointers to task-specific versions.
71 -- Also used for Create_TSD, Destroy_TSD, Get_Current_Excep
73 with System
.Tasking
.Initialization
;
74 -- Used for Remove_From_All_Tasks_List
77 -- Initialization.Poll_Base_Priority_Change
78 -- Finalize_Attributes_Link
79 -- Initialize_Attributes_Link
81 pragma Elaborate_All
(System
.Tasking
.Initialization
);
82 -- This insures that tasking is initialized if any tasks are created.
84 with System
.Tasking
.Utilities
;
85 -- Used for Make_Passive
88 with System
.Tasking
.Queuing
;
89 -- Used for Dequeue_Head
91 with System
.Tasking
.Rendezvous
;
92 -- Used for Call_Simple
94 with System
.OS_Primitives
;
95 -- Used for Delay_Modes
97 with System
.Finalization_Implementation
;
98 -- Used for System.Finalization_Implementation.Finalize_Global_List
100 with System
.Secondary_Stack
;
103 with System
.Storage_Elements
;
104 -- used for Storage_Array
106 with System
.Standard_Library
;
107 -- used for Exception_Trace
109 with System
.Traces
.Tasking
;
110 -- used for Send_Trace_Info
112 with Unchecked_Deallocation
;
113 -- To recover from failure of ATCB initialization.
115 package body System
.Tasking
.Stages
is
117 package STPO
renames System
.Task_Primitives
.Operations
;
118 package SSL
renames System
.Soft_Links
;
119 package SSE
renames System
.Storage_Elements
;
120 package SST
renames System
.Secondary_Stack
;
126 use Task_Primitives
.Operations
;
130 use System
.Traces
.Tasking
;
132 -----------------------
133 -- Local Subprograms --
134 -----------------------
136 procedure Free
is new
137 Unchecked_Deallocation
(Ada_Task_Control_Block
, Task_Id
);
139 procedure Trace_Unhandled_Exception_In_Task
(Self_Id
: Task_Id
);
140 -- This procedure outputs the task specific message for exception
143 procedure Task_Wrapper
(Self_ID
: Task_Id
);
144 -- This is the procedure that is called by the GNULL from the
145 -- new context when a task is created. It waits for activation
146 -- and then calls the task body procedure. When the task body
147 -- procedure completes, it terminates the task.
149 procedure Vulnerable_Complete_Task
(Self_ID
: Task_Id
);
150 -- Complete the calling task.
151 -- This procedure must be called with abort deferred.
152 -- It should only be called by Complete_Task and
153 -- Finalizate_Global_Tasks (for the environment task).
155 procedure Vulnerable_Complete_Master
(Self_ID
: Task_Id
);
156 -- Complete the current master of the calling task.
157 -- This procedure must be called with abort deferred.
158 -- It should only be called by Vulnerable_Complete_Task and
161 procedure Vulnerable_Complete_Activation
(Self_ID
: Task_Id
);
162 -- Signal to Self_ID's activator that Self_ID has
163 -- completed activation.
165 -- Call this procedure with abort deferred.
167 procedure Abort_Dependents
(Self_ID
: Task_Id
);
168 -- Abort all the direct dependents of Self at its current master
169 -- nesting level, plus all of their dependents, transitively.
170 -- RTS_Lock should be locked by the caller.
172 procedure Vulnerable_Free_Task
(T
: Task_Id
);
173 -- Recover all runtime system storage associated with the task T.
174 -- This should only be called after T has terminated and will no
175 -- longer be referenced.
177 -- For tasks created by an allocator that fails, due to an exception,
178 -- it is called from Expunge_Unactivated_Tasks.
180 -- It is also called from Unchecked_Deallocation, for objects that
181 -- are or contain tasks.
183 -- Different code is used at master completion, in Terminate_Dependents,
184 -- due to a need for tighter synchronization with the master.
186 ----------------------
187 -- Abort_Dependents --
188 ----------------------
190 procedure Abort_Dependents
(Self_ID
: Task_Id
) is
198 P
:= C
.Common
.Parent
;
202 -- ??? C is supposed to take care of its own dependents, so
203 -- there should be no need to worry about them. Need to double
206 if C
.Master_of_Task
= Self_ID
.Master_Within
then
207 Utilities
.Abort_One_Task
(Self_ID
, C
);
208 C
.Dependents_Aborted
:= True;
214 P
:= P
.Common
.Parent
;
217 C
:= C
.Common
.All_Tasks_Link
;
220 Self_ID
.Dependents_Aborted
:= True;
221 end Abort_Dependents
;
227 procedure Abort_Tasks
(Tasks
: Task_List
) is
229 Utilities
.Abort_Tasks
(Tasks
);
236 -- Note that locks of activator and activated task are both locked
237 -- here. This is necessary because C.Common.State and
238 -- Self.Common.Wait_Count have to be synchronized. This is safe from
239 -- deadlock because the activator is always created before the activated
240 -- task. That satisfies our in-order-of-creation ATCB locking policy.
242 -- At one point, we may also lock the parent, if the parent is
243 -- different from the activator. That is also consistent with the
244 -- lock ordering policy, since the activator cannot be created
245 -- before the parent.
247 -- Since we are holding both the activator's lock, and Task_Wrapper
248 -- locks that before it does anything more than initialize the
249 -- low-level ATCB components, it should be safe to wait to update
250 -- the counts until we see that the thread creation is successful.
252 -- If the thread creation fails, we do need to close the entries
253 -- of the task. The first phase, of dequeuing calls, only requires
254 -- locking the acceptor's ATCB, but the waking up of the callers
255 -- requires locking the caller's ATCB. We cannot safely do this
256 -- while we are holding other locks. Therefore, the queue-clearing
257 -- operation is done in a separate pass over the activation chain.
259 procedure Activate_Tasks
(Chain_Access
: Activation_Chain_Access
) is
260 Self_ID
: constant Task_Id
:= STPO
.Self
;
263 Next_C
, Last_C
: Task_Id
;
264 Activate_Prio
: System
.Any_Priority
;
266 All_Elaborated
: Boolean := True;
270 (Debug
.Trace
(Self_ID
, "Activate_Tasks", 'C'));
272 Initialization
.Defer_Abort_Nestable
(Self_ID
);
274 pragma Assert
(Self_ID
.Common
.Wait_Count
= 0);
276 -- Lock RTS_Lock, to prevent activated tasks
277 -- from racing ahead before we finish activating the chain.
281 -- Check that all task bodies have been elaborated.
283 C
:= Chain_Access
.T_ID
;
287 if C
.Common
.Elaborated
/= null
288 and then not C
.Common
.Elaborated
.all
290 All_Elaborated
:= False;
293 -- Reverse the activation chain so that tasks are
294 -- activated in the same order they're declared.
296 Next_C
:= C
.Common
.Activation_Link
;
297 C
.Common
.Activation_Link
:= Last_C
;
302 Chain_Access
.T_ID
:= Last_C
;
304 if not All_Elaborated
then
306 Initialization
.Undefer_Abort_Nestable
(Self_ID
);
308 (Program_Error
'Identity, "Some tasks have not been elaborated");
311 -- Activate all the tasks in the chain.
312 -- Creation of the thread of control was deferred until
313 -- activation. So create it now.
315 C
:= Chain_Access
.T_ID
;
318 if C
.Common
.State
/= Terminated
then
319 pragma Assert
(C
.Common
.State
= Unactivated
);
321 P
:= C
.Common
.Parent
;
325 if C
.Common
.Base_Priority
< Get_Priority
(Self_ID
) then
326 Activate_Prio
:= Get_Priority
(Self_ID
);
328 Activate_Prio
:= C
.Common
.Base_Priority
;
331 System
.Task_Primitives
.Operations
.Create_Task
332 (C
, Task_Wrapper
'Address,
334 (C
.Common
.Compiler_Data
.Pri_Stack_Info
.Size
),
335 Activate_Prio
, Success
);
337 -- There would be a race between the created task and the
338 -- creator to do the following initialization, if we did not
339 -- have a Lock/Unlock_RTS pair in the task wrapper to prevent
340 -- it from racing ahead.
343 C
.Common
.State
:= Runnable
;
346 P
.Awake_Count
:= P
.Awake_Count
+ 1;
347 P
.Alive_Count
:= P
.Alive_Count
+ 1;
349 if P
.Common
.State
= Master_Completion_Sleep
and then
350 C
.Master_of_Task
= P
.Master_Within
352 pragma Assert
(Self_ID
/= P
);
353 P
.Common
.Wait_Count
:= P
.Common
.Wait_Count
+ 1;
360 -- No need to set Awake_Count, State, etc. here since the loop
361 -- below will do that for any Unactivated tasks.
365 Self_ID
.Common
.Activation_Failed
:= True;
369 C
:= C
.Common
.Activation_Link
;
372 if not Single_Lock
then
376 -- Close the entries of any tasks that failed thread creation,
377 -- and count those that have not finished activation.
379 Write_Lock
(Self_ID
);
380 Self_ID
.Common
.State
:= Activator_Sleep
;
382 C
:= Chain_Access
.T_ID
;
386 if C
.Common
.State
= Unactivated
then
387 C
.Common
.Activator
:= null;
388 C
.Common
.State
:= Terminated
;
390 Utilities
.Cancel_Queued_Entry_Calls
(C
);
392 elsif C
.Common
.Activator
/= null then
393 Self_ID
.Common
.Wait_Count
:= Self_ID
.Common
.Wait_Count
+ 1;
397 P
:= C
.Common
.Activation_Link
;
398 C
.Common
.Activation_Link
:= null;
402 -- Wait for the activated tasks to complete activation. It is
403 -- unsafe to abort any of these tasks until the count goes to zero.
406 Initialization
.Poll_Base_Priority_Change
(Self_ID
);
407 exit when Self_ID
.Common
.Wait_Count
= 0;
408 Sleep
(Self_ID
, Activator_Sleep
);
411 Self_ID
.Common
.State
:= Runnable
;
418 -- Remove the tasks from the chain
420 Chain_Access
.T_ID
:= null;
421 Initialization
.Undefer_Abort_Nestable
(Self_ID
);
423 if Self_ID
.Common
.Activation_Failed
then
424 Self_ID
.Common
.Activation_Failed
:= False;
425 Raise_Exception
(Tasking_Error
'Identity,
426 "Failure during activation");
430 -------------------------
431 -- Complete_Activation --
432 -------------------------
434 procedure Complete_Activation
is
435 Self_ID
: constant Task_Id
:= STPO
.Self
;
437 Initialization
.Defer_Abort_Nestable
(Self_ID
);
443 Vulnerable_Complete_Activation
(Self_ID
);
449 Initialization
.Undefer_Abort_Nestable
(Self_ID
);
452 -- Why do we need to allow for nested deferral here?
454 if Runtime_Traces
then
455 Send_Trace_Info
(T_Activate
);
457 end Complete_Activation
;
459 ---------------------
460 -- Complete_Master --
461 ---------------------
463 procedure Complete_Master
is
464 Self_ID
: constant Task_Id
:= STPO
.Self
;
467 pragma Assert
(Self_ID
.Deferral_Level
> 0);
469 Vulnerable_Complete_Master
(Self_ID
);
476 -- See comments on Vulnerable_Complete_Task for details
478 procedure Complete_Task
is
479 Self_ID
: constant Task_Id
:= STPO
.Self
;
481 pragma Assert
(Self_ID
.Deferral_Level
> 0);
483 Vulnerable_Complete_Task
(Self_ID
);
485 -- All of our dependents have terminated. Never undefer abort again!
493 -- Compiler interface only. Do not call from within the RTS.
494 -- This must be called to create a new task.
496 procedure Create_Task
498 Size
: System
.Parameters
.Size_Type
;
499 Task_Info
: System
.Task_Info
.Task_Info_Type
;
500 Num_Entries
: Task_Entry_Index
;
501 Master
: Master_Level
;
502 State
: Task_Procedure_Access
;
503 Discriminants
: System
.Address
;
504 Elaborated
: Access_Boolean
;
505 Chain
: in out Activation_Chain
;
507 Created_Task
: out Task_Id
)
510 Self_ID
: constant Task_Id
:= STPO
.Self
;
512 Base_Priority
: System
.Any_Priority
;
517 (Debug
.Trace
(Self_ID
, "Create_Task", 'C'));
519 if Priority
= Unspecified_Priority
then
520 Base_Priority
:= Self_ID
.Common
.Base_Priority
;
522 Base_Priority
:= System
.Any_Priority
(Priority
);
525 -- Find parent P of new Task, via master level number
530 while P
.Master_of_Task
>= Master
loop
531 P
:= P
.Common
.Parent
;
536 Initialization
.Defer_Abort_Nestable
(Self_ID
);
539 T
:= New_ATCB
(Num_Entries
);
543 Initialization
.Undefer_Abort_Nestable
(Self_ID
);
544 Raise_Exception
(Storage_Error
'Identity, "Cannot allocate task");
547 -- RTS_Lock is used by Abort_Dependents and Abort_Tasks.
548 -- Up to this point, it is possible that we may be part of
549 -- a family of tasks that is being aborted.
552 Write_Lock
(Self_ID
);
554 -- Now, we must check that we have not been aborted.
555 -- If so, we should give up on creating this task,
556 -- and simply return.
558 if not Self_ID
.Callable
then
559 pragma Assert
(Self_ID
.Pending_ATC_Level
= 0);
560 pragma Assert
(Self_ID
.Pending_Action
);
561 pragma Assert
(Chain
.T_ID
= null
562 or else Chain
.T_ID
.Common
.State
= Unactivated
);
566 Initialization
.Undefer_Abort_Nestable
(Self_ID
);
568 -- ??? Should never get here
570 pragma Assert
(False);
571 raise Standard
'Abort_Signal;
574 Initialize_ATCB
(Self_ID
, State
, Discriminants
, P
, Elaborated
,
575 Base_Priority
, Task_Info
, Size
, T
, Success
);
581 Initialization
.Undefer_Abort_Nestable
(Self_ID
);
583 (Storage_Error
'Identity, "Failed to initialize task");
586 T
.Master_of_Task
:= Master
;
587 T
.Master_Within
:= T
.Master_of_Task
+ 1;
589 for L
in T
.Entry_Calls
'Range loop
590 T
.Entry_Calls
(L
).Self
:= T
;
591 T
.Entry_Calls
(L
).Level
:= L
;
594 if Task_Image
'Length = 0 then
595 T
.Common
.Task_Image_Len
:= 0;
598 T
.Common
.Task_Image
(1) := Task_Image
(Task_Image
'First);
600 for J
in Task_Image
'First + 1 .. Task_Image
'Last loop
602 -- Remove unwanted blank space generated by 'Image
604 if Task_Image
(J
) /= ' '
605 or else Task_Image
(J
- 1) /= '('
608 T
.Common
.Task_Image
(Len
) := Task_Image
(J
);
610 exit when Len
= T
.Common
.Task_Image
'Last;
614 T
.Common
.Task_Image_Len
:= Len
;
620 -- Create TSD as early as possible in the creation of a task, since it
621 -- may be used by the operation of Ada code within the task.
623 SSL
.Create_TSD
(T
.Common
.Compiler_Data
);
624 T
.Common
.Activation_Link
:= Chain
.T_ID
;
626 Initialization
.Initialize_Attributes_Link
.all (T
);
628 Initialization
.Undefer_Abort_Nestable
(Self_ID
);
630 if Runtime_Traces
then
631 Send_Trace_Info
(T_Create
, T
);
639 function Current_Master
return Master_Level
is
641 return STPO
.Self
.Master_Within
;
648 procedure Enter_Master
is
649 Self_ID
: constant Task_Id
:= STPO
.Self
;
652 Self_ID
.Master_Within
:= Self_ID
.Master_Within
+ 1;
655 -------------------------------
656 -- Expunge_Unactivated_Tasks --
657 -------------------------------
659 -- See procedure Close_Entries for the general case.
661 procedure Expunge_Unactivated_Tasks
(Chain
: in out Activation_Chain
) is
662 Self_ID
: constant Task_Id
:= STPO
.Self
;
664 Call
: Entry_Call_Link
;
669 (Debug
.Trace
(Self_ID
, "Expunge_Unactivated_Tasks", 'C'));
671 Initialization
.Defer_Abort_Nestable
(Self_ID
);
674 -- Experimentation has shown that abort is sometimes (but not
675 -- always) already deferred when this is called.
677 -- That may indicate an error. Find out what is going on.
682 pragma Assert
(C
.Common
.State
= Unactivated
);
684 Temp
:= C
.Common
.Activation_Link
;
686 if C
.Common
.State
= Unactivated
then
690 for J
in 1 .. C
.Entry_Num
loop
691 Queuing
.Dequeue_Head
(C
.Entry_Queues
(J
), Call
);
692 pragma Assert
(Call
= null);
697 Initialization
.Remove_From_All_Tasks_List
(C
);
700 Vulnerable_Free_Task
(C
);
706 Initialization
.Undefer_Abort_Nestable
(Self_ID
);
707 end Expunge_Unactivated_Tasks
;
709 ---------------------------
710 -- Finalize_Global_Tasks --
711 ---------------------------
714 -- We have a potential problem here if finalization of global
715 -- objects does anything with signals or the timer server, since
716 -- by that time those servers have terminated.
718 -- It is hard to see how that would occur.
720 -- However, a better solution might be to do all this finalization
721 -- using the global finalization chain.
723 procedure Finalize_Global_Tasks
is
724 Self_ID
: constant Task_Id
:= STPO
.Self
;
728 if Self_ID
.Deferral_Level
= 0 then
730 -- In principle, we should be able to predict whether
731 -- abort is already deferred here (and it should not be deferred
732 -- yet but in practice it seems Finalize_Global_Tasks is being
733 -- called sometimes, from RTS code for exceptions, with abort already
736 Initialization
.Defer_Abort_Nestable
(Self_ID
);
738 -- Never undefer again!!!
741 -- This code is only executed by the environment task
743 pragma Assert
(Self_ID
= Environment_Task
);
745 -- Set Environment_Task'Callable to false to notify library-level tasks
746 -- that it is waiting for them (cf 5619-003).
748 Self_ID
.Callable
:= False;
750 -- Exit level 2 master, for normal tasks in library-level packages.
754 -- Force termination of "independent" library-level server tasks.
758 Abort_Dependents
(Self_ID
);
760 if not Single_Lock
then
764 -- We need to explicitely wait for the task to be terminated here
765 -- because on true concurrent system, we may end this procedure
766 -- before the tasks are really terminated.
768 Write_Lock
(Self_ID
);
771 exit when Utilities
.Independent_Task_Count
= 0;
773 -- We used to yield here, but this did not take into account
774 -- low priority tasks that would cause dead lock in some cases.
778 (Self_ID
, 0.01, System
.OS_Primitives
.Relative
,
779 Self_ID
.Common
.State
, Ignore
, Ignore
);
782 -- ??? On multi-processor environments, it seems that the above loop
783 -- isn't sufficient, so we need to add an additional delay.
786 (Self_ID
, 0.01, System
.OS_Primitives
.Relative
,
787 Self_ID
.Common
.State
, Ignore
, Ignore
);
795 -- Complete the environment task
797 Vulnerable_Complete_Task
(Self_ID
);
799 System
.Finalization_Implementation
.Finalize_Global_List
;
801 SSL
.Abort_Defer
:= SSL
.Abort_Defer_NT
'Access;
802 SSL
.Abort_Undefer
:= SSL
.Abort_Undefer_NT
'Access;
803 SSL
.Lock_Task
:= SSL
.Task_Lock_NT
'Access;
804 SSL
.Unlock_Task
:= SSL
.Task_Unlock_NT
'Access;
805 SSL
.Get_Jmpbuf_Address
:= SSL
.Get_Jmpbuf_Address_NT
'Access;
806 SSL
.Set_Jmpbuf_Address
:= SSL
.Set_Jmpbuf_Address_NT
'Access;
807 SSL
.Get_Sec_Stack_Addr
:= SSL
.Get_Sec_Stack_Addr_NT
'Access;
808 SSL
.Set_Sec_Stack_Addr
:= SSL
.Set_Sec_Stack_Addr_NT
'Access;
809 SSL
.Get_Exc_Stack_Addr
:= SSL
.Get_Exc_Stack_Addr_NT
'Access;
810 SSL
.Set_Exc_Stack_Addr
:= SSL
.Set_Exc_Stack_Addr_NT
'Access;
811 SSL
.Check_Abort_Status
:= SSL
.Check_Abort_Status_NT
'Access;
812 SSL
.Get_Stack_Info
:= SSL
.Get_Stack_Info_NT
'Access;
814 -- Don't bother trying to finalize Initialization.Global_Task_Lock
815 -- and System.Task_Primitives.RTS_Lock.
817 end Finalize_Global_Tasks
;
823 procedure Free_Task
(T
: Task_Id
) is
824 Self_Id
: constant Task_Id
:= Self
;
827 if T
.Common
.State
= Terminated
then
829 -- It is not safe to call Abort_Defer or Write_Lock at this stage
831 Initialization
.Task_Lock
(Self_Id
);
834 Initialization
.Remove_From_All_Tasks_List
(T
);
837 Initialization
.Task_Unlock
(Self_Id
);
839 System
.Task_Primitives
.Operations
.Finalize_TCB
(T
);
841 -- If the task is not terminated, then we simply ignore the call. This
842 -- happens when a user program attempts an unchecked deallocation on
843 -- a non-terminated task.
854 -- The task wrapper is a procedure that is called first for each task
855 -- task body, and which in turn calls the compiler-generated task body
856 -- procedure. The wrapper's main job is to do initialization for the task.
857 -- It also has some locally declared objects that server as per-task local
858 -- data. Task finalization is done by Complete_Task, which is called from
859 -- an at-end handler that the compiler generates.
861 procedure Task_Wrapper
(Self_ID
: Task_Id
) is
862 use type System
.Parameters
.Size_Type
;
863 use type SSE
.Storage_Offset
;
864 use System
.Standard_Library
;
866 Secondary_Stack
: aliased SSE
.Storage_Array
867 (1 .. Self_ID
.Common
.Compiler_Data
.Pri_Stack_Info
.Size
*
868 SSE
.Storage_Offset
(Parameters
.Sec_Stack_Ratio
) / 100);
869 Secondary_Stack_Address
: System
.Address
:= Secondary_Stack
'Address;
872 pragma Assert
(Self_ID
.Deferral_Level
= 1);
874 if not Parameters
.Sec_Stack_Dynamic
then
875 Self_ID
.Common
.Compiler_Data
.Sec_Stack_Addr
:=
876 Secondary_Stack
'Address;
877 SST
.SS_Init
(Secondary_Stack_Address
, Integer (Secondary_Stack
'Last));
880 -- Set the guard page at the bottom of the stack. The call to
881 -- unprotect the page is done in Terminate_Task
883 Stack_Guard
(Self_ID
, True);
885 -- Initialize low-level TCB components, that cannot be initialized
886 -- by the creator. Enter_Task sets Self_ID.Known_Tasks_Index and
887 -- also Self_ID.LL.Thread
889 Enter_Task
(Self_ID
);
891 -- We lock RTS_Lock to wait for activator to finish activating
892 -- the rest of the chain, so that everyone in the chain comes out
893 -- in priority order.
895 -- This also protects the value of
896 -- Self_ID.Common.Activator.Common.Wait_Count.
902 -- We are separating the following portion of the code in order to
903 -- place the exception handlers in a different block. In this way,
904 -- we do not call Set_Jmpbuf_Address (which needs Self) before we
905 -- set Self in Enter_Task
907 -- Call the task body procedure
909 -- The task body is called with abort still deferred. That
910 -- eliminates a dangerous window, for which we had to patch-up in
913 -- During the expansion of the task body, we insert an RTS-call
914 -- to Abort_Undefer, at the first point where abort should be
917 Self_ID
.Common
.Task_Entry_Point
(Self_ID
.Common
.Task_Arg
);
918 Initialization
.Defer_Abort_Nestable
(Self_ID
);
921 -- We can't call Terminate_Task in the exception handlers below,
922 -- since there may be (e.g. in the case of GCC exception handling)
923 -- clean ups associated with the exception handler that need to
924 -- access task specific data.
926 -- Defer abortion so that this task can't be aborted while exiting
928 when Standard
'Abort_Signal =>
929 Initialization
.Defer_Abort_Nestable
(Self_ID
);
932 -- ??? Using an E : others here causes CD2C11A to fail on
933 -- DEC Unix, see 7925-005.
935 Initialization
.Defer_Abort_Nestable
(Self_ID
);
937 -- Perform the task specific exception tracing duty. We handle
938 -- these outputs here and not in the common notification routine
939 -- because we need access to tasking related data and we don't
940 -- want to drag dependencies against tasking related units in the
941 -- the common notification units. Additionally, no trace is ever
942 -- triggered from the common routine for the Unhandled_Raise case
943 -- in tasks, since an exception never appears unhandled in this
944 -- context because of this handler.
946 if Exception_Trace
= Unhandled_Raise
then
947 Trace_Unhandled_Exception_In_Task
(Self_ID
);
951 Terminate_Task
(Self_ID
);
958 -- Before we allow the thread to exit, we must clean up. This is a
959 -- a delicate job. We must wake up the task's master, who may immediately
960 -- try to deallocate the ATCB out from under the current task WHILE IT IS
963 -- To avoid this, the parent task must be blocked up to the latest
964 -- statement executed. The trouble is that we have another step that we
965 -- also want to postpone to the very end, i.e., calling SSL.Destroy_TSD.
966 -- We have to postpone that until the end because compiler-generated code
967 -- is likely to try to access that data at just about any point.
969 -- We can't call Destroy_TSD while we are holding any other locks, because
970 -- it locks Global_Task_Lock, and our deadlock prevention rules require
971 -- that to be the outermost lock. Our first "solution" was to just lock
972 -- Global_Task_Lock in addition to the other locks, and force the parent
973 -- to also lock this lock between its wakeup and its freeing of the ATCB.
974 -- See Complete_Task for the parent-side of the code that has the matching
975 -- calls to Task_Lock and Task_Unlock. That was not really a solution,
976 -- since the operation Task_Unlock continued to access the ATCB after
977 -- unlocking, after which the parent was observed to race ahead,
978 -- deallocate the ATCB, and then reallocate it to another task. The
979 -- call to Undefer_Abortion in Task_Unlock by the "terminated" task was
980 -- overwriting the data of the new task that reused the ATCB! To solve
981 -- this problem, we introduced the new operation Final_Task_Unlock.
983 procedure Terminate_Task
(Self_ID
: Task_Id
) is
984 Environment_Task
: constant Task_Id
:= STPO
.Environment_Task
;
985 Master_of_Task
: Integer;
988 Debug
.Task_Termination_Hook
;
990 if Runtime_Traces
then
991 Send_Trace_Info
(T_Terminate
);
994 -- Since GCC cannot allocate stack chunks efficiently without reordering
995 -- some of the allocations, we have to handle this unexpected situation
996 -- here. We should normally never have to call Vulnerable_Complete_Task
997 -- here. See 6602-003 for more details.
999 if Self_ID
.Common
.Activator
/= null then
1000 Vulnerable_Complete_Task
(Self_ID
);
1003 Initialization
.Task_Lock
(Self_ID
);
1009 Master_of_Task
:= Self_ID
.Master_of_Task
;
1011 -- Check if the current task is an independent task
1012 -- If so, decrement the Independent_Task_Count value.
1014 if Master_of_Task
= 2 then
1016 Utilities
.Independent_Task_Count
:=
1017 Utilities
.Independent_Task_Count
- 1;
1020 Write_Lock
(Environment_Task
);
1021 Utilities
.Independent_Task_Count
:=
1022 Utilities
.Independent_Task_Count
- 1;
1023 Unlock
(Environment_Task
);
1027 -- Unprotect the guard page if needed
1029 Stack_Guard
(Self_ID
, False);
1031 Utilities
.Make_Passive
(Self_ID
, Task_Completed
=> True);
1037 pragma Assert
(Check_Exit
(Self_ID
));
1039 SSL
.Destroy_TSD
(Self_ID
.Common
.Compiler_Data
);
1040 Initialization
.Final_Task_Unlock
(Self_ID
);
1043 -- past this point, this thread must assume that the ATCB
1044 -- has been deallocated. It should not be accessed again.
1046 if Master_of_Task
> 0 then
1055 function Terminated
(T
: Task_Id
) return Boolean is
1056 Self_ID
: constant Task_Id
:= STPO
.Self
;
1060 Initialization
.Defer_Abort_Nestable
(Self_ID
);
1067 Result
:= T
.Common
.State
= Terminated
;
1074 Initialization
.Undefer_Abort_Nestable
(Self_ID
);
1078 ----------------------------------------
1079 -- Trace_Unhandled_Exception_In_Task --
1080 ----------------------------------------
1082 procedure Trace_Unhandled_Exception_In_Task
(Self_Id
: Task_Id
) is
1083 procedure To_Stderr
(S
: String);
1084 pragma Import
(Ada
, To_Stderr
, "__gnat_to_stderr");
1086 use System
.Task_Info
;
1087 use System
.Soft_Links
;
1088 use System
.Standard_Library
;
1090 function To_Address
is new
1091 Unchecked_Conversion
(Task_Id
, System
.Address
);
1093 function Tailored_Exception_Information
1094 (E
: Exception_Occurrence
) return String;
1096 (Ada
, Tailored_Exception_Information
,
1097 "__gnat_tailored_exception_information");
1099 Excep
: constant Exception_Occurrence_Access
:=
1100 SSL
.Get_Current_Excep
.all;
1103 -- This procedure is called by the task outermost handler in
1104 -- Task_Wrapper below, so only once the task stack has been fully
1105 -- unwound. The common notification routine has been called at the
1106 -- raise point already.
1108 To_Stderr
("task ");
1110 if Self_Id
.Common
.Task_Image_Len
/= 0 then
1112 (Self_Id
.Common
.Task_Image
(1 .. Self_Id
.Common
.Task_Image_Len
));
1116 To_Stderr
(System
.Address_Image
(To_Address
(Self_Id
)));
1117 To_Stderr
(" terminated by unhandled exception");
1118 To_Stderr
((1 => ASCII
.LF
));
1119 To_Stderr
(Tailored_Exception_Information
(Excep
.all));
1120 end Trace_Unhandled_Exception_In_Task
;
1122 ------------------------------------
1123 -- Vulnerable_Complete_Activation --
1124 ------------------------------------
1126 -- As in several other places, the locks of the activator and activated
1127 -- task are both locked here. This follows our deadlock prevention lock
1128 -- ordering policy, since the activated task must be created after the
1131 procedure Vulnerable_Complete_Activation
(Self_ID
: Task_Id
) is
1132 Activator
: constant Task_Id
:= Self_ID
.Common
.Activator
;
1135 pragma Debug
(Debug
.Trace
(Self_ID
, "V_Complete_Activation", 'C'));
1137 Write_Lock
(Activator
);
1138 Write_Lock
(Self_ID
);
1140 pragma Assert
(Self_ID
.Common
.Activator
/= null);
1142 -- Remove dangling reference to Activator, since a task may
1143 -- outlive its activator.
1145 Self_ID
.Common
.Activator
:= null;
1147 -- Wake up the activator, if it is waiting for a chain of tasks to
1148 -- activate, and we are the last in the chain to complete activation.
1150 if Activator
.Common
.State
= Activator_Sleep
then
1151 Activator
.Common
.Wait_Count
:= Activator
.Common
.Wait_Count
- 1;
1153 if Activator
.Common
.Wait_Count
= 0 then
1154 Wakeup
(Activator
, Activator_Sleep
);
1158 -- The activator raises a Tasking_Error if any task it is activating
1159 -- is completed before the activation is done. However, if the reason
1160 -- for the task completion is an abortion, we do not raise an exception.
1163 if not Self_ID
.Callable
and then Self_ID
.Pending_ATC_Level
/= 0 then
1164 Activator
.Common
.Activation_Failed
:= True;
1170 -- After the activation, active priority should be the same
1171 -- as base priority. We must unlock the Activator first,
1172 -- though, since it should not wait if we have lower priority.
1174 if Get_Priority
(Self_ID
) /= Self_ID
.Common
.Base_Priority
then
1175 Write_Lock
(Self_ID
);
1176 Set_Priority
(Self_ID
, Self_ID
.Common
.Base_Priority
);
1179 end Vulnerable_Complete_Activation
;
1181 --------------------------------
1182 -- Vulnerable_Complete_Master --
1183 --------------------------------
1185 procedure Vulnerable_Complete_Master
(Self_ID
: Task_Id
) is
1188 CM
: constant Master_Level
:= Self_ID
.Master_Within
;
1189 T
: aliased Task_Id
;
1191 To_Be_Freed
: Task_Id
;
1192 -- This is a list of ATCBs to be freed, after we have released
1193 -- all RTS locks. This is necessary because of the locking order
1194 -- rules, since the storage manager uses Global_Task_Lock.
1196 pragma Warnings
(Off
);
1197 function Check_Unactivated_Tasks
return Boolean;
1198 pragma Warnings
(On
);
1199 -- Temporary error-checking code below. This is part of the checks
1200 -- added in the new run time. Call it only inside a pragma Assert.
1202 -----------------------------
1203 -- Check_Unactivated_Tasks --
1204 -----------------------------
1206 function Check_Unactivated_Tasks
return Boolean is
1208 if not Single_Lock
then
1212 Write_Lock
(Self_ID
);
1213 C
:= All_Tasks_List
;
1215 while C
/= null loop
1216 if C
.Common
.Activator
= Self_ID
then
1220 if C
.Common
.Parent
= Self_ID
and then C
.Master_of_Task
= CM
then
1223 if C
.Common
.State
= Unactivated
then
1230 C
:= C
.Common
.All_Tasks_Link
;
1235 if not Single_Lock
then
1240 end Check_Unactivated_Tasks
;
1242 -- Start of processing for Vulnerable_Complete_Master
1246 (Debug
.Trace
(Self_ID
, "V_Complete_Master", 'C'));
1248 pragma Assert
(Self_ID
.Common
.Wait_Count
= 0);
1249 pragma Assert
(Self_ID
.Deferral_Level
> 0);
1251 -- Count how many active dependent tasks this master currently
1252 -- has, and record this in Wait_Count.
1254 -- This count should start at zero, since it is initialized to
1255 -- zero for new tasks, and the task should not exit the
1256 -- sleep-loops that use this count until the count reaches zero.
1259 Write_Lock
(Self_ID
);
1260 C
:= All_Tasks_List
;
1262 while C
/= null loop
1263 if C
.Common
.Activator
= Self_ID
then
1264 pragma Assert
(C
.Common
.State
= Unactivated
);
1267 C
.Common
.Activator
:= null;
1268 C
.Common
.State
:= Terminated
;
1269 C
.Callable
:= False;
1270 Utilities
.Cancel_Queued_Entry_Calls
(C
);
1274 if C
.Common
.Parent
= Self_ID
and then C
.Master_of_Task
= CM
then
1277 if C
.Awake_Count
/= 0 then
1278 Self_ID
.Common
.Wait_Count
:= Self_ID
.Common
.Wait_Count
+ 1;
1284 C
:= C
.Common
.All_Tasks_Link
;
1287 Self_ID
.Common
.State
:= Master_Completion_Sleep
;
1290 if not Single_Lock
then
1294 -- Wait until dependent tasks are all terminated or ready to terminate.
1295 -- While waiting, the task may be awakened if the task's priority needs
1296 -- changing, or this master is aborted. In the latter case, we want
1297 -- to abort the dependents, and resume waiting until Wait_Count goes
1300 Write_Lock
(Self_ID
);
1303 Initialization
.Poll_Base_Priority_Change
(Self_ID
);
1304 exit when Self_ID
.Common
.Wait_Count
= 0;
1306 -- Here is a difference as compared to Complete_Master
1308 if Self_ID
.Pending_ATC_Level
< Self_ID
.ATC_Nesting_Level
1309 and then not Self_ID
.Dependents_Aborted
1312 Abort_Dependents
(Self_ID
);
1316 Abort_Dependents
(Self_ID
);
1318 Write_Lock
(Self_ID
);
1321 Sleep
(Self_ID
, Master_Completion_Sleep
);
1325 Self_ID
.Common
.State
:= Runnable
;
1328 -- Dependents are all terminated or on terminate alternatives.
1329 -- Now, force those on terminate alternatives to terminate, by
1332 pragma Assert
(Check_Unactivated_Tasks
);
1334 if Self_ID
.Alive_Count
> 1 then
1336 -- Consider finding a way to skip the following extra steps if there
1337 -- are no dependents with terminate alternatives. This could be done
1338 -- by adding another count to the ATCB, similar to Awake_Count, but
1339 -- keeping track of tasks that are on terminate alternatives.
1341 pragma Assert
(Self_ID
.Common
.Wait_Count
= 0);
1343 -- Force any remaining dependents to terminate, by aborting them.
1345 if not Single_Lock
then
1349 Abort_Dependents
(Self_ID
);
1351 -- Above, when we "abort" the dependents we are simply using this
1352 -- operation for convenience. We are not required to support the full
1353 -- abort-statement semantics; in particular, we are not required to
1354 -- immediately cancel any queued or in-service entry calls. That is
1355 -- good, because if we tried to cancel a call we would need to lock
1356 -- the caller, in order to wake the caller up. Our anti-deadlock
1357 -- rules prevent us from doing that without releasing the locks on C
1358 -- and Self_ID. Releasing and retaking those locks would be wasteful
1359 -- at best, and should not be considered further without more
1360 -- detailed analysis of potential concurrent accesses to the
1361 -- ATCBs of C and Self_ID.
1363 -- Count how many "alive" dependent tasks this master currently
1364 -- has, and record this in Wait_Count. This count should start at
1365 -- zero, since it is initialized to zero for new tasks, and the
1366 -- task should not exit the sleep-loops that use this count until
1367 -- the count reaches zero.
1369 pragma Assert
(Self_ID
.Common
.Wait_Count
= 0);
1371 Write_Lock
(Self_ID
);
1372 C
:= All_Tasks_List
;
1374 while C
/= null loop
1375 if C
.Common
.Parent
= Self_ID
and then C
.Master_of_Task
= CM
then
1378 pragma Assert
(C
.Awake_Count
= 0);
1380 if C
.Alive_Count
> 0 then
1381 pragma Assert
(C
.Terminate_Alternative
);
1382 Self_ID
.Common
.Wait_Count
:= Self_ID
.Common
.Wait_Count
+ 1;
1388 C
:= C
.Common
.All_Tasks_Link
;
1391 Self_ID
.Common
.State
:= Master_Phase_2_Sleep
;
1394 if not Single_Lock
then
1398 -- Wait for all counted tasks to finish terminating themselves.
1400 Write_Lock
(Self_ID
);
1403 Initialization
.Poll_Base_Priority_Change
(Self_ID
);
1404 exit when Self_ID
.Common
.Wait_Count
= 0;
1405 Sleep
(Self_ID
, Master_Phase_2_Sleep
);
1408 Self_ID
.Common
.State
:= Runnable
;
1412 -- We don't wake up for abortion here. We are already terminating
1413 -- just as fast as we can, so there is no point.
1415 -- Remove terminated tasks from the list of Self_ID's dependents, but
1416 -- don't free their ATCBs yet, because of lock order restrictions,
1417 -- which don't allow us to call "free" or "malloc" while holding any
1418 -- other locks. Instead, we put those ATCBs to be freed onto a
1419 -- temporary list, called To_Be_Freed.
1421 if not Single_Lock
then
1425 C
:= All_Tasks_List
;
1428 while C
/= null loop
1429 if C
.Common
.Parent
= Self_ID
and then C
.Master_of_Task
>= CM
then
1431 P
.Common
.All_Tasks_Link
:= C
.Common
.All_Tasks_Link
;
1433 All_Tasks_List
:= C
.Common
.All_Tasks_Link
;
1436 T
:= C
.Common
.All_Tasks_Link
;
1437 C
.Common
.All_Tasks_Link
:= To_Be_Freed
;
1443 C
:= C
.Common
.All_Tasks_Link
;
1449 -- Free all the ATCBs on the list To_Be_Freed.
1451 -- The ATCBs in the list are no longer in All_Tasks_List, and after
1452 -- any interrupt entries are detached from them they should no longer
1455 -- Global_Task_Lock (Task_Lock/Unlock) is locked in the loop below to
1456 -- avoid a race between a terminating task and its parent. The parent
1457 -- might try to deallocate the ACTB out from underneath the exiting
1458 -- task. Note that Free will also lock Global_Task_Lock, but that is
1459 -- OK, since this is the *one* lock for which we have a mechanism to
1460 -- support nested locking. See Task_Wrapper and its finalizer for more
1464 -- The check "T.Common.Parent /= null ..." below is to prevent dangling
1465 -- references to terminated library-level tasks, which could
1466 -- otherwise occur during finalization of library-level objects.
1467 -- A better solution might be to hook task objects into the
1468 -- finalization chain and deallocate the ATCB when the task
1469 -- object is deallocated. However, this change is not likely
1470 -- to gain anything significant, since all this storage should
1471 -- be recovered en-masse when the process exits.
1473 while To_Be_Freed
/= null loop
1475 To_Be_Freed
:= T
.Common
.All_Tasks_Link
;
1477 -- ??? On SGI there is currently no Interrupt_Manager, that's
1478 -- why we need to check if the Interrupt_Manager_ID is null
1480 if T
.Interrupt_Entry
and Interrupt_Manager_ID
/= null then
1482 Detach_Interrupt_Entries_Index
: constant Task_Entry_Index
:= 1;
1483 -- Corresponds to the entry index of System.Interrupts.
1484 -- Interrupt_Manager.Detach_Interrupt_Entries.
1485 -- Be sure to update this value when changing
1486 -- Interrupt_Manager specs.
1488 type Param_Type
is access all Task_Id
;
1490 Param
: aliased Param_Type
:= T
'Access;
1493 System
.Tasking
.Rendezvous
.Call_Simple
1494 (Interrupt_Manager_ID
, Detach_Interrupt_Entries_Index
,
1499 if (T
.Common
.Parent
/= null
1500 and then T
.Common
.Parent
.Common
.Parent
/= null)
1501 or else T
.Master_of_Task
> 3
1503 Initialization
.Task_Lock
(Self_ID
);
1505 -- If Sec_Stack_Addr is not null, it means that Destroy_TSD
1506 -- has not been called yet (case of an unactivated task).
1508 if T
.Common
.Compiler_Data
.Sec_Stack_Addr
/= Null_Address
then
1509 SSL
.Destroy_TSD
(T
.Common
.Compiler_Data
);
1512 Vulnerable_Free_Task
(T
);
1513 Initialization
.Task_Unlock
(Self_ID
);
1517 -- It might seem nice to let the terminated task deallocate its own
1518 -- ATCB. That would not cover the case of unactivated tasks. It also
1519 -- would force us to keep the underlying thread around past termination,
1520 -- since references to the ATCB are possible past termination.
1521 -- Currently, we get rid of the thread as soon as the task terminates,
1522 -- and let the parent recover the ATCB later.
1524 -- Some day, if we want to recover the ATCB earlier, at task
1525 -- termination, we could consider using "fat task IDs", that include the
1526 -- serial number with the ATCB pointer, to catch references to tasks
1527 -- that no longer have ATCBs. It is not clear how much this would gain,
1528 -- since the user-level task object would still be occupying storage.
1530 -- Make next master level up active.
1531 -- We don't need to lock the ATCB, since the value is only updated by
1532 -- each task for itself.
1534 Self_ID
.Master_Within
:= CM
- 1;
1535 end Vulnerable_Complete_Master
;
1537 ------------------------------
1538 -- Vulnerable_Complete_Task --
1539 ------------------------------
1541 -- Complete the calling task
1543 -- This procedure must be called with abort deferred. (That's why the
1544 -- name has "Vulnerable" in it.) It should only be called by Complete_Task
1545 -- and Finalize_Global_Tasks (for the environment task).
1547 -- The effect is similar to that of Complete_Master. Differences include
1548 -- the closing of entries here, and computation of the number of active
1549 -- dependent tasks in Complete_Master.
1551 -- We don't lock Self_ID before the call to Vulnerable_Complete_Activation,
1552 -- because that does its own locking, and because we do not need the lock
1553 -- to test Self_ID.Common.Activator. That value should only be read and
1554 -- modified by Self.
1556 procedure Vulnerable_Complete_Task
(Self_ID
: Task_Id
) is
1558 pragma Assert
(Self_ID
.Deferral_Level
> 0);
1559 pragma Assert
(Self_ID
= Self
);
1560 pragma Assert
(Self_ID
.Master_Within
= Self_ID
.Master_of_Task
+ 1
1562 Self_ID
.Master_Within
= Self_ID
.Master_of_Task
+ 2);
1563 pragma Assert
(Self_ID
.Common
.Wait_Count
= 0);
1564 pragma Assert
(Self_ID
.Open_Accepts
= null);
1565 pragma Assert
(Self_ID
.ATC_Nesting_Level
= 1);
1567 pragma Debug
(Debug
.Trace
(Self_ID
, "V_Complete_Task", 'C'));
1573 Write_Lock
(Self_ID
);
1574 Self_ID
.Callable
:= False;
1576 -- In theory, Self should have no pending entry calls left on its
1577 -- call-stack. Each async. select statement should clean its own call,
1578 -- and blocking entry calls should defer abort until the calls are
1579 -- cancelled, then clean up.
1581 Utilities
.Cancel_Queued_Entry_Calls
(Self_ID
);
1584 if Self_ID
.Common
.Activator
/= null then
1585 Vulnerable_Complete_Activation
(Self_ID
);
1592 -- If Self_ID.Master_Within = Self_ID.Master_of_Task + 2
1593 -- we may have dependent tasks for which we need to wait.
1594 -- Otherwise, we can just exit.
1596 if Self_ID
.Master_Within
= Self_ID
.Master_of_Task
+ 2 then
1597 Vulnerable_Complete_Master
(Self_ID
);
1599 end Vulnerable_Complete_Task
;
1601 --------------------------
1602 -- Vulnerable_Free_Task --
1603 --------------------------
1605 -- Recover all runtime system storage associated with the task T.
1606 -- This should only be called after T has terminated and will no
1607 -- longer be referenced.
1609 -- For tasks created by an allocator that fails, due to an exception,
1610 -- it is called from Expunge_Unactivated_Tasks.
1612 -- For tasks created by elaboration of task object declarations it
1613 -- is called from the finalization code of the Task_Wrapper procedure.
1614 -- It is also called from Unchecked_Deallocation, for objects that
1615 -- are or contain tasks.
1617 procedure Vulnerable_Free_Task
(T
: Task_Id
) is
1619 pragma Debug
(Debug
.Trace
(Self
, "Vulnerable_Free_Task", 'C', T
));
1626 Initialization
.Finalize_Attributes_Link
.all (T
);
1633 System
.Task_Primitives
.Operations
.Finalize_TCB
(T
);
1634 end Vulnerable_Free_Task
;
1637 -- Establish the Adafinal softlink.
1639 -- This is not done inside the central RTS initialization routine
1640 -- to avoid with-ing this package from System.Tasking.Initialization.
1642 SSL
.Adafinal
:= Finalize_Global_Tasks
'Access;
1644 -- Establish soft links for subprograms that manipulate master_id's.
1645 -- This cannot be done when the RTS is initialized, because of various
1646 -- elaboration constraints.
1648 SSL
.Current_Master
:= Stages
.Current_Master
'Access;
1649 SSL
.Enter_Master
:= Stages
.Enter_Master
'Access;
1650 SSL
.Complete_Master
:= Stages
.Complete_Master
'Access;
1651 end System
.Tasking
.Stages
;