code.delx.au - gnu-emacs/blob - test/etags/ada-src/2ataspri.ads

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                 GNU ADA RUNTIME 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               --
   6 --                                                                          --
   7 --                                  S p e c                                 --
   8 --                                                                          --
   9 --                             $Revision: 1.1 $                             --
  10 --                                                                          --
  11 --   Copyright (C) 1991,1992,1993,1994,1995,1996 Florida State University   --
  12 --                                                                          --
  13 -- GNARL is free software; you can  redistribute it  and/or modify it under --
  14 -- terms of the  GNU General Public License as published  by the Free Soft- --
  15 -- ware  Foundation;  either version 2,  or (at your option) any later ver- --
  16 -- sion. GNARL is distributed in the hope that it will be useful, but WITH- --
  17 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  18 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  19 -- for  more details.  You should have  received  a copy of the GNU General --
  20 -- Public License  distributed with GNARL; see file COPYING.  If not, write --
  21 -- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
  22 -- MA 02111-1307, USA.                                                      --
  23 --                                                                          --
  24 -- As a special exception,  if other files  instantiate  generics from this --
  25 -- unit, or you link  this unit with other files  to produce an executable, --
  26 -- this  unit  does not  by itself cause  the resulting  executable  to  be --
  27 -- covered  by the  GNU  General  Public  License.  This exception does not --
  28 -- however invalidate  any other reasons why  the executable file  might be --
  29 -- covered by the  GNU Public License.                                      --
  30 --                                                                          --
  31 -- GNARL was developed by the GNARL team at Florida State University. It is --
  32 -- now maintained by Ada Core Technologies Inc. in cooperation with Florida --
  33 -- State University (http://www.gnat.com).                                  --
  34 --                                                                          --
  35 ------------------------------------------------------------------------------
  36
  37 with Interfaces.C;
  38 --  Used for Size_t;
  39
  40 with Interfaces.C.Pthreads;
  41 --  Used for, size_t,
  42 --            pthread_mutex_t,
  43 --            pthread_cond_t,
  44 --            pthread_t
  45
  46 with Interfaces.C.POSIX_RTE;
  47 --  Used for, Signal,
  48 --            siginfo_ptr,
  49
  50 with System.Task_Clock;
  51 --  Used for, Stimespec
  52
  53 with Unchecked_Conversion;
  54
  55 pragma Elaborate_All (Interfaces.C.Pthreads);
  56
  57 with System.Task_Info;
  58 package System.Task_Primitives is
  59
  60    --  Low level Task size and state definition
  61
  62    type LL_Task_Procedure_Access is access procedure (Arg : System.Address);
  63
  64    type Pre_Call_State is new System.Address;
  65
  66    type Task_Storage_Size is new Interfaces.C.size_t;
  67
  68    type Machine_Exceptions is new Interfaces.C.POSIX_RTE.Signal;
  69
  70    type Error_Information is new Interfaces.C.POSIX_RTE.siginfo_ptr;
  71
  72    type Lock is private;
  73    type Condition_Variable is private;
  74
  75    --  The above types should both be limited. They are not due to a hack in
  76    --  ATCB allocation which allocates a block of the correct size and then
  77    --  assigns an initialized ATCB to it. This won't work with limited types.
  78    --  When allocation is done with new, these can become limited once again.
  79    --  ???
  80
  81    type Task_Control_Block is record
  82       LL_Entry_Point : LL_Task_Procedure_Access;
  83       LL_Arg         : System.Address;
  84       Thread         : aliased Interfaces.C.Pthreads.pthread_t;
  85       Stack_Size     : Task_Storage_Size;
  86       Stack_Limit    : System.Address;
  87    end record;
  88
  89    type TCB_Ptr is access all Task_Control_Block;
  90
  91    --  Task ATCB related and variables.
  92
  93    function Address_To_TCB_Ptr is new
  94      Unchecked_Conversion (System.Address, TCB_Ptr);
  95
  96    procedure Initialize_LL_Tasks (T : TCB_Ptr);
  97    --  Initialize GNULLI. T points to the Task Control Block that should
  98    --  be initialized for use by the environment task.
  99
 100    function Self return TCB_Ptr;
 101    --  Return a pointer to the Task Control Block of the calling task.
 102
 103    procedure Initialize_Lock (Prio : System.Any_Priority; L : in out Lock);
 104    --  Initialize a lock object. Prio is the ceiling priority associated
 105    --  with the lock.
 106
 107    procedure Finalize_Lock (L : in out Lock);
 108    --  Finalize a lock object, freeing any resources allocated by the
 109    --  corresponding Initialize_Lock.
 110
 111    procedure Write_Lock (L : in out Lock; Ceiling_Violation : out Boolean);
 112    pragma Inline (Write_Lock);
 113    --  Lock a lock object for write access to a critical section. After
 114    --  this operation returns, the calling task owns the lock, and
 115    --  no other Write_Lock or Read_Lock operation on the same object will
 116    --  return the owner executes an Unlock operation on the same object.
 117
 118    procedure Read_Lock (L : in out Lock; Ceiling_Violation : out Boolean);
 119    pragma Inline (Read_Lock);
 120    --  Lock a lock object for read access to a critical section. After
 121    --  this operation returns, the calling task owns the lock, and
 122    --  no other Write_Lock operation on the same object will return until
 123    --  the owner(s) execute Unlock operation(s) on the same object.
 124    --  A Read_Lock to an owned lock object may return while the lock is
 125    --  still owned, though an implementation may also implement
 126    --  Read_Lock to have the same semantics.
 127
 128    procedure Unlock (L : in out Lock);
 129    pragma Inline (Unlock);
 130    --  Unlock a locked lock object. The results are undefined if the
 131    --  calling task does not own the lock. Lock/Unlock operations must
 132    --  be nested, that is, the argument to Unlock must be the object
 133    --  most recently locked.
 134
 135    procedure Initialize_Cond (Cond : in out Condition_Variable);
 136    --  Initialize a condition variable object.
 137
 138    procedure Finalize_Cond (Cond : in out Condition_Variable);
 139    --  Finalize a condition variable object, recovering any resources
 140    --  allocated for it by Initialize_Cond.
 141
 142    procedure Cond_Wait (Cond : in out Condition_Variable; L : in out Lock);
 143    pragma Inline (Cond_Wait);
 144    --  Wait on a condition variable. The mutex object L is unlocked
 145    --  atomically, such that another task that is able to lock the mutex
 146    --  can be assured that the wait has actually commenced, and that
 147    --  a Cond_Signal operation will cause the waiting task to become
 148    --  eligible for execution once again. Before Cond_Wait returns,
 149    --  the waiting task will again lock the mutex. The waiting task may become
 150    --  eligible for execution at any time, but will become eligible for
 151    --  execution when a Cond_Signal operation is performed on the
 152    --  same condition variable object. The effect of more than one
 153    --  task waiting on the same condition variable is unspecified.
 154
 155    procedure Cond_Timed_Wait
 156      (Cond      : in out Condition_Variable;
 157       L         : in out Lock; Abs_Time : System.Task_Clock.Stimespec;
 158       Timed_Out : out Boolean);
 159    pragma Inline (Cond_Timed_Wait);
 160    --  Wait on a condition variable, as for Cond_Wait, above. In addition,
 161    --  the waiting task will become eligible for execution again
 162    --  when the absolute time specified by Timed_Out arrives.
 163
 164    procedure Cond_Signal (Cond : in out Condition_Variable);
 165    pragma Inline (Cond_Signal);
 166    --  Wake up a task waiting on the condition variable object specified
 167    --  by Cond, making it eligible for execution once again.
 168
 169    procedure Set_Priority (T : TCB_Ptr; Prio : System.Any_Priority);
 170    pragma Inline (Set_Priority);
 171    --  Set the priority of the task specified by T to P.
 172
 173    procedure Set_Own_Priority (Prio : System.Any_Priority);
 174    pragma Inline (Set_Own_Priority);
 175    --  Set the priority of the calling task to P.
 176
 177    function Get_Priority (T : TCB_Ptr) return System.Any_Priority;
 178    pragma Inline (Get_Priority);
 179    --  Return the priority of the task specified by T.
 180
 181    function Get_Own_Priority return System.Any_Priority;
 182    pragma Inline (Get_Own_Priority);
 183    --  Return the priority of the calling task.
 184
 185    procedure Create_LL_Task
 186      (Priority       : System.Any_Priority;
 187       Stack_Size     : Task_Storage_Size;
 188       Task_Info      : System.Task_Info.Task_Info_Type;
 189       LL_Entry_Point : LL_Task_Procedure_Access;
 190       Arg            : System.Address;
 191       T              : TCB_Ptr);
 192    --  Create a new low-level task with priority Priority. A new thread
 193    --  of control is created with a stack size of at least Stack_Size,
 194    --  and the procedure LL_Entry_Point is called with the argument Arg
 195    --  from this new thread of control. The Task Control Block pointed
 196    --  to by T is initialized to refer to this new task.
 197
 198    procedure Exit_LL_Task;
 199    --  Exit a low-level task. The resources allocated for the task
 200    --  by Create_LL_Task are recovered. The task no longer executes, and
 201    --  the effects of further operations on task are unspecified.
 202
 203    procedure Abort_Task (T : TCB_Ptr);
 204    --  Abort the task specified by T (the target task). This causes
 205    --  the target task to asynchronously execute the handler procedure
 206    --  installed by the target task using Install_Abort_Handler. The
 207    --  effect of this operation is unspecified if there is no abort
 208    --  handler procedure for the target task.
 209
 210    procedure Test_Abort;
 211    --  ??? Obsolete?  This is intended to allow implementation of
 212    --      abortion and ATC in the absence of an asynchronous Abort_Task,
 213    --      but I think that we decided that GNARL can handle this on
 214    --      its own by making sure that there is an Undefer_Abortion at
 215    --      every abortion synchronization point.
 216
 217    type Abort_Handler_Pointer is access procedure (Context : Pre_Call_State);
 218
 219    procedure Install_Abort_Handler (Handler : Abort_Handler_Pointer);
 220    --  Install an abort handler procedure. This procedure is called
 221    --  asynchronously by the calling task whenever a call to Abort_Task
 222    --  specifies the calling task as the target. If the abort handler
 223    --  procedure is asynchronously executed during a GNULLI operation
 224    --  and then calls some other GNULLI operation, the effect is unspecified.
 225
 226    procedure Install_Error_Handler (Handler : System.Address);
 227    --  Install an error handler for the calling task. The handler will
 228    --  be called synchronously if an error is encountered during the
 229    --  execution of the calling task.
 230
 231    procedure LL_Assert (B : Boolean; M : String);
 232    --  If B is False, print the string M to the console and halt the
 233    --  program.
 234
 235    Task_Wrapper_Frame : constant Integer := 72;
 236    --  This is the size of the frame for the Pthread_Wrapper procedure.
 237
 238    type Proc is access procedure (Addr : System.Address);
 239
 240
 241    --  Test and Set support
 242    type TAS_Cell is private;
 243    --  On some systems we can not assume that an arbitrary memory location
 244    --  can be used in an atomic test and set instruction (e.g. on some
 245    --  multiprocessor machines, only memory regions are cache interlocked).
 246    --  TAS_Cell is private to facilitate adaption to a variety of
 247    --  implementations.
 248
 249    procedure Initialize_TAS_Cell (Cell :    out TAS_Cell);
 250    pragma Inline (Initialize_TAS_Cell);
 251    --  Initialize a Test And Set Cell.  On some targets this will allocate
 252    --  a system-level lock object from a special pool.  For most systems,
 253    --  this is a nop.
 254
 255    procedure Finalize_TAS_Cell   (Cell : in out TAS_Cell);
 256    pragma Inline (Finalize_TAS_Cell);
 257    --  Finalize a Test and Set cell, freeing any resources allocated by the
 258    --  corresponding Initialize_TAS_Cell.
 259
 260    procedure Clear        (Cell : in out TAS_Cell);
 261    pragma Inline (Clear);
 262    --  Set the state of the named TAS_Cell such that a subsequent call to
 263    --  Is_Set will return False.  This operation must be atomic with
 264    --  respect to the Is_Set and Test_And_Set operations for the same
 265    --  cell.
 266
 267    procedure Test_And_Set (Cell : in out TAS_Cell; Result : out Boolean);
 268    pragma Inline (Test_And_Set);
 269    --  Modify the state of the named TAS_Cell such that a subsequent call
 270    --  to Is_Set will return True.  Result is set to True if Is_Set
 271    --  was False prior to the call, False otherwise.  This operation must
 272    --  be atomic with respect to the Clear and Is_Set operations for the
 273    --  same cell.
 274
 275    function  Is_Set       (Cell : in     TAS_Cell) return Boolean;
 276    pragma Inline (Is_Set);
 277    --  Returns the current value of the named TAS_Cell.  This operation
 278    --  must be atomic with respect to the Clear and Test_And_Set operations
 279    --  for the same cell.
 280
 281 private
 282
 283    type Lock is
 284       record
 285          mutex : aliased Interfaces.C.Pthreads.pthread_mutex_t;
 286       end record;
 287
 288    type Condition_Variable is
 289       record
 290          CV : aliased Interfaces.C.Pthreads.pthread_cond_t;
 291       end record;
 292
 293    type TAS_Cell is
 294       record
 295          Value : aliased Interfaces.C.unsigned := 0;
 296       end record;
 297
 298 end System.Task_Primitives;