------------------------------------------------------------------------------ -- -- -- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS -- -- -- -- S Y S T E M . T A S K _ P R I M I T I V E S .O P E R A T I O N S -- -- -- -- S p e c -- -- -- -- $Revision$ -- -- -- Copyright (C) 1992-2001, 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. It is -- -- now maintained by Ada Core Technologies, Inc. (http://www.gnat.com). -- -- -- ------------------------------------------------------------------------------ -- This package contains all the GNULL primitives that interface directly -- with the underlying OS. with System.Parameters; -- used for Size_Type with System.Tasking; -- used for Task_ID with System.OS_Interface; -- used for Thread_Id package System.Task_Primitives.Operations is pragma Elaborate_Body; package ST renames System.Tasking; package OSI renames System.OS_Interface; procedure Initialize (Environment_Task : ST.Task_ID); pragma Inline (Initialize); -- This must be called once, before any other subprograms of this -- package are called. procedure Create_Task (T : ST.Task_ID; Wrapper : System.Address; Stack_Size : System.Parameters.Size_Type; Priority : System.Any_Priority; Succeeded : out Boolean); pragma Inline (Create_Task); -- Create a new low-level task with ST.Task_ID T and place other needed -- information in the ATCB. -- -- A new thread of control is created, with a stack of at least Stack_Size -- storage units, and the procedure Wrapper is called by this new thread -- of control. If Stack_Size = Unspecified_Storage_Size, choose a default -- stack size; this may be effectively "unbounded" on some systems. -- -- The newly created low-level task is associated with the ST.Task_ID T -- such that any subsequent call to Self from within the context of the -- low-level task returns T. -- -- The caller is responsible for ensuring that the storage of the Ada -- task control block object pointed to by T persists for the lifetime -- of the new task. -- -- Succeeded is set to true unless creation of the task failed, -- as it may if there are insufficient resources to create another task. procedure Enter_Task (Self_ID : ST.Task_ID); pragma Inline (Enter_Task); -- Initialize data structures specific to the calling task. -- Self must be the ID of the calling task. -- It must be called (once) by the task immediately after creation, -- while abortion is still deferred. -- The effects of other operations defined below are not defined -- unless the caller has previously called Initialize_Task. procedure Exit_Task; pragma Inline (Exit_Task); -- Destroy the thread of control. -- Self must be the ID of the calling task. -- The effects of further calls to operations defined below -- on the task are undefined thereafter. function New_ATCB (Entry_Num : ST.Task_Entry_Index) return ST.Task_ID; pragma Inline (New_ATCB); -- Allocate a new ATCB with the specified number of entries. procedure Initialize_TCB (Self_ID : ST.Task_ID; Succeeded : out Boolean); pragma Inline (Initialize_TCB); -- Initialize all fields of the TCB procedure Finalize_TCB (T : ST.Task_ID); pragma Inline (Finalize_TCB); -- Finalizes Private_Data of ATCB, and then deallocates it. -- This is also responsible for recovering any storage or other resources -- that were allocated by Create_Task (the one in this package). -- This should only be called from Free_Task. -- After it is called there should be no further -- reference to the ATCB that corresponds to T. procedure Abort_Task (T : ST.Task_ID); pragma Inline (Abort_Task); -- Abort the task specified by T (the target task). This causes -- the target task to asynchronously raise Abort_Signal if -- abort is not deferred, or if it is blocked on an interruptible -- system call. -- -- precondition: -- the calling task is holding T's lock and has abort deferred -- -- postcondition: -- the calling task is holding T's lock and has abort deferred. -- ??? modify GNARL to skip wakeup and always call Abort_Task function Self return ST.Task_ID; pragma Inline (Self); -- Return a pointer to the Ada Task Control Block of the calling task. type Lock_Level is (PO_Level, Global_Task_Level, RTS_Lock_Level, ATCB_Level); -- Type used to describe kind of lock for second form of Initialize_Lock -- call specified below. -- See locking rules in System.Tasking (spec) for more details. procedure Initialize_Lock (Prio : System.Any_Priority; L : access Lock); procedure Initialize_Lock (L : access RTS_Lock; Level : Lock_Level); pragma Inline (Initialize_Lock); -- Initialize a lock object. -- -- For Lock, Prio is the ceiling priority associated with the lock. -- For RTS_Lock, the ceiling is implicitly Priority'Last. -- -- If the underlying system does not support priority ceiling -- locking, the Prio parameter is ignored. -- -- The effect of either initialize operation is undefined unless L -- is a lock object that has not been initialized, or which has been -- finalized since it was last initialized. -- -- The effects of the other operations on lock objects -- are undefined unless the lock object has been initialized -- and has not since been finalized. -- -- Initialization of the per-task lock is implicit in Create_Task. -- -- These operations raise Storage_Error if a lack of storage is detected. procedure Finalize_Lock (L : access Lock); procedure Finalize_Lock (L : access RTS_Lock); pragma Inline (Finalize_Lock); -- Finalize a lock object, freeing any resources allocated by the -- corresponding Initialize_Lock operation. procedure Write_Lock (L : access Lock; Ceiling_Violation : out Boolean); procedure Write_Lock (L : access RTS_Lock; Global_Lock : Boolean := False); procedure Write_Lock (T : ST.Task_ID); pragma Inline (Write_Lock); -- Lock a lock object for write access. After this operation returns, -- the calling task holds write permission for the lock object. No other -- Write_Lock or Read_Lock operation on the same lock object will return -- until this task executes an Unlock operation on the same object. The -- effect is undefined if the calling task already holds read or write -- permission for the lock object L. -- -- For the operation on Lock, Ceiling_Violation is set to true iff the -- operation failed, which will happen if there is a priority ceiling -- violation. -- -- For the operation on RTS_Lock, Global_Lock should be set to True -- if L is a global lock (Single_RTS_Lock, Global_Task_Lock). -- -- For the operation on ST.Task_ID, the lock is the special lock object -- associated with that task's ATCB. This lock has effective ceiling -- priority high enough that it is safe to call by a task with any -- priority in the range System.Priority. It is implicitly initialized -- by task creation. The effect is undefined if the calling task already -- holds T's lock, or has interrupt-level priority. Finalization of the -- per-task lock is implicit in Exit_Task. procedure Read_Lock (L : access Lock; Ceiling_Violation : out Boolean); pragma Inline (Read_Lock); -- Lock a lock object for read access. After this operation returns, -- the calling task has non-exclusive read permission for the logical -- resources that are protected by the lock. No other Write_Lock operation -- on the same object will return until this task and any other tasks with -- read permission for this lock have executed Unlock operation(s) on the -- lock object. A Read_Lock for a lock object may return immediately while -- there are tasks holding read permission, provided there are no tasks -- holding write permission for the object. The effect is undefined if -- the calling task already holds read or write permission for L. -- -- Alternatively: An implementation may treat Read_Lock identically to -- Write_Lock. This simplifies the implementation, but reduces the level -- of concurrency that can be achieved. -- -- Note that Read_Lock is not defined for RT_Lock and ST.Task_ID. -- That is because (1) so far Read_Lock has always been implemented -- the same as Write_Lock, (2) most lock usage inside the RTS involves -- potential write access, and (3) implementations of priority ceiling -- locking that make a reader-writer distinction have higher overhead. procedure Unlock (L : access Lock); procedure Unlock (L : access RTS_Lock; Global_Lock : Boolean := False); procedure Unlock (T : ST.Task_ID); pragma Inline (Unlock); -- Unlock a locked lock object. -- -- The effect is undefined unless the calling task holds read or write -- permission for the lock L, and L is the lock object most recently -- locked by the calling task for which the calling task still holds -- read or write permission. (That is, matching pairs of Lock and Unlock -- operations on each lock object must be properly nested.) -- For the operation on RTS_Lock, Global_Lock should be set to True -- if L is a global lock (Single_RTS_Lock, Global_Task_Lock). -- -- Note that Write_Lock for RTS_Lock does not have an out-parameter. -- RTS_Locks are used in situations where we have not made provision -- for recovery from ceiling violations. We do not expect them to -- occur inside the runtime system, because all RTS locks have ceiling -- Priority'Last. -- There is one way there can be a ceiling violation. -- That is if the runtime system is called from a task that is -- executing in the Interrupt_Priority range. -- It is not clear what to do about ceiling violations due -- to RTS calls done at interrupt priority. In general, it -- is not acceptable to give all RTS locks interrupt priority, -- since that whould give terrible performance on systems where -- this has the effect of masking hardware interrupts, though we -- could get away with allowing Interrupt_Priority'last where we -- are layered on an OS that does not allow us to mask interrupts. -- Ideally, we would like to raise Program_Error back at the -- original point of the RTS call, but this would require a lot of -- detailed analysis and recoding, with almost certain performance -- penalties. -- For POSIX systems, we considered just skipping setting a -- priority ceiling on RTS locks. This would mean there is no -- ceiling violation, but we would end up with priority inversions -- inside the runtime system, resulting in failure to satisfy the -- Ada priority rules, and possible missed validation tests. -- This could be compensated-for by explicit priority-change calls -- to raise the caller to Priority'Last whenever it first enters -- the runtime system, but the expected overhead seems high, though -- it might be lower than using locks with ceilings if the underlying -- implementation of ceiling locks is an inefficient one. -- This issue should be reconsidered whenever we get around to -- checking for calls to potentially blocking operations from -- within protected operations. If we check for such calls and -- catch them on entry to the OS, it may be that we can eliminate -- the possibility of ceiling violations inside the RTS. For this -- to work, we would have to forbid explicitly setting the priority -- of a task to anything in the Interrupt_Priority range, at least. -- We would also have to check that there are no RTS-lock operations -- done inside any operations that are not treated as potentially -- blocking. -- The latter approach seems to be the best, i.e. to check on entry -- to RTS calls that may need to use locks that the priority is not -- in the interrupt range. If there are RTS operations that NEED to -- be called from interrupt handlers, those few RTS locks should then -- be converted to PO-type locks, with ceiling Interrupt_Priority'Last. -- For now, we will just shut down the system if there is a -- ceiling violation. procedure Yield (Do_Yield : Boolean := True); pragma Inline (Yield); -- Yield the processor. Add the calling task to the tail of the -- ready queue for its active_priority. -- The Do_Yield argument is only used in some very rare cases very -- a yield should have an effect on a specific target and not on regular -- ones. procedure Set_Priority (T : ST.Task_ID; Prio : System.Any_Priority; Loss_Of_Inheritance : Boolean := False); pragma Inline (Set_Priority); -- Set the priority of the task specified by T to T.Current_Priority. -- The priority set is what would correspond to the Ada concept of -- "base priority" in the terms of the lower layer system, but -- the operation may be used by the upper layer to implement -- changes in "active priority" that are not due to lock effects. -- The effect should be consistent with the Ada Reference Manual. -- In particular, when a task lowers its priority due to the loss of -- inherited priority, it goes at the head of the queue for its new -- priority (RM D.2.2 par 9). -- Loss_Of_Inheritance helps the underlying implementation to do it -- right when the OS doesn't. function Get_Priority (T : ST.Task_ID) return System.Any_Priority; pragma Inline (Get_Priority); -- Returns the priority last set by Set_Priority for this task. function Monotonic_Clock return Duration; pragma Inline (Monotonic_Clock); -- Returns "absolute" time, represented as an offset -- relative to "the Epoch", which is Jan 1, 1970. -- This clock implementation is immune to the system's clock changes. function RT_Resolution return Duration; pragma Inline (RT_Resolution); -- Returns the resolution of the underlying clock used to implement -- RT_Clock. ---------------- -- Extensions -- ---------------- -- Whoever calls either of the Sleep routines is responsible -- for checking for pending aborts before the call. -- Pending priority changes are handled internally. procedure Sleep (Self_ID : ST.Task_ID; Reason : System.Tasking.Task_States); pragma Inline (Sleep); -- Wait until the current task, T, is signaled to wake up. -- -- precondition: -- The calling task is holding its own ATCB lock -- and has abort deferred -- -- postcondition: -- The calling task is holding its own ATCB lock -- and has abort deferred. -- The effect is to atomically unlock T's lock and wait, so that another -- task that is able to lock T's lock can be assured that the wait has -- actually commenced, and that a Wakeup operation will cause the waiting -- task to become ready for execution once again. When Sleep returns, -- the waiting task will again hold its own ATCB lock. The waiting task -- may become ready for execution at any time (that is, spurious wakeups -- are permitted), but it will definitely become ready for execution when -- a Wakeup operation is performed for the same task. procedure Timed_Sleep (Self_ID : ST.Task_ID; Time : Duration; Mode : ST.Delay_Modes; Reason : System.Tasking.Task_States; Timedout : out Boolean; Yielded : out Boolean); -- Combination of Sleep (above) and Timed_Delay procedure Timed_Delay (Self_ID : ST.Task_ID; Time : Duration; Mode : ST.Delay_Modes); -- Implements the semantics of the delay statement. It is assumed that -- the caller is not abort-deferred and does not hold any locks. procedure Wakeup (T : ST.Task_ID; Reason : System.Tasking.Task_States); pragma Inline (Wakeup); -- Wake up task T if it is waiting on a Sleep call (of ordinary -- or timed variety), making it ready for execution once again. -- If the task T is not waiting on a Sleep, the operation has no effect. function Environment_Task return ST.Task_ID; pragma Inline (Environment_Task); -- returns the task ID of the environment task -- Consider putting this into a variable visible directly -- by the rest of the runtime system. ??? function Get_Thread_Id (T : ST.Task_ID) return OSI.Thread_Id; -- returns the thread id of the specified task. ----------------------- -- RTS Entrance/Exit -- ----------------------- -- Following two routines are used for possible operations needed -- to be setup/cleared upon entrance/exit of RTS while maintaining -- a single thread of control in the RTS. Since we intend these -- routines to be used for implementing the Single_Lock RTS, -- Lock_RTS should follow the first Defer_Abortion operation -- entering RTS. In the same fashion Unlock_RTS should preceed -- the last Undefer_Abortion exiting RTS. -- -- These routines also replace the functions Lock/Unlock_All_Tasks_List procedure Lock_RTS; -- Take the global RTS lock. procedure Unlock_RTS; -- Release the global RTS lock. -------------------- -- Stack Checking -- -------------------- -- Stack checking in GNAT is done using the concept of stack probes. A -- stack probe is an operation that will generate a storage error if -- an insufficient amount of stack space remains in the current task. -- The exact mechanism for a stack probe is target dependent. Typical -- possibilities are to use a load from a non-existent page, a store -- to a read-only page, or a comparison with some stack limit constant. -- Where possible we prefer to use a trap on a bad page access, since -- this has less overhead. The generation of stack probes is either -- automatic if the ABI requires it (as on for example DEC Unix), or -- is controlled by the gcc parameter -fstack-check. -- When we are using bad-page accesses, we need a bad page, called a -- guard page, at the end of each task stack. On some systems, this -- is provided automatically, but on other systems, we need to create -- the guard page ourselves, and the procedure Stack_Guard is provided -- for this purpose. procedure Stack_Guard (T : ST.Task_ID; On : Boolean); -- Ensure guard page is set if one is needed and the underlying thread -- system does not provide it. The procedure is as follows: -- -- 1. When we create a task adjust its size so a guard page can -- safely be set at the bottom of the stack -- -- 2. When the thread is created (and its stack allocated by the -- underlying thread system), get the stack base (and size, depending -- how the stack is growing), and create the guard page taking care of -- page boundaries issues. -- -- 3. When the task is destroyed, remove the guard page. -- -- If On is true then protect the stack bottom (i.e make it read only) -- else unprotect it (i.e. On is True for the call when creating a task, -- and False when a task is destroyed). -- -- The call to Stack_Guard has no effect if guard pages are not used on -- the target, or if guard pages are automatically provided by the system. ----------------------------------------- -- Runtime System Debugging Interfaces -- ----------------------------------------- -- These interfaces have been added to assist in debugging the -- tasking runtime system. function Check_Exit (Self_ID : ST.Task_ID) return Boolean; pragma Inline (Check_Exit); -- Check that the current task is holding only Global_Task_Lock. function Check_No_Locks (Self_ID : ST.Task_ID) return Boolean; pragma Inline (Check_No_Locks); -- Check that current task is holding no locks. function Suspend_Task (T : ST.Task_ID; Thread_Self : OSI.Thread_Id) return Boolean; -- Suspend a specific task when the underlying thread library provides -- such functionality, unless the thread associated with T is Thread_Self. -- Such functionality is needed by gdb on some targets (e.g VxWorks) -- Return True is the operation is successful function Resume_Task (T : ST.Task_ID; Thread_Self : OSI.Thread_Id) return Boolean; -- Resume a specific task when the underlying thread library provides -- such functionality, unless the thread associated with T is Thread_Self. -- Such functionality is needed by gdb on some targets (e.g VxWorks) -- Return True is the operation is successful end System.Task_Primitives.Operations;