gcc/ada/5zosinte.ads

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                 GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS              --
   4 --                                                                          --
   5 --                    S Y S T E M . O S _ I N T E R F A C E                 --
   6 --                                                                          --
   7 --                                   S p e c                                --
   8 --                                                                          --
   9 --                             $Revision$
  10 --                                                                          --
  11 --           Copyright (C) 1997-2001 Free Software Foundation, Inc.         --
  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 --  This is the VxWorks version of this package.
  38 --
  39 --  VxWorks does not directly support the needed POSIX routines, but it
  40 --  does have other routines that make it possible to code equivalent
  41 --  POSIX compliant routines.  The approach taken is to provide an
  42 --  FSU threads compliant interface.
  43
  44 --  This package encapsulates all direct interfaces to OS services
  45 --  that are needed by children of System.
  46
  47 --  PLEASE DO NOT add any with-clauses to this package
  48 --  or remove the pragma Elaborate_Body.
  49 --  It is designed to be a bottom-level (leaf) package.
  50
  51 with Interfaces.C;
  52 with System.VxWorks;
  53 package System.OS_Interface is
  54    pragma Preelaborate;
  55
  56    subtype int            is Interfaces.C.int;
  57    subtype short          is Interfaces.C.short;
  58    subtype long           is Interfaces.C.long;
  59    subtype unsigned       is Interfaces.C.unsigned;
  60    subtype unsigned_short is Interfaces.C.unsigned_short;
  61    subtype unsigned_long  is Interfaces.C.unsigned_long;
  62    subtype unsigned_char  is Interfaces.C.unsigned_char;
  63    subtype plain_char     is Interfaces.C.plain_char;
  64    subtype size_t         is Interfaces.C.size_t;
  65    subtype char           is Interfaces.C.char;
  66
  67    -----------
  68    -- Errno --
  69    -----------
  70
  71    function errno return int;
  72    pragma Import (C, errno, "errnoGet");
  73
  74    EINTR     : constant := 4;
  75    EAGAIN    : constant := 35;
  76    ENOMEM    : constant := 12;
  77    EINVAL    : constant := 22;
  78    ETIMEDOUT : constant := 60;
  79
  80    FUNC_ERR  : constant := -1;
  81
  82    ----------------------------
  83    -- Signals and Interrupts --
  84    ----------------------------
  85
  86    --  In order to support both signal and hardware interrupt handling,
  87    --  the ranges of "interrupt IDs" for the vectored hardware interrupts
  88    --  and the signals are catenated. In other words, the external IDs
  89    --  used to designate signals are relocated beyond the range of the
  90    --  vectored interrupts. The IDs given in Ada.Interrupts.Names should
  91    --  be used to designate signals; vectored interrupts are designated
  92    --  by their interrupt number.
  93
  94    NSIG : constant := 32;
  95    --  Number of signals on the target OS
  96    type Signal is new int range 0 .. Interfaces.C."-" (NSIG, 1);
  97
  98    Max_HW_Interrupt : constant := System.VxWorks.Num_HW_Interrupts - 1;
  99    type HW_Interrupt is new int range 0 .. Max_HW_Interrupt;
 100
 101    Max_Interrupt : constant := Max_HW_Interrupt + NSIG;
 102
 103    SIGILL  : constant :=  4; --  illegal instruction (not reset)
 104    SIGABRT : constant :=  6; --  used by abort, replace SIGIOT in the future
 105    SIGFPE  : constant :=  8; --  floating point exception
 106    SIGBUS  : constant := 10; --  bus error
 107    SIGSEGV : constant := 11; --  segmentation violation
 108
 109    -----------------------------------
 110    -- Signal processing definitions --
 111    -----------------------------------
 112
 113    --  The how in sigprocmask().
 114    SIG_BLOCK   : constant := 1;
 115    SIG_UNBLOCK : constant := 2;
 116    SIG_SETMASK : constant := 3;
 117
 118    --  The sa_flags in struct sigaction.
 119    SA_SIGINFO : constant := 16#0002#;
 120    SA_ONSTACK : constant := 16#0004#;
 121
 122    --  ANSI args and returns from signal().
 123    SIG_DFL : constant := 0;
 124    SIG_IGN : constant := 1;
 125
 126    type sigset_t is private;
 127
 128    type struct_sigaction is record
 129       sa_handler : System.Address;
 130       sa_mask    : sigset_t;
 131       sa_flags   : int;
 132    end record;
 133    pragma Convention (C, struct_sigaction);
 134    type struct_sigaction_ptr is access all struct_sigaction;
 135
 136    function sigaddset (set : access sigset_t; sig : Signal) return int;
 137    pragma Import (C, sigaddset, "sigaddset");
 138
 139    function sigdelset (set : access sigset_t; sig : Signal) return int;
 140    pragma Import (C, sigdelset, "sigdelset");
 141
 142    function sigfillset (set : access sigset_t) return int;
 143    pragma Import (C, sigfillset, "sigfillset");
 144
 145    function sigismember (set : access sigset_t; sig : Signal) return int;
 146    pragma Import (C, sigismember, "sigismember");
 147
 148    function sigemptyset (set : access sigset_t) return int;
 149    pragma Import (C, sigemptyset, "sigemptyset");
 150
 151    function sigaction
 152      (sig  : Signal;
 153       act  : struct_sigaction_ptr;
 154       oact : struct_sigaction_ptr) return int;
 155    pragma Import (C, sigaction, "sigaction");
 156
 157    type isr_address is access procedure (sig : int);
 158
 159    function c_signal (sig : Signal; handler : isr_address) return isr_address;
 160    pragma Import (C, c_signal, "signal");
 161
 162    function sigwait (set : access sigset_t; sig : access Signal) return int;
 163    pragma Inline (sigwait);
 164
 165    type sigset_t_ptr is access all sigset_t;
 166
 167    function pthread_sigmask
 168      (how  : int;
 169       set  : sigset_t_ptr;
 170       oset : sigset_t_ptr) return int;
 171    pragma Import (C, pthread_sigmask, "sigprocmask");
 172
 173    ----------
 174    -- Time --
 175    ----------
 176
 177    type time_t is new unsigned_long;
 178
 179    type timespec is record
 180       ts_sec  : time_t;
 181       ts_nsec : long;
 182    end record;
 183    pragma Convention (C, timespec);
 184
 185    type clockid_t is private;
 186
 187    CLOCK_REALTIME : constant clockid_t;   --  System wide realtime clock
 188
 189    function To_Duration (TS : timespec) return Duration;
 190    pragma Inline (To_Duration);
 191
 192    function To_Timespec (D : Duration) return timespec;
 193    pragma Inline (To_Timespec);
 194
 195    function To_Clock_Ticks (D : Duration) return int;
 196    --  Convert a duration value (in seconds) into clock ticks.
 197
 198    function clock_gettime
 199      (clock_id : clockid_t; tp : access timespec) return int;
 200    pragma Import (C, clock_gettime, "clock_gettime");
 201
 202    -------------------------
 203    -- Priority Scheduling --
 204    -------------------------
 205
 206    --  Scheduling policies.
 207    SCHED_FIFO  : constant := 1;
 208    SCHED_RR    : constant := 2;
 209    SCHED_OTHER : constant := 4;
 210
 211    -------------
 212    -- Threads --
 213    -------------
 214
 215    type Thread_Body is access
 216      function (arg : System.Address) return System.Address;
 217
 218    type pthread_t           is private;
 219    subtype Thread_Id        is pthread_t;
 220
 221    null_pthread : constant pthread_t;
 222
 223    type pthread_mutex_t     is limited private;
 224    type pthread_cond_t      is limited private;
 225    type pthread_attr_t      is limited private;
 226    type pthread_mutexattr_t is limited private;
 227    type pthread_condattr_t  is limited private;
 228    type pthread_key_t       is private;
 229
 230    PTHREAD_CREATE_DETACHED : constant := 0;
 231    PTHREAD_CREATE_JOINABLE : constant := 1;
 232
 233    function kill (pid : pthread_t; sig : Signal) return int;
 234    pragma Import (C, kill, "kill");
 235
 236    --  VxWorks doesn't have getpid; taskIdSelf is the equivalent
 237    --  routine.
 238    function getpid return pthread_t;
 239    pragma Import (C, getpid, "taskIdSelf");
 240
 241    ---------------------------------
 242    -- Nonstandard Thread Routines --
 243    ---------------------------------
 244
 245    procedure pthread_init;
 246    pragma Inline (pthread_init);
 247    --  Vxworks requires this for the moment.
 248
 249    function taskIdSelf return pthread_t;
 250    pragma Import (C, taskIdSelf, "taskIdSelf");
 251
 252    function taskSuspend (tid : pthread_t) return int;
 253    pragma Import (C, taskSuspend, "taskSuspend");
 254
 255    function taskResume (tid : pthread_t) return int;
 256    pragma Import (C, taskResume, "taskResume");
 257
 258    function taskIsSuspended (tid : pthread_t) return int;
 259    pragma Import (C, taskIsSuspended, "taskIsSuspended");
 260
 261    function taskVarAdd
 262      (tid  : pthread_t;
 263       pVar : access System.Address) return int;
 264    pragma Import (C, taskVarAdd, "taskVarAdd");
 265
 266    function taskVarDelete
 267      (tid  : pthread_t;
 268       pVar : access System.Address) return int;
 269    pragma Import (C, taskVarDelete, "taskVarDelete");
 270
 271    function taskVarSet
 272      (tid   : pthread_t;
 273       pVar  : access System.Address;
 274       value : System.Address) return int;
 275    pragma Import (C, taskVarSet, "taskVarSet");
 276
 277    function taskVarGet
 278      (tid   : pthread_t;
 279       pVar  : access System.Address) return int;
 280    pragma Import (C, taskVarGet, "taskVarGet");
 281
 282    function taskInfoGet
 283      (tid       : pthread_t;
 284       pTaskDesc : access System.VxWorks.TASK_DESC) return int;
 285    pragma Import (C, taskInfoGet, "taskInfoGet");
 286
 287    function taskDelay (ticks : int) return int;
 288    pragma Import (C, taskDelay, "taskDelay");
 289
 290    function sysClkRateGet return int;
 291    pragma Import (C, sysClkRateGet, "sysClkRateGet");
 292
 293    --------------------------
 294    -- POSIX.1c  Section 11 --
 295    --------------------------
 296
 297    function pthread_mutexattr_init
 298      (attr : access pthread_mutexattr_t) return int;
 299    pragma Inline (pthread_mutexattr_init);
 300
 301    function pthread_mutexattr_destroy
 302      (attr : access pthread_mutexattr_t) return int;
 303    pragma Inline (pthread_mutexattr_destroy);
 304
 305    function pthread_mutex_init
 306      (mutex : access pthread_mutex_t;
 307       attr  : access pthread_mutexattr_t) return int;
 308    pragma Inline (pthread_mutex_init);
 309
 310    function pthread_mutex_destroy (mutex : access pthread_mutex_t) return int;
 311    pragma Inline (pthread_mutex_destroy);
 312
 313    function pthread_mutex_lock (mutex : access pthread_mutex_t) return int;
 314    pragma Inline (pthread_mutex_lock);
 315
 316    function pthread_mutex_unlock (mutex : access pthread_mutex_t) return int;
 317    pragma Inline (pthread_mutex_unlock);
 318
 319    function pthread_condattr_init
 320      (attr : access pthread_condattr_t) return int;
 321    pragma Inline (pthread_condattr_init);
 322
 323    function pthread_condattr_destroy
 324      (attr : access pthread_condattr_t) return int;
 325    pragma Inline (pthread_condattr_destroy);
 326
 327    function pthread_cond_init
 328      (cond : access pthread_cond_t;
 329       attr : access pthread_condattr_t) return int;
 330    pragma Inline (pthread_cond_init);
 331
 332    function pthread_cond_destroy (cond : access pthread_cond_t) return int;
 333    pragma Inline (pthread_cond_destroy);
 334
 335    function pthread_cond_signal (cond : access pthread_cond_t) return int;
 336    pragma Inline (pthread_cond_signal);
 337
 338    function pthread_cond_wait
 339      (cond  : access pthread_cond_t;
 340       mutex : access pthread_mutex_t) return int;
 341    pragma Inline (pthread_cond_wait);
 342
 343    function pthread_cond_timedwait
 344      (cond    : access pthread_cond_t;
 345       mutex   : access pthread_mutex_t;
 346       abstime : access timespec) return int;
 347    pragma Inline (pthread_cond_timedwait);
 348
 349    --------------------------
 350    -- POSIX.1c  Section 13 --
 351    --------------------------
 352
 353    PTHREAD_PRIO_NONE    : constant := 0;
 354    PTHREAD_PRIO_PROTECT : constant := 2;
 355    PTHREAD_PRIO_INHERIT : constant := 1;
 356
 357    function pthread_mutexattr_setprotocol
 358      (attr     : access pthread_mutexattr_t;
 359       protocol : int) return int;
 360    pragma Inline (pthread_mutexattr_setprotocol);
 361
 362    function pthread_mutexattr_setprioceiling
 363      (attr        : access pthread_mutexattr_t;
 364       prioceiling : int) return int;
 365    pragma Inline (pthread_mutexattr_setprioceiling);
 366
 367    type struct_sched_param is record
 368       sched_priority : int;
 369    end record;
 370
 371    function pthread_setschedparam
 372      (thread : pthread_t;
 373       policy : int;
 374       param  : access struct_sched_param) return int;
 375    pragma Inline (pthread_setschedparam);
 376
 377    function sched_yield return int;
 378    pragma Inline (sched_yield);
 379
 380    function pthread_sched_rr_set_interval (usecs : int) return int;
 381    pragma Inline (pthread_sched_rr_set_interval);
 382
 383    ---------------------------
 384    -- P1003.1c - Section 16 --
 385    ---------------------------
 386
 387    function pthread_attr_init (attr : access pthread_attr_t) return int;
 388    pragma Inline (pthread_attr_init);
 389
 390    function pthread_attr_destroy (attr : access pthread_attr_t) return int;
 391    pragma Inline (pthread_attr_destroy);
 392
 393    function pthread_attr_setdetachstate
 394      (attr        : access pthread_attr_t;
 395       detachstate : int) return int;
 396    pragma Inline (pthread_attr_setdetachstate);
 397
 398    function pthread_attr_setstacksize
 399      (attr      : access pthread_attr_t;
 400       stacksize : size_t) return int;
 401    pragma Inline (pthread_attr_setstacksize);
 402
 403    function pthread_attr_setname_np
 404      (attr : access pthread_attr_t;
 405       name : System.Address) return int;
 406    --  In VxWorks tasks, we have a non-portable routine to set the
 407    --  task name. This makes it really convenient for debugging.
 408    pragma Inline (pthread_attr_setname_np);
 409
 410    function pthread_create
 411      (thread        : access pthread_t;
 412       attr          : access pthread_attr_t;
 413       start_routine : Thread_Body;
 414       arg           : System.Address) return int;
 415    pragma Inline (pthread_create);
 416
 417    function pthread_detach (thread : pthread_t) return int;
 418    pragma Inline (pthread_detach);
 419
 420    procedure pthread_exit (status : System.Address);
 421    pragma Inline (pthread_exit);
 422
 423    function pthread_self return pthread_t;
 424    pragma Inline (pthread_self);
 425
 426    function pthread_equal (t1 : pthread_t; t2 : pthread_t) return int;
 427    pragma Inline (pthread_equal);
 428    --  be careful not to use "=" on thread_t!
 429
 430    --------------------------
 431    -- POSIX.1c  Section 17 --
 432    --------------------------
 433
 434    function pthread_setspecific
 435      (key   : pthread_key_t;
 436       value : System.Address) return int;
 437    pragma Inline (pthread_setspecific);
 438
 439    function pthread_getspecific (key : pthread_key_t) return System.Address;
 440    pragma Inline (pthread_getspecific);
 441
 442    type destructor_pointer is access procedure (arg : System.Address);
 443
 444    function pthread_key_create
 445      (key        : access pthread_key_t;
 446       destructor : destructor_pointer) return int;
 447    pragma Inline (pthread_key_create);
 448
 449    --  VxWorks binary semaphores. These are exported for use by the
 450    --  implementation of hardware interrupt handling.
 451
 452    subtype STATUS is int;
 453    --  Equivalent of the C type STATUS
 454
 455    OK    : constant STATUS := 0;
 456    ERROR : constant STATUS := Interfaces.C."-" (1);
 457
 458    --  Semaphore creation flags.
 459
 460    SEM_Q_FIFO         : constant := 0;
 461    SEM_Q_PRIORITY     : constant := 1;
 462    SEM_DELETE_SAFE    : constant := 4;  -- only valid for binary semaphore
 463    SEM_INVERSION_SAFE : constant := 8;  -- only valid for binary semaphore
 464
 465    --  Semaphore initial state flags;
 466
 467    SEM_EMPTY : constant := 0;
 468    SEM_FULL  : constant := 1;
 469
 470    --  Semaphore take (semTake) time constants.
 471
 472    WAIT_FOREVER : constant := -1;
 473    NO_WAIT      : constant := 0;
 474
 475    type SEM_ID is new long;
 476    --  The VxWorks semaphore ID is an integer which is really just
 477    --  a pointer to a semaphore structure.
 478
 479    function semBCreate (Options : int; Initial_State : int) return SEM_ID;
 480    --  Create a binary semaphore.  Returns ID, or 0 if memory could not
 481    --  be allocated
 482    pragma Import (C, semBCreate, "semBCreate");
 483
 484    function semTake (SemID : SEM_ID; Timeout : int) return STATUS;
 485    --  Attempt to take binary semaphore.  Error is returned if operation
 486    --  times out
 487    pragma Import (C, semTake, "semTake");
 488
 489    function semGive (SemID : SEM_ID) return STATUS;
 490    --  Release one thread blocked on the semaphore
 491    pragma Import (C, semGive, "semGive");
 492
 493    function semFlush (SemID : SEM_ID) return STATUS;
 494    --  Release all threads blocked on the semaphore
 495    pragma Import (C, semFlush, "semFlush");
 496
 497    function semDelete (SemID : SEM_ID) return STATUS;
 498    --  Delete a semaphore
 499    pragma Import (C, semDelete, "semDelete");
 500
 501
 502 private
 503    --  This interface assumes that "unsigned" and "int" are 32-bit entities.
 504
 505    type sigset_t is new long;
 506
 507    type pid_t is new int;
 508
 509    ERROR_PID : constant pid_t := -1;
 510
 511    type clockid_t is new int;
 512    CLOCK_REALTIME : constant clockid_t := 0;
 513
 514    --  Priority ceilings are now implemented in the body of
 515    --  this package.
 516
 517    type pthread_mutexattr_t is record
 518       Flags        : int;   --  mutex semaphore creation flags
 519       Prio_Ceiling : int;   --  priority ceiling
 520       Protocol     : int;
 521    end record;
 522
 523    type pthread_mutex_t is record
 524       Mutex        : SEM_ID;
 525       Protocol     : int;
 526       Prio_Ceiling : int;  --  priority ceiling of lock
 527    end record;
 528
 529    type pthread_condattr_t is record
 530       Flags : int;
 531    end record;
 532
 533    type pthread_cond_t is record
 534       Sem     : SEM_ID;   --  VxWorks semaphore ID
 535       Waiting : Integer;  --  Number of queued tasks waiting
 536    end record;
 537
 538    type pthread_attr_t is record
 539       Stacksize   : size_t;
 540       Detachstate : int;
 541       Priority    : int;
 542       Taskname    : System.Address;
 543    end record;
 544
 545    type pthread_t is new long;
 546
 547    null_pthread : constant pthread_t := 0;
 548
 549    type pthread_key_t is new int;
 550
 551    --  These are to store the pthread_keys that are created with
 552    --  pthread_key_create.  Currently, we only need one key.
 553
 554    Key_Storage  : array (1 .. 10) of aliased System.Address;
 555    Keys_Created : Integer;
 556
 557    Time_Slice : int;
 558
 559 end System.OS_Interface;