+++ /dev/null
-------------------------------------------------------------------------------
--- --
--- 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.2 $
--- --
--- 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 explicitly 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;
projects / msp430-gcc.git / blobdiff