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-2008, 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 with
37 with System
.Parameters
;
39 with System
.OS_Interface
;
41 package System
.Task_Primitives
.Operations
is
44 package ST
renames System
.Tasking
;
45 package OSI
renames System
.OS_Interface
;
47 procedure Initialize
(Environment_Task
: ST
.Task_Id
);
48 -- Perform initialization and set up of the environment task for proper
49 -- operation of the tasking run-time. This must be called once, before any
50 -- other subprograms of this package are called.
54 Wrapper
: System
.Address
;
55 Stack_Size
: System
.Parameters
.Size_Type
;
56 Priority
: System
.Any_Priority
;
57 Succeeded
: out Boolean);
58 pragma Inline
(Create_Task
);
59 -- Create a new low-level task with ST.Task_Id T and place other needed
60 -- information in the ATCB.
62 -- A new thread of control is created, with a stack of at least Stack_Size
63 -- storage units, and the procedure Wrapper is called by this new thread
64 -- of control. If Stack_Size = Unspecified_Storage_Size, choose a default
65 -- stack size; this may be effectively "unbounded" on some systems.
67 -- The newly created low-level task is associated with the ST.Task_Id T
68 -- such that any subsequent call to Self from within the context of the
69 -- low-level task returns T.
71 -- The caller is responsible for ensuring that the storage of the Ada
72 -- task control block object pointed to by T persists for the lifetime
75 -- Succeeded is set to true unless creation of the task failed,
76 -- as it may if there are insufficient resources to create another task.
78 procedure Enter_Task
(Self_ID
: ST
.Task_Id
);
79 pragma Inline
(Enter_Task
);
80 -- Initialize data structures specific to the calling task. Self must be
81 -- the ID of the calling task. It must be called (once) by the task
82 -- immediately after creation, while abort is still deferred. The effects
83 -- of other operations defined below are not defined unless the caller has
84 -- previously called Initialize_Task.
87 pragma Inline
(Exit_Task
);
88 -- Destroy the thread of control. Self must be the ID of the calling task.
89 -- The effects of further calls to operations defined below on the task
90 -- are undefined thereafter.
92 function New_ATCB
(Entry_Num
: ST
.Task_Entry_Index
) return ST
.Task_Id
;
93 pragma Inline
(New_ATCB
);
94 -- Allocate a new ATCB with the specified number of entries
96 procedure Initialize_TCB
(Self_ID
: ST
.Task_Id
; Succeeded
: out Boolean);
97 pragma Inline
(Initialize_TCB
);
98 -- Initialize all fields of the TCB
100 procedure Finalize_TCB
(T
: ST
.Task_Id
);
101 pragma Inline
(Finalize_TCB
);
102 -- Finalizes Private_Data of ATCB, and then deallocates it. This is also
103 -- responsible for recovering any storage or other resources that were
104 -- allocated by Create_Task (the one in this package). This should only be
105 -- called from Free_Task. After it is called there should be no further
106 -- reference to the ATCB that corresponds to T.
108 procedure Abort_Task
(T
: ST
.Task_Id
);
109 pragma Inline
(Abort_Task
);
110 -- Abort the task specified by T (the target task). This causes the target
111 -- task to asynchronously raise Abort_Signal if abort is not deferred, or
112 -- if it is blocked on an interruptible system call.
115 -- the calling task is holding T's lock and has abort deferred
118 -- the calling task is holding T's lock and has abort deferred.
120 -- ??? modify GNARL to skip wakeup and always call Abort_Task
122 function Self
return ST
.Task_Id
;
123 pragma Inline
(Self
);
124 -- Return a pointer to the Ada Task Control Block of the calling task
131 -- Type used to describe kind of lock for second form of Initialize_Lock
132 -- call specified below. See locking rules in System.Tasking (spec) for
135 procedure Initialize_Lock
136 (Prio
: System
.Any_Priority
;
137 L
: not null access Lock
);
138 procedure Initialize_Lock
139 (L
: not null access RTS_Lock
;
141 pragma Inline
(Initialize_Lock
);
142 -- Initialize a lock object
144 -- For Lock, Prio is the ceiling priority associated with the lock. For
145 -- RTS_Lock, the ceiling is implicitly Priority'Last.
147 -- If the underlying system does not support priority ceiling
148 -- locking, the Prio parameter is ignored.
150 -- The effect of either initialize operation is undefined unless is a lock
151 -- object that has not been initialized, or which has been finalized since
152 -- it was last initialized.
154 -- The effects of the other operations on lock objects are undefined
155 -- unless the lock object has been initialized and has not since been
158 -- Initialization of the per-task lock is implicit in Create_Task
160 -- These operations raise Storage_Error if a lack of storage is detected
162 procedure Finalize_Lock
(L
: not null access Lock
);
163 procedure Finalize_Lock
(L
: not null access RTS_Lock
);
164 pragma Inline
(Finalize_Lock
);
165 -- Finalize a lock object, freeing any resources allocated by the
166 -- corresponding Initialize_Lock operation.
169 (L
: not null access Lock
;
170 Ceiling_Violation
: out Boolean);
172 (L
: not null access RTS_Lock
;
173 Global_Lock
: Boolean := False);
176 pragma Inline
(Write_Lock
);
177 -- Lock a lock object for write access. After this operation returns,
178 -- the calling task holds write permission for the lock object. No other
179 -- Write_Lock or Read_Lock operation on the same lock object will return
180 -- until this task executes an Unlock operation on the same object. The
181 -- effect is undefined if the calling task already holds read or write
182 -- permission for the lock object L.
184 -- For the operation on Lock, Ceiling_Violation is set to true iff the
185 -- operation failed, which will happen if there is a priority ceiling
188 -- For the operation on RTS_Lock, Global_Lock should be set to True
189 -- if L is a global lock (Single_RTS_Lock, Global_Task_Lock).
191 -- For the operation on ST.Task_Id, the lock is the special lock object
192 -- associated with that task's ATCB. This lock has effective ceiling
193 -- priority high enough that it is safe to call by a task with any
194 -- priority in the range System.Priority. It is implicitly initialized
195 -- by task creation. The effect is undefined if the calling task already
196 -- holds T's lock, or has interrupt-level priority. Finalization of the
197 -- per-task lock is implicit in Exit_Task.
200 (L
: not null access Lock
;
201 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.
224 (L
: not null access Lock
);
226 (L
: not null access RTS_Lock
;
227 Global_Lock
: Boolean := False);
230 pragma Inline
(Unlock
);
231 -- Unlock a locked lock object
233 -- The effect is undefined unless the calling task holds read or write
234 -- permission for the lock L, and L is the lock object most recently
235 -- locked by the calling task for which the calling task still holds
236 -- read or write permission. (That is, matching pairs of Lock and Unlock
237 -- operations on each lock object must be properly nested.)
239 -- For the operation on RTS_Lock, Global_Lock should be set to True if L
240 -- is a global lock (Single_RTS_Lock, Global_Task_Lock).
242 -- Note that Write_Lock for RTS_Lock does not have an out-parameter.
243 -- RTS_Locks are used in situations where we have not made provision for
244 -- recovery from ceiling violations. We do not expect them to occur inside
245 -- the runtime system, because all RTS locks have ceiling Priority'Last.
247 -- There is one way there can be a ceiling violation. That is if the
248 -- runtime system is called from a task that is executing in the
249 -- Interrupt_Priority range.
251 -- It is not clear what to do about ceiling violations due to RTS calls
252 -- done at interrupt priority. In general, it is not acceptable to give
253 -- all RTS locks interrupt priority, since that would give terrible
254 -- performance on systems where this has the effect of masking hardware
255 -- interrupts, though we could get away allowing Interrupt_Priority'last
256 -- where we are layered on an OS that does not allow us to mask interrupts.
257 -- Ideally, we would like to raise Program_Error back at the original point
258 -- of the RTS call, but this would require a lot of detailed analysis and
259 -- recoding, with almost certain performance penalties.
261 -- For POSIX systems, we considered just skipping setting priority ceiling
262 -- on RTS locks. This would mean there is no ceiling violation, but we
263 -- would end up with priority inversions inside the runtime system,
264 -- resulting in failure to satisfy the Ada priority rules, and possible
265 -- missed validation tests. This could be compensated-for by explicit
266 -- priority-change calls to raise the caller to Priority'Last whenever it
267 -- first enters the runtime system, but the expected overhead seems high,
268 -- though it might be lower than using locks with ceilings if the
269 -- underlying implementation of ceiling locks is an inefficient one.
271 -- This issue should be reconsidered whenever we get around to checking
272 -- for calls to potentially blocking operations from within protected
273 -- operations. If we check for such calls and catch them on entry to the
274 -- OS, it may be that we can eliminate the possibility of ceiling
275 -- violations inside the RTS. For this to work, we would have to forbid
276 -- explicitly setting the priority of a task to anything in the
277 -- Interrupt_Priority range, at least. We would also have to check that
278 -- there are no RTS-lock operations done inside any operations that are
279 -- not treated as potentially blocking.
281 -- The latter approach seems to be the best, i.e. to check on entry to RTS
282 -- calls that may need to use locks that the priority is not in the
283 -- interrupt range. If there are RTS operations that NEED to be called
284 -- from interrupt handlers, those few RTS locks should then be converted
285 -- to PO-type locks, with ceiling Interrupt_Priority'Last.
287 -- For now, we will just shut down the system if there is ceiling violation
289 procedure Set_Ceiling
290 (L
: not null access Lock
;
291 Prio
: System
.Any_Priority
);
292 pragma Inline
(Set_Ceiling
);
293 -- Change the ceiling priority associated to the lock
295 -- The effect is undefined unless the calling task holds read or write
296 -- permission for the lock L, and L is the lock object most recently
297 -- locked by the calling task for which the calling task still holds
298 -- read or write permission. (That is, matching pairs of Lock and Unlock
299 -- operations on each lock object must be properly nested.)
301 procedure Yield
(Do_Yield
: Boolean := True);
302 pragma Inline
(Yield
);
303 -- Yield the processor. Add the calling task to the tail of the ready
304 -- queue for its active_priority. The Do_Yield argument is only used in
305 -- some very rare cases very a yield should have an effect on a specific
306 -- target and not on regular ones.
308 procedure Set_Priority
310 Prio
: System
.Any_Priority
;
311 Loss_Of_Inheritance
: Boolean := False);
312 pragma Inline
(Set_Priority
);
313 -- Set the priority of the task specified by T to T.Current_Priority. The
314 -- priority set is what would correspond to the Ada concept of "base
315 -- priority" in the terms of the lower layer system, but the operation may
316 -- be used by the upper layer to implement changes in "active priority"
317 -- that are not due to lock effects. The effect should be consistent with
318 -- the Ada Reference Manual. In particular, when a task lowers its
319 -- priority due to the loss of inherited priority, it goes at the head of
320 -- the queue for its new priority (RM D.2.2 par 9). Loss_Of_Inheritance
321 -- helps the underlying implementation to do it right when the OS doesn't.
323 function Get_Priority
(T
: ST
.Task_Id
) return System
.Any_Priority
;
324 pragma Inline
(Get_Priority
);
325 -- Returns the priority last set by Set_Priority for this task
327 function Monotonic_Clock
return Duration;
328 pragma Inline
(Monotonic_Clock
);
329 -- Returns "absolute" time, represented as an offset relative to "the
330 -- Epoch", which is Jan 1, 1970. This clock implementation is immune to
331 -- the system's clock changes.
333 function RT_Resolution
return Duration;
334 pragma Inline
(RT_Resolution
);
335 -- Returns resolution of the underlying clock used to implement RT_Clock
341 -- Whoever calls either of the Sleep routines is responsible for checking
342 -- for pending aborts before the call. Pending priority changes are handled
346 (Self_ID
: ST
.Task_Id
;
347 Reason
: System
.Tasking
.Task_States
);
348 pragma Inline
(Sleep
);
349 -- Wait until the current task, T, is signaled to wake up
352 -- The calling task is holding its own ATCB lock
353 -- and has abort deferred
356 -- The calling task is holding its own ATCB lock and has abort deferred.
358 -- The effect is to atomically unlock T's lock and wait, so that another
359 -- task that is able to lock T's lock can be assured that the wait has
360 -- actually commenced, and that a Wakeup operation will cause the waiting
361 -- task to become ready for execution once again. When Sleep returns, the
362 -- waiting task will again hold its own ATCB lock. The waiting task may
363 -- become ready for execution at any time (that is, spurious wakeups are
364 -- permitted), but it will definitely become ready for execution when a
365 -- Wakeup operation is performed for the same task.
367 procedure Timed_Sleep
368 (Self_ID
: ST
.Task_Id
;
370 Mode
: ST
.Delay_Modes
;
371 Reason
: System
.Tasking
.Task_States
;
372 Timedout
: out Boolean;
373 Yielded
: out Boolean);
374 -- Combination of Sleep (above) and Timed_Delay
376 procedure Timed_Delay
377 (Self_ID
: ST
.Task_Id
;
379 Mode
: ST
.Delay_Modes
);
380 -- Implement the semantics of the delay statement.
381 -- The caller should be abort-deferred and should not hold any locks.
385 Reason
: System
.Tasking
.Task_States
);
386 pragma Inline
(Wakeup
);
387 -- Wake up task T if it is waiting on a Sleep call (of ordinary
388 -- or timed variety), making it ready for execution once again.
389 -- If the task T is not waiting on a Sleep, the operation has no effect.
391 function Environment_Task
return ST
.Task_Id
;
392 pragma Inline
(Environment_Task
);
393 -- Return the task ID of the environment task
394 -- Consider putting this into a variable visible directly
395 -- by the rest of the runtime system. ???
397 function Get_Thread_Id
(T
: ST
.Task_Id
) return OSI
.Thread_Id
;
398 -- Return the thread id of the specified task
400 function Is_Valid_Task
return Boolean;
401 pragma Inline
(Is_Valid_Task
);
402 -- Does the calling thread have an ATCB?
404 function Register_Foreign_Thread
return ST
.Task_Id
;
405 -- Allocate and initialize a new ATCB for the current thread
407 -----------------------
408 -- RTS Entrance/Exit --
409 -----------------------
411 -- Following two routines are used for possible operations needed to be
412 -- setup/cleared upon entrance/exit of RTS while maintaining a single
413 -- thread of control in the RTS. Since we intend these routines to be used
414 -- for implementing the Single_Lock RTS, Lock_RTS should follow the first
415 -- Defer_Abort operation entering RTS. In the same fashion Unlock_RTS
416 -- should precede the last Undefer_Abort exiting RTS.
418 -- These routines also replace the functions Lock/Unlock_All_Tasks_List
421 -- Take the global RTS lock
423 procedure Unlock_RTS
;
424 -- Release the global RTS lock
430 -- Stack checking in GNAT is done using the concept of stack probes. A
431 -- stack probe is an operation that will generate a storage error if
432 -- an insufficient amount of stack space remains in the current task.
434 -- The exact mechanism for a stack probe is target dependent. Typical
435 -- possibilities are to use a load from a non-existent page, a store to a
436 -- read-only page, or a comparison with some stack limit constant. Where
437 -- possible we prefer to use a trap on a bad page access, since this has
438 -- less overhead. The generation of stack probes is either automatic if
439 -- the ABI requires it (as on for example DEC Unix), or is controlled by
440 -- the gcc parameter -fstack-check.
442 -- When we are using bad-page accesses, we need a bad page, called guard
443 -- page, at the end of each task stack. On some systems, this is provided
444 -- automatically, but on other systems, we need to create the guard page
445 -- ourselves, and the procedure Stack_Guard is provided for this purpose.
447 procedure Stack_Guard
(T
: ST
.Task_Id
; On
: Boolean);
448 -- Ensure guard page is set if one is needed and the underlying thread
449 -- system does not provide it. The procedure is as follows:
451 -- 1. When we create a task adjust its size so a guard page can
452 -- safely be set at the bottom of the stack.
454 -- 2. When the thread is created (and its stack allocated by the
455 -- underlying thread system), get the stack base (and size, depending
456 -- how the stack is growing), and create the guard page taking care
457 -- of page boundaries issues.
459 -- 3. When the task is destroyed, remove the guard page.
461 -- If On is true then protect the stack bottom (i.e make it read only)
462 -- else unprotect it (i.e. On is True for the call when creating a task,
463 -- and False when a task is destroyed).
465 -- The call to Stack_Guard has no effect if guard pages are not used on
466 -- the target, or if guard pages are automatically provided by the system.
468 ------------------------
469 -- Suspension objects --
470 ------------------------
472 -- These subprograms provide the functionality required for synchronizing
473 -- on a suspension object. Tasks can suspend execution and relinquish the
474 -- processors until the condition is signaled.
476 function Current_State
(S
: Suspension_Object
) return Boolean;
477 -- Return the state of the suspension object
479 procedure Set_False
(S
: in out Suspension_Object
);
480 -- Set the state of the suspension object to False
482 procedure Set_True
(S
: in out Suspension_Object
);
483 -- Set the state of the suspension object to True. If a task were
484 -- suspended on the protected object then this task is released (and
485 -- the state of the suspension object remains set to False).
487 procedure Suspend_Until_True
(S
: in out Suspension_Object
);
488 -- If the state of the suspension object is True then the calling task
489 -- continues its execution, and the state is set to False. If the state
490 -- of the object is False then the task is suspended on the suspension
491 -- object until a Set_True operation is executed. Program_Error is raised
492 -- if another task is already waiting on that suspension object.
494 procedure Initialize
(S
: in out Suspension_Object
);
495 -- Initialize the suspension object
497 procedure Finalize
(S
: in out Suspension_Object
);
498 -- Finalize the suspension object
500 -----------------------------------------
501 -- Runtime System Debugging Interfaces --
502 -----------------------------------------
504 -- These interfaces have been added to assist in debugging the
505 -- tasking runtime system.
507 function Check_Exit
(Self_ID
: ST
.Task_Id
) return Boolean;
508 pragma Inline
(Check_Exit
);
509 -- Check that the current task is holding only Global_Task_Lock
511 function Check_No_Locks
(Self_ID
: ST
.Task_Id
) return Boolean;
512 pragma Inline
(Check_No_Locks
);
513 -- Check that current task is holding no locks
515 function Suspend_Task
517 Thread_Self
: OSI
.Thread_Id
) return Boolean;
518 -- Suspend a specific task when the underlying thread library provides this
519 -- functionality, unless the thread associated with T is Thread_Self. Such
520 -- functionality is needed by gdb on some targets (e.g VxWorks) Return True
521 -- is the operation is successful. On targets where this operation is not
522 -- available, a dummy body is present which always returns False.
526 Thread_Self
: OSI
.Thread_Id
) return Boolean;
527 -- Resume a specific task when the underlying thread library provides
528 -- such functionality, unless the thread associated with T is Thread_Self.
529 -- Such functionality is needed by gdb on some targets (e.g VxWorks)
530 -- Return True is the operation is successful
532 procedure Stop_All_Tasks
;
533 -- Stop all tasks when the underlying thread library provides such
534 -- functionality. Such functionality is needed by gdb on some targets (e.g
535 -- VxWorks) This function can be run from an interrupt handler. Return True
536 -- is the operation is successful
538 function Stop_Task
(T
: ST
.Task_Id
) return Boolean;
539 -- Stop a specific task when the underlying thread library provides
540 -- such functionality. Such functionality is needed by gdb on some targets
541 -- (e.g VxWorks). Return True is the operation is successful.
543 function Continue_Task
(T
: ST
.Task_Id
) return Boolean;
544 -- Continue a specific task when the underlying thread library provides
545 -- such functionality. Such functionality is needed by gdb on some targets
546 -- (e.g VxWorks) Return True is the operation is successful
548 end System
.Task_Primitives
.Operations
;