OSDN Git Service

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