X-Git-Url: http://git.sourceforge.jp/view?p=pf3gnuchains%2Fgcc-fork.git;a=blobdiff_plain;f=gcc%2Fada%2Fs-taprop.ads;h=4f0a5408d9c3314a61aae52abc06375dc97da977;hp=41101095814e4765a07e8282b075a1150b2907cb;hb=febb409f6902e6f6fe5898499b6e4088b8b22f31;hpb=e2aa7314de5939148a7e7b3d0546c9b52bb31bea diff --git a/gcc/ada/s-taprop.ads b/gcc/ada/s-taprop.ads index 41101095814..4f0a5408d9c 100644 --- a/gcc/ada/s-taprop.ads +++ b/gcc/ada/s-taprop.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2004, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2008, 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- -- @@ -16,8 +16,8 @@ -- 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. -- +-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, -- +-- Boston, MA 02110-1301, 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, -- @@ -31,28 +31,23 @@ -- -- ------------------------------------------------------------------------------ --- This package contains all the GNULL primitives that interface directly --- with the underlying OS. +-- 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 Preelaborate; - 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. + -- Perform initialization and set up of the environment task for proper + -- operation of the tasking run-time. This must be called once, before any + -- other subprograms of this package are called. procedure Create_Task (T : ST.Task_Id; @@ -82,23 +77,21 @@ package System.Task_Primitives.Operations is 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. + -- 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 abort 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. + -- 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. + -- 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); @@ -106,19 +99,17 @@ package System.Task_Primitives.Operations is 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 + -- 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. + -- 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 @@ -130,7 +121,7 @@ package System.Task_Primitives.Operations is function Self return ST.Task_Id; pragma Inline (Self); - -- Return a pointer to the Ada Task Control Block of the calling task. + -- Return a pointer to the Ada Task Control Block of the calling task type Lock_Level is (PO_Level, @@ -138,41 +129,50 @@ package System.Task_Primitives.Operations is 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); + -- call specified below. See locking rules in System.Tasking (spec) for + -- more details. + + procedure Initialize_Lock + (Prio : System.Any_Priority; + L : not null access Lock); + procedure Initialize_Lock + (L : not null access RTS_Lock; + Level : Lock_Level); pragma Inline (Initialize_Lock); - -- Initialize a lock object. + -- Initialize a lock object -- - -- For Lock, Prio is the ceiling priority associated with the lock. - -- For RTS_Lock, the ceiling is implicitly Priority'Last. + -- 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 effect of either initialize operation is undefined unless 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. + -- 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. + -- Initialization of the per-task lock is implicit in Create_Task -- - -- These operations raise Storage_Error if a lack of storage is detected. + -- 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); + procedure Finalize_Lock (L : not null access Lock); + procedure Finalize_Lock (L : not null 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); + procedure Write_Lock + (L : not null access Lock; + Ceiling_Violation : out Boolean); + procedure Write_Lock + (L : not null 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 @@ -196,7 +196,9 @@ package System.Task_Primitives.Operations is -- 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); + procedure Read_Lock + (L : not null 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 @@ -218,11 +220,15 @@ package System.Task_Primitives.Operations is -- 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); + procedure Unlock + (L : not null access Lock); + procedure Unlock + (L : not null access RTS_Lock; + Global_Lock : Boolean := False); + procedure Unlock + (T : ST.Task_Id); pragma Inline (Unlock); - -- Unlock a locked lock object. + -- 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 @@ -230,89 +236,93 @@ package System.Task_Primitives.Operations is -- 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). + -- 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. + -- 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 would give terrible + -- performance on systems where this has the effect of masking hardware + -- interrupts, though we could get away 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 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 ceiling violation + + procedure Set_Ceiling + (L : not null access Lock; + Prio : System.Any_Priority); + pragma Inline (Set_Ceiling); + -- Change the ceiling priority associated to the lock + -- + -- 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.) 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. + -- 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. + -- 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. + -- Returns the priority last set by Set_Priority for this task function Monotonic_Clock return Duration; pragma Inline (Monotonic_Clock); @@ -328,32 +338,31 @@ package System.Task_Primitives.Operations is -- Extensions -- ---------------- - -- Whoever calls either of the Sleep routines is responsible - -- for checking for pending aborts before the call. - -- Pending priority changes are handled internally. + -- 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. + -- 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 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. + -- 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; @@ -368,8 +377,8 @@ package System.Task_Primitives.Operations is (Self_ID : ST.Task_Id; Time : Duration; Mode : ST.Delay_Modes); - -- Implement the semantics of the delay statement. It is assumed that - -- the caller is not abort-deferred and does not hold any locks. + -- Implement the semantics of the delay statement. + -- The caller should be abort-deferred and should not hold any locks. procedure Wakeup (T : ST.Task_Id; @@ -399,21 +408,20 @@ package System.Task_Primitives.Operations is -- 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. + -- 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_Abort operation entering RTS. In the same fashion Unlock_RTS + -- should precede the last Undefer_Abort exiting RTS. -- -- These routines also replace the functions Lock/Unlock_All_Tasks_List procedure Lock_RTS; - -- Take the global RTS lock. + -- Take the global RTS lock procedure Unlock_RTS; - -- Release the global RTS lock. + -- Release the global RTS lock -------------------- -- Stack Checking -- @@ -424,30 +432,29 @@ package System.Task_Primitives.Operations is -- 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. + -- 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 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 + -- 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. + -- 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. -- @@ -458,6 +465,38 @@ package System.Task_Primitives.Operations is -- 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. + ------------------------ + -- Suspension objects -- + ------------------------ + + -- These subprograms provide the functionality required for synchronizing + -- on a suspension object. Tasks can suspend execution and relinquish the + -- processors until the condition is signaled. + + function Current_State (S : Suspension_Object) return Boolean; + -- Return the state of the suspension object + + procedure Set_False (S : in out Suspension_Object); + -- Set the state of the suspension object to False + + procedure Set_True (S : in out Suspension_Object); + -- Set the state of the suspension object to True. If a task were + -- suspended on the protected object then this task is released (and + -- the state of the suspension object remains set to False). + + procedure Suspend_Until_True (S : in out Suspension_Object); + -- If the state of the suspension object is True then the calling task + -- continues its execution, and the state is set to False. If the state + -- of the object is False then the task is suspended on the suspension + -- object until a Set_True operation is executed. Program_Error is raised + -- if another task is already waiting on that suspension object. + + procedure Initialize (S : in out Suspension_Object); + -- Initialize the suspension object + + procedure Finalize (S : in out Suspension_Object); + -- Finalize the suspension object + ----------------------------------------- -- Runtime System Debugging Interfaces -- ----------------------------------------- @@ -467,19 +506,20 @@ package System.Task_Primitives.Operations is 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. + -- 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. + -- 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 + -- Suspend a specific task when the underlying thread library provides this + -- 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. On targets where this operation is not + -- available, a dummy body is present which always returns False. function Resume_Task (T : ST.Task_Id; @@ -489,4 +529,20 @@ package System.Task_Primitives.Operations is -- Such functionality is needed by gdb on some targets (e.g VxWorks) -- Return True is the operation is successful + procedure Stop_All_Tasks; + -- Stop all tasks when the underlying thread library provides such + -- functionality. Such functionality is needed by gdb on some targets (e.g + -- VxWorks) This function can be run from an interrupt handler. Return True + -- is the operation is successful + + function Stop_Task (T : ST.Task_Id) return Boolean; + -- Stop a specific task when the underlying thread library provides + -- such functionality. Such functionality is needed by gdb on some targets + -- (e.g VxWorks). Return True is the operation is successful. + + function Continue_Task (T : ST.Task_Id) return Boolean; + -- Continue a specific task when the underlying thread library provides + -- such functionality. Such functionality is needed by gdb on some targets + -- (e.g VxWorks) Return True is the operation is successful + end System.Task_Primitives.Operations;