------------------------------------------------------------------------------ -- -- -- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS -- -- -- -- S Y S T E M . T A S K I N G . R E S T R I C T E D . S T A G E S -- -- -- -- B o d y -- -- -- -- Copyright (C) 1999-2004, Free Software Foundation, Inc. -- -- -- -- 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. -- -- Extensive contributions were provided by Ada Core Technologies, Inc. -- -- -- ------------------------------------------------------------------------------ pragma Style_Checks (All_Checks); -- Turn off subprogram alpha order check, since we group soft link -- bodies and also separate off subprograms for restricted GNARLI. -- This is a simplified version of the System.Tasking.Stages package, -- intended to be used in a restricted run time. -- This package represents the high level tasking interface used by the -- compiler to expand Ada 95 tasking constructs into simpler run time calls. 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 System.Parameters; -- used for Size_Type -- Single_Lock with System.Task_Info; -- used for Task_Info_Type with System.Task_Primitives.Operations; -- used for Enter_Task -- Write_Lock -- Unlock -- Wakeup -- Get_Priority with System.Soft_Links; -- used for the non-tasking routines (*_NT) that refer to global data. -- They are needed here before the tasking run time has been elaborated. -- used for Create_TSD -- This package also provides initialization routines for task specific data. -- The GNARL must call these to be sure that all non-tasking -- Ada constructs will work. with System.Soft_Links.Tasking; -- Used for Init_Tasking_Soft_Links with System.Secondary_Stack; -- used for SS_Init; with System.Storage_Elements; -- used for Storage_Array; package body System.Tasking.Restricted.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 Parameters; use Task_Primitives.Operations; use Task_Info; Global_Task_Lock : aliased System.Task_Primitives.RTS_Lock; -- This is a global lock; it is used to execute in mutual exclusion -- from all other tasks. It is only used by Task_Lock and Task_Unlock. ----------------------------------------------------------------- -- Tasking versions of services needed by non-tasking programs -- ----------------------------------------------------------------- procedure Task_Lock; -- Locks out other tasks. Preceding a section of code by Task_Lock and -- following it by Task_Unlock creates a critical region. This is used -- for ensuring that a region of non-tasking code (such as code used to -- allocate memory) is tasking safe. Note that it is valid for calls to -- Task_Lock/Task_Unlock to be nested, and this must work properly, i.e. -- only the corresponding outer level Task_Unlock will actually unlock. procedure Task_Unlock; -- Releases lock previously set by call to Task_Lock. In the nested case, -- all nested locks must be released before other tasks competing for the -- tasking lock are released. ----------------------- -- Local Subprograms -- ----------------------- 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 Terminate_Task (Self_ID : Task_Id); -- Terminate the calling task. -- This should only be called by the Task_Wrapper procedure. procedure Init_RTS; -- This procedure performs the initialization of the GNARL. -- It consists of initializing the environment task, global locks, and -- installing tasking versions of certain operations used by the compiler. -- Init_RTS is called during elaboration. --------------- -- Task_Lock -- --------------- procedure Task_Lock is begin STPO.Write_Lock (Global_Task_Lock'Access, Global_Lock => True); end Task_Lock; ----------------- -- Task_Unlock -- ----------------- procedure Task_Unlock is begin STPO.Unlock (Global_Task_Lock'Access, Global_Lock => True); end Task_Unlock; ------------------ -- 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. -- 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. procedure Task_Wrapper (Self_ID : Task_Id) is ID : Task_Id := Self_ID; pragma Volatile (ID); pragma Warnings (Off, ID); -- Turn off warnings (stand alone volatile constant has to be -- imported, so we cannot just make ID constant). -- Do not delete this variable. -- In some targets, we need this variable to implement a fast Self. use type System.Parameters.Size_Type; use type SSE.Storage_Offset; Secondary_Stack : aliased SSE.Storage_Array (1 .. Self_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 if not Parameters.Sec_Stack_Dynamic then Self_ID.Common.Compiler_Data.Sec_Stack_Addr := Secondary_Stack'Address; SST.SS_Init (Secondary_Stack_Address, Integer (Secondary_Stack'Last)); end if; -- Initialize low-level TCB components, that -- cannot be initialized by the creator. Enter_Task (Self_ID); -- Call the task body procedure. 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. -- Note that in the case of Ravenscar HI-E where there are no -- exception handlers, the exception handler is suppressed. -- Call the task body procedure. Self_ID.Common.Task_Entry_Point (Self_ID.Common.Task_Arg); Terminate_Task (Self_ID); exception when others => Terminate_Task (Self_ID); end; end Task_Wrapper; ----------------------- -- Restricted GNARLI -- ----------------------- ------------------------------- -- Activate_Restricted_Tasks -- ------------------------------- -- Note that locks of activator and activated task are both locked -- here. This is necessary because C.State and Self.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. procedure Activate_Restricted_Tasks (Chain_Access : Activation_Chain_Access) is Self_ID : constant Task_Id := STPO.Self; C : Task_Id; Activate_Prio : System.Any_Priority; Success : Boolean; begin pragma Assert (Self_ID = Environment_Task); pragma Assert (Self_ID.Common.Wait_Count = 0); if Single_Lock then Lock_RTS; end if; -- Lock self, to prevent activated tasks -- from racing ahead before we finish activating the chain. Write_Lock (Self_ID); -- 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); 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; STPO.Create_Task (C, Task_Wrapper'Address, Parameters.Size_Type (C.Common.Compiler_Data.Pri_Stack_Info.Size), Activate_Prio, Success); Self_ID.Common.Wait_Count := Self_ID.Common.Wait_Count + 1; if Success then C.Common.State := Runnable; else raise Program_Error; end if; Unlock (C); end if; C := C.Common.Activation_Link; end loop; Self_ID.Common.State := Activator_Sleep; -- Wait for the activated tasks to complete activation. -- It is unsafe to abort any of these tasks until the count goes to -- zero. loop exit when Self_ID.Common.Wait_Count = 0; Sleep (Self_ID, Activator_Sleep); end loop; Self_ID.Common.State := Runnable; Unlock (Self_ID); if Single_Lock then Unlock_RTS; end if; -- Remove the tasks from the chain. Chain_Access.T_ID := null; end Activate_Restricted_Tasks; ------------------------------------ -- Complete_Restricted_Activation -- ------------------------------------ -- 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 Complete_Restricted_Activation is Self_ID : constant Task_Id := STPO.Self; Activator : constant Task_Id := Self_ID.Common.Activator; begin if Single_Lock then Lock_RTS; end if; Write_Lock (Activator); Write_Lock (Self_ID); -- 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; Unlock (Self_ID); Unlock (Activator); if Single_Lock then Unlock_RTS; end if; -- 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 Set_Priority (Self_ID, Self_ID.Common.Base_Priority); end if; end Complete_Restricted_Activation; ------------------------------ -- Complete_Restricted_Task -- ------------------------------ procedure Complete_Restricted_Task is begin STPO.Self.Common.State := Terminated; end Complete_Restricted_Task; ---------------------------- -- Create_Restricted_Task -- ---------------------------- procedure Create_Restricted_Task (Priority : Integer; Stack_Address : System.Address; Size : System.Parameters.Size_Type; Task_Info : System.Task_Info.Task_Info_Type; State : Task_Procedure_Access; Discriminants : System.Address; Elaborated : Access_Boolean; Chain : in out Activation_Chain; Task_Image : String; Created_Task : Task_Id) is Self_ID : constant Task_Id := STPO.Self; Base_Priority : System.Any_Priority; Success : Boolean; begin -- Stack is not preallocated on this target, so that -- Stack_Address must be null. pragma Assert (Stack_Address = Null_Address); if Priority = Unspecified_Priority then Base_Priority := Self_ID.Common.Base_Priority; else Base_Priority := System.Any_Priority (Priority); end if; if Single_Lock then Lock_RTS; end if; Write_Lock (Self_ID); -- With no task hierarchy, the parent of all non-Environment tasks that -- are created must be the Environment task Initialize_ATCB (Self_ID, State, Discriminants, Self_ID, Elaborated, Base_Priority, Task_Info, Size, Created_Task, Success); -- If we do our job right then there should never be any failures, -- which was probably said about the Titanic; so just to be safe, -- let's retain this code for now if not Success then Unlock (Self_ID); if Single_Lock then Unlock_RTS; end if; raise Program_Error; end if; Created_Task.Entry_Calls (1).Self := Created_Task; Created_Task.Common.Task_Image_Len := Integer'Min (Created_Task.Common.Task_Image'Length, Task_Image'Length); Created_Task.Common.Task_Image (1 .. Created_Task.Common.Task_Image_Len) := Task_Image; Unlock (Self_ID); if Single_Lock then Unlock_RTS; end if; -- 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 (Created_Task.Common.Compiler_Data); Created_Task.Common.Activation_Link := Chain.T_ID; Chain.T_ID := Created_Task; end Create_Restricted_Task; --------------------------- -- Finalize_Global_Tasks -- --------------------------- -- This is needed to support the compiler interface; it will only be called -- by the Environment task. Instead, it will cause the Environment to block -- forever, since none of the dependent tasks are expected to terminate procedure Finalize_Global_Tasks is Self_ID : constant Task_Id := STPO.Self; begin pragma Assert (Self_ID = STPO.Environment_Task); if Single_Lock then Lock_RTS; end if; Write_Lock (Self_ID); Sleep (Self_ID, Master_Completion_Sleep); Unlock (Self_ID); if Single_Lock then Unlock_RTS; end if; -- Should never return from Master Completion Sleep raise Program_Error; end Finalize_Global_Tasks; --------------------------- -- Restricted_Terminated -- --------------------------- function Restricted_Terminated (T : Task_Id) return Boolean is begin return T.Common.State = Terminated; end Restricted_Terminated; -------------------- -- Terminate_Task -- -------------------- procedure Terminate_Task (Self_ID : Task_Id) is begin Self_ID.Common.State := Terminated; end Terminate_Task; -------------- -- Init_RTS -- -------------- procedure Init_RTS is begin -- Initialize lock used to implement mutual exclusion between all tasks STPO.Initialize_Lock (Global_Task_Lock'Access, STPO.Global_Task_Level); -- Notify that the tasking run time has been elaborated so that -- the tasking version of the soft links can be used. SSL.Lock_Task := Task_Lock'Access; SSL.Unlock_Task := Task_Unlock'Access; SSL.Adafinal := Finalize_Global_Tasks'Access; -- Initialize the tasking soft links (if not done yet) that are common -- to the full and the restricted run times. SSL.Tasking.Init_Tasking_Soft_Links; end Init_RTS; begin Init_RTS; end System.Tasking.Restricted.Stages;