1 ------------------------------------------------------------------------------
3 -- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS --
5 -- 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 --
11 -- Copyright (C) 1992-2001, Free Software Foundation, Inc. --
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 ------------------------------------------------------------------------------
37 -- This package contains all the GNULL primitives that interface directly
38 -- with the underlying OS.
40 with System.Parameters;
46 with System.OS_Interface;
49 package System.Task_Primitives.Operations is
51 pragma Elaborate_Body;
52 package ST renames System.Tasking;
53 package OSI renames System.OS_Interface;
55 procedure Initialize (Environment_Task : ST.Task_ID);
56 pragma Inline (Initialize);
57 -- This must be called once, before any other subprograms of this
58 -- package are called.
62 Wrapper : System.Address;
63 Stack_Size : System.Parameters.Size_Type;
64 Priority : System.Any_Priority;
65 Succeeded : out Boolean);
66 pragma Inline (Create_Task);
67 -- Create a new low-level task with ST.Task_ID T and place other needed
68 -- information in the ATCB.
70 -- A new thread of control is created, with a stack of at least Stack_Size
71 -- storage units, and the procedure Wrapper is called by this new thread
72 -- of control. If Stack_Size = Unspecified_Storage_Size, choose a default
73 -- stack size; this may be effectively "unbounded" on some systems.
75 -- The newly created low-level task is associated with the ST.Task_ID T
76 -- such that any subsequent call to Self from within the context of the
77 -- low-level task returns T.
79 -- The caller is responsible for ensuring that the storage of the Ada
80 -- task control block object pointed to by T persists for the lifetime
83 -- Succeeded is set to true unless creation of the task failed,
84 -- as it may if there are insufficient resources to create another task.
86 procedure Enter_Task (Self_ID : ST.Task_ID);
87 pragma Inline (Enter_Task);
88 -- Initialize data structures specific to the calling task.
89 -- Self must be the ID of the calling task.
90 -- It must be called (once) by the task immediately after creation,
91 -- while abortion is still deferred.
92 -- The effects of other operations defined below are not defined
93 -- unless the caller has previously called Initialize_Task.
96 pragma Inline (Exit_Task);
97 -- Destroy the thread of control.
98 -- Self must be the ID of the calling task.
99 -- The effects of further calls to operations defined below
100 -- on the task are undefined thereafter.
102 function New_ATCB (Entry_Num : ST.Task_Entry_Index) return ST.Task_ID;
103 pragma Inline (New_ATCB);
104 -- Allocate a new ATCB with the specified number of entries.
106 procedure Initialize_TCB (Self_ID : ST.Task_ID; Succeeded : out Boolean);
107 pragma Inline (Initialize_TCB);
108 -- Initialize all fields of the TCB
110 procedure Finalize_TCB (T : ST.Task_ID);
111 pragma Inline (Finalize_TCB);
112 -- Finalizes Private_Data of ATCB, and then deallocates it.
113 -- This is also responsible for recovering any storage or other resources
114 -- that were allocated by Create_Task (the one in this package).
115 -- This should only be called from Free_Task.
116 -- After it is called there should be no further
117 -- reference to the ATCB that corresponds to T.
119 procedure Abort_Task (T : ST.Task_ID);
120 pragma Inline (Abort_Task);
121 -- Abort the task specified by T (the target task). This causes
122 -- the target task to asynchronously raise Abort_Signal if
123 -- abort is not deferred, or if it is blocked on an interruptible
127 -- the calling task is holding T's lock and has abort deferred
130 -- the calling task is holding T's lock and has abort deferred.
132 -- ??? modify GNARL to skip wakeup and always call Abort_Task
134 function Self return ST.Task_ID;
135 pragma Inline (Self);
136 -- Return a pointer to the Ada Task Control Block of the calling task.
145 -- Type used to describe kind of lock for second form of Initialize_Lock
146 -- call specified below.
147 -- See locking rules in System.Tasking (spec) for more details.
149 procedure Initialize_Lock (Prio : System.Any_Priority; L : access Lock);
150 procedure Initialize_Lock (L : access RTS_Lock; Level : Lock_Level);
151 pragma Inline (Initialize_Lock);
152 -- Initialize a lock object.
154 -- For Lock, Prio is the ceiling priority associated with the lock.
155 -- For RTS_Lock, the ceiling is implicitly Priority'Last.
157 -- If the underlying system does not support priority ceiling
158 -- locking, the Prio parameter is ignored.
160 -- The effect of either initialize operation is undefined unless L
161 -- is a lock object that has not been initialized, or which has been
162 -- finalized since it was last initialized.
164 -- The effects of the other operations on lock objects
165 -- are undefined unless the lock object has been initialized
166 -- and has not since been finalized.
168 -- Initialization of the per-task lock is implicit in Create_Task.
170 -- These operations raise Storage_Error if a lack of storage is detected.
172 procedure Finalize_Lock (L : access Lock);
173 procedure Finalize_Lock (L : access RTS_Lock);
174 pragma Inline (Finalize_Lock);
175 -- Finalize a lock object, freeing any resources allocated by the
176 -- corresponding Initialize_Lock operation.
178 procedure Write_Lock (L : access Lock; Ceiling_Violation : out Boolean);
179 procedure Write_Lock (L : access RTS_Lock);
180 procedure Write_Lock (T : ST.Task_ID);
181 pragma Inline (Write_Lock);
182 -- Lock a lock object for write access. After this operation returns,
183 -- the calling task holds write permission for the lock object. No other
184 -- Write_Lock or Read_Lock operation on the same lock object will return
185 -- until this task executes an Unlock operation on the same object. The
186 -- effect is undefined if the calling task already holds read or write
187 -- permission for the lock object L.
189 -- For the operation on Lock, Ceiling_Violation is set to true iff the
190 -- operation failed, which will happen if there is a priority ceiling
193 -- For the operation on ST.Task_ID, the lock is the special lock object
194 -- associated with that task's ATCB. This lock has effective ceiling
195 -- priority high enough that it is safe to call by a task with any
196 -- priority in the range System.Priority. It is implicitly initialized
197 -- by task creation. The effect is undefined if the calling task already
198 -- holds T's lock, or has interrupt-level priority. Finalization of the
199 -- per-task lock is implicit in Exit_Task.
201 procedure Read_Lock (L : access Lock; Ceiling_Violation : out Boolean);
202 pragma Inline (Read_Lock);
203 -- Lock a lock object for read access. After this operation returns,
204 -- the calling task has non-exclusive read permission for the logical
205 -- resources that are protected by the lock. No other Write_Lock operation
206 -- on the same object will return until this task and any other tasks with
207 -- read permission for this lock have executed Unlock operation(s) on the
208 -- lock object. A Read_Lock for a lock object may return immediately while
209 -- there are tasks holding read permission, provided there are no tasks
210 -- holding write permission for the object. The effect is undefined if
211 -- the calling task already holds read or write permission for L.
213 -- Alternatively: An implementation may treat Read_Lock identically to
214 -- Write_Lock. This simplifies the implementation, but reduces the level
215 -- of concurrency that can be achieved.
217 -- Note that Read_Lock is not defined for RT_Lock and ST.Task_ID.
218 -- That is because (1) so far Read_Lock has always been implemented
219 -- the same as Write_Lock, (2) most lock usage inside the RTS involves
220 -- potential write access, and (3) implementations of priority ceiling
221 -- locking that make a reader-writer distinction have higher overhead.
223 procedure Unlock (L : access Lock);
224 procedure Unlock (L : access RTS_Lock);
225 procedure Unlock (T : ST.Task_ID);
226 pragma Inline (Unlock);
227 -- Unlock a locked lock object.
229 -- The effect is undefined unless the calling task holds read or write
230 -- permission for the lock L, and L is the lock object most recently
231 -- locked by the calling task for which the calling task still holds
232 -- read or write permission. (That is, matching pairs of Lock and Unlock
233 -- operations on each lock object must be properly nested.)
235 -- Note that Write_Lock for RTS_Lock does not have an out-parameter.
236 -- RTS_Locks are used in situations where we have not made provision
237 -- for recovery from ceiling violations. We do not expect them to
238 -- occur inside the runtime system, because all RTS locks have ceiling
241 -- There is one way there can be a ceiling violation.
242 -- That is if the runtime system is called from a task that is
243 -- executing in the Interrupt_Priority range.
245 -- It is not clear what to do about ceiling violations due
246 -- to RTS calls done at interrupt priority. In general, it
247 -- is not acceptable to give all RTS locks interrupt priority,
248 -- since that whould give terrible performance on systems where
249 -- this has the effect of masking hardware interrupts, though we
250 -- could get away with allowing Interrupt_Priority'last where we
251 -- are layered on an OS that does not allow us to mask interrupts.
252 -- Ideally, we would like to raise Program_Error back at the
253 -- original point of the RTS call, but this would require a lot of
254 -- detailed analysis and recoding, with almost certain performance
257 -- For POSIX systems, we considered just skipping setting a
258 -- priority ceiling on RTS locks. This would mean there is no
259 -- ceiling violation, but we would end up with priority inversions
260 -- inside the runtime system, resulting in failure to satisfy the
261 -- Ada priority rules, and possible missed validation tests.
262 -- This could be compensated-for by explicit priority-change calls
263 -- to raise the caller to Priority'Last whenever it first enters
264 -- the runtime system, but the expected overhead seems high, though
265 -- it might be lower than using locks with ceilings if the underlying
266 -- implementation of ceiling locks is an inefficient one.
268 -- This issue should be reconsidered whenever we get around to
269 -- checking for calls to potentially blocking operations from
270 -- within protected operations. If we check for such calls and
271 -- catch them on entry to the OS, it may be that we can eliminate
272 -- the possibility of ceiling violations inside the RTS. For this
273 -- to work, we would have to forbid explicitly setting the priority
274 -- of a task to anything in the Interrupt_Priority range, at least.
275 -- We would also have to check that there are no RTS-lock operations
276 -- done inside any operations that are not treated as potentially
279 -- The latter approach seems to be the best, i.e. to check on entry
280 -- to RTS calls that may need to use locks that the priority is not
281 -- in the interrupt range. If there are RTS operations that NEED to
282 -- be called from interrupt handlers, those few RTS locks should then
283 -- be converted to PO-type locks, with ceiling Interrupt_Priority'Last.
285 -- For now, we will just shut down the system if there is a
286 -- ceiling violation.
288 procedure Yield (Do_Yield : Boolean := True);
289 pragma Inline (Yield);
290 -- Yield the processor. Add the calling task to the tail of the
291 -- ready queue for its active_priority.
292 -- The Do_Yield argument is only used in some very rare cases very
293 -- a yield should have an effect on a specific target and not on regular
296 procedure Set_Priority
298 Prio : System.Any_Priority;
299 Loss_Of_Inheritance : Boolean := False);
300 pragma Inline (Set_Priority);
301 -- Set the priority of the task specified by T to T.Current_Priority.
302 -- The priority set is what would correspond to the Ada concept of
303 -- "base priority" in the terms of the lower layer system, but
304 -- the operation may be used by the upper layer to implement
305 -- changes in "active priority" that are not due to lock effects.
306 -- The effect should be consistent with the Ada Reference Manual.
307 -- In particular, when a task lowers its priority due to the loss of
308 -- inherited priority, it goes at the head of the queue for its new
309 -- priority (RM D.2.2 par 9).
310 -- Loss_Of_Inheritance helps the underlying implementation to do it
311 -- right when the OS doesn't.
313 function Get_Priority (T : ST.Task_ID) return System.Any_Priority;
314 pragma Inline (Get_Priority);
315 -- Returns the priority last set by Set_Priority for this task.
317 function Monotonic_Clock return Duration;
318 pragma Inline (Monotonic_Clock);
319 -- Returns "absolute" time, represented as an offset
320 -- relative to "the Epoch", which is Jan 1, 1970.
321 -- This clock implementation is immune to the system's clock changes.
323 function RT_Resolution return Duration;
324 pragma Inline (RT_Resolution);
325 -- Returns the resolution of the underlying clock used to implement
332 -- Whoever calls either of the Sleep routines is responsible
333 -- for checking for pending aborts before the call.
334 -- Pending priority changes are handled internally.
337 (Self_ID : ST.Task_ID;
338 Reason : System.Tasking.Task_States);
339 pragma Inline (Sleep);
340 -- Wait until the current task, T, is signaled to wake up.
343 -- The calling task is holding its own ATCB lock
344 -- and has abort deferred
347 -- The calling task is holding its own ATCB lock
348 -- and has abort deferred.
350 -- The effect is to atomically unlock T's lock and wait, so that another
351 -- task that is able to lock T's lock can be assured that the wait has
352 -- actually commenced, and that a Wakeup operation will cause the waiting
353 -- task to become ready for execution once again. When Sleep returns,
354 -- the waiting task will again hold its own ATCB lock. The waiting task
355 -- may become ready for execution at any time (that is, spurious wakeups
356 -- are permitted), but it will definitely become ready for execution when
357 -- a Wakeup operation is performed for the same task.
359 procedure Timed_Sleep
360 (Self_ID : ST.Task_ID;
362 Mode : ST.Delay_Modes;
363 Reason : System.Tasking.Task_States;
364 Timedout : out Boolean;
365 Yielded : out Boolean);
366 -- Combination of Sleep (above) and Timed_Delay
368 procedure Timed_Delay
369 (Self_ID : ST.Task_ID;
371 Mode : ST.Delay_Modes);
372 -- Implements the semantics of the delay statement. It is assumed that
373 -- the caller is not abort-deferred and does not hold any locks.
377 Reason : System.Tasking.Task_States);
378 pragma Inline (Wakeup);
379 -- Wake up task T if it is waiting on a Sleep call (of ordinary
380 -- or timed variety), making it ready for execution once again.
381 -- If the task T is not waiting on a Sleep, the operation has no effect.
383 function Environment_Task return ST.Task_ID;
384 pragma Inline (Environment_Task);
385 -- returns the task ID of the environment task
386 -- Consider putting this into a variable visible directly
387 -- by the rest of the runtime system. ???
389 function Get_Thread_Id (T : ST.Task_ID) return OSI.Thread_Id;
390 -- returns the thread id of the specified task.
396 -- Stack checking in GNAT is done using the concept of stack probes. A
397 -- stack probe is an operation that will generate a storage error if
398 -- an insufficient amount of stack space remains in the current task.
400 -- The exact mechanism for a stack probe is target dependent. Typical
401 -- possibilities are to use a load from a non-existent page, a store
402 -- to a read-only page, or a comparison with some stack limit constant.
403 -- Where possible we prefer to use a trap on a bad page access, since
404 -- this has less overhead. The generation of stack probes is either
405 -- automatic if the ABI requires it (as on for example DEC Unix), or
406 -- is controlled by the gcc parameter -fstack-check.
408 -- When we are using bad-page accesses, we need a bad page, called a
409 -- guard page, at the end of each task stack. On some systems, this
410 -- is provided automatically, but on other systems, we need to create
411 -- the guard page ourselves, and the procedure Stack_Guard is provided
414 procedure Stack_Guard (T : ST.Task_ID; On : Boolean);
415 -- Ensure guard page is set if one is needed and the underlying thread
416 -- system does not provide it. The procedure is as follows:
418 -- 1. When we create a task adjust its size so a guard page can
419 -- safely be set at the bottom of the stack
421 -- 2. When the thread is created (and its stack allocated by the
422 -- underlying thread system), get the stack base (and size, depending
423 -- how the stack is growing), and create the guard page taking care of
424 -- page boundaries issues.
426 -- 3. When the task is destroyed, remove the guard page.
428 -- If On is true then protect the stack bottom (i.e make it read only)
429 -- else unprotect it (i.e. On is True for the call when creating a task,
430 -- and False when a task is destroyed).
432 -- The call to Stack_Guard has no effect if guard pages are not used on
433 -- the target, or if guard pages are automatically provided by the system.
435 -----------------------------------------
436 -- Runtime System Debugging Interfaces --
437 -----------------------------------------
439 -- These interfaces have been added to assist in debugging the
440 -- tasking runtime system.
442 function Check_Exit (Self_ID : ST.Task_ID) return Boolean;
443 pragma Inline (Check_Exit);
444 -- Check that the current task is holding only Global_Task_Lock.
446 function Check_No_Locks (Self_ID : ST.Task_ID) return Boolean;
447 pragma Inline (Check_No_Locks);
448 -- Check that current task is holding no locks.
450 function Suspend_Task
452 Thread_Self : OSI.Thread_Id)
454 -- Suspend a specific task when the underlying thread library provides
455 -- such functionality, unless the thread associated with T is Thread_Self.
456 -- Such functionality is needed by gdb on some targets (e.g VxWorks)
457 -- Return True is the operation is successful
461 Thread_Self : OSI.Thread_Id)
463 -- Resume a specific task when the underlying thread library provides
464 -- such functionality, unless the thread associated with T is Thread_Self.
465 -- Such functionality is needed by gdb on some targets (e.g VxWorks)
466 -- Return True is the operation is successful
468 procedure Lock_All_Tasks_List;
469 procedure Unlock_All_Tasks_List;
470 -- Lock/Unlock the All_Tasks_L lock which protects
471 -- System.Initialization.All_Tasks_List and Known_Tasks
472 -- ??? These routines were previousely in System.Tasking.Initialization
473 -- but were moved here to avoid dependency problems. That would be
474 -- nice to look at it some day and put it back in Initialization.
476 end System.Task_Primitives.Operations;
OSDN Git Service
