|
111
|
1 ------------------------------------------------------------------------------
|
|
|
2 -- --
|
|
|
3 -- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS --
|
|
|
4 -- --
|
|
|
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 --
|
|
|
6 -- --
|
|
|
7 -- S p e c --
|
|
|
8 -- --
|
|
131
|
9 -- Copyright (C) 1992-2018, Free Software Foundation, Inc. --
|
|
111
|
10 -- --
|
|
|
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 3, or (at your option) any later ver- --
|
|
|
14 -- sion. GNAT 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. --
|
|
|
17 -- --
|
|
|
18 -- As a special exception under Section 7 of GPL version 3, you are granted --
|
|
|
19 -- additional permissions described in the GCC Runtime Library Exception, --
|
|
|
20 -- version 3.1, as published by the Free Software Foundation. --
|
|
|
21 -- --
|
|
|
22 -- You should have received a copy of the GNU General Public License and --
|
|
|
23 -- a copy of the GCC Runtime Library Exception along with this program; --
|
|
|
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
|
|
|
25 -- <http://www.gnu.org/licenses/>. --
|
|
|
26 -- --
|
|
|
27 -- GNARL was developed by the GNARL team at Florida State University. --
|
|
|
28 -- Extensive contributions were provided by Ada Core Technologies, Inc. --
|
|
|
29 -- --
|
|
|
30 ------------------------------------------------------------------------------
|
|
|
31
|
|
|
32 -- This package contains all the GNULL primitives that interface directly with
|
|
|
33 -- the underlying OS.
|
|
|
34
|
|
|
35 with System.Parameters;
|
|
|
36 with System.Tasking;
|
|
|
37 with System.OS_Interface;
|
|
|
38
|
|
|
39 package System.Task_Primitives.Operations is
|
|
|
40 pragma Preelaborate;
|
|
|
41
|
|
|
42 package ST renames System.Tasking;
|
|
|
43 package OSI renames System.OS_Interface;
|
|
|
44
|
|
|
45 procedure Initialize (Environment_Task : ST.Task_Id);
|
|
|
46 -- Perform initialization and set up of the environment task for proper
|
|
|
47 -- operation of the tasking run-time. This must be called once, before any
|
|
|
48 -- other subprograms of this package are called.
|
|
|
49
|
|
|
50 procedure Create_Task
|
|
|
51 (T : ST.Task_Id;
|
|
|
52 Wrapper : System.Address;
|
|
|
53 Stack_Size : System.Parameters.Size_Type;
|
|
|
54 Priority : System.Any_Priority;
|
|
|
55 Succeeded : out Boolean);
|
|
|
56 pragma Inline (Create_Task);
|
|
|
57 -- Create a new low-level task with ST.Task_Id T and place other needed
|
|
|
58 -- information in the ATCB.
|
|
|
59 --
|
|
|
60 -- A new thread of control is created, with a stack of at least Stack_Size
|
|
|
61 -- storage units, and the procedure Wrapper is called by this new thread
|
|
|
62 -- of control. If Stack_Size = Unspecified_Storage_Size, choose a default
|
|
|
63 -- stack size; this may be effectively "unbounded" on some systems.
|
|
|
64 --
|
|
|
65 -- The newly created low-level task is associated with the ST.Task_Id T
|
|
|
66 -- such that any subsequent call to Self from within the context of the
|
|
|
67 -- low-level task returns T.
|
|
|
68 --
|
|
|
69 -- The caller is responsible for ensuring that the storage of the Ada
|
|
|
70 -- task control block object pointed to by T persists for the lifetime
|
|
|
71 -- of the new task.
|
|
|
72 --
|
|
|
73 -- Succeeded is set to true unless creation of the task failed,
|
|
|
74 -- as it may if there are insufficient resources to create another task.
|
|
|
75
|
|
|
76 procedure Enter_Task (Self_ID : ST.Task_Id);
|
|
|
77 pragma Inline (Enter_Task);
|
|
|
78 -- Initialize data structures specific to the calling task. Self must be
|
|
|
79 -- the ID of the calling task. It must be called (once) by the task
|
|
|
80 -- immediately after creation, while abort is still deferred. The effects
|
|
|
81 -- of other operations defined below are not defined unless the caller has
|
|
|
82 -- previously called Initialize_Task.
|
|
|
83
|
|
|
84 procedure Exit_Task;
|
|
|
85 pragma Inline (Exit_Task);
|
|
|
86 -- Destroy the thread of control. Self must be the ID of the calling task.
|
|
|
87 -- The effects of further calls to operations defined below on the task
|
|
|
88 -- are undefined thereafter.
|
|
|
89
|
|
|
90 ----------------------------------
|
|
|
91 -- ATCB allocation/deallocation --
|
|
|
92 ----------------------------------
|
|
|
93
|
|
|
94 package ATCB_Allocation is
|
|
|
95
|
|
|
96 function New_ATCB (Entry_Num : ST.Task_Entry_Index) return ST.Task_Id;
|
|
|
97 pragma Inline (New_ATCB);
|
|
|
98 -- Allocate a new ATCB with the specified number of entries
|
|
|
99
|
|
|
100 procedure Free_ATCB (T : ST.Task_Id);
|
|
|
101 pragma Inline (Free_ATCB);
|
|
|
102 -- Deallocate an ATCB previously allocated by New_ATCB
|
|
|
103
|
|
|
104 end ATCB_Allocation;
|
|
|
105
|
|
|
106 function New_ATCB (Entry_Num : ST.Task_Entry_Index) return ST.Task_Id
|
|
|
107 renames ATCB_Allocation.New_ATCB;
|
|
|
108
|
|
|
109 procedure Initialize_TCB (Self_ID : ST.Task_Id; Succeeded : out Boolean);
|
|
|
110 pragma Inline (Initialize_TCB);
|
|
|
111 -- Initialize all fields of the TCB
|
|
|
112
|
|
|
113 procedure Finalize_TCB (T : ST.Task_Id);
|
|
|
114 pragma Inline (Finalize_TCB);
|
|
|
115 -- Finalizes Private_Data of ATCB, and then deallocates it. This is also
|
|
|
116 -- responsible for recovering any storage or other resources that were
|
|
|
117 -- allocated by Create_Task (the one in this package). This should only be
|
|
|
118 -- called from Free_Task. After it is called there should be no further
|
|
|
119 -- reference to the ATCB that corresponds to T.
|
|
|
120
|
|
|
121 procedure Abort_Task (T : ST.Task_Id);
|
|
|
122 pragma Inline (Abort_Task);
|
|
|
123 -- Abort the task specified by T (the target task). This causes the target
|
|
|
124 -- task to asynchronously raise Abort_Signal if abort is not deferred, or
|
|
|
125 -- if it is blocked on an interruptible system call.
|
|
|
126 --
|
|
|
127 -- precondition:
|
|
|
128 -- the calling task is holding T's lock and has abort deferred
|
|
|
129 --
|
|
|
130 -- postcondition:
|
|
|
131 -- the calling task is holding T's lock and has abort deferred.
|
|
|
132
|
|
|
133 -- ??? modify GNARL to skip wakeup and always call Abort_Task
|
|
|
134
|
|
|
135 function Self return ST.Task_Id;
|
|
|
136 pragma Inline (Self);
|
|
|
137 -- Return a pointer to the Ada Task Control Block of the calling task
|
|
|
138
|
|
|
139 type Lock_Level is
|
|
|
140 (PO_Level,
|
|
|
141 Global_Task_Level,
|
|
|
142 RTS_Lock_Level,
|
|
|
143 ATCB_Level);
|
|
|
144 -- Type used to describe kind of lock for second form of Initialize_Lock
|
|
|
145 -- call specified below. See locking rules in System.Tasking (spec) for
|
|
|
146 -- more details.
|
|
|
147
|
|
|
148 procedure Initialize_Lock
|
|
|
149 (Prio : System.Any_Priority;
|
|
|
150 L : not null access Lock);
|
|
|
151 procedure Initialize_Lock
|
|
|
152 (L : not null access RTS_Lock;
|
|
|
153 Level : Lock_Level);
|
|
|
154 pragma Inline (Initialize_Lock);
|
|
|
155 -- Initialize a lock object
|
|
|
156 --
|
|
|
157 -- For Lock, Prio is the ceiling priority associated with the lock. For
|
|
|
158 -- RTS_Lock, the ceiling is implicitly Priority'Last.
|
|
|
159 --
|
|
|
160 -- If the underlying system does not support priority ceiling
|
|
|
161 -- locking, the Prio parameter is ignored.
|
|
|
162 --
|
|
|
163 -- The effect of either initialize operation is undefined unless is a lock
|
|
|
164 -- object that has not been initialized, or which has been finalized since
|
|
|
165 -- it was last initialized.
|
|
|
166 --
|
|
|
167 -- The effects of the other operations on lock objects are undefined
|
|
|
168 -- unless the lock object has been initialized and has not since been
|
|
|
169 -- finalized.
|
|
|
170 --
|
|
|
171 -- Initialization of the per-task lock is implicit in Create_Task
|
|
|
172 --
|
|
|
173 -- These operations raise Storage_Error if a lack of storage is detected
|
|
|
174
|
|
|
175 procedure Finalize_Lock (L : not null access Lock);
|
|
|
176 procedure Finalize_Lock (L : not null access RTS_Lock);
|
|
|
177 pragma Inline (Finalize_Lock);
|
|
|
178 -- Finalize a lock object, freeing any resources allocated by the
|
|
|
179 -- corresponding Initialize_Lock operation.
|
|
|
180
|
|
|
181 procedure Write_Lock
|
|
|
182 (L : not null access Lock;
|
|
|
183 Ceiling_Violation : out Boolean);
|
|
|
184 procedure Write_Lock
|
|
|
185 (L : not null access RTS_Lock;
|
|
|
186 Global_Lock : Boolean := False);
|
|
|
187 procedure Write_Lock
|
|
|
188 (T : ST.Task_Id);
|
|
|
189 pragma Inline (Write_Lock);
|
|
|
190 -- Lock a lock object for write access. After this operation returns,
|
|
|
191 -- the calling task holds write permission for the lock object. No other
|
|
|
192 -- Write_Lock or Read_Lock operation on the same lock object will return
|
|
|
193 -- until this task executes an Unlock operation on the same object. The
|
|
|
194 -- effect is undefined if the calling task already holds read or write
|
|
|
195 -- permission for the lock object L.
|
|
|
196 --
|
|
|
197 -- For the operation on Lock, Ceiling_Violation is set to true iff the
|
|
|
198 -- operation failed, which will happen if there is a priority ceiling
|
|
|
199 -- violation.
|
|
|
200 --
|
|
|
201 -- For the operation on RTS_Lock, Global_Lock should be set to True
|
|
|
202 -- if L is a global lock (Single_RTS_Lock, Global_Task_Lock).
|
|
|
203 --
|
|
|
204 -- For the operation on ST.Task_Id, the lock is the special lock object
|
|
|
205 -- associated with that task's ATCB. This lock has effective ceiling
|
|
|
206 -- priority high enough that it is safe to call by a task with any
|
|
|
207 -- priority in the range System.Priority. It is implicitly initialized
|
|
|
208 -- by task creation. The effect is undefined if the calling task already
|
|
|
209 -- holds T's lock, or has interrupt-level priority. Finalization of the
|
|
|
210 -- per-task lock is implicit in Exit_Task.
|
|
|
211
|
|
|
212 procedure Read_Lock
|
|
|
213 (L : not null access Lock;
|
|
|
214 Ceiling_Violation : out Boolean);
|
|
|
215 pragma Inline (Read_Lock);
|
|
|
216 -- Lock a lock object for read access. After this operation returns,
|
|
|
217 -- the calling task has non-exclusive read permission for the logical
|
|
|
218 -- resources that are protected by the lock. No other Write_Lock operation
|
|
|
219 -- on the same object will return until this task and any other tasks with
|
|
|
220 -- read permission for this lock have executed Unlock operation(s) on the
|
|
|
221 -- lock object. A Read_Lock for a lock object may return immediately while
|
|
|
222 -- there are tasks holding read permission, provided there are no tasks
|
|
|
223 -- holding write permission for the object. The effect is undefined if
|
|
|
224 -- the calling task already holds read or write permission for L.
|
|
|
225 --
|
|
|
226 -- Alternatively: An implementation may treat Read_Lock identically to
|
|
|
227 -- Write_Lock. This simplifies the implementation, but reduces the level
|
|
|
228 -- of concurrency that can be achieved.
|
|
|
229 --
|
|
|
230 -- Note that Read_Lock is not defined for RT_Lock and ST.Task_Id.
|
|
|
231 -- That is because (1) so far Read_Lock has always been implemented
|
|
|
232 -- the same as Write_Lock, (2) most lock usage inside the RTS involves
|
|
|
233 -- potential write access, and (3) implementations of priority ceiling
|
|
|
234 -- locking that make a reader-writer distinction have higher overhead.
|
|
|
235
|
|
|
236 procedure Unlock
|
|
|
237 (L : not null access Lock);
|
|
|
238 procedure Unlock
|
|
|
239 (L : not null access RTS_Lock;
|
|
|
240 Global_Lock : Boolean := False);
|
|
|
241 procedure Unlock
|
|
|
242 (T : ST.Task_Id);
|
|
|
243 pragma Inline (Unlock);
|
|
|
244 -- Unlock a locked lock object
|
|
|
245 --
|
|
|
246 -- The effect is undefined unless the calling task holds read or write
|
|
|
247 -- permission for the lock L, and L is the lock object most recently
|
|
|
248 -- locked by the calling task for which the calling task still holds
|
|
|
249 -- read or write permission. (That is, matching pairs of Lock and Unlock
|
|
|
250 -- operations on each lock object must be properly nested.)
|
|
|
251
|
|
|
252 -- For the operation on RTS_Lock, Global_Lock should be set to True if L
|
|
|
253 -- is a global lock (Single_RTS_Lock, Global_Task_Lock).
|
|
|
254 --
|
|
|
255 -- Note that Write_Lock for RTS_Lock does not have an out-parameter.
|
|
|
256 -- RTS_Locks are used in situations where we have not made provision for
|
|
|
257 -- recovery from ceiling violations. We do not expect them to occur inside
|
|
|
258 -- the runtime system, because all RTS locks have ceiling Priority'Last.
|
|
|
259
|
|
|
260 -- There is one way there can be a ceiling violation. That is if the
|
|
|
261 -- runtime system is called from a task that is executing in the
|
|
|
262 -- Interrupt_Priority range.
|
|
|
263
|
|
|
264 -- It is not clear what to do about ceiling violations due to RTS calls
|
|
|
265 -- done at interrupt priority. In general, it is not acceptable to give
|
|
|
266 -- all RTS locks interrupt priority, since that would give terrible
|
|
|
267 -- performance on systems where this has the effect of masking hardware
|
|
|
268 -- interrupts, though we could get away allowing Interrupt_Priority'last
|
|
|
269 -- where we are layered on an OS that does not allow us to mask interrupts.
|
|
|
270 -- Ideally, we would like to raise Program_Error back at the original point
|
|
|
271 -- of the RTS call, but this would require a lot of detailed analysis and
|
|
|
272 -- recoding, with almost certain performance penalties.
|
|
|
273
|
|
|
274 -- For POSIX systems, we considered just skipping setting priority ceiling
|
|
|
275 -- on RTS locks. This would mean there is no ceiling violation, but we
|
|
|
276 -- would end up with priority inversions inside the runtime system,
|
|
|
277 -- resulting in failure to satisfy the Ada priority rules, and possible
|
|
|
278 -- missed validation tests. This could be compensated-for by explicit
|
|
|
279 -- priority-change calls to raise the caller to Priority'Last whenever it
|
|
|
280 -- first enters the runtime system, but the expected overhead seems high,
|
|
|
281 -- though it might be lower than using locks with ceilings if the
|
|
|
282 -- underlying implementation of ceiling locks is an inefficient one.
|
|
|
283
|
|
|
284 -- This issue should be reconsidered whenever we get around to checking
|
|
|
285 -- for calls to potentially blocking operations from within protected
|
|
|
286 -- operations. If we check for such calls and catch them on entry to the
|
|
|
287 -- OS, it may be that we can eliminate the possibility of ceiling
|
|
|
288 -- violations inside the RTS. For this to work, we would have to forbid
|
|
|
289 -- explicitly setting the priority of a task to anything in the
|
|
|
290 -- Interrupt_Priority range, at least. We would also have to check that
|
|
|
291 -- there are no RTS-lock operations done inside any operations that are
|
|
|
292 -- not treated as potentially blocking.
|
|
|
293
|
|
|
294 -- The latter approach seems to be the best, i.e. to check on entry to RTS
|
|
|
295 -- calls that may need to use locks that the priority is not in the
|
|
|
296 -- interrupt range. If there are RTS operations that NEED to be called
|
|
|
297 -- from interrupt handlers, those few RTS locks should then be converted
|
|
|
298 -- to PO-type locks, with ceiling Interrupt_Priority'Last.
|
|
|
299
|
|
|
300 -- For now, we will just shut down the system if there is ceiling violation
|
|
|
301
|
|
|
302 procedure Set_Ceiling
|
|
|
303 (L : not null access Lock;
|
|
|
304 Prio : System.Any_Priority);
|
|
|
305 pragma Inline (Set_Ceiling);
|
|
|
306 -- Change the ceiling priority associated to the lock
|
|
|
307 --
|
|
|
308 -- The effect is undefined unless the calling task holds read or write
|
|
|
309 -- permission for the lock L, and L is the lock object most recently
|
|
|
310 -- locked by the calling task for which the calling task still holds
|
|
|
311 -- read or write permission. (That is, matching pairs of Lock and Unlock
|
|
|
312 -- operations on each lock object must be properly nested.)
|
|
|
313
|
|
|
314 procedure Yield (Do_Yield : Boolean := True);
|
|
|
315 pragma Inline (Yield);
|
|
|
316 -- Yield the processor. Add the calling task to the tail of the ready queue
|
|
|
317 -- for its active_priority. On most platforms, Yield is a no-op if Do_Yield
|
|
|
318 -- is False. But on some platforms (notably VxWorks), Do_Yield is ignored.
|
|
|
319 -- This is only used in some very rare cases where a Yield should have an
|
|
|
320 -- effect on a specific target and not on regular ones.
|
|
|
321
|
|
|
322 procedure Set_Priority
|
|
|
323 (T : ST.Task_Id;
|
|
|
324 Prio : System.Any_Priority;
|
|
|
325 Loss_Of_Inheritance : Boolean := False);
|
|
|
326 pragma Inline (Set_Priority);
|
|
|
327 -- Set the priority of the task specified by T to Prio. The priority set
|
|
|
328 -- is what would correspond to the Ada concept of "base priority" in the
|
|
|
329 -- terms of the lower layer system, but the operation may be used by the
|
|
|
330 -- upper layer to implement changes in "active priority" that are not due
|
|
|
331 -- to lock effects. The effect should be consistent with the Ada Reference
|
|
|
332 -- Manual. In particular, when a task lowers its priority due to the loss
|
|
|
333 -- of inherited priority, it goes at the head of the queue for its new
|
|
|
334 -- priority (RM D.2.2 par 9). Loss_Of_Inheritance helps the underlying
|
|
|
335 -- implementation to do it right when the OS doesn't.
|
|
|
336
|
|
|
337 function Get_Priority (T : ST.Task_Id) return System.Any_Priority;
|
|
|
338 pragma Inline (Get_Priority);
|
|
|
339 -- Returns the priority last set by Set_Priority for this task
|
|
|
340
|
|
|
341 function Monotonic_Clock return Duration;
|
|
|
342 pragma Inline (Monotonic_Clock);
|
|
131
|
343 -- Returns "absolute" time, represented as an offset relative to an
|
|
|
344 -- unspecified Epoch. This clock implementation is immune to the
|
|
|
345 -- system's clock changes.
|
|
111
|
346
|
|
|
347 function RT_Resolution return Duration;
|
|
|
348 pragma Inline (RT_Resolution);
|
|
|
349 -- Returns resolution of the underlying clock used to implement RT_Clock
|
|
|
350
|
|
|
351 ----------------
|
|
|
352 -- Extensions --
|
|
|
353 ----------------
|
|
|
354
|
|
|
355 -- Whoever calls either of the Sleep routines is responsible for checking
|
|
|
356 -- for pending aborts before the call. Pending priority changes are handled
|
|
|
357 -- internally.
|
|
|
358
|
|
|
359 procedure Sleep
|
|
|
360 (Self_ID : ST.Task_Id;
|
|
|
361 Reason : System.Tasking.Task_States);
|
|
|
362 pragma Inline (Sleep);
|
|
|
363 -- Wait until the current task, T, is signaled to wake up
|
|
|
364 --
|
|
|
365 -- precondition:
|
|
|
366 -- The calling task is holding its own ATCB lock
|
|
|
367 -- and has abort deferred
|
|
|
368 --
|
|
|
369 -- postcondition:
|
|
|
370 -- The calling task is holding its own ATCB lock and has abort deferred.
|
|
|
371
|
|
|
372 -- The effect is to atomically unlock T's lock and wait, so that another
|
|
|
373 -- task that is able to lock T's lock can be assured that the wait has
|
|
|
374 -- actually commenced, and that a Wakeup operation will cause the waiting
|
|
|
375 -- task to become ready for execution once again. When Sleep returns, the
|
|
|
376 -- waiting task will again hold its own ATCB lock. The waiting task may
|
|
|
377 -- become ready for execution at any time (that is, spurious wakeups are
|
|
|
378 -- permitted), but it will definitely become ready for execution when a
|
|
|
379 -- Wakeup operation is performed for the same task.
|
|
|
380
|
|
|
381 procedure Timed_Sleep
|
|
|
382 (Self_ID : ST.Task_Id;
|
|
|
383 Time : Duration;
|
|
|
384 Mode : ST.Delay_Modes;
|
|
|
385 Reason : System.Tasking.Task_States;
|
|
|
386 Timedout : out Boolean;
|
|
|
387 Yielded : out Boolean);
|
|
|
388 -- Combination of Sleep (above) and Timed_Delay
|
|
|
389
|
|
|
390 procedure Timed_Delay
|
|
|
391 (Self_ID : ST.Task_Id;
|
|
|
392 Time : Duration;
|
|
|
393 Mode : ST.Delay_Modes);
|
|
|
394 -- Implement the semantics of the delay statement.
|
|
|
395 -- The caller should be abort-deferred and should not hold any locks.
|
|
|
396
|
|
|
397 procedure Wakeup
|
|
|
398 (T : ST.Task_Id;
|
|
|
399 Reason : System.Tasking.Task_States);
|
|
|
400 pragma Inline (Wakeup);
|
|
|
401 -- Wake up task T if it is waiting on a Sleep call (of ordinary
|
|
|
402 -- or timed variety), making it ready for execution once again.
|
|
|
403 -- If the task T is not waiting on a Sleep, the operation has no effect.
|
|
|
404
|
|
|
405 function Environment_Task return ST.Task_Id;
|
|
|
406 pragma Inline (Environment_Task);
|
|
|
407 -- Return the task ID of the environment task
|
|
|
408 -- Consider putting this into a variable visible directly
|
|
|
409 -- by the rest of the runtime system. ???
|
|
|
410
|
|
|
411 function Get_Thread_Id (T : ST.Task_Id) return OSI.Thread_Id;
|
|
|
412 -- Return the thread id of the specified task
|
|
|
413
|
|
|
414 function Is_Valid_Task return Boolean;
|
|
|
415 pragma Inline (Is_Valid_Task);
|
|
|
416 -- Does the calling thread have an ATCB?
|
|
|
417
|
|
|
418 function Register_Foreign_Thread return ST.Task_Id;
|
|
|
419 -- Allocate and initialize a new ATCB for the current thread
|
|
|
420
|
|
|
421 -----------------------
|
|
|
422 -- RTS Entrance/Exit --
|
|
|
423 -----------------------
|
|
|
424
|
|
|
425 -- Following two routines are used for possible operations needed to be
|
|
|
426 -- setup/cleared upon entrance/exit of RTS while maintaining a single
|
|
|
427 -- thread of control in the RTS. Since we intend these routines to be used
|
|
|
428 -- for implementing the Single_Lock RTS, Lock_RTS should follow the first
|
|
|
429 -- Defer_Abort operation entering RTS. In the same fashion Unlock_RTS
|
|
|
430 -- should precede the last Undefer_Abort exiting RTS.
|
|
|
431 --
|
|
|
432 -- These routines also replace the functions Lock/Unlock_All_Tasks_List
|
|
|
433
|
|
|
434 procedure Lock_RTS;
|
|
|
435 -- Take the global RTS lock
|
|
|
436
|
|
|
437 procedure Unlock_RTS;
|
|
|
438 -- Release the global RTS lock
|
|
|
439
|
|
|
440 --------------------
|
|
|
441 -- Stack Checking --
|
|
|
442 --------------------
|
|
|
443
|
|
|
444 -- Stack checking in GNAT is done using the concept of stack probes. A
|
|
|
445 -- stack probe is an operation that will generate a storage error if
|
|
|
446 -- an insufficient amount of stack space remains in the current task.
|
|
|
447
|
|
|
448 -- The exact mechanism for a stack probe is target dependent. Typical
|
|
|
449 -- possibilities are to use a load from a non-existent page, a store to a
|
|
|
450 -- read-only page, or a comparison with some stack limit constant. Where
|
|
|
451 -- possible we prefer to use a trap on a bad page access, since this has
|
|
|
452 -- less overhead. The generation of stack probes is either automatic if
|
|
|
453 -- the ABI requires it (as on for example DEC Unix), or is controlled by
|
|
|
454 -- the gcc parameter -fstack-check.
|
|
|
455
|
|
|
456 -- When we are using bad-page accesses, we need a bad page, called guard
|
|
|
457 -- page, at the end of each task stack. On some systems, this is provided
|
|
|
458 -- automatically, but on other systems, we need to create the guard page
|
|
|
459 -- ourselves, and the procedure Stack_Guard is provided for this purpose.
|
|
|
460
|
|
|
461 procedure Stack_Guard (T : ST.Task_Id; On : Boolean);
|
|
|
462 -- Ensure guard page is set if one is needed and the underlying thread
|
|
|
463 -- system does not provide it. The procedure is as follows:
|
|
|
464 --
|
|
|
465 -- 1. When we create a task adjust its size so a guard page can
|
|
|
466 -- safely be set at the bottom of the stack.
|
|
|
467 --
|
|
|
468 -- 2. When the thread is created (and its stack allocated by the
|
|
|
469 -- underlying thread system), get the stack base (and size, depending
|
|
|
470 -- how the stack is growing), and create the guard page taking care
|
|
|
471 -- of page boundaries issues.
|
|
|
472 --
|
|
|
473 -- 3. When the task is destroyed, remove the guard page.
|
|
|
474 --
|
|
|
475 -- If On is true then protect the stack bottom (i.e make it read only)
|
|
|
476 -- else unprotect it (i.e. On is True for the call when creating a task,
|
|
|
477 -- and False when a task is destroyed).
|
|
|
478 --
|
|
|
479 -- The call to Stack_Guard has no effect if guard pages are not used on
|
|
|
480 -- the target, or if guard pages are automatically provided by the system.
|
|
|
481
|
|
|
482 ------------------------
|
|
|
483 -- Suspension objects --
|
|
|
484 ------------------------
|
|
|
485
|
|
|
486 -- These subprograms provide the functionality required for synchronizing
|
|
|
487 -- on a suspension object. Tasks can suspend execution and relinquish the
|
|
|
488 -- processors until the condition is signaled.
|
|
|
489
|
|
|
490 function Current_State (S : Suspension_Object) return Boolean;
|
|
|
491 -- Return the state of the suspension object
|
|
|
492
|
|
|
493 procedure Set_False (S : in out Suspension_Object);
|
|
|
494 -- Set the state of the suspension object to False
|
|
|
495
|
|
|
496 procedure Set_True (S : in out Suspension_Object);
|
|
|
497 -- Set the state of the suspension object to True. If a task were
|
|
|
498 -- suspended on the protected object then this task is released (and
|
|
|
499 -- the state of the suspension object remains set to False).
|
|
|
500
|
|
|
501 procedure Suspend_Until_True (S : in out Suspension_Object);
|
|
|
502 -- If the state of the suspension object is True then the calling task
|
|
|
503 -- continues its execution, and the state is set to False. If the state
|
|
|
504 -- of the object is False then the task is suspended on the suspension
|
|
|
505 -- object until a Set_True operation is executed. Program_Error is raised
|
|
|
506 -- if another task is already waiting on that suspension object.
|
|
|
507
|
|
|
508 procedure Initialize (S : in out Suspension_Object);
|
|
|
509 -- Initialize the suspension object
|
|
|
510
|
|
|
511 procedure Finalize (S : in out Suspension_Object);
|
|
|
512 -- Finalize the suspension object
|
|
|
513
|
|
|
514 -----------------------------------------
|
|
|
515 -- Runtime System Debugging Interfaces --
|
|
|
516 -----------------------------------------
|
|
|
517
|
|
|
518 -- These interfaces have been added to assist in debugging the
|
|
|
519 -- tasking runtime system.
|
|
|
520
|
|
|
521 function Check_Exit (Self_ID : ST.Task_Id) return Boolean;
|
|
|
522 pragma Inline (Check_Exit);
|
|
|
523 -- Check that the current task is holding only Global_Task_Lock
|
|
|
524
|
|
|
525 function Check_No_Locks (Self_ID : ST.Task_Id) return Boolean;
|
|
|
526 pragma Inline (Check_No_Locks);
|
|
|
527 -- Check that current task is holding no locks
|
|
|
528
|
|
|
529 function Suspend_Task
|
|
|
530 (T : ST.Task_Id;
|
|
|
531 Thread_Self : OSI.Thread_Id) return Boolean;
|
|
|
532 -- Suspend a specific task when the underlying thread library provides this
|
|
|
533 -- functionality, unless the thread associated with T is Thread_Self. Such
|
|
|
534 -- functionality is needed by gdb on some targets (e.g VxWorks) Return True
|
|
|
535 -- is the operation is successful. On targets where this operation is not
|
|
|
536 -- available, a dummy body is present which always returns False.
|
|
|
537
|
|
|
538 function Resume_Task
|
|
|
539 (T : ST.Task_Id;
|
|
|
540 Thread_Self : OSI.Thread_Id) return Boolean;
|
|
|
541 -- Resume a specific task when the underlying thread library provides
|
|
|
542 -- such functionality, unless the thread associated with T is Thread_Self.
|
|
|
543 -- Such functionality is needed by gdb on some targets (e.g VxWorks)
|
|
|
544 -- Return True is the operation is successful
|
|
|
545
|
|
|
546 procedure Stop_All_Tasks;
|
|
|
547 -- Stop all tasks when the underlying thread library provides such
|
|
|
548 -- functionality. Such functionality is needed by gdb on some targets (e.g
|
|
|
549 -- VxWorks) This function can be run from an interrupt handler. Return True
|
|
|
550 -- is the operation is successful
|
|
|
551
|
|
|
552 function Stop_Task (T : ST.Task_Id) return Boolean;
|
|
|
553 -- Stop a specific task when the underlying thread library provides
|
|
|
554 -- such functionality. Such functionality is needed by gdb on some targets
|
|
|
555 -- (e.g VxWorks). Return True is the operation is successful.
|
|
|
556
|
|
|
557 function Continue_Task (T : ST.Task_Id) return Boolean;
|
|
|
558 -- Continue a specific task when the underlying thread library provides
|
|
|
559 -- such functionality. Such functionality is needed by gdb on some targets
|
|
|
560 -- (e.g VxWorks) Return True is the operation is successful
|
|
|
561
|
|
|
562 -------------------
|
|
|
563 -- Task affinity --
|
|
|
564 -------------------
|
|
|
565
|
|
|
566 procedure Set_Task_Affinity (T : ST.Task_Id);
|
|
|
567 -- Enforce at the operating system level the task affinity defined in the
|
|
|
568 -- Ada Task Control Block. Has no effect if the underlying operating system
|
|
|
569 -- does not support this capability.
|
|
|
570
|
|
|
571 end System.Task_Primitives.Operations;
|
