File : s-osinte-linux-xenomai.ads


   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                 GNAT 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 --             Copyright (C) 1991-1994, Florida State University            --
  10 --          Copyright (C) 1995-2014, Free Software Foundation, Inc.         --
  11 --                                                                          --
  12 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  13 -- terms of the  GNU General Public License as published  by the Free Soft- --
  14 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  15 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  16 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  17 -- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
  18 --                                                                          --
  19 --                                                                          --
  20 --                                                                          --
  21 --                                                                          --
  22 --                                                                          --
  23 -- You should have received a copy of the GNU General Public License and    --
  24 -- a copy of the GCC Runtime Library Exception along with this program;     --
  25 -- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
  26 -- <http://www.gnu.org/licenses/>.                                          --
  27 --                                                                          --
  28 -- GNARL was developed by the GNARL team at Florida State University.       --
  29 -- Extensive contributions were provided by Ada Core Technologies, Inc.     --
  30 --                                                                          --
  31 ------------------------------------------------------------------------------
  32 
  33 --  This is a GNU/Linux (Xenomai) version of this package
  34 
  35 --  This package encapsulates all direct interfaces to OS services
  36 --  that are needed by the tasking run-time (libgnarl).
  37 
  38 --  PLEASE DO NOT add any with-clauses to this package or remove the pragma
  39 --  Preelaborate. This package is designed to be a bottom-level (leaf) package.
  40 
  41 with Ada.Unchecked_Conversion;
  42 with Interfaces.C;
  43 with System.Linux;
  44 
  45 package System.OS_Interface is
  46    pragma Preelaborate;
  47 
  48    subtype int            is Interfaces.C.int;
  49    subtype char           is Interfaces.C.char;
  50    subtype short          is Interfaces.C.short;
  51    subtype long           is Interfaces.C.long;
  52    subtype unsigned       is Interfaces.C.unsigned;
  53    subtype unsigned_short is Interfaces.C.unsigned_short;
  54    subtype unsigned_long  is Interfaces.C.unsigned_long;
  55    subtype unsigned_char  is Interfaces.C.unsigned_char;
  56    subtype plain_char     is Interfaces.C.plain_char;
  57    subtype size_t         is Interfaces.C.size_t;
  58 
  59    -----------
  60    -- Errno --
  61    -----------
  62 
  63    function errno return int;
  64    pragma Import (C, errno, "__get_errno");
  65 
  66    EAGAIN    : constant := -System.Linux.EAGAIN;
  67    EINTR     : constant := -System.Linux.EINTR;
  68    EINVAL    : constant := -System.Linux.EINVAL;
  69    ENOMEM    : constant := -System.Linux.ENOMEM;
  70    EPERM     : constant := -System.Linux.EPERM;
  71    ETIMEDOUT : constant := -System.Linux.ETIMEDOUT;
  72 
  73    -------------
  74    -- Signals --
  75    -------------
  76 
  77    Max_Interrupt : constant := 63;
  78    type Signal is new int range 0 .. Max_Interrupt;
  79    for Signal'Size use int'Size;
  80 
  81    SIGHUP     : constant := System.Linux.SIGHUP;
  82    SIGINT     : constant := System.Linux.SIGINT;
  83    SIGQUIT    : constant := System.Linux.SIGQUIT;
  84    SIGILL     : constant := System.Linux.SIGILL;
  85    SIGTRAP    : constant := System.Linux.SIGTRAP;
  86    SIGIOT     : constant := System.Linux.SIGIOT;
  87    SIGABRT    : constant := System.Linux.SIGABRT;
  88    SIGFPE     : constant := System.Linux.SIGFPE;
  89    SIGKILL    : constant := System.Linux.SIGKILL;
  90    SIGBUS     : constant := System.Linux.SIGBUS;
  91    SIGSEGV    : constant := System.Linux.SIGSEGV;
  92    SIGPIPE    : constant := System.Linux.SIGPIPE;
  93    SIGALRM    : constant := System.Linux.SIGALRM;
  94    SIGTERM    : constant := System.Linux.SIGTERM;
  95    SIGUSR1    : constant := System.Linux.SIGUSR1;
  96    SIGUSR2    : constant := System.Linux.SIGUSR2;
  97    SIGCLD     : constant := System.Linux.SIGCLD;
  98    SIGCHLD    : constant := System.Linux.SIGCHLD;
  99    SIGPWR     : constant := System.Linux.SIGPWR;
 100    SIGWINCH   : constant := System.Linux.SIGWINCH;
 101    SIGURG     : constant := System.Linux.SIGURG;
 102    SIGPOLL    : constant := System.Linux.SIGPOLL;
 103    SIGIO      : constant := System.Linux.SIGIO;
 104    SIGLOST    : constant := System.Linux.SIGLOST;
 105    SIGSTOP    : constant := System.Linux.SIGSTOP;
 106    SIGTSTP    : constant := System.Linux.SIGTSTP;
 107    SIGCONT    : constant := System.Linux.SIGCONT;
 108    SIGTTIN    : constant := System.Linux.SIGTTIN;
 109    SIGTTOU    : constant := System.Linux.SIGTTOU;
 110    SIGVTALRM  : constant := System.Linux.SIGVTALRM;
 111    SIGPROF    : constant := System.Linux.SIGPROF;
 112    SIGXCPU    : constant := System.Linux.SIGXCPU;
 113    SIGXFSZ    : constant := System.Linux.SIGXFSZ;
 114    SIGUNUSED  : constant := System.Linux.SIGUNUSED;
 115    SIGSTKFLT  : constant := System.Linux.SIGSTKFLT;
 116    SIGLTHRRES : constant := System.Linux.SIGLTHRRES;
 117    SIGLTHRCAN : constant := System.Linux.SIGLTHRCAN;
 118    SIGLTHRDBG : constant := System.Linux.SIGLTHRDBG;
 119 
 120    SIGADAABORT : constant := SIGABRT;
 121    --  Change this if you want to use another signal for task abort.
 122    --  SIGTERM might be a good one.
 123 
 124    type Signal_Set is array (Natural range <>) of Signal;
 125 
 126    Unmasked    : constant Signal_Set := (
 127       SIGTRAP,
 128       --  To enable debugging on multithreaded applications, mark SIGTRAP to
 129       --  be kept unmasked.
 130 
 131       SIGBUS,
 132 
 133       SIGTTIN, SIGTTOU, SIGTSTP,
 134       --  Keep these three signals unmasked so that background processes
 135       --  and IO behaves as normal "C" applications
 136 
 137       SIGPROF,
 138       --  To avoid confusing the profiler
 139 
 140       SIGKILL, SIGSTOP,
 141       --  These two signals actually cannot be masked;
 142       --  POSIX simply won't allow it.
 143 
 144       SIGLTHRRES, SIGLTHRCAN, SIGLTHRDBG);
 145       --  These three signals are used by GNU/LinuxThreads starting from
 146       --  glibc 2.1 (future 2.2).
 147 
 148    Reserved    : constant Signal_Set :=
 149    --  I am not sure why the following two signals are reserved.
 150    --  I guess they are not supported by this version of GNU/Linux.
 151      (SIGVTALRM, SIGUNUSED);
 152 
 153    type sigset_t is private;
 154 
 155    function sigaddset (set : access sigset_t; sig : Signal) return int;
 156    pragma Import (C, sigaddset, "sigaddset");
 157 
 158    function sigdelset (set : access sigset_t; sig : Signal) return int;
 159    pragma Import (C, sigdelset, "sigdelset");
 160 
 161    function sigfillset (set : access sigset_t) return int;
 162    pragma Import (C, sigfillset, "sigfillset");
 163 
 164    function sigismember (set : access sigset_t; sig : Signal) return int;
 165    pragma Import (C, sigismember, "sigismember");
 166 
 167    function sigemptyset (set : access sigset_t) return int;
 168    pragma Import (C, sigemptyset, "sigemptyset");
 169 
 170    type union_type_3 is new String (1 .. 116);
 171    type siginfo_t is record
 172       si_signo : int;
 173       si_code  : int;
 174       si_errno : int;
 175       X_data   : union_type_3;
 176    end record;
 177    pragma Convention (C, siginfo_t);
 178 
 179    type struct_sigaction is record
 180       sa_handler  : System.Address;
 181       sa_mask     : sigset_t;
 182       sa_flags    : Interfaces.C.unsigned_long;
 183       sa_restorer : System.Address;
 184    end record;
 185    pragma Convention (C, struct_sigaction);
 186 
 187    type struct_sigaction_ptr is access all struct_sigaction;
 188 
 189    type Machine_State is record
 190       eip : unsigned_long;
 191       ebx : unsigned_long;
 192       esp : unsigned_long;
 193       ebp : unsigned_long;
 194       esi : unsigned_long;
 195       edi : unsigned_long;
 196    end record;
 197    type Machine_State_Ptr is access all Machine_State;
 198 
 199    SA_SIGINFO : constant := System.Linux.SA_SIGINFO;
 200    SA_ONSTACK : constant := System.Linux.SA_ONSTACK;
 201 
 202    SIG_BLOCK   : constant := 0;
 203    SIG_UNBLOCK : constant := 1;
 204    SIG_SETMASK : constant := 2;
 205 
 206    SIG_DFL : constant := 0;
 207    SIG_IGN : constant := 1;
 208 
 209    function sigaction
 210      (sig  : Signal;
 211       act  : struct_sigaction_ptr;
 212       oact : struct_sigaction_ptr) return int;
 213    pragma Import (C, sigaction, "sigaction");
 214 
 215    ----------
 216    -- Time --
 217    ----------
 218 
 219    subtype time_t   is System.Linux.time_t;
 220    subtype timespec is System.Linux.timespec;
 221    subtype timeval  is System.Linux.timeval;
 222 
 223    function To_Duration (TS : timespec) return Duration;
 224    pragma Inline (To_Duration);
 225 
 226    function To_Timespec (D : Duration) return timespec;
 227    pragma Inline (To_Timespec);
 228 
 229    type RTime is mod 2 ** Long_Long_Integer'Size;
 230 
 231    function timer_read return RTime;
 232    pragma Import (C, timer_read, "rt_timer_read");
 233 
 234    type SRTime is new Long_Long_Integer;
 235 
 236    function timer_ns2ticks (Ns : SRTime) return SRTime;
 237    pragma Import (C, timer_ns2ticks, "rt_timer_ns2ticks");
 238 
 239    function timer_ticks2ns (Ticks : SRTime) return SRTime;
 240    pragma Import (C, timer_ticks2ns, "rt_timer_ticks2ns");
 241 
 242    type timer_info is record
 243       period : RTime; -- Current status (unset, aperiodic, period)
 244       date   : RTime; -- Current wallclock time
 245       tsc    : RTime; -- Current tsc count
 246    end record;
 247    pragma Convention (C, timer_info);
 248 
 249    procedure timer_inquire (Info : access timer_info);
 250    pragma Import (C, timer_inquire, "rt_timer_inquire");
 251 
 252    function task_sleep (Relative_Time : RTime) return int;
 253    pragma Import (C, task_sleep, "rt_task_sleep");
 254 
 255    function task_sleep_until (Absolute_Time : RTime) return int;
 256    pragma Import (C, task_sleep_until, "rt_task_sleep_until");
 257 
 258    function sysconf (name : int) return long;
 259    pragma Import (C, sysconf);
 260 
 261    SC_CLK_TCK          : constant := 2;
 262    SC_NPROCESSORS_ONLN : constant := 84;
 263 
 264    -------------
 265    -- Process --
 266    -------------
 267 
 268    type pid_t is private;
 269 
 270    function kill (pid : pid_t; sig : Signal) return int;
 271    pragma Import (C, kill, "kill");
 272 
 273    function getpid return pid_t;
 274    pragma Import (C, getpid, "getpid");
 275 
 276    -------------
 277    -- Threads --
 278    -------------
 279 
 280    type Thread_Body is access
 281      function (arg : System.Address) return System.Address;
 282    pragma Convention (C, Thread_Body);
 283 
 284    function Thread_Body_Access is new
 285      Ada.Unchecked_Conversion (System.Address, Thread_Body);
 286 
 287    type thread_mutex_t is limited private;
 288    type thread_cond_t  is limited private;
 289 
 290    type pthread_key_t is private;
 291 
 292    type pthread_t is private;
 293 
 294    type task_descriptor is limited private;
 295    type thread_t is access task_descriptor;
 296 
 297    subtype Thread_Id is thread_t;
 298 
 299    -----------
 300    -- Stack --
 301    -----------
 302 
 303    type stack_t is record
 304       ss_sp    : System.Address;
 305       ss_flags : int;
 306       ss_size  : size_t;
 307    end record;
 308    pragma Convention (C, stack_t);
 309 
 310    function sigaltstack
 311      (ss  : not null access stack_t;
 312       oss : access stack_t) return int;
 313    pragma Import (C, sigaltstack, "sigaltstack");
 314 
 315    Alternate_Stack : aliased System.Address;
 316    pragma Import (C, Alternate_Stack, "__gnat_alternate_stack");
 317    --  The alternate signal stack for stack overflows
 318 
 319    Alternate_Stack_Size : constant := 16 * 1024;
 320    --  This must be in keeping with init.c:__gnat_alternate_stack
 321 
 322    function Get_Stack_Base (thread : pthread_t) return Address;
 323    pragma Inline (Get_Stack_Base);
 324    --  This is a dummy procedure to share some GNULLI files
 325 
 326    ---------------------------------------
 327    -- Nonstandard Thread Initialization --
 328    ---------------------------------------
 329 
 330    procedure pthread_init;
 331    pragma Inline (pthread_init);
 332    --  This is a dummy procedure to share some GNULLI files
 333 
 334    -------------------------
 335    -- POSIX.1c  Section 3 --
 336    -------------------------
 337 
 338    function sigwait (set : access sigset_t; sig : access Signal) return int;
 339    pragma Import (C, sigwait, "sigwait");
 340 
 341    function pthread_kill (thread : pthread_t; sig : Signal) return int;
 342    pragma Import (C, pthread_kill, "pthread_kill");
 343 
 344    function pthread_sigmask
 345      (how  : int;
 346       set  : access sigset_t;
 347       oset : access sigset_t) return int;
 348    pragma Import (C, pthread_sigmask, "pthread_sigmask");
 349 
 350    -------------
 351    -- Mutexes --
 352    -------------
 353 
 354    function mutex_create
 355      (mutex : access thread_mutex_t; name : access constant char) return int;
 356    pragma Import (C, mutex_create, "rt_mutex_create");
 357 
 358    function mutex_delete (mutex : access thread_mutex_t) return int;
 359    pragma Import (C, mutex_delete, "rt_mutex_delete");
 360 
 361    function mutex_lock
 362      (mutex : access thread_mutex_t; timeout : RTime) return int;
 363    pragma Import (C, mutex_lock, "rt_mutex_acquire");
 364 
 365    function mutex_unlock (mutex : access thread_mutex_t) return int;
 366    pragma Import (C, mutex_unlock, "rt_mutex_release");
 367 
 368    -------------------------
 369    -- Condition variables --
 370    -------------------------
 371 
 372    function cond_create
 373      (cond : access thread_cond_t; name : access constant char) return int;
 374    pragma Import (C, cond_create, "rt_cond_create");
 375 
 376    function cond_delete (cond : access thread_cond_t) return int;
 377    pragma Import (C, cond_delete, "rt_cond_delete");
 378 
 379    function cond_signal (cond : access thread_cond_t) return int;
 380    pragma Import (C, cond_signal, "rt_cond_signal");
 381 
 382    function cond_wait
 383      (cond    : access thread_cond_t;
 384       mutex   : access thread_mutex_t;
 385       timeout : RTime) return int;
 386    pragma Import (C, cond_wait, "rt_cond_wait");
 387 
 388    -------------
 389    -- Threads --
 390    -------------
 391 
 392    function task_create
 393      (thread     : thread_t;
 394       name       : access constant char;
 395       stack_size : size_t;
 396       priority   : int;
 397       mode       : int) return int;
 398    pragma Import (C, task_create, "rt_task_create");
 399 
 400    function task_start
 401      (thread        : thread_t;
 402       start_routine : Thread_Body;
 403       arg           : System.Address) return int;
 404    pragma Import (C, task_start, "rt_task_start");
 405 
 406    function task_delete (thread : thread_t) return int;
 407    pragma Import (C, task_delete, "rt_task_delete");
 408 
 409    function thread_self return thread_t;
 410    pragma Import (C, thread_self, "rt_task_self");
 411 
 412    function pthread_self return pthread_t;
 413    pragma Import (C, pthread_self, "pthread_self");
 414 
 415    function lwp_self return System.Address;
 416    pragma Import (C, lwp_self, "__gnat_lwp_self");
 417 
 418    function sched_yield return int;
 419    pragma Import (C, sched_yield, "rt_task_yield");
 420 
 421    function To_Target_Priority
 422      (Prio : System.Any_Priority) return Interfaces.C.int;
 423    --  Maps System.Any_Priority to a POSIX priority
 424 
 425    function task_set_priority
 426      (thread : thread_t; priority : int) return int;
 427    pragma Import (C, task_set_priority, "rt_task_set_priority");
 428 
 429    function task_unblock (thread : thread_t) return int;
 430    pragma Import (C, task_unblock, "rt_task_unblock");
 431 
 432    function task_suspend (thread : thread_t) return int;
 433    pragma Import (C, task_suspend, "rt_task_suspend");
 434 
 435    function task_resume (thread : thread_t) return int;
 436    pragma Import (C, task_resume, "rt_task_resume");
 437 
 438    --------------------------
 439    -- Thread-specific data --
 440    --------------------------
 441 
 442    function pthread_setspecific
 443      (key   : pthread_key_t;
 444       value : System.Address) return int;
 445    pragma Import (C, pthread_setspecific, "pthread_setspecific");
 446 
 447    function pthread_getspecific (key : pthread_key_t) return System.Address;
 448    pragma Import (C, pthread_getspecific, "pthread_getspecific");
 449 
 450    type destructor_pointer is access procedure (arg : System.Address);
 451    pragma Convention (C, destructor_pointer);
 452 
 453    function pthread_key_create
 454      (key        : access pthread_key_t;
 455       destructor : destructor_pointer) return int;
 456    pragma Import (C, pthread_key_create, "pthread_key_create");
 457 
 458 private
 459 
 460    type sigset_t is array (0 .. 127) of Interfaces.C.unsigned_char;
 461    pragma Convention (C, sigset_t);
 462    for sigset_t'Alignment use Interfaces.C.unsigned_long'Alignment;
 463 
 464    pragma Warnings (Off);
 465    for struct_sigaction use record
 466       sa_handler at                  0 range 0 .. Standard'Address_Size - 1;
 467       sa_mask    at Linux.sa_mask_pos  range 0 .. 1023;
 468       sa_flags   at Linux.sa_flags_pos range 0 .. Standard'Address_Size - 1;
 469    end record;
 470    --  We intentionally leave sa_restorer unspecified and let the compiler
 471    --  append it after the last field, so disable corresponding warning.
 472    pragma Warnings (On);
 473 
 474    type pid_t is new int;
 475 
 476    type pthread_t is new int;
 477 
 478    type task_descriptor is record
 479       opaque  : unsigned_long;
 480       opaque2 : unsigned_long;
 481    end record;
 482    pragma Convention (C, task_descriptor);
 483 
 484    type thread_mutex_t is record
 485       opaque   : unsigned_long;
 486       fastlock : access long;
 487       lockcnt  : int;
 488    end record;
 489    pragma Convention (C, thread_mutex_t);
 490    --  Note that the fields fastlock and lockcnt are not part of older versions
 491    --  (such as Xenomai 2.4). However, making the type bigger than what is
 492    --  needed (for old Xenomai versions) is not problematic because the extra
 493    --  fields can be considered as unused padding.
 494 
 495    type thread_cond_t is record
 496       opaque : unsigned_long;
 497    end record;
 498    pragma Convention (C, thread_cond_t);
 499 
 500    type pthread_key_t is new unsigned;
 501 
 502 end System.OS_Interface;