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 --
9 -- Copyright (C) 1992-2005, Free Software Foundation, Inc. --
11 -- GNARL is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 2, or (at your option) any later ver- --
14 -- sion. GNARL is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNARL; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, USA. --
22 -- As a special exception, if other files instantiate generics from this --
23 -- unit, or you link this unit with other files to produce an executable, --
24 -- this unit does not by itself cause the resulting executable to be --
25 -- covered by the GNU General Public License. This exception does not --
26 -- however invalidate any other reasons why the executable file might be --
27 -- covered by the GNU Public License. --
29 -- GNARL was developed by the GNARL team at Florida State University. --
30 -- Extensive contributions were provided by Ada Core Technologies, Inc. --
32 ------------------------------------------------------------------------------
34 -- This package contains all the GNULL primitives that interface directly
35 -- with the underlying OS.
37 with System.Parameters;
43 with System.OS_Interface;
46 package System.Task_Primitives.Operations is
49 package ST renames System.Tasking;
50 package OSI renames System.OS_Interface;
52 procedure Initialize (Environment_Task : ST.Task_Id);
53 -- Perform initialization and set up of the environment task for proper
54 -- operation of the tasking run-time. This must be called once, before any
55 -- other subprograms of this package are called.
59 Wrapper : System.Address;
60 Stack_Size : System.Parameters.Size_Type;
61 Priority : System.Any_Priority;
62 Succeeded : out Boolean);
63 pragma Inline (Create_Task);
64 -- Create a new low-level task with ST.Task_Id T and place other needed
65 -- information in the ATCB.
67 -- A new thread of control is created, with a stack of at least Stack_Size
68 -- storage units, and the procedure Wrapper is called by this new thread
69 -- of control. If Stack_Size = Unspecified_Storage_Size, choose a default
70 -- stack size; this may be effectively "unbounded" on some systems.
72 -- The newly created low-level task is associated with the ST.Task_Id T
73 -- such that any subsequent call to Self from within the context of the
74 -- low-level task returns T.
76 -- The caller is responsible for ensuring that the storage of the Ada
77 -- task control block object pointed to by T persists for the lifetime
80 -- Succeeded is set to true unless creation of the task failed,
81 -- as it may if there are insufficient resources to create another task.
83 procedure Enter_Task (Self_ID : ST.Task_Id);
84 pragma Inline (Enter_Task);
85 -- Initialize data structures specific to the calling task. Self must be
86 -- the ID of the calling task. It must be called (once) by the task
87 -- immediately after creation, while abort is still deferred. The effects
88 -- of other operations defined below are not defined unless the caller has
89 -- previously called Initialize_Task.
92 pragma Inline (Exit_Task);
93 -- Destroy the thread of control. Self must be the ID of the calling task.
94 -- The effects of further calls to operations defined below on the task
95 -- are undefined thereafter.
97 function New_ATCB (Entry_Num : ST.Task_Entry_Index) return ST.Task_Id;
98 pragma Inline (New_ATCB);
99 -- Allocate a new ATCB with the specified number of entries
101 procedure Initialize_TCB (Self_ID : ST.Task_Id; Succeeded : out Boolean);
102 pragma Inline (Initialize_TCB);
103 -- Initialize all fields of the TCB
105 procedure Finalize_TCB (T : ST.Task_Id);
106 pragma Inline (Finalize_TCB);
107 -- Finalizes Private_Data of ATCB, and then deallocates it. This is also
108 -- responsible for recovering any storage or other resources that were
109 -- allocated by Create_Task (the one in this package). This should only be
110 -- called from Free_Task. After it is called there should be no further
111 -- reference to the ATCB that corresponds to T.
113 procedure Abort_Task (T : ST.Task_Id);
114 pragma Inline (Abort_Task);
115 -- Abort the task specified by T (the target task). This causes the target
116 -- task to asynchronously raise Abort_Signal if abort is not deferred, or
117 -- if it is blocked on an interruptible system call.
120 -- the calling task is holding T's lock and has abort deferred
123 -- the calling task is holding T's lock and has abort deferred.
125 -- ??? modify GNARL to skip wakeup and always call Abort_Task
127 function Self return ST.Task_Id;
128 pragma Inline (Self);
129 -- Return a pointer to the Ada Task Control Block of the calling task
136 -- Type used to describe kind of lock for second form of Initialize_Lock
137 -- call specified below. See locking rules in System.Tasking (spec) for
140 procedure Initialize_Lock (Prio : System.Any_Priority; L : access Lock);
141 procedure Initialize_Lock (L : access RTS_Lock; Level : Lock_Level);
142 pragma Inline (Initialize_Lock);
143 -- Initialize a lock object.
145 -- For Lock, Prio is the ceiling priority associated with the lock. For
146 -- RTS_Lock, the ceiling is implicitly Priority'Last.
148 -- If the underlying system does not support priority ceiling
149 -- locking, the Prio parameter is ignored.
151 -- The effect of either initialize operation is undefined unless is a lock
152 -- object that has not been initialized, or which has been finalized since
153 -- it was last initialized.
155 -- The effects of the other operations on lock objects are undefined
156 -- unless the lock object has been initialized and has not since been
159 -- Initialization of the per-task lock is implicit in Create_Task.
161 -- These operations raise Storage_Error if a lack of storage is detected.
163 procedure Finalize_Lock (L : access Lock);
164 procedure Finalize_Lock (L : access RTS_Lock);
165 pragma Inline (Finalize_Lock);
166 -- Finalize a lock object, freeing any resources allocated by the
167 -- corresponding Initialize_Lock operation.
169 procedure Write_Lock (L : access Lock; Ceiling_Violation : out Boolean);
170 procedure Write_Lock (L : access RTS_Lock; Global_Lock : Boolean := False);
171 procedure Write_Lock (T : ST.Task_Id);
172 pragma Inline (Write_Lock);
173 -- Lock a lock object for write access. After this operation returns,
174 -- the calling task holds write permission for the lock object. No other
175 -- Write_Lock or Read_Lock operation on the same lock object will return
176 -- until this task executes an Unlock operation on the same object. The
177 -- effect is undefined if the calling task already holds read or write
178 -- permission for the lock object L.
180 -- For the operation on Lock, Ceiling_Violation is set to true iff the
181 -- operation failed, which will happen if there is a priority ceiling
184 -- For the operation on RTS_Lock, Global_Lock should be set to True
185 -- if L is a global lock (Single_RTS_Lock, Global_Task_Lock).
187 -- For the operation on ST.Task_Id, the lock is the special lock object
188 -- associated with that task's ATCB. This lock has effective ceiling
189 -- priority high enough that it is safe to call by a task with any
190 -- priority in the range System.Priority. It is implicitly initialized
191 -- by task creation. The effect is undefined if the calling task already
192 -- holds T's lock, or has interrupt-level priority. Finalization of the
193 -- per-task lock is implicit in Exit_Task.
195 procedure Read_Lock (L : access Lock; Ceiling_Violation : out Boolean);
196 pragma Inline (Read_Lock);
197 -- Lock a lock object for read access. After this operation returns,
198 -- the calling task has non-exclusive read permission for the logical
199 -- resources that are protected by the lock. No other Write_Lock operation
200 -- on the same object will return until this task and any other tasks with
201 -- read permission for this lock have executed Unlock operation(s) on the
202 -- lock object. A Read_Lock for a lock object may return immediately while
203 -- there are tasks holding read permission, provided there are no tasks
204 -- holding write permission for the object. The effect is undefined if
205 -- the calling task already holds read or write permission for L.
207 -- Alternatively: An implementation may treat Read_Lock identically to
208 -- Write_Lock. This simplifies the implementation, but reduces the level
209 -- of concurrency that can be achieved.
211 -- Note that Read_Lock is not defined for RT_Lock and ST.Task_Id.
212 -- That is because (1) so far Read_Lock has always been implemented
213 -- the same as Write_Lock, (2) most lock usage inside the RTS involves
214 -- potential write access, and (3) implementations of priority ceiling
215 -- locking that make a reader-writer distinction have higher overhead.
217 procedure Unlock (L : access Lock);
218 procedure Unlock (L : access RTS_Lock; Global_Lock : Boolean := False);
219 procedure Unlock (T : ST.Task_Id);
220 pragma Inline (Unlock);
221 -- Unlock a locked lock object.
223 -- The effect is undefined unless the calling task holds read or write
224 -- permission for the lock L, and L is the lock object most recently
225 -- locked by the calling task for which the calling task still holds
226 -- read or write permission. (That is, matching pairs of Lock and Unlock
227 -- operations on each lock object must be properly nested.)
229 -- For the operation on RTS_Lock, Global_Lock should be set to True if L
230 -- is a global lock (Single_RTS_Lock, Global_Task_Lock).
232 -- Note that Write_Lock for RTS_Lock does not have an out-parameter.
233 -- RTS_Locks are used in situations where we have not made provision for
234 -- recovery from ceiling violations. We do not expect them to occur inside
235 -- the runtime system, because all RTS locks have ceiling Priority'Last.
237 -- There is one way there can be a ceiling violation. That is if the
238 -- runtime system is called from a task that is executing in the
239 -- Interrupt_Priority range.
241 -- It is not clear what to do about ceiling violations due to RTS calls
242 -- done at interrupt priority. In general, it is not acceptable to give
243 -- all RTS locks interrupt priority, since that whould give terrible
244 -- performance on systems where this has the effect of masking hardware
245 -- interrupts, though we could get away with allowing
246 -- Interrupt_Priority'last where we are layered on an OS that does not
247 -- allow us to mask interrupts. Ideally, we would like to raise
248 -- Program_Error back at the original point of the RTS call, but this
249 -- would require a lot of detailed analysis and recoding, with almost
250 -- certain performance penalties.
252 -- For POSIX systems, we considered just skipping setting priority ceiling
253 -- on RTS locks. This would mean there is no ceiling violation, but we
254 -- would end up with priority inversions inside the runtime system,
255 -- resulting in failure to satisfy the Ada priority rules, and possible
256 -- missed validation tests. This could be compensated-for by explicit
257 -- priority-change calls to raise the caller to Priority'Last whenever it
258 -- first enters the runtime system, but the expected overhead seems high,
259 -- though it might be lower than using locks with ceilings if the
260 -- underlying implementation of ceiling locks is an inefficient one.
262 -- This issue should be reconsidered whenever we get around to checking
263 -- for calls to potentially blocking operations from within protected
264 -- operations. If we check for such calls and catch them on entry to the
265 -- OS, it may be that we can eliminate the possibility of ceiling
266 -- violations inside the RTS. For this to work, we would have to forbid
267 -- explicitly setting the priority of a task to anything in the
268 -- Interrupt_Priority range, at least. We would also have to check that
269 -- there are no RTS-lock operations done inside any operations that are
270 -- not treated as potentially blocking.
272 -- The latter approach seems to be the best, i.e. to check on entry to RTS
273 -- calls that may need to use locks that the priority is not in the
274 -- interrupt range. If there are RTS operations that NEED to be called
275 -- from interrupt handlers, those few RTS locks should then be converted
276 -- to PO-type locks, with ceiling Interrupt_Priority'Last.
278 -- For now, we will just shut down the system if there is ceiling violation
280 procedure Yield (Do_Yield : Boolean := True);
281 pragma Inline (Yield);
282 -- Yield the processor. Add the calling task to the tail of the ready
283 -- queue for its active_priority. The Do_Yield argument is only used in
284 -- some very rare cases very a yield should have an effect on a specific
285 -- target and not on regular ones.
287 procedure Set_Priority
289 Prio : System.Any_Priority;
290 Loss_Of_Inheritance : Boolean := False);
291 pragma Inline (Set_Priority);
292 -- Set the priority of the task specified by T to T.Current_Priority. The
293 -- priority set is what would correspond to the Ada concept of "base
294 -- priority" in the terms of the lower layer system, but the operation may
295 -- be used by the upper layer to implement changes in "active priority"
296 -- that are not due to lock effects. The effect should be consistent with
297 -- the Ada Reference Manual. In particular, when a task lowers its
298 -- priority due to the loss of inherited priority, it goes at the head of
299 -- the queue for its new priority (RM D.2.2 par 9). Loss_Of_Inheritance
300 -- helps the underlying implementation to do it right when the OS doesn't.
302 function Get_Priority (T : ST.Task_Id) return System.Any_Priority;
303 pragma Inline (Get_Priority);
304 -- Returns the priority last set by Set_Priority for this task
306 function Monotonic_Clock return Duration;
307 pragma Inline (Monotonic_Clock);
308 -- Returns "absolute" time, represented as an offset relative to "the
309 -- Epoch", which is Jan 1, 1970. This clock implementation is immune to
310 -- the system's clock changes.
312 function RT_Resolution return Duration;
313 pragma Inline (RT_Resolution);
314 -- Returns resolution of the underlying clock used to implement RT_Clock
320 -- Whoever calls either of the Sleep routines is responsible
321 -- for checking for pending aborts before the call.
322 -- Pending priority changes are handled internally.
325 (Self_ID : ST.Task_Id;
326 Reason : System.Tasking.Task_States);
327 pragma Inline (Sleep);
328 -- Wait until the current task, T, is signaled to wake up.
331 -- The calling task is holding its own ATCB lock
332 -- and has abort deferred
335 -- The calling task is holding its own ATCB lock and has abort deferred.
337 -- The effect is to atomically unlock T's lock and wait, so that another
338 -- task that is able to lock T's lock can be assured that the wait has
339 -- actually commenced, and that a Wakeup operation will cause the waiting
340 -- task to become ready for execution once again. When Sleep returns, the
341 -- waiting task will again hold its own ATCB lock. The waiting task may
342 -- become ready for execution at any time (that is, spurious wakeups are
343 -- permitted), but it will definitely become ready for execution when a
344 -- Wakeup operation is performed for the same task.
346 procedure Timed_Sleep
347 (Self_ID : ST.Task_Id;
349 Mode : ST.Delay_Modes;
350 Reason : System.Tasking.Task_States;
351 Timedout : out Boolean;
352 Yielded : out Boolean);
353 -- Combination of Sleep (above) and Timed_Delay
355 procedure Timed_Delay
356 (Self_ID : ST.Task_Id;
358 Mode : ST.Delay_Modes);
359 -- Implement the semantics of the delay statement.
360 -- The caller should be abort-deferred and should not hold any locks.
364 Reason : System.Tasking.Task_States);
365 pragma Inline (Wakeup);
366 -- Wake up task T if it is waiting on a Sleep call (of ordinary
367 -- or timed variety), making it ready for execution once again.
368 -- If the task T is not waiting on a Sleep, the operation has no effect.
370 function Environment_Task return ST.Task_Id;
371 pragma Inline (Environment_Task);
372 -- Return the task ID of the environment task
373 -- Consider putting this into a variable visible directly
374 -- by the rest of the runtime system. ???
376 function Get_Thread_Id (T : ST.Task_Id) return OSI.Thread_Id;
377 -- Return the thread id of the specified task
379 function Is_Valid_Task return Boolean;
380 pragma Inline (Is_Valid_Task);
381 -- Does the calling thread have an ATCB?
383 function Register_Foreign_Thread return ST.Task_Id;
384 -- Allocate and initialize a new ATCB for the current thread
386 -----------------------
387 -- RTS Entrance/Exit --
388 -----------------------
390 -- Following two routines are used for possible operations needed to be
391 -- setup/cleared upon entrance/exit of RTS while maintaining a single
392 -- thread of control in the RTS. Since we intend these routines to be used
393 -- for implementing the Single_Lock RTS, Lock_RTS should follow the first
394 -- Defer_Abortion operation entering RTS. In the same fashion Unlock_RTS
395 -- should preceed the last Undefer_Abortion exiting RTS.
397 -- These routines also replace the functions Lock/Unlock_All_Tasks_List
400 -- Take the global RTS lock
402 procedure Unlock_RTS;
403 -- Release the global RTS lock
409 -- Stack checking in GNAT is done using the concept of stack probes. A
410 -- stack probe is an operation that will generate a storage error if
411 -- an insufficient amount of stack space remains in the current task.
413 -- The exact mechanism for a stack probe is target dependent. Typical
414 -- possibilities are to use a load from a non-existent page, a store to a
415 -- read-only page, or a comparison with some stack limit constant. Where
416 -- possible we prefer to use a trap on a bad page access, since this has
417 -- less overhead. The generation of stack probes is either automatic if
418 -- the ABI requires it (as on for example DEC Unix), or is controlled by
419 -- the gcc parameter -fstack-check.
421 -- When we are using bad-page accesses, we need a bad page, called guard
422 -- page, at the end of each task stack. On some systems, this is provided
423 -- automatically, but on other systems, we need to create the guard page
424 -- ourselves, and the procedure Stack_Guard is provided for this purpose.
426 procedure Stack_Guard (T : ST.Task_Id; On : Boolean);
427 -- Ensure guard page is set if one is needed and the underlying thread
428 -- system does not provide it. The procedure is as follows:
430 -- 1. When we create a task adjust its size so a guard page can
431 -- safely be set at the bottom of the stack.
433 -- 2. When the thread is created (and its stack allocated by the
434 -- underlying thread system), get the stack base (and size, depending
435 -- how the stack is growing), and create the guard page taking care
436 -- of page boundaries issues.
438 -- 3. When the task is destroyed, remove the guard page.
440 -- If On is true then protect the stack bottom (i.e make it read only)
441 -- else unprotect it (i.e. On is True for the call when creating a task,
442 -- and False when a task is destroyed).
444 -- The call to Stack_Guard has no effect if guard pages are not used on
445 -- the target, or if guard pages are automatically provided by the system.
447 ------------------------
448 -- Suspension objects --
449 ------------------------
451 -- These subprograms provide the functionality required for synchronizing
452 -- on a suspension object. Tasks can suspend execution and relinquish the
453 -- processors until the condition is signaled.
455 function Current_State (S : Suspension_Object) return Boolean;
456 -- Return the state of the suspension object
458 procedure Set_False (S : in out Suspension_Object);
459 -- Set the state of the suspension object to False
461 procedure Set_True (S : in out Suspension_Object);
462 -- Set the state of the suspension object to True. If a task were
463 -- suspended on the protected object then this task is released (and
464 -- the state of the suspension object remains set to False).
466 procedure Suspend_Until_True (S : in out Suspension_Object);
467 -- If the state of the suspension object is True then the calling task
468 -- continues its execution, and the state is set to False. If the state
469 -- of the object is False then the task is suspended on the suspension
470 -- object until a Set_True operation is executed. Program_Error is raised
471 -- if another task is already waiting on that suspension object.
473 procedure Initialize (S : in out Suspension_Object);
474 -- Initialize the suspension object
476 procedure Finalize (S : in out Suspension_Object);
477 -- Finalize the suspension object
479 -----------------------------------------
480 -- Runtime System Debugging Interfaces --
481 -----------------------------------------
483 -- These interfaces have been added to assist in debugging the
484 -- tasking runtime system.
486 function Check_Exit (Self_ID : ST.Task_Id) return Boolean;
487 pragma Inline (Check_Exit);
488 -- Check that the current task is holding only Global_Task_Lock
490 function Check_No_Locks (Self_ID : ST.Task_Id) return Boolean;
491 pragma Inline (Check_No_Locks);
492 -- Check that current task is holding no locks
494 function Suspend_Task
496 Thread_Self : OSI.Thread_Id) return Boolean;
497 -- Suspend a specific task when the underlying thread library provides
498 -- such functionality, unless the thread associated with T is Thread_Self.
499 -- Such functionality is needed by gdb on some targets (e.g VxWorks)
500 -- Return True is the operation is successful
504 Thread_Self : OSI.Thread_Id) return Boolean;
505 -- Resume a specific task when the underlying thread library provides
506 -- such functionality, unless the thread associated with T is Thread_Self.
507 -- Such functionality is needed by gdb on some targets (e.g VxWorks)
508 -- Return True is the operation is successful
510 end System.Task_Primitives.Operations;
OSDN Git Service
