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-2004, 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, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, 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
48 pragma Elaborate_Body
;
49 package ST
renames System
.Tasking
;
50 package OSI
renames System
.OS_Interface
;
52 procedure Initialize
(Environment_Task
: ST
.Task_Id
);
53 pragma Inline
(Initialize
);
54 -- This must be called once, before any other subprograms of this
55 -- 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.
86 -- Self must be the ID of the calling task.
87 -- It must be called (once) by the task immediately after creation,
88 -- while abortion is still deferred.
89 -- The effects of other operations defined below are not defined
90 -- unless the caller has previously called Initialize_Task.
93 pragma Inline
(Exit_Task
);
94 -- Destroy the thread of control.
95 -- Self must be the ID of the calling task.
96 -- The effects of further calls to operations defined below
97 -- on the task are undefined thereafter.
99 function New_ATCB
(Entry_Num
: ST
.Task_Entry_Index
) return ST
.Task_Id
;
100 pragma Inline
(New_ATCB
);
101 -- Allocate a new ATCB with the specified number of entries.
103 procedure Initialize_TCB
(Self_ID
: ST
.Task_Id
; Succeeded
: out Boolean);
104 pragma Inline
(Initialize_TCB
);
105 -- Initialize all fields of the TCB
107 procedure Finalize_TCB
(T
: ST
.Task_Id
);
108 pragma Inline
(Finalize_TCB
);
109 -- Finalizes Private_Data of ATCB, and then deallocates it.
110 -- This is also responsible for recovering any storage or other resources
111 -- that were allocated by Create_Task (the one in this package).
112 -- This should only be called from Free_Task.
113 -- After it is called there should be no further
114 -- reference to the ATCB that corresponds to T.
116 procedure Abort_Task
(T
: ST
.Task_Id
);
117 pragma Inline
(Abort_Task
);
118 -- Abort the task specified by T (the target task). This causes
119 -- the target task to asynchronously raise Abort_Signal if
120 -- abort is not deferred, or if it is blocked on an interruptible
124 -- the calling task is holding T's lock and has abort deferred
127 -- the calling task is holding T's lock and has abort deferred.
129 -- ??? modify GNARL to skip wakeup and always call Abort_Task
131 function Self
return ST
.Task_Id
;
132 pragma Inline
(Self
);
133 -- Return a pointer to the Ada Task Control Block of the calling task.
140 -- Type used to describe kind of lock for second form of Initialize_Lock
141 -- call specified below.
142 -- See locking rules in System.Tasking (spec) for more details.
144 procedure Initialize_Lock
(Prio
: System
.Any_Priority
; L
: access Lock
);
145 procedure Initialize_Lock
(L
: access RTS_Lock
; Level
: Lock_Level
);
146 pragma Inline
(Initialize_Lock
);
147 -- Initialize a lock object.
149 -- For Lock, Prio is the ceiling priority associated with the lock.
150 -- For RTS_Lock, the ceiling is implicitly Priority'Last.
152 -- If the underlying system does not support priority ceiling
153 -- locking, the Prio parameter is ignored.
155 -- The effect of either initialize operation is undefined unless L
156 -- is a lock object that has not been initialized, or which has been
157 -- finalized since it was last initialized.
159 -- The effects of the other operations on lock objects
160 -- are undefined unless the lock object has been initialized
161 -- and has not since been finalized.
163 -- Initialization of the per-task lock is implicit in Create_Task.
165 -- These operations raise Storage_Error if a lack of storage is detected.
167 procedure Finalize_Lock
(L
: access Lock
);
168 procedure Finalize_Lock
(L
: access RTS_Lock
);
169 pragma Inline
(Finalize_Lock
);
170 -- Finalize a lock object, freeing any resources allocated by the
171 -- corresponding Initialize_Lock operation.
173 procedure Write_Lock
(L
: access Lock
; Ceiling_Violation
: out Boolean);
174 procedure Write_Lock
(L
: access RTS_Lock
; Global_Lock
: Boolean := False);
175 procedure Write_Lock
(T
: ST
.Task_Id
);
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.
199 procedure Read_Lock
(L
: access Lock
; Ceiling_Violation
: out Boolean);
200 pragma Inline
(Read_Lock
);
201 -- Lock a lock object for read access. After this operation returns,
202 -- the calling task has non-exclusive read permission for the logical
203 -- resources that are protected by the lock. No other Write_Lock operation
204 -- on the same object will return until this task and any other tasks with
205 -- read permission for this lock have executed Unlock operation(s) on the
206 -- lock object. A Read_Lock for a lock object may return immediately while
207 -- there are tasks holding read permission, provided there are no tasks
208 -- holding write permission for the object. The effect is undefined if
209 -- the calling task already holds read or write permission for L.
211 -- Alternatively: An implementation may treat Read_Lock identically to
212 -- Write_Lock. This simplifies the implementation, but reduces the level
213 -- of concurrency that can be achieved.
215 -- Note that Read_Lock is not defined for RT_Lock and ST.Task_Id.
216 -- That is because (1) so far Read_Lock has always been implemented
217 -- the same as Write_Lock, (2) most lock usage inside the RTS involves
218 -- potential write access, and (3) implementations of priority ceiling
219 -- locking that make a reader-writer distinction have higher overhead.
221 procedure Unlock
(L
: access Lock
);
222 procedure Unlock
(L
: access RTS_Lock
; Global_Lock
: Boolean := False);
223 procedure Unlock
(T
: ST
.Task_Id
);
224 pragma Inline
(Unlock
);
225 -- Unlock a locked lock object.
227 -- The effect is undefined unless the calling task holds read or write
228 -- permission for the lock L, and L is the lock object most recently
229 -- locked by the calling task for which the calling task still holds
230 -- read or write permission. (That is, matching pairs of Lock and Unlock
231 -- operations on each lock object must be properly nested.)
233 -- For the operation on RTS_Lock, Global_Lock should be set to True
234 -- if L is a global lock (Single_RTS_Lock, Global_Task_Lock).
236 -- Note that Write_Lock for RTS_Lock does not have an out-parameter.
237 -- RTS_Locks are used in situations where we have not made provision
238 -- for recovery from ceiling violations. We do not expect them to
239 -- occur inside the runtime system, because all RTS locks have ceiling
242 -- There is one way there can be a ceiling violation.
243 -- That is if the runtime system is called from a task that is
244 -- executing in the Interrupt_Priority range.
246 -- It is not clear what to do about ceiling violations due
247 -- to RTS calls done at interrupt priority. In general, it
248 -- is not acceptable to give all RTS locks interrupt priority,
249 -- since that whould give terrible performance on systems where
250 -- this has the effect of masking hardware interrupts, though we
251 -- could get away with allowing Interrupt_Priority'last where we
252 -- are layered on an OS that does not allow us to mask interrupts.
253 -- Ideally, we would like to raise Program_Error back at the
254 -- original point of the RTS call, but this would require a lot of
255 -- detailed analysis and recoding, with almost certain performance
258 -- For POSIX systems, we considered just skipping setting a
259 -- priority ceiling on RTS locks. This would mean there is no
260 -- ceiling violation, but we would end up with priority inversions
261 -- inside the runtime system, resulting in failure to satisfy the
262 -- Ada priority rules, and possible missed validation tests.
263 -- This could be compensated-for by explicit priority-change calls
264 -- to raise the caller to Priority'Last whenever it first enters
265 -- the runtime system, but the expected overhead seems high, though
266 -- it might be lower than using locks with ceilings if the underlying
267 -- implementation of ceiling locks is an inefficient one.
269 -- This issue should be reconsidered whenever we get around to
270 -- checking for calls to potentially blocking operations from
271 -- within protected operations. If we check for such calls and
272 -- catch them on entry to the OS, it may be that we can eliminate
273 -- the possibility of ceiling violations inside the RTS. For this
274 -- to work, we would have to forbid explicitly setting the priority
275 -- of a task to anything in the Interrupt_Priority range, at least.
276 -- We would also have to check that there are no RTS-lock operations
277 -- done inside any operations that are not treated as potentially
280 -- The latter approach seems to be the best, i.e. to check on entry
281 -- to RTS calls that may need to use locks that the priority is not
282 -- in the interrupt range. If there are RTS operations that NEED to
283 -- be called from interrupt handlers, those few RTS locks should then
284 -- be converted to PO-type locks, with ceiling Interrupt_Priority'Last.
286 -- For now, we will just shut down the system if there is a
287 -- ceiling violation.
289 procedure Yield
(Do_Yield
: Boolean := True);
290 pragma Inline
(Yield
);
291 -- Yield the processor. Add the calling task to the tail of the
292 -- ready queue for its active_priority.
293 -- The Do_Yield argument is only used in some very rare cases very
294 -- a yield should have an effect on a specific target and not on regular
297 procedure Set_Priority
299 Prio
: System
.Any_Priority
;
300 Loss_Of_Inheritance
: Boolean := False);
301 pragma Inline
(Set_Priority
);
302 -- Set the priority of the task specified by T to T.Current_Priority.
303 -- The priority set is what would correspond to the Ada concept of
304 -- "base priority" in the terms of the lower layer system, but
305 -- the operation may be used by the upper layer to implement
306 -- changes in "active priority" that are not due to lock effects.
307 -- The effect should be consistent with the Ada Reference Manual.
308 -- In particular, when a task lowers its priority due to the loss of
309 -- inherited priority, it goes at the head of the queue for its new
310 -- priority (RM D.2.2 par 9). Loss_Of_Inheritance helps the underlying
311 -- implementation to do it 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 relative to "the
320 -- Epoch", which is Jan 1, 1970. This clock implementation is immune to
321 -- the system's clock changes.
323 function RT_Resolution
return Duration;
324 pragma Inline
(RT_Resolution
);
325 -- Returns resolution of the underlying clock used to implement RT_Clock
331 -- Whoever calls either of the Sleep routines is responsible
332 -- for checking for pending aborts before the call.
333 -- Pending priority changes are handled internally.
336 (Self_ID
: ST
.Task_Id
;
337 Reason
: System
.Tasking
.Task_States
);
338 pragma Inline
(Sleep
);
339 -- Wait until the current task, T, is signaled to wake up.
342 -- The calling task is holding its own ATCB lock
343 -- and has abort deferred
346 -- The calling task is holding its own ATCB lock
347 -- and has abort deferred.
349 -- The effect is to atomically unlock T's lock and wait, so that another
350 -- task that is able to lock T's lock can be assured that the wait has
351 -- actually commenced, and that a Wakeup operation will cause the waiting
352 -- task to become ready for execution once again. When Sleep returns,
353 -- the waiting task will again hold its own ATCB lock. The waiting task
354 -- may become ready for execution at any time (that is, spurious wakeups
355 -- are permitted), but it will definitely become ready for execution when
356 -- a Wakeup operation is performed for the same task.
358 procedure Timed_Sleep
359 (Self_ID
: ST
.Task_Id
;
361 Mode
: ST
.Delay_Modes
;
362 Reason
: System
.Tasking
.Task_States
;
363 Timedout
: out Boolean;
364 Yielded
: out Boolean);
365 -- Combination of Sleep (above) and Timed_Delay
367 procedure Timed_Delay
368 (Self_ID
: ST
.Task_Id
;
370 Mode
: ST
.Delay_Modes
);
371 -- Implement the semantics of the delay statement. It is assumed that
372 -- the caller is not abort-deferred and does not hold any locks.
376 Reason
: System
.Tasking
.Task_States
);
377 pragma Inline
(Wakeup
);
378 -- Wake up task T if it is waiting on a Sleep call (of ordinary
379 -- or timed variety), making it ready for execution once again.
380 -- If the task T is not waiting on a Sleep, the operation has no effect.
382 function Environment_Task
return ST
.Task_Id
;
383 pragma Inline
(Environment_Task
);
384 -- Return the task ID of the environment task
385 -- Consider putting this into a variable visible directly
386 -- by the rest of the runtime system. ???
388 function Get_Thread_Id
(T
: ST
.Task_Id
) return OSI
.Thread_Id
;
389 -- Return the thread id of the specified task
391 function Is_Valid_Task
return Boolean;
392 pragma Inline
(Is_Valid_Task
);
393 -- Does the calling thread have an ATCB?
395 function Register_Foreign_Thread
return ST
.Task_Id
;
396 -- Allocate and initialize a new ATCB for the current thread
398 -----------------------
399 -- RTS Entrance/Exit --
400 -----------------------
402 -- Following two routines are used for possible operations needed
403 -- to be setup/cleared upon entrance/exit of RTS while maintaining
404 -- a single thread of control in the RTS. Since we intend these
405 -- routines to be used for implementing the Single_Lock RTS,
406 -- Lock_RTS should follow the first Defer_Abortion operation
407 -- entering RTS. In the same fashion Unlock_RTS should preceed
408 -- the last Undefer_Abortion exiting RTS.
410 -- These routines also replace the functions Lock/Unlock_All_Tasks_List
413 -- Take the global RTS lock.
415 procedure Unlock_RTS
;
416 -- Release the global RTS lock.
422 -- Stack checking in GNAT is done using the concept of stack probes. A
423 -- stack probe is an operation that will generate a storage error if
424 -- an insufficient amount of stack space remains in the current task.
426 -- The exact mechanism for a stack probe is target dependent. Typical
427 -- possibilities are to use a load from a non-existent page, a store
428 -- to a read-only page, or a comparison with some stack limit constant.
429 -- Where possible we prefer to use a trap on a bad page access, since
430 -- this has less overhead. The generation of stack probes is either
431 -- automatic if the ABI requires it (as on for example DEC Unix), or
432 -- is controlled by the gcc parameter -fstack-check.
434 -- When we are using bad-page accesses, we need a bad page, called a
435 -- guard page, at the end of each task stack. On some systems, this
436 -- is provided automatically, but on other systems, we need to create
437 -- the guard page ourselves, and the procedure Stack_Guard is provided
440 procedure Stack_Guard
(T
: ST
.Task_Id
; On
: Boolean);
441 -- Ensure guard page is set if one is needed and the underlying thread
442 -- system does not provide it. The procedure is as follows:
444 -- 1. When we create a task adjust its size so a guard page can
445 -- safely be set at the bottom of the stack
447 -- 2. When the thread is created (and its stack allocated by the
448 -- underlying thread system), get the stack base (and size, depending
449 -- how the stack is growing), and create the guard page taking care of
450 -- page boundaries issues.
452 -- 3. When the task is destroyed, remove the guard page.
454 -- If On is true then protect the stack bottom (i.e make it read only)
455 -- else unprotect it (i.e. On is True for the call when creating a task,
456 -- and False when a task is destroyed).
458 -- The call to Stack_Guard has no effect if guard pages are not used on
459 -- the target, or if guard pages are automatically provided by the system.
461 -----------------------------------------
462 -- Runtime System Debugging Interfaces --
463 -----------------------------------------
465 -- These interfaces have been added to assist in debugging the
466 -- tasking runtime system.
468 function Check_Exit
(Self_ID
: ST
.Task_Id
) return Boolean;
469 pragma Inline
(Check_Exit
);
470 -- Check that the current task is holding only Global_Task_Lock.
472 function Check_No_Locks
(Self_ID
: ST
.Task_Id
) return Boolean;
473 pragma Inline
(Check_No_Locks
);
474 -- Check that current task is holding no locks.
476 function Suspend_Task
478 Thread_Self
: OSI
.Thread_Id
) return Boolean;
479 -- Suspend a specific task when the underlying thread library provides
480 -- such functionality, unless the thread associated with T is Thread_Self.
481 -- Such functionality is needed by gdb on some targets (e.g VxWorks)
482 -- Return True is the operation is successful
486 Thread_Self
: OSI
.Thread_Id
) return Boolean;
487 -- Resume a specific task when the underlying thread library provides
488 -- such functionality, unless the thread associated with T is Thread_Self.
489 -- Such functionality is needed by gdb on some targets (e.g VxWorks)
490 -- Return True is the operation is successful
492 end System
.Task_Primitives
.Operations
;