New Language: Ada

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@45957 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 1549 insertions, 0 deletions

diff --git a/gcc/ada/s-tassta.adb b/gcc/ada/s-tassta.adb
new file mode 100644
index 00000000000..3c265f2f1d2
--- /dev/null
+++ b/gcc/ada/s-tassta.adb
@@ -0,0 +1,1549 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
+--                                                                          --
+--                 S Y S T E M . T A S K I N G . S T A G E S                --
+--                                                                          --
+--                                  B o d y                                 --
+--                                                                          --
+--                            $Revision: 1.138 $
+--                                                                          --
+--            Copyright (C) 1991-2001 Florida State University              --
+--                                                                          --
+-- GNARL is free software; you can  redistribute it  and/or modify it under --
+-- terms of the  GNU General Public License as published  by the Free Soft- --
+-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
+-- sion. GNARL is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+-- for  more details.  You should have  received  a copy of the GNU General --
+-- Public License  distributed with GNARL; see file COPYING.  If not, write --
+-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
+-- MA 02111-1307, USA.                                                      --
+--                                                                          --
+-- As a special exception,  if other files  instantiate  generics from this --
+-- unit, or you link  this unit with other files  to produce an executable, --
+-- this  unit  does not  by itself cause  the resulting  executable  to  be --
+-- covered  by the  GNU  General  Public  License.  This exception does not --
+-- however invalidate  any other reasons why  the executable file  might be --
+-- covered by the  GNU Public License.                                      --
+--                                                                          --
+-- GNARL was developed by the GNARL team at Florida State University. It is --
+-- now maintained by Ada Core Technologies Inc. in cooperation with Florida --
+-- State University (http://www.gnat.com).                                  --
+--                                                                          --
+------------------------------------------------------------------------------
+
+pragma Polling (Off);
+--  Turn off polling, we do not want ATC polling to take place during
+--  tasking operations. It causes infinite loops and other problems.
+
+with Ada.Exceptions;
+--  used for Raise_Exception
+
+with System.Tasking.Debug;
+pragma Warnings (Off, System.Tasking.Debug);
+--  used for enabling tasking facilities with gdb
+
+with System.Address_Image;
+--  used for the function itself.
+
+with System.Parameters;
+--  used for Size_Type
+
+with System.Task_Info;
+--  used for Task_Info_Type
+--           Task_Image_Type
+
+with System.Task_Primitives.Operations;
+--  used for Finalize_Lock
+--           Enter_Task
+--           Write_Lock
+--           Unlock
+--           Sleep
+--           Wakeup
+--           Get_Priority
+--           Lock/Unlock_All_Tasks_List
+--           New_ATCB
+
+with System.Soft_Links;
+--  These are procedure pointers to non-tasking routines that use
+--  task specific data. In the absence of tasking, these routines
+--  refer to global data. In the presense of tasking, they must be
+--  replaced with pointers to task-specific versions.
+--  Also used for Create_TSD, Destroy_TSD, Get_Current_Excep
+
+with System.Tasking.Initialization;
+--  Used for Remove_From_All_Tasks_List
+--           Defer_Abort
+--           Undefer_Abort
+--           Initialization.Poll_Base_Priority_Change
+--           Finalize_Attributes_Link
+--           Initialize_Attributes_Link
+
+pragma Elaborate_All (System.Tasking.Initialization);
+--  This insures that tasking is initialized if any tasks are created.
+
+with System.Tasking.Utilities;
+--  Used for Make_Passive
+--           Abort_One_Task
+
+with System.Tasking.Queuing;
+--  Used for Dequeue_Head
+
+with System.Tasking.Rendezvous;
+--  Used for Call_Simple
+
+with System.OS_Primitives;
+--  Used for Delay_Modes
+
+with System.Finalization_Implementation;
+--  Used for System.Finalization_Implementation.Finalize_Global_List
+
+with Interfaces.C;
+--  Used for type Unsigned.
+
+with System.Secondary_Stack;
+--  used for SS_Init;
+
+with System.Storage_Elements;
+--  used for Storage_Array;
+
+with System.Standard_Library;
+--  used for Exception_Trace
+
+package body System.Tasking.Stages is
+
+   package STPO renames System.Task_Primitives.Operations;
+   package SSL  renames System.Soft_Links;
+   package SSE  renames System.Storage_Elements;
+   package SST  renames System.Secondary_Stack;
+
+   use Ada.Exceptions;
+
+   use System.Task_Primitives;
+   use System.Task_Primitives.Operations;
+   use System.Task_Info;
+
+   procedure Wakeup_Entry_Caller
+     (Self_ID    : Task_ID;
+      Entry_Call : Entry_Call_Link;
+      New_State  : Entry_Call_State)
+   renames Initialization.Wakeup_Entry_Caller;
+
+   procedure Cancel_Queued_Entry_Calls (T : Task_ID)
+   renames Utilities.Cancel_Queued_Entry_Calls;
+
+   procedure Abort_One_Task
+     (Self_ID : Task_ID;
+      T       : Task_ID)
+   renames Utilities.Abort_One_Task;
+
+   -----------------------
+   -- Local Subprograms --
+   -----------------------
+
+   procedure Notify_Exception
+     (Self_Id : Task_ID;
+      Excep   : Exception_Occurrence);
+   --  This procedure will output the task ID and the exception information,
+   --  including traceback if available.
+
+   procedure Task_Wrapper (Self_ID : Task_ID);
+   --  This is the procedure that is called by the GNULL from the
+   --  new context when a task is created. It waits for activation
+   --  and then calls the task body procedure. When the task body
+   --  procedure completes, it terminates the task.
+
+   procedure Vulnerable_Complete_Task (Self_ID : Task_ID);
+   --  Complete the calling task.
+   --  This procedure must be called with abort deferred.
+   --  It should only be called by Complete_Task and
+   --  Finalizate_Global_Tasks (for the environment task).
+
+   procedure Vulnerable_Complete_Master (Self_ID : Task_ID);
+   --  Complete the current master of the calling task.
+   --  This procedure must be called with abort deferred.
+   --  It should only be called by Vulnerable_Complete_Task and
+   --  Complete_Master.
+
+   procedure Vulnerable_Complete_Activation (Self_ID : Task_ID);
+   --  Signal to Self_ID's activator that Self_ID has
+   --  completed activation.
+   --
+   --  Does not defer abortion (unlike Complete_Activation).
+
+   procedure Abort_Dependents (Self_ID : Task_ID);
+   --  Abort all the dependents of Self at our current master
+   --  nesting level.
+
+   procedure Vulnerable_Free_Task (T : Task_ID);
+   --  Recover all runtime system storage associated with the task T.
+   --  This should only be called after T has terminated and will no
+   --  longer be referenced.
+   --
+   --  For tasks created by an allocator that fails, due to an exception,
+   --  it is called from Expunge_Unactivated_Tasks.
+   --
+   --  It is also called from Unchecked_Deallocation, for objects that
+   --  are or contain tasks.
+   --
+   --  Different code is used at master completion, in Terminate_Dependents,
+   --  due to a need for tighter synchronization with the master.
+
+   procedure Terminate_Task (Self_ID : Task_ID);
+   --  Terminate the calling task.
+   --  This should only be called by the Task_Wrapper procedure.
+
+   ----------------------
+   -- Abort_Dependents --
+   ----------------------
+
+   --  Abort all the direct dependents of Self at its current master
+   --  nesting level, plus all of their dependents, transitively.
+   --  No locks should be held when this routine is called.
+
+   procedure Abort_Dependents (Self_ID : Task_ID) is
+      C : Task_ID;
+      P : Task_ID;
+
+   begin
+      Lock_All_Tasks_List;
+
+      C := All_Tasks_List;
+      while C /= null loop
+         P := C.Common.Parent;
+         while P /= null loop
+            if P = Self_ID then
+
+               --  ??? C is supposed to take care of its own dependents, so
+               --  there should be no need to take worry about them. Need to
+               --  double check this.
+
+               if C.Master_of_Task = Self_ID.Master_Within then
+                  Abort_One_Task (Self_ID, C);
+                  C.Dependents_Aborted := True;
+               end if;
+
+               exit;
+            end if;
+
+            P := P.Common.Parent;
+         end loop;
+
+         C := C.Common.All_Tasks_Link;
+      end loop;
+
+      Self_ID.Dependents_Aborted := True;
+      Unlock_All_Tasks_List;
+   end Abort_Dependents;
+
+   -----------------
+   -- Abort_Tasks --
+   -----------------
+
+   procedure Abort_Tasks (Tasks : Task_List) is
+   begin
+      Utilities.Abort_Tasks (Tasks);
+   end Abort_Tasks;
+
+   --------------------
+   -- Activate_Tasks --
+   --------------------
+
+   --  Note that locks of activator and activated task are both locked
+   --  here. This is necessary because C.Common.State and
+   --  Self.Common.Wait_Count have to be synchronized. This is safe from
+   --  deadlock because the activator is always created before the activated
+   --  task. That satisfies our in-order-of-creation ATCB locking policy.
+
+   --  At one point, we may also lock the parent, if the parent is
+   --  different from the activator.  That is also consistent with the
+   --  lock ordering policy, since the activator cannot be created
+   --  before the parent.
+
+   --  Since we are holding both the activator's lock, and Task_Wrapper
+   --  locks that before it does anything more than initialize the
+   --  low-level ATCB components, it should be safe to wait to update
+   --  the counts until we see that the thread creation is successful.
+
+   --  If the thread creation fails, we do need to close the entries
+   --  of the task.  The first phase, of dequeuing calls, only requires
+   --  locking the acceptor's ATCB, but the waking up of the callers
+   --  requires locking the caller's ATCB.  We cannot safely do this
+   --  while we are holding other locks.  Therefore, the queue-clearing
+   --  operation is done in a separate pass over the activation chain.
+
+   procedure Activate_Tasks
+     (Chain_Access : Activation_Chain_Access)
+   is
+      Self_ID        : constant Task_ID := STPO.Self;
+      P              : Task_ID;
+      C              : Task_ID;
+      Next_C, Last_C : Task_ID;
+      Activate_Prio  : System.Any_Priority;
+      Success        : Boolean;
+      All_Elaborated : Boolean := True;
+
+   begin
+      pragma Debug
+        (Debug.Trace (Self_ID, "Activate_Tasks", 'C'));
+
+      Initialization.Defer_Abort_Nestable (Self_ID);
+
+      pragma Assert (Self_ID.Common.Wait_Count = 0);
+
+      --  Lock All_Tasks_L, to prevent activated tasks
+      --  from racing ahead before we finish activating the chain.
+
+      --  ?????
+      --  Is there some less heavy-handed way?
+      --  In an earlier version, we used the activator's lock here,
+      --  but that violated the locking order rule when we had
+      --  to lock the parent later.
+
+      Lock_All_Tasks_List;
+
+      --  Check that all task bodies have been elaborated.
+
+      C := Chain_Access.T_ID;
+      Last_C := null;
+      while C /= null loop
+         if C.Common.Elaborated /= null
+           and then not C.Common.Elaborated.all
+         then
+            All_Elaborated := False;
+         end if;
+
+         --  Reverse the activation chain so that tasks are
+         --  activated in the same order they're declared.
+
+         Next_C := C.Common.Activation_Link;
+         C.Common.Activation_Link := Last_C;
+         Last_C := C;
+         C := Next_C;
+      end loop;
+
+      Chain_Access.T_ID := Last_C;
+
+      if not All_Elaborated then
+         Unlock_All_Tasks_List;
+         Initialization.Undefer_Abort_Nestable (Self_ID);
+         Raise_Exception
+           (Program_Error'Identity, "Some tasks have not been elaborated");
+      end if;
+
+      --  Activate all the tasks in the chain.
+      --  Creation of the thread of control was deferred until
+      --  activation. So create it now.
+
+      C := Chain_Access.T_ID;
+      while C /= null loop
+         if C.Common.State /= Terminated then
+            pragma Assert (C.Common.State = Unactivated);
+
+            P := C.Common.Parent;
+            Write_Lock (P);
+            Write_Lock (C);
+
+            if C.Common.Base_Priority < Get_Priority (Self_ID) then
+               Activate_Prio := Get_Priority (Self_ID);
+            else
+               Activate_Prio := C.Common.Base_Priority;
+            end if;
+
+            System.Task_Primitives.Operations.Create_Task
+              (C, Task_Wrapper'Address,
+               Parameters.Size_Type
+                 (C.Common.Compiler_Data.Pri_Stack_Info.Size),
+               Activate_Prio, Success);
+
+            --  There would be a race between the created task and
+            --  the creator to do the following initialization,
+            --  if we did not have a Lock/Unlock_All_Tasks_List pair
+            --  in the task wrapper, to prevent it from racing ahead.
+
+            if Success then
+               C.Common.State := Runnable;
+               C.Awake_Count := 1;
+               C.Alive_Count := 1;
+               P.Awake_Count := P.Awake_Count + 1;
+               P.Alive_Count := P.Alive_Count + 1;
+
+               if P.Common.State = Master_Completion_Sleep and then
+                 C.Master_of_Task = P.Master_Within
+               then
+                  pragma Assert (Self_ID /= P);
+                  P.Common.Wait_Count := P.Common.Wait_Count + 1;
+               end if;
+
+               Unlock (C);
+               Unlock (P);
+
+            else
+               --  No need to set Awake_Count, State, etc. here since the loop
+               --  below will do that for any Unactivated tasks.
+
+               Unlock (C);
+               Unlock (P);
+               Self_ID.Common.Activation_Failed := True;
+            end if;
+         end if;
+
+         C := C.Common.Activation_Link;
+      end loop;
+
+      Unlock_All_Tasks_List;
+
+      --  Close the entries of any tasks that failed thread creation,
+      --  and count those that have not finished activation.
+
+      Write_Lock (Self_ID);
+      Self_ID.Common.State := Activator_Sleep;
+
+      C :=  Chain_Access.T_ID;
+      while C /= null loop
+         Write_Lock (C);
+
+         if C.Common.State = Unactivated then
+            C.Common.Activator := null;
+            C.Common.State := Terminated;
+            C.Callable := False;
+            Cancel_Queued_Entry_Calls (C);
+
+         elsif C.Common.Activator /= null then
+            Self_ID.Common.Wait_Count := Self_ID.Common.Wait_Count + 1;
+         end if;
+
+         Unlock (C);
+         P := C.Common.Activation_Link;
+         C.Common.Activation_Link := null;
+         C := P;
+      end loop;
+
+      --  Wait for the activated tasks to complete activation.
+      --  It is unsafe to abort any of these tasks until the count goes to
+      --  zero.
+
+      loop
+         Initialization.Poll_Base_Priority_Change (Self_ID);
+         exit when Self_ID.Common.Wait_Count = 0;
+         Sleep (Self_ID, Activator_Sleep);
+      end loop;
+
+      Self_ID.Common.State := Runnable;
+      Unlock (Self_ID);
+
+      --  Remove the tasks from the chain.
+
+      Chain_Access.T_ID := null;
+      Initialization.Undefer_Abort_Nestable (Self_ID);
+
+      if Self_ID.Common.Activation_Failed then
+         Self_ID.Common.Activation_Failed := False;
+         Raise_Exception (Tasking_Error'Identity,
+           "Failure during activation");
+      end if;
+   end Activate_Tasks;
+
+   -------------------------
+   -- Complete_Activation --
+   -------------------------
+
+   procedure Complete_Activation is
+      Self_ID : constant Task_ID := STPO.Self;
+
+   begin
+      Initialization.Defer_Abort_Nestable (Self_ID);
+      Vulnerable_Complete_Activation (Self_ID);
+      Initialization.Undefer_Abort_Nestable (Self_ID);
+
+      --  ?????
+      --  Why do we need to allow for nested deferral here?
+
+   end Complete_Activation;
+
+   ---------------------
+   -- Complete_Master --
+   ---------------------
+
+   procedure Complete_Master is
+      Self_ID : Task_ID := STPO.Self;
+
+   begin
+      pragma Assert (Self_ID.Deferral_Level > 0);
+
+      Vulnerable_Complete_Master (Self_ID);
+   end Complete_Master;
+
+   -------------------
+   -- Complete_Task --
+   -------------------
+
+   --  See comments on Vulnerable_Complete_Task for details.
+
+   procedure Complete_Task is
+      Self_ID  : constant Task_ID := STPO.Self;
+
+   begin
+      pragma Assert (Self_ID.Deferral_Level > 0);
+
+      Vulnerable_Complete_Task (Self_ID);
+
+      --  All of our dependents have terminated.
+      --  Never undefer abort again!
+
+   end Complete_Task;
+
+   -----------------
+   -- Create_Task --
+   -----------------
+
+   --  Compiler interface only. Do not call from within the RTS.
+   --  This must be called to create a new task.
+
+   procedure Create_Task
+     (Priority      : Integer;
+      Size          : System.Parameters.Size_Type;
+      Task_Info     : System.Task_Info.Task_Info_Type;
+      Num_Entries   : Task_Entry_Index;
+      Master        : Master_Level;
+      State         : Task_Procedure_Access;
+      Discriminants : System.Address;
+      Elaborated    : Access_Boolean;
+      Chain         : in out Activation_Chain;
+      Task_Image    : System.Task_Info.Task_Image_Type;
+      Created_Task  : out Task_ID)
+   is
+      T, P          : Task_ID;
+      Self_ID       : constant Task_ID := STPO.Self;
+      Success       : Boolean;
+      Base_Priority : System.Any_Priority;
+
+   begin
+      pragma Debug
+        (Debug.Trace (Self_ID, "Create_Task", 'C'));
+
+      if Priority = Unspecified_Priority then
+         Base_Priority := Self_ID.Common.Base_Priority;
+      else
+         Base_Priority := System.Any_Priority (Priority);
+      end if;
+
+      --  Find parent P of new Task, via master level number.
+
+      P := Self_ID;
+
+      if P /= null then
+         while P.Master_of_Task >= Master loop
+            P := P.Common.Parent;
+            exit when P = null;
+         end loop;
+      end if;
+
+      Initialization.Defer_Abort_Nestable (Self_ID);
+
+      begin
+         T := New_ATCB (Num_Entries);
+
+      exception
+         when others =>
+            Initialization.Undefer_Abort_Nestable (Self_ID);
+            Raise_Exception (Storage_Error'Identity, "Cannot allocate task");
+      end;
+
+      --  All_Tasks_L is used by Abort_Dependents and Abort_Tasks.
+      --  Up to this point, it is possible that we may be part of
+      --  a family of tasks that is being aborted.
+
+      Lock_All_Tasks_List;
+      Write_Lock (Self_ID);
+
+      --  Now, we must check that we have not been aborted.
+      --  If so, we should give up on creating this task,
+      --  and simply return.
+
+      if not Self_ID.Callable then
+         pragma Assert (Self_ID.Pending_ATC_Level = 0);
+         pragma Assert (Self_ID.Pending_Action);
+         pragma Assert (Chain.T_ID = null
+             or else Chain.T_ID.Common.State = Unactivated);
+
+         Unlock (Self_ID);
+         Unlock_All_Tasks_List;
+         Initialization.Undefer_Abort_Nestable (Self_ID);
+
+         --  ??? Should never get here
+
+         pragma Assert (False);
+         raise Standard'Abort_Signal;
+      end if;
+
+      Initialize_ATCB (Self_ID, State, Discriminants, P, Elaborated,
+        Base_Priority, Task_Info, Size, T, Success);
+
+      if not Success then
+         Unlock (Self_ID);
+         Unlock_All_Tasks_List;
+         Initialization.Undefer_Abort_Nestable (Self_ID);
+         Raise_Exception
+           (Storage_Error'Identity, "Failed to initialize task");
+      end if;
+
+      T.Master_of_Task := Master;
+      T.Master_Within := T.Master_of_Task + 1;
+
+      for L in T.Entry_Calls'Range loop
+         T.Entry_Calls (L).Self := T;
+         T.Entry_Calls (L).Level := L;
+      end loop;
+
+      T.Common.Task_Image := Task_Image;
+      Unlock (Self_ID);
+      Unlock_All_Tasks_List;
+
+      --  Create TSD as early as possible in the creation of a task, since it
+      --  may be used by the operation of Ada code within the task.
+
+      SSL.Create_TSD (T.Common.Compiler_Data);
+      T.Common.Activation_Link := Chain.T_ID;
+      Chain.T_ID := T;
+      Initialization.Initialize_Attributes_Link.all (T);
+      Created_Task := T;
+      Initialization.Undefer_Abort_Nestable (Self_ID);
+   end Create_Task;
+
+   --------------------
+   -- Current_Master --
+   --------------------
+
+   function Current_Master return Master_Level is
+      Self_ID : constant Task_ID := STPO.Self;
+
+   begin
+      return Self_ID.Master_Within;
+   end Current_Master;
+
+   ------------------
+   -- Enter_Master --
+   ------------------
+
+   procedure Enter_Master is
+      Self_ID : constant Task_ID := STPO.Self;
+
+   begin
+      Self_ID.Master_Within := Self_ID.Master_Within + 1;
+   end Enter_Master;
+
+   -------------------------------
+   -- Expunge_Unactivated_Tasks --
+   -------------------------------
+
+   --  See procedure Close_Entries for the general case.
+
+   procedure Expunge_Unactivated_Tasks (Chain : in out Activation_Chain) is
+      Self_ID : constant Task_ID := STPO.Self;
+      C       : Task_ID;
+      Call    : Entry_Call_Link;
+      Temp    : Task_ID;
+
+   begin
+      pragma Debug
+        (Debug.Trace (Self_ID, "Expunge_Unactivated_Tasks", 'C'));
+
+      Initialization.Defer_Abort_Nestable (Self_ID);
+
+      --  ????
+      --  Experimentation has shown that abort is sometimes (but not
+      --  always) already deferred when this is called.
+      --  That may indicate an error.  Find out what is going on.
+
+      C := Chain.T_ID;
+
+      while C /= null loop
+         pragma Assert (C.Common.State = Unactivated);
+
+         Temp := C.Common.Activation_Link;
+
+         if C.Common.State = Unactivated then
+            Write_Lock (C);
+
+            for J in 1 .. C.Entry_Num loop
+               Queuing.Dequeue_Head (C.Entry_Queues (J), Call);
+               pragma Assert (Call = null);
+            end loop;
+
+            Unlock (C);
+            Initialization.Remove_From_All_Tasks_List (C);
+            Vulnerable_Free_Task (C);
+            C := Temp;
+         end if;
+      end loop;
+
+      Chain.T_ID := null;
+      Initialization.Undefer_Abort_Nestable (Self_ID);
+   end Expunge_Unactivated_Tasks;
+
+   ---------------------------
+   -- Finalize_Global_Tasks --
+   ---------------------------
+
+   --  ????
+   --  We have a potential problem here if finalization of global
+   --  objects does anything with signals or the timer server, since
+   --  by that time those servers have terminated.
+
+   --  It is hard to see how that would occur.
+
+   --  However, a better solution might be to do all this finalization
+   --  using the global finalization chain.
+
+   procedure Finalize_Global_Tasks is
+      Self_ID          : constant Task_ID := STPO.Self;
+      Zero_Independent : Boolean;
+
+   begin
+      if Self_ID.Deferral_Level = 0 then
+
+         --  ??????
+         --  In principle, we should be able to predict whether
+         --  abort is already deferred here (and it should not be deferred
+         --  yet but in practice it seems Finalize_Global_Tasks is being
+         --  called sometimes, from RTS code for exceptions, with abort already
+         --  deferred.
+
+         Initialization.Defer_Abort_Nestable (Self_ID);
+
+         --  Never undefer again!!!
+
+      end if;
+
+      --  This code is only executed by the environment task
+
+      pragma Assert (Self_ID = Environment_Task);
+
+      --  Set Environment_Task'Callable to false to notify library-level tasks
+      --  that it is waiting for them (cf 5619-003).
+
+      Self_ID.Callable := False;
+
+      --  Exit level 2 master, for normal tasks in library-level packages.
+
+      Complete_Master;
+
+      --  Force termination of "independent" library-level server tasks.
+
+      Abort_Dependents (Self_ID);
+
+      --  We need to explicitely wait for the task to be
+      --  terminated here because on true concurrent system, we
+      --  may end this procedure before the tasks are really
+      --  terminated.
+
+      loop
+         Write_Lock (Self_ID);
+         Zero_Independent := Utilities.Independent_Task_Count = 0;
+         Unlock (Self_ID);
+
+         --  We used to yield here, but this did not take into account
+         --  low priority tasks that would cause dead lock in some cases.
+         --  See 8126-020.
+
+         Timed_Delay (Self_ID, 0.01, System.OS_Primitives.Relative);
+         exit when Zero_Independent;
+      end loop;
+
+      --  ??? On multi-processor environments, it seems that the above loop
+      --  isn't sufficient, so we need to add an additional delay.
+
+      Timed_Delay (Self_ID, 0.1, System.OS_Primitives.Relative);
+
+      --  Complete the environment task.
+
+      Vulnerable_Complete_Task (Self_ID);
+
+      System.Finalization_Implementation.Finalize_Global_List;
+
+      SSL.Abort_Defer        := SSL.Abort_Defer_NT'Access;
+      SSL.Abort_Undefer      := SSL.Abort_Undefer_NT'Access;
+      SSL.Lock_Task          := SSL.Task_Lock_NT'Access;
+      SSL.Unlock_Task        := SSL.Task_Unlock_NT'Access;
+      SSL.Get_Jmpbuf_Address := SSL.Get_Jmpbuf_Address_NT'Access;
+      SSL.Set_Jmpbuf_Address := SSL.Set_Jmpbuf_Address_NT'Access;
+      SSL.Get_Sec_Stack_Addr := SSL.Get_Sec_Stack_Addr_NT'Access;
+      SSL.Set_Sec_Stack_Addr := SSL.Set_Sec_Stack_Addr_NT'Access;
+      SSL.Get_Exc_Stack_Addr := SSL.Get_Exc_Stack_Addr_NT'Access;
+      SSL.Set_Exc_Stack_Addr := SSL.Set_Exc_Stack_Addr_NT'Access;
+      SSL.Check_Abort_Status := SSL.Check_Abort_Status_NT'Access;
+      SSL.Get_Stack_Info     := SSL.Get_Stack_Info_NT'Access;
+
+      --  Don't bother trying to finalize Initialization.Global_Task_Lock
+      --  and System.Task_Primitives.All_Tasks_L.
+   end Finalize_Global_Tasks;
+
+   ---------------
+   -- Free_Task --
+   ---------------
+
+   procedure Free_Task (T : Task_ID) is
+      Self_Id : constant Task_ID := Self;
+
+   begin
+      if T.Common.State = Terminated then
+
+         --  It is not safe to call Abort_Defer or Write_Lock at this stage
+
+         Initialization.Task_Lock (Self_Id);
+
+         if T.Common.Task_Image /= null then
+            Free_Task_Image (T.Common.Task_Image);
+         end if;
+
+         Initialization.Remove_From_All_Tasks_List (T);
+         Initialization.Task_Unlock (Self_Id);
+
+         System.Task_Primitives.Operations.Finalize_TCB (T);
+
+      --  If the task is not terminated, then we simply ignore the call. This
+      --  happens when a user program attempts an unchecked deallocation on
+      --  a non-terminated task.
+
+      else
+         null;
+      end if;
+   end Free_Task;
+
+   ----------------------
+   -- Notify_Exception --
+   ----------------------
+
+   procedure Notify_Exception
+     (Self_Id : Task_ID;
+      Excep   : Exception_Occurrence)
+   is
+      procedure To_Stderr (S : String);
+      pragma Import (Ada, To_Stderr, "__gnat_to_stderr");
+
+      use System.Task_Info;
+      use System.Soft_Links;
+
+      function To_Address is new
+        Unchecked_Conversion (Task_ID, System.Address);
+
+      function Tailored_Exception_Information
+        (E : Exception_Occurrence) return String;
+      pragma Import
+        (Ada, Tailored_Exception_Information,
+         "__gnat_tailored_exception_information");
+
+   begin
+      To_Stderr ("task ");
+
+      if Self_Id.Common.Task_Image /= null then
+         To_Stderr (Self_Id.Common.Task_Image.all);
+         To_Stderr ("_");
+      end if;
+
+      To_Stderr (System.Address_Image (To_Address (Self_Id)));
+      To_Stderr (" terminated by unhandled exception");
+      To_Stderr ((1 => ASCII.LF));
+      To_Stderr (Tailored_Exception_Information (Excep));
+   end Notify_Exception;
+
+   ------------------
+   -- Task_Wrapper --
+   ------------------
+
+   --  The task wrapper is a procedure that is called first for each task
+   --  task body, and which in turn calls the compiler-generated task body
+   --  procedure. The wrapper's main job is to do initialization for the task.
+   --  It also has some locally declared objects that server as per-task local
+   --  data. Task finalization is done by Complete_Task, which is called from
+   --  an at-end handler that the compiler generates.
+
+   --  The variable ID in the task wrapper is used to implement the Self
+   --  function on targets where there is a fast way to find the stack base
+   --  of the current thread, since it should be at a fixed offset from the
+   --  stack base.
+
+   --  The variable Magic_Number is also used in such implementations
+   --  of Self, to check whether the current task is an Ada task, as
+   --  compared to other-language threads.
+
+   --  Both act as constants, once initialized, but need to be marked as
+   --  volatile or aliased to prevent the compiler from optimizing away the
+   --  storage. See System.Task_Primitives.Operations.Self for more info.
+
+   procedure Task_Wrapper (Self_ID : Task_ID) is
+      ID : Task_ID := Self_ID;
+      pragma Volatile (ID);
+      --  Do not delete this variable.
+      --  In some targets, we need this variable to implement a fast Self.
+
+      Magic_Number : Interfaces.C.unsigned := 16#ADAADAAD#;
+      pragma Volatile (Magic_Number);
+      --  We use this to verify that we are looking at an Ada task,
+      --  inside of System.Task_Primitives.Operations.Self.
+
+      use type System.Parameters.Size_Type;
+      use type SSE.Storage_Offset;
+      use System.Standard_Library;
+
+      Secondary_Stack : aliased SSE.Storage_Array
+        (1 .. ID.Common.Compiler_Data.Pri_Stack_Info.Size *
+           SSE.Storage_Offset (Parameters.Sec_Stack_Ratio) / 100);
+      Secondary_Stack_Address : System.Address := Secondary_Stack'Address;
+
+   begin
+      pragma Assert (Self_ID.Deferral_Level = 1);
+
+      if not Parameters.Sec_Stack_Dynamic then
+         ID.Common.Compiler_Data.Sec_Stack_Addr := Secondary_Stack'Address;
+         SST.SS_Init (Secondary_Stack_Address, Integer (Secondary_Stack'Last));
+      end if;
+
+      --  Set the guard page at the bottom of the stack.
+      --  The call to unprotect the page is done in Terminate_Task
+
+      Stack_Guard (Self_ID, True);
+
+      --  Initialize low-level TCB components, that
+      --  cannot be initialized by the creator.
+      --  Enter_Task sets Self_ID.Known_Tasks_Index
+      --  and Self_ID.LL.Thread
+
+      Enter_Task (Self_ID);
+
+      --  We lock All_Tasks_L to wait for activator to finish activating
+      --  the rest of the chain, so that everyone in the chain comes out
+      --  in priority order.
+      --  This also protects the value of
+      --   Self_ID.Common.Activator.Common.Wait_Count.
+
+      Lock_All_Tasks_List;
+      Unlock_All_Tasks_List;
+
+      begin
+         --  We are separating the following portion of the code in order to
+         --  place the exception handlers in a different block.
+         --  In this way we do not call Set_Jmpbuf_Address (which needs
+         --  Self) before we set Self in Enter_Task
+
+         --  Call the task body procedure.
+
+         --  The task body is called with abort still deferred. That
+         --  eliminates a dangerous window, for which we had to patch-up in
+         --  Terminate_Task.
+         --  During the expansion of the task body, we insert an RTS-call
+         --  to Abort_Undefer, at the first point where abort should be
+         --  allowed.
+
+         Self_ID.Common.Task_Entry_Point (Self_ID.Common.Task_Arg);
+
+         Terminate_Task (Self_ID);
+
+      exception
+         when Standard'Abort_Signal =>
+            Terminate_Task (Self_ID);
+
+         when others =>
+            --  ??? Using an E : others here causes CD2C11A  to fail on
+            --      DEC Unix, see 7925-005.
+
+            if Exception_Trace = Unhandled_Raise then
+               Notify_Exception (Self_ID, SSL.Get_Current_Excep.all.all);
+            end if;
+
+            Terminate_Task (Self_ID);
+      end;
+   end Task_Wrapper;
+
+   --------------------
+   -- Terminate_Task --
+   --------------------
+
+   --  Before we allow the thread to exit, we must clean up. This is a
+   --  a delicate job. We must wake up the task's master, who may immediately
+   --  try to deallocate the ATCB out from under the current task WHILE IT IS
+   --  STILL EXECUTING.
+
+   --  To avoid this, the parent task must be blocked up to the last thing
+   --  done before the call to Exit_Task. The trouble is that we have another
+   --  step that we also want to postpone to the very end, i.e., calling
+   --  SSL.Destroy_TSD. We have to postpone that until the end because
+   --  compiler-generated code is likely to try to access that data at just
+   --  about any point.
+
+   --  We can't call Destroy_TSD while we are holding any other locks, because
+   --  it locks Global_Task_Lock, and our deadlock prevention rules require
+   --  that to be the outermost lock. Our first "solution" was to just lock
+   --  Global_Task_Lock in addition to the other locks, and force the parent
+   --  to also lock this lock between its wakeup and its freeing of the ATCB.
+   --  See Complete_Task for the parent-side of the code that has the matching
+   --  calls to Task_Lock and Task_Unlock. That was not really a solution,
+   --  since the operation Task_Unlock continued to access the ATCB after
+   --  unlocking, after which the parent was observed to race ahead,
+   --  deallocate the ATCB, and then reallocate it to another task.  The
+   --  call to Undefer_Abortion in Task_Unlock by the "terminated" task was
+   --  overwriting the data of the new task that reused the ATCB!  To solve
+   --  this problem, we introduced the new operation Final_Task_Unlock.
+
+   procedure Terminate_Task (Self_ID : Task_ID) is
+      Environment_Task : constant Task_ID := STPO.Environment_Task;
+
+   begin
+      pragma Assert (Self_ID.Common.Activator = null);
+
+      --  Since GCC cannot allocate stack chunks efficiently without reordering
+      --  some of the allocations, we have to handle this unexpected situation
+      --  here. We should normally never have to call Vulnerable_Complete_Task
+      --  here. See 6602-003 for more details.
+
+      if Self_ID.Common.Activator /= null then
+         Vulnerable_Complete_Task (Self_ID);
+      end if;
+
+      --  Check if the current task is an independent task
+      --  If so, decrement the Independent_Task_Count value.
+
+      if Self_ID.Master_of_Task = 2 then
+         Write_Lock (Environment_Task);
+         Utilities.Independent_Task_Count :=
+           Utilities.Independent_Task_Count - 1;
+         Unlock (Environment_Task);
+      end if;
+
+      --  Unprotect the guard page if needed.
+
+      Stack_Guard (Self_ID, False);
+
+      Initialization.Task_Lock (Self_ID);
+      Utilities.Make_Passive (Self_ID, Task_Completed => True);
+
+      pragma Assert (Check_Exit (Self_ID));
+
+      SSL.Destroy_TSD (Self_ID.Common.Compiler_Data);
+      Initialization.Final_Task_Unlock (Self_ID);
+
+      --  WARNING
+      --  past this point, this thread must assume that the ATCB
+      --  has been deallocated. It should not be accessed again.
+
+      STPO.Exit_Task;
+   end Terminate_Task;
+
+   ----------------
+   -- Terminated --
+   ----------------
+
+   function Terminated (T : Task_ID) return Boolean is
+      Result  : Boolean;
+      Self_ID : Task_ID := STPO.Self;
+
+   begin
+      Initialization.Defer_Abort_Nestable (Self_ID);
+      Write_Lock (T);
+      Result := T.Common.State = Terminated;
+      Unlock (T);
+      Initialization.Undefer_Abort_Nestable (Self_ID);
+      return Result;
+   end Terminated;
+
+   ------------------------------------
+   -- Vulnerable_Complete_Activation --
+   ------------------------------------
+
+   --  Only call this procedure with abortion deferred.
+
+   --  As in several other places, the locks of the activator and activated
+   --  task are both locked here.  This follows our deadlock prevention lock
+   --  ordering policy, since the activated task must be created after the
+   --  activator.
+
+   procedure Vulnerable_Complete_Activation (Self_ID : Task_ID) is
+      Activator : Task_ID := Self_ID.Common.Activator;
+
+   begin
+      pragma Debug
+        (Debug.Trace (Self_ID, "V_Complete_Activation", 'C'));
+
+      Write_Lock (Activator);
+      Write_Lock (Self_ID);
+
+      pragma Assert (Self_ID.Common.Activator /= null);
+
+      --  Remove dangling reference to Activator,
+      --  since a task may outlive its activator.
+
+      Self_ID.Common.Activator := null;
+
+      --  Wake up the activator, if it is waiting for a chain
+      --  of tasks to activate, and we are the last in the chain
+      --  to complete activation
+
+      if Activator.Common.State = Activator_Sleep then
+         Activator.Common.Wait_Count := Activator.Common.Wait_Count - 1;
+
+         if Activator.Common.Wait_Count = 0 then
+            Wakeup (Activator, Activator_Sleep);
+         end if;
+      end if;
+
+      --  The activator raises a Tasking_Error if any task
+      --  it is activating is completed before the activation is
+      --  done. However, if the reason for the task completion is
+      --  an abortion, we do not raise an exception. ARM 9.2(5).
+
+      if not Self_ID.Callable and then Self_ID.Pending_ATC_Level /= 0 then
+         Activator.Common.Activation_Failed := True;
+      end if;
+
+      Unlock (Self_ID);
+      Unlock (Activator);
+
+      --  After the activation, active priority should be the same
+      --  as base priority.   We must unlock the Activator first,
+      --  though, since it should not wait if we have lower priority.
+
+      if Get_Priority (Self_ID) /= Self_ID.Common.Base_Priority then
+         Write_Lock (Self_ID);
+         Set_Priority (Self_ID, Self_ID.Common.Base_Priority);
+         Unlock (Self_ID);
+      end if;
+   end Vulnerable_Complete_Activation;
+
+   --------------------------------
+   -- Vulnerable_Complete_Master --
+   --------------------------------
+
+   procedure Vulnerable_Complete_Master (Self_ID : Task_ID) is
+      C      : Task_ID;
+      P      : Task_ID;
+      CM     : Master_Level := Self_ID.Master_Within;
+      T      : aliased Task_ID;
+
+      To_Be_Freed : Task_ID;
+      --  This is a list of ATCBs to be freed, after we have released
+      --  all RTS locks.  This is necessary because of the locking order
+      --  rules, since the storage manager uses Global_Task_Lock.
+
+      pragma Warnings (Off);
+      function Check_Unactivated_Tasks return Boolean;
+      pragma Warnings (On);
+      --  Temporary error-checking code below. This is part of the checks
+      --  added in the new run time. Call it only inside a pragma Assert.
+
+      function Check_Unactivated_Tasks return Boolean is
+      begin
+         Lock_All_Tasks_List;
+         Write_Lock (Self_ID);
+         C := All_Tasks_List;
+
+         while C /= null loop
+            if C.Common.Activator = Self_ID then
+               return False;
+            end if;
+
+            if C.Common.Parent = Self_ID and then C.Master_of_Task = CM then
+               Write_Lock (C);
+
+               if C.Common.State = Unactivated then
+                  return False;
+               end if;
+
+               Unlock (C);
+            end if;
+
+            C := C.Common.All_Tasks_Link;
+         end loop;
+
+         Unlock (Self_ID);
+         Unlock_All_Tasks_List;
+         return True;
+      end Check_Unactivated_Tasks;
+
+   --  Start of processing for Vulnerable_Complete_Master
+
+   begin
+
+      pragma Debug
+        (Debug.Trace (Self_ID, "V_Complete_Master", 'C'));
+
+      pragma Assert (Self_ID.Common.Wait_Count = 0);
+      pragma Assert (Self_ID.Deferral_Level > 0);
+
+      --  Count how many active dependent tasks this master currently
+      --  has, and record this in Wait_Count.
+
+      --  This count should start at zero, since it is initialized to
+      --  zero for new tasks, and the task should not exit the
+      --  sleep-loops that use this count until the count reaches zero.
+
+      Lock_All_Tasks_List;
+      Write_Lock (Self_ID);
+      C := All_Tasks_List;
+
+      while C /= null loop
+         if C.Common.Activator = Self_ID then
+            pragma Assert (C.Common.State = Unactivated);
+
+            Write_Lock (C);
+            C.Common.Activator := null;
+            C.Common.State := Terminated;
+            C.Callable := False;
+            Cancel_Queued_Entry_Calls (C);
+            Unlock (C);
+         end if;
+
+         if C.Common.Parent = Self_ID and then C.Master_of_Task = CM then
+            Write_Lock (C);
+
+            if C.Awake_Count /= 0 then
+               Self_ID.Common.Wait_Count := Self_ID.Common.Wait_Count + 1;
+            end if;
+
+            Unlock (C);
+         end if;
+
+         C := C.Common.All_Tasks_Link;
+      end loop;
+
+      Self_ID.Common.State := Master_Completion_Sleep;
+      Unlock (Self_ID);
+      Unlock_All_Tasks_List;
+
+      --  Wait until dependent tasks are all terminated or ready to terminate.
+      --  While waiting, the task may be awakened if the task's priority needs
+      --  changing, or this master is aborted. In the latter case, we want
+      --  to abort the dependents, and resume waiting until Wait_Count goes
+      --  to zero.
+
+      Write_Lock (Self_ID);
+      loop
+         Initialization.Poll_Base_Priority_Change (Self_ID);
+         exit when Self_ID.Common.Wait_Count = 0;
+
+         --  Here is a difference as compared to Complete_Master
+
+         if Self_ID.Pending_ATC_Level < Self_ID.ATC_Nesting_Level
+           and then not Self_ID.Dependents_Aborted
+         then
+            Unlock (Self_ID);
+            Abort_Dependents (Self_ID);
+            Write_Lock (Self_ID);
+
+         else
+            Sleep (Self_ID, Master_Completion_Sleep);
+         end if;
+      end loop;
+
+      Self_ID.Common.State := Runnable;
+      Unlock (Self_ID);
+
+      --  Dependents are all terminated or on terminate alternatives.
+      --  Now, force those on terminate alternatives to terminate, by
+      --  aborting them.
+
+      pragma Assert (Check_Unactivated_Tasks);
+
+      if Self_ID.Alive_Count > 1 then
+
+         --  ?????
+         --  Consider finding a way to skip the following extra steps if
+         --  there are no dependents with terminate alternatives.  This
+         --  could be done by adding another count to the ATCB, similar to
+         --  Awake_Count, but keeping track of count of tasks that are on
+         --  terminate alternatives.
+
+         pragma Assert (Self_ID.Common.Wait_Count = 0);
+
+         --  Force any remaining dependents to terminate, by aborting them.
+
+         Abort_Dependents (Self_ID);
+
+         --  Above, when we "abort" the dependents we are simply using this
+         --  operation for convenience. We are not required to support the full
+         --  abort-statement semantics; in particular, we are not required to
+         --  immediately cancel any queued or in-service entry calls.  That is
+         --  good, because if we tried to cancel a call we would need to lock
+         --  the caller, in order to wake the caller up.  Our anti-deadlock
+         --  rules prevent us from doing that without releasing the locks on C
+         --  and Self_ID.  Releasing and retaking those locks would be
+         --  wasteful, at best, and should not be considered further without
+         --  more detailed analysis of potential concurrent accesses to the
+         --  ATCBs of C and Self_ID.
+
+         --  Count how many "alive" dependent tasks this master currently
+         --  has, and record this in Wait_Count.
+         --  This count should start at zero, since it is initialized to
+         --  zero for new tasks, and the task should not exit the
+         --  sleep-loops that use this count until the count reaches zero.
+
+         pragma Assert (Self_ID.Common.Wait_Count = 0);
+
+         Lock_All_Tasks_List;
+         Write_Lock (Self_ID);
+         C := All_Tasks_List;
+
+         while C /= null loop
+            if C.Common.Parent = Self_ID and then C.Master_of_Task = CM then
+               Write_Lock (C);
+
+               pragma Assert (C.Awake_Count = 0);
+
+               if C.Alive_Count > 0 then
+                  pragma Assert (C.Terminate_Alternative);
+                  Self_ID.Common.Wait_Count := Self_ID.Common.Wait_Count + 1;
+               end if;
+
+               Unlock (C);
+            end if;
+
+            C := C.Common.All_Tasks_Link;
+         end loop;
+
+         Self_ID.Common.State := Master_Phase_2_Sleep;
+         Unlock (Self_ID);
+         Unlock_All_Tasks_List;
+
+         --  Wait for all counted tasks to finish terminating themselves.
+
+         Write_Lock (Self_ID);
+
+         loop
+            Initialization.Poll_Base_Priority_Change (Self_ID);
+            exit when Self_ID.Common.Wait_Count = 0;
+            Sleep (Self_ID, Master_Phase_2_Sleep);
+         end loop;
+
+         Self_ID.Common.State := Runnable;
+         Unlock (Self_ID);
+      end if;
+
+      --  We don't wake up for abortion here. We are already terminating
+      --  just as fast as we can, so there is no point.
+      --  ????
+      --  Consider whether we want to bother checking for priority
+      --  changes in the loop above, though.
+
+      --  Remove terminated tasks from the list of Self_ID's dependents, but
+      --  don't free their ATCBs yet, because of lock order restrictions,
+      --  which don't allow us to call "free" or "malloc" while holding any
+      --  other locks. Instead, we put those ATCBs to be freed onto a
+      --  temporary list, called To_Be_Freed.
+
+      Lock_All_Tasks_List;
+      C := All_Tasks_List;
+      P := null;
+
+      while C /= null loop
+         if C.Common.Parent = Self_ID and then C.Master_of_Task >= CM then
+            if P /= null then
+               P.Common.All_Tasks_Link := C.Common.All_Tasks_Link;
+            else
+               All_Tasks_List := C.Common.All_Tasks_Link;
+            end if;
+
+            T := C.Common.All_Tasks_Link;
+            C.Common.All_Tasks_Link := To_Be_Freed;
+            To_Be_Freed := C;
+            C := T;
+
+         else
+            P := C;
+            C := C.Common.All_Tasks_Link;
+         end if;
+      end loop;
+
+      Unlock_All_Tasks_List;
+
+      --  Free all the ATCBs on the list To_Be_Freed.
+
+      --  The ATCBs in the list are no longer in All_Tasks_List, and after
+      --  any interrupt entries are detached from them they should no longer
+      --  be referenced.
+
+      --  Global_Task_Lock (Task_Lock/Unlock) is locked in the loop below to
+      --  avoid a race between a terminating task and its parent. The parent
+      --  might try to deallocate the ACTB out from underneath the exiting
+      --  task. Note that Free will also lock Global_Task_Lock, but that is
+      --  OK, since this is the *one* lock for which we have a mechanism to
+      --  support nested locking. See Task_Wrapper and its finalizer for more
+      --  explanation.
+
+      --  ???
+      --  The check "T.Common.Parent /= null ..." below is to prevent dangling
+      --  references to terminated library-level tasks, which could
+      --  otherwise occur during finalization of library-level objects.
+      --  A better solution might be to hook task objects into the
+      --  finalization chain and deallocate the ATCB when the task
+      --  object is deallocated.  However, this change is not likely
+      --  to gain anything significant, since all this storage should
+      --  be recovered en-masse when the process exits.
+
+      while To_Be_Freed /= null loop
+         T := To_Be_Freed;
+         To_Be_Freed := T.Common.All_Tasks_Link;
+
+         --  ??? On SGI there is currently no Interrupt_Manager, that's
+         --  why we need to check if the Interrupt_Manager_ID is null
+
+         if T.Interrupt_Entry and Interrupt_Manager_ID /= null then
+            declare
+               Detach_Interrupt_Entries_Index : Task_Entry_Index := 6;
+               --  Corresponds to the entry index of System.Interrupts.
+               --  Interrupt_Manager.Detach_Interrupt_Entries.
+               --  Be sure to update this value when changing
+               --  Interrupt_Manager specs.
+
+               type Param_Type is access all Task_ID;
+               Param : aliased Param_Type := T'Access;
+            begin
+               System.Tasking.Rendezvous.Call_Simple
+                 (Interrupt_Manager_ID, Detach_Interrupt_Entries_Index,
+                  Param'Address);
+            end;
+         end if;
+
+         if (T.Common.Parent /= null
+              and then T.Common.Parent.Common.Parent /= null)
+           or else T.Master_of_Task > 3
+         then
+            Initialization.Task_Lock (Self_ID);
+
+            --  If Sec_Stack_Addr is not null, it means that Destroy_TSD
+            --  has not been called yet (case of an unactivated task).
+
+            if T.Common.Compiler_Data.Sec_Stack_Addr /= Null_Address then
+               SSL.Destroy_TSD (T.Common.Compiler_Data);
+            end if;
+
+            Vulnerable_Free_Task (T);
+            Initialization.Task_Unlock (Self_ID);
+         end if;
+      end loop;
+
+      --  It might seem nice to let the terminated task deallocate
+      --  its own ATCB.  That would not cover the case of unactivated
+      --  tasks.  It also would force us to keep the underlying thread
+      --  around past termination, since references to the ATCB are
+      --  possible past termination.  Currently, we get rid of the
+      --  thread as soon as the task terminates, and let the parent
+      --  recover the ATCB later.
+
+      --  ????
+      --  Some day, if we want to recover the ATCB earlier, at task
+      --  termination, we could consider using "fat task IDs", that
+      --  include the serial number with the ATCB pointer, to catch
+      --  references to tasks that no longer have ATCBs.  It is not
+      --  clear how much this would gain, since the user-level task
+      --  object would still be occupying storage.
+
+      --  Make next master level up active.
+      --  We don't need to lock the ATCB, since the value is only
+      --  updated by each task for itself.
+
+      Self_ID.Master_Within := CM - 1;
+   end Vulnerable_Complete_Master;
+
+   ------------------------------
+   -- Vulnerable_Complete_Task --
+   ------------------------------
+
+   --  Complete the calling task.
+
+   --  This procedure must be called with abort deferred. (That's why the
+   --  name has "Vulnerable" in it.) It should only be called by Complete_Task
+   --  and Finalizate_Global_Tasks (for the environment task).
+
+   --  The effect is similar to that of Complete_Master. Differences include
+   --  the closing of entries here, and computation of the number of active
+   --  dependent tasks in Complete_Master.
+
+   --  We don't lock Self_ID before the call to Vulnerable_Complete_Activation,
+   --  because that does its own locking, and because we do not need the lock
+   --  to test Self_ID.Common.Activator. That value should only be read and
+   --  modified by Self.
+
+   procedure Vulnerable_Complete_Task (Self_ID : Task_ID) is
+   begin
+      pragma Assert (Self_ID.Deferral_Level > 0);
+      pragma Assert (Self_ID = Self);
+      pragma Assert (Self_ID.Master_Within = Self_ID.Master_of_Task + 1
+                       or else
+                     Self_ID.Master_Within = Self_ID.Master_of_Task + 2);
+      pragma Assert (Self_ID.Common.Wait_Count = 0);
+      pragma Assert (Self_ID.Open_Accepts = null);
+      pragma Assert (Self_ID.ATC_Nesting_Level = 1);
+
+      pragma Debug
+        (Debug.Trace (Self_ID, "V_Complete_Task", 'C'));
+
+      Write_Lock (Self_ID);
+      Self_ID.Callable := False;
+
+      --  In theory, Self should have no pending entry calls
+      --  left on its call-stack.  Each async. select statement should
+      --  clean its own call, and blocking entry calls should
+      --  defer abort until the calls are cancelled, then clean up.
+
+      Cancel_Queued_Entry_Calls (Self_ID);
+      Unlock (Self_ID);
+
+      if Self_ID.Common.Activator /= null then
+         Vulnerable_Complete_Activation (Self_ID);
+      end if;
+
+      --  If Self_ID.Master_Within = Self_ID.Master_of_Task + 2
+      --  we may have dependent tasks for which we need to wait.
+      --  Otherwise, we can just exit.
+
+      if Self_ID.Master_Within = Self_ID.Master_of_Task + 2 then
+         Vulnerable_Complete_Master (Self_ID);
+      end if;
+
+   end Vulnerable_Complete_Task;
+
+   --------------------------
+   -- Vulnerable_Free_Task --
+   --------------------------
+
+   --  Recover all runtime system storage associated with the task T.
+   --  This should only be called after T has terminated and will no
+   --  longer be referenced.
+   --  For tasks created by an allocator that fails, due to an exception,
+   --  it is called from Expunge_Unactivated_Tasks.
+   --  For tasks created by elaboration of task object declarations it
+   --  is called from the finalization code of the Task_Wrapper procedure.
+   --  It is also called from Unchecked_Deallocation, for objects that
+   --  are or contain tasks.
+
+   procedure Vulnerable_Free_Task (T : Task_ID) is
+   begin
+      pragma Debug
+        (Debug.Trace ("Vulnerable_Free_Task", T, 'C'));
+
+      Write_Lock (T);
+      Initialization.Finalize_Attributes_Link.all (T);
+      Unlock (T);
+      if T.Common.Task_Image /= null then
+         Free_Task_Image (T.Common.Task_Image);
+      end if;
+      System.Task_Primitives.Operations.Finalize_TCB (T);
+   end Vulnerable_Free_Task;
+
+begin
+   --  Establish the Adafinal softlink.
+   --  This is not done inside the central RTS initialization routine
+   --  to avoid with-ing this package from System.Tasking.Initialization.
+
+   SSL.Adafinal := Finalize_Global_Tasks'Access;
+
+   --  Establish soft links for subprograms that manipulate master_id's.
+   --  This cannot be done when the RTS is initialized, because of various
+   --  elaboration constraints.
+
+   SSL.Current_Master  := Stages.Current_Master'Access;
+   SSL.Enter_Master    := Stages.Enter_Master'Access;
+   SSL.Complete_Master := Stages.Complete_Master'Access;
+end System.Tasking.Stages;