1 ------------------------------------------------------------------------------
3 -- GNU ADA RUNTIME LIBRARY (GNARL) COMPONENTS --
5 -- S Y S T E M . T A S K _ P R I M I T I V E S --
11 -- Copyright (C) 1991,1992,1993,1994,1995,1996 Florida State University --
13 -- GNARL is free software; you can redistribute it and/or modify it under --
14 -- terms of the GNU General Public License as published by the Free Soft- --
15 -- ware Foundation; either version 2, or (at your option) any later ver- --
16 -- sion. GNARL is distributed in the hope that it will be useful, but WITH- --
17 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
18 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
19 -- for more details. You should have received a copy of the GNU General --
20 -- Public License distributed with GNARL; see file COPYING. If not, write --
21 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
22 -- MA 02111-1307, USA. --
24 -- As a special exception, if other files instantiate generics from this --
25 -- unit, or you link this unit with other files to produce an executable, --
26 -- this unit does not by itself cause the resulting executable to be --
27 -- covered by the GNU General Public License. This exception does not --
28 -- however invalidate any other reasons why the executable file might be --
29 -- covered by the GNU Public License. --
31 -- GNARL was developed by the GNARL team at Florida State University. It is --
32 -- now maintained by Ada Core Technologies Inc. in cooperation with Florida --
33 -- State University (http://www.gnat.com). --
35 ------------------------------------------------------------------------------
40 with Interfaces.C.Pthreads;
46 with Interfaces.C.POSIX_RTE;
50 with System.Task_Clock;
51 -- Used for, Stimespec
53 with Unchecked_Conversion;
55 pragma Elaborate_All (Interfaces.C.Pthreads);
57 with System.Task_Info;
58 package System.Task_Primitives is
60 -- Low level Task size and state definition
62 type LL_Task_Procedure_Access is access procedure (Arg : System.Address);
64 type Pre_Call_State is new System.Address;
66 type Task_Storage_Size is new Interfaces.C.size_t;
68 type Machine_Exceptions is new Interfaces.C.POSIX_RTE.Signal;
70 type Error_Information is new Interfaces.C.POSIX_RTE.siginfo_ptr;
73 type Condition_Variable is private;
75 -- The above types should both be limited. They are not due to a hack in
76 -- ATCB allocation which allocates a block of the correct size and then
77 -- assigns an initialized ATCB to it. This won't work with limited types.
78 -- When allocation is done with new, these can become limited once again.
81 type Task_Control_Block is record
82 LL_Entry_Point : LL_Task_Procedure_Access;
83 LL_Arg : System.Address;
84 Thread : aliased Interfaces.C.Pthreads.pthread_t;
85 Stack_Size : Task_Storage_Size;
86 Stack_Limit : System.Address;
89 type TCB_Ptr is access all Task_Control_Block;
91 -- Task ATCB related and variables.
93 function Address_To_TCB_Ptr is new
94 Unchecked_Conversion (System.Address, TCB_Ptr);
96 procedure Initialize_LL_Tasks (T : TCB_Ptr);
97 -- Initialize GNULLI. T points to the Task Control Block that should
98 -- be initialized for use by the environment task.
100 function Self return TCB_Ptr;
101 -- Return a pointer to the Task Control Block of the calling task.
103 procedure Initialize_Lock (Prio : System.Any_Priority; L : in out Lock);
104 -- Initialize a lock object. Prio is the ceiling priority associated
107 procedure Finalize_Lock (L : in out Lock);
108 -- Finalize a lock object, freeing any resources allocated by the
109 -- corresponding Initialize_Lock.
111 procedure Write_Lock (L : in out Lock; Ceiling_Violation : out Boolean);
112 pragma Inline (Write_Lock);
113 -- Lock a lock object for write access to a critical section. After
114 -- this operation returns, the calling task owns the lock, and
115 -- no other Write_Lock or Read_Lock operation on the same object will
116 -- return the owner executes an Unlock operation on the same object.
118 procedure Read_Lock (L : in out Lock; Ceiling_Violation : out Boolean);
119 pragma Inline (Read_Lock);
120 -- Lock a lock object for read access to a critical section. After
121 -- this operation returns, the calling task owns the lock, and
122 -- no other Write_Lock operation on the same object will return until
123 -- the owner(s) execute Unlock operation(s) on the same object.
124 -- A Read_Lock to an owned lock object may return while the lock is
125 -- still owned, though an implementation may also implement
126 -- Read_Lock to have the same semantics.
128 procedure Unlock (L : in out Lock);
129 pragma Inline (Unlock);
130 -- Unlock a locked lock object. The results are undefined if the
131 -- calling task does not own the lock. Lock/Unlock operations must
132 -- be nested, that is, the argument to Unlock must be the object
133 -- most recently locked.
135 procedure Initialize_Cond (Cond : in out Condition_Variable);
136 -- Initialize a condition variable object.
138 procedure Finalize_Cond (Cond : in out Condition_Variable);
139 -- Finalize a condition variable object, recovering any resources
140 -- allocated for it by Initialize_Cond.
142 procedure Cond_Wait (Cond : in out Condition_Variable; L : in out Lock);
143 pragma Inline (Cond_Wait);
144 -- Wait on a condition variable. The mutex object L is unlocked
145 -- atomically, such that another task that is able to lock the mutex
146 -- can be assured that the wait has actually commenced, and that
147 -- a Cond_Signal operation will cause the waiting task to become
148 -- eligible for execution once again. Before Cond_Wait returns,
149 -- the waiting task will again lock the mutex. The waiting task may become
150 -- eligible for execution at any time, but will become eligible for
151 -- execution when a Cond_Signal operation is performed on the
152 -- same condition variable object. The effect of more than one
153 -- task waiting on the same condition variable is unspecified.
155 procedure Cond_Timed_Wait
156 (Cond : in out Condition_Variable;
157 L : in out Lock; Abs_Time : System.Task_Clock.Stimespec;
158 Timed_Out : out Boolean);
159 pragma Inline (Cond_Timed_Wait);
160 -- Wait on a condition variable, as for Cond_Wait, above. In addition,
161 -- the waiting task will become eligible for execution again
162 -- when the absolute time specified by Timed_Out arrives.
164 procedure Cond_Signal (Cond : in out Condition_Variable);
165 pragma Inline (Cond_Signal);
166 -- Wake up a task waiting on the condition variable object specified
167 -- by Cond, making it eligible for execution once again.
169 procedure Set_Priority (T : TCB_Ptr; Prio : System.Any_Priority);
170 pragma Inline (Set_Priority);
171 -- Set the priority of the task specified by T to P.
173 procedure Set_Own_Priority (Prio : System.Any_Priority);
174 pragma Inline (Set_Own_Priority);
175 -- Set the priority of the calling task to P.
177 function Get_Priority (T : TCB_Ptr) return System.Any_Priority;
178 pragma Inline (Get_Priority);
179 -- Return the priority of the task specified by T.
181 function Get_Own_Priority return System.Any_Priority;
182 pragma Inline (Get_Own_Priority);
183 -- Return the priority of the calling task.
185 procedure Create_LL_Task
186 (Priority : System.Any_Priority;
187 Stack_Size : Task_Storage_Size;
188 Task_Info : System.Task_Info.Task_Info_Type;
189 LL_Entry_Point : LL_Task_Procedure_Access;
190 Arg : System.Address;
192 -- Create a new low-level task with priority Priority. A new thread
193 -- of control is created with a stack size of at least Stack_Size,
194 -- and the procedure LL_Entry_Point is called with the argument Arg
195 -- from this new thread of control. The Task Control Block pointed
196 -- to by T is initialized to refer to this new task.
198 procedure Exit_LL_Task;
199 -- Exit a low-level task. The resources allocated for the task
200 -- by Create_LL_Task are recovered. The task no longer executes, and
201 -- the effects of further operations on task are unspecified.
203 procedure Abort_Task (T : TCB_Ptr);
204 -- Abort the task specified by T (the target task). This causes
205 -- the target task to asynchronously execute the handler procedure
206 -- installed by the target task using Install_Abort_Handler. The
207 -- effect of this operation is unspecified if there is no abort
208 -- handler procedure for the target task.
210 procedure Test_Abort;
211 -- ??? Obsolete? This is intended to allow implementation of
212 -- abortion and ATC in the absence of an asynchronous Abort_Task,
213 -- but I think that we decided that GNARL can handle this on
214 -- its own by making sure that there is an Undefer_Abortion at
215 -- every abortion synchronization point.
217 type Abort_Handler_Pointer is access procedure (Context : Pre_Call_State);
219 procedure Install_Abort_Handler (Handler : Abort_Handler_Pointer);
220 -- Install an abort handler procedure. This procedure is called
221 -- asynchronously by the calling task whenever a call to Abort_Task
222 -- specifies the calling task as the target. If the abort handler
223 -- procedure is asynchronously executed during a GNULLI operation
224 -- and then calls some other GNULLI operation, the effect is unspecified.
226 procedure Install_Error_Handler (Handler : System.Address);
227 -- Install an error handler for the calling task. The handler will
228 -- be called synchronously if an error is encountered during the
229 -- execution of the calling task.
231 procedure LL_Assert (B : Boolean; M : String);
232 -- If B is False, print the string M to the console and halt the
235 Task_Wrapper_Frame : constant Integer := 72;
236 -- This is the size of the frame for the Pthread_Wrapper procedure.
238 type Proc is access procedure (Addr : System.Address);
241 -- Test and Set support
242 type TAS_Cell is private;
243 -- On some systems we can not assume that an arbitrary memory location
244 -- can be used in an atomic test and set instruction (e.g. on some
245 -- multiprocessor machines, only memory regions are cache interlocked).
246 -- TAS_Cell is private to facilitate adaption to a variety of
249 procedure Initialize_TAS_Cell (Cell : out TAS_Cell);
250 pragma Inline (Initialize_TAS_Cell);
251 -- Initialize a Test And Set Cell. On some targets this will allocate
252 -- a system-level lock object from a special pool. For most systems,
255 procedure Finalize_TAS_Cell (Cell : in out TAS_Cell);
256 pragma Inline (Finalize_TAS_Cell);
257 -- Finalize a Test and Set cell, freeing any resources allocated by the
258 -- corresponding Initialize_TAS_Cell.
260 procedure Clear (Cell : in out TAS_Cell);
261 pragma Inline (Clear);
262 -- Set the state of the named TAS_Cell such that a subsequent call to
263 -- Is_Set will return False. This operation must be atomic with
264 -- respect to the Is_Set and Test_And_Set operations for the same
267 procedure Test_And_Set (Cell : in out TAS_Cell; Result : out Boolean);
268 pragma Inline (Test_And_Set);
269 -- Modify the state of the named TAS_Cell such that a subsequent call
270 -- to Is_Set will return True. Result is set to True if Is_Set
271 -- was False prior to the call, False otherwise. This operation must
272 -- be atomic with respect to the Clear and Is_Set operations for the
275 function Is_Set (Cell : in TAS_Cell) return Boolean;
276 pragma Inline (Is_Set);
277 -- Returns the current value of the named TAS_Cell. This operation
278 -- must be atomic with respect to the Clear and Test_And_Set operations
279 -- for the same cell.
285 mutex : aliased Interfaces.C.Pthreads.pthread_mutex_t;
288 type Condition_Variable is
290 CV : aliased Interfaces.C.Pthreads.pthread_cond_t;
295 Value : aliased Interfaces.C.unsigned := 0;
298 end System.Task_Primitives;