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--          Copyright (C) 1997-2003 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,  59 Temple Place - Suite 330,  Boston, --
20-- MA 02111-1307, 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 is a AIX (Native THREADS) version of this package.
35
36--  This package encapsulates all direct interfaces to OS services
37--  that are needed by children of System.
38
39--  PLEASE DO NOT add any with-clauses to this package
40--  or remove the pragma Elaborate_Body.
41--  It is designed to be a bottom-level (leaf) package.
42
43with Interfaces.C;
44package System.OS_Interface is
45   pragma Preelaborate;
46
47   pragma Linker_Options ("-lpthreads");
48   pragma Linker_Options ("-lc_r");
49
50   subtype int            is Interfaces.C.int;
51   subtype short          is Interfaces.C.short;
52   subtype long           is Interfaces.C.long;
53   subtype unsigned       is Interfaces.C.unsigned;
54   subtype unsigned_short is Interfaces.C.unsigned_short;
55   subtype unsigned_long  is Interfaces.C.unsigned_long;
56   subtype unsigned_char  is Interfaces.C.unsigned_char;
57   subtype plain_char     is Interfaces.C.plain_char;
58   subtype size_t         is Interfaces.C.size_t;
59
60   -----------
61   -- Errno --
62   -----------
63
64   function errno return int;
65   pragma Import (C, errno, "__get_errno");
66
67   EAGAIN    : constant := 11;
68   EINTR     : constant := 4;
69   EINVAL    : constant := 22;
70   ENOMEM    : constant := 12;
71   ETIMEDOUT : constant := 78;
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 := 1; --  hangup
82   SIGINT      : constant := 2; --  interrupt (rubout)
83   SIGQUIT     : constant := 3; --  quit (ASCD FS)
84   SIGILL      : constant := 4; --  illegal instruction (not reset)
85   SIGTRAP     : constant := 5; --  trace trap (not reset)
86   SIGIOT      : constant := 6; --  IOT instruction
87   SIGABRT     : constant := 6; --  used by abort, replace SIGIOT in the future
88   SIGEMT      : constant := 7; --  EMT instruction
89   SIGFPE      : constant := 8; --  floating point exception
90   SIGKILL     : constant := 9; --  kill (cannot be caught or ignored)
91   SIGBUS      : constant := 10; --  bus error
92   SIGSEGV     : constant := 11; --  segmentation violation
93   SIGSYS      : constant := 12; --  bad argument to system call
94   SIGPIPE     : constant := 13; --  write on a pipe with no one to read it
95   SIGALRM     : constant := 14; --  alarm clock
96   SIGTERM     : constant := 15; --  software termination signal from kill
97   SIGUSR1     : constant := 30; --  user defined signal 1
98   SIGUSR2     : constant := 31; --  user defined signal 2
99   SIGCLD      : constant := 20; --  alias for SIGCHLD
100   SIGCHLD     : constant := 20; --  child status change
101   SIGPWR      : constant := 29; --  power-fail restart
102   SIGWINCH    : constant := 28; --  window size change
103   SIGURG      : constant := 16; --  urgent condition on IO channel
104   SIGPOLL     : constant := 23; --  pollable event occurred
105   SIGIO       : constant := 23; --  I/O possible (Solaris SIGPOLL alias)
106   SIGSTOP     : constant := 17; --  stop (cannot be caught or ignored)
107   SIGTSTP     : constant := 18; --  user stop requested from tty
108   SIGCONT     : constant := 19; --  stopped process has been continued
109   SIGTTIN     : constant := 21; --  background tty read attempted
110   SIGTTOU     : constant := 22; --  background tty write attempted
111   SIGVTALRM   : constant := 34; --  virtual timer expired
112   SIGPROF     : constant := 32; --  profiling timer expired
113   SIGXCPU     : constant := 24; --  CPU time limit exceeded
114   SIGXFSZ     : constant := 25; --  filesize limit exceeded
115   SIGWAITING  : constant := 39; --  m:n scheduling
116
117   --  the following signals are AIX specific
118   SIGMSG      : constant := 27; -- input data is in the ring buffer
119   SIGDANGER   : constant := 33; -- system crash imminent
120   SIGMIGRATE  : constant := 35; -- migrate process
121   SIGPRE      : constant := 36; -- programming exception
122   SIGVIRT     : constant := 37; -- AIX virtual time alarm
123   SIGALRM1    : constant := 38; -- m:n condition variables
124   SIGKAP      : constant := 60; -- keep alive poll from native keyboard
125   SIGGRANT    : constant := SIGKAP; -- monitor mode granted
126   SIGRETRACT  : constant := 61; -- monitor mode should be relinguished
127   SIGSOUND    : constant := 62; -- sound control has completed
128   SIGSAK      : constant := 63; -- secure attention key
129
130   SIGADAABORT : constant := SIGTERM;
131   --  Note: on other targets, we usually use SIGABRT, but on AiX, it
132   --  appears that SIGABRT can't be used in sigwait(), so we use SIGTERM.
133
134   type Signal_Set is array (Natural range <>) of Signal;
135
136   Unmasked    : constant Signal_Set :=
137     (SIGTRAP, SIGTTIN, SIGTTOU, SIGTSTP, SIGPROF);
138   Reserved    : constant Signal_Set := (SIGABRT, SIGKILL, SIGSTOP);
139
140   type sigset_t is private;
141
142   function sigaddset (set : access sigset_t; sig : Signal) return int;
143   pragma Import (C, sigaddset, "sigaddset");
144
145   function sigdelset (set : access sigset_t; sig : Signal) return int;
146   pragma Import (C, sigdelset, "sigdelset");
147
148   function sigfillset (set : access sigset_t) return int;
149   pragma Import (C, sigfillset, "sigfillset");
150
151   function sigismember (set : access sigset_t; sig : Signal) return int;
152   pragma Import (C, sigismember, "sigismember");
153
154   function sigemptyset (set : access sigset_t) return int;
155   pragma Import (C, sigemptyset, "sigemptyset");
156
157   type struct_sigaction is record
158      sa_handler : System.Address;
159      sa_mask    : sigset_t;
160      sa_flags   : int;
161   end record;
162   pragma Convention (C, struct_sigaction);
163   type struct_sigaction_ptr is access all struct_sigaction;
164
165   SA_SIGINFO  : constant := 16#0100#;
166
167   SIG_BLOCK   : constant := 0;
168   SIG_UNBLOCK : constant := 1;
169   SIG_SETMASK : constant := 2;
170
171   SIG_DFL : constant := 0;
172   SIG_IGN : constant := 1;
173
174   function sigaction
175     (sig  : Signal;
176      act  : struct_sigaction_ptr;
177      oact : struct_sigaction_ptr) return int;
178   pragma Import (C, sigaction, "sigaction");
179
180   ----------
181   -- Time --
182   ----------
183
184   Time_Slice_Supported : constant Boolean := False;
185   --  Indicates wether time slicing is supported
186
187   type timespec is private;
188
189   type clockid_t is private;
190
191   CLOCK_REALTIME : constant clockid_t;
192
193   function clock_gettime
194     (clock_id : clockid_t;
195      tp       : access timespec) return int;
196   --  AiX threads don't have clock_gettime
197   --  We instead use gettimeofday()
198
199   function To_Duration (TS : timespec) return Duration;
200   pragma Inline (To_Duration);
201
202   function To_Timespec (D : Duration) return timespec;
203   pragma Inline (To_Timespec);
204
205   type struct_timezone is record
206      tz_minuteswest : int;
207      tz_dsttime     : int;
208   end record;
209   pragma Convention (C, struct_timezone);
210   type struct_timezone_ptr is access all struct_timezone;
211
212   type struct_timeval is private;
213   --  This is needed on systems that do not have clock_gettime()
214   --  but do have gettimeofday().
215
216   function To_Duration (TV : struct_timeval) return Duration;
217   pragma Inline (To_Duration);
218
219   function To_Timeval (D : Duration) return struct_timeval;
220   pragma Inline (To_Timeval);
221
222   -------------------------
223   -- Priority Scheduling --
224   -------------------------
225
226   SCHED_FIFO  : constant := 1;
227   SCHED_RR    : constant := 2;
228   SCHED_OTHER : constant := 0;
229
230   -------------
231   -- Process --
232   -------------
233
234   type pid_t is private;
235
236   function kill (pid : pid_t; sig : Signal) return int;
237   pragma Import (C, kill, "kill");
238
239   function getpid return pid_t;
240   pragma Import (C, getpid, "getpid");
241
242   ---------
243   -- LWP --
244   ---------
245
246   function lwp_self return System.Address;
247   pragma Import (C, lwp_self, "thread_self");
248
249   -------------
250   -- Threads --
251   -------------
252
253   type Thread_Body is access
254     function (arg : System.Address) return System.Address;
255   type pthread_t           is private;
256   subtype Thread_Id        is pthread_t;
257
258   type pthread_mutex_t     is limited private;
259   type pthread_cond_t      is limited private;
260   type pthread_attr_t      is limited private;
261   type pthread_mutexattr_t is limited private;
262   type pthread_condattr_t  is limited private;
263   type pthread_key_t       is private;
264
265   PTHREAD_CREATE_DETACHED : constant := 1;
266
267   -----------
268   -- Stack --
269   -----------
270
271   Stack_Base_Available : constant Boolean := False;
272   --  Indicates wether the stack base is available on this target.
273
274   function Get_Stack_Base (thread : pthread_t) return Address;
275   pragma Inline (Get_Stack_Base);
276   --  returns the stack base of the specified thread.
277   --  Only call this function when Stack_Base_Available is True.
278
279   function Get_Page_Size return size_t;
280   function Get_Page_Size return Address;
281   pragma Import (C, Get_Page_Size, "getpagesize");
282   --  returns the size of a page, or 0 if this is not relevant on this
283   --  target
284
285   PROT_NONE  : constant := 0;
286   PROT_READ  : constant := 1;
287   PROT_WRITE : constant := 2;
288   PROT_EXEC  : constant := 4;
289   PROT_ALL   : constant := PROT_READ + PROT_WRITE + PROT_EXEC;
290
291   PROT_ON    : constant := PROT_READ;
292   PROT_OFF   : constant := PROT_ALL;
293
294   function mprotect (addr : Address; len : size_t; prot : int) return int;
295   pragma Import (C, mprotect);
296
297   ---------------------------------------
298   -- Nonstandard Thread Initialization --
299   ---------------------------------------
300
301   --  Though not documented, pthread_init *must* be called before any other
302   --  pthread call
303
304   procedure pthread_init;
305   pragma Import (C, pthread_init, "pthread_init");
306
307   -------------------------
308   -- POSIX.1c  Section 3 --
309   -------------------------
310
311   function sigwait
312     (set : access sigset_t;
313      sig : access Signal) return int;
314   pragma Import (C, sigwait, "sigwait");
315
316   function pthread_kill
317     (thread : pthread_t;
318      sig    : Signal) return int;
319   pragma Import (C, pthread_kill, "pthread_kill");
320
321   type sigset_t_ptr is access all sigset_t;
322
323   function pthread_sigmask
324     (how  : int;
325      set  : sigset_t_ptr;
326      oset : sigset_t_ptr) return int;
327   pragma Import (C, pthread_sigmask, "sigthreadmask");
328
329   --------------------------
330   -- POSIX.1c  Section 11 --
331   --------------------------
332
333   function pthread_mutexattr_init
334     (attr : access pthread_mutexattr_t) return int;
335   pragma Import (C, pthread_mutexattr_init, "pthread_mutexattr_init");
336
337   function pthread_mutexattr_destroy
338     (attr : access pthread_mutexattr_t) return int;
339   pragma Import (C, pthread_mutexattr_destroy, "pthread_mutexattr_destroy");
340
341   function pthread_mutex_init
342     (mutex : access pthread_mutex_t;
343      attr  : access pthread_mutexattr_t) return int;
344   pragma Import (C, pthread_mutex_init, "pthread_mutex_init");
345
346   function pthread_mutex_destroy (mutex : access pthread_mutex_t) return int;
347   pragma Import (C, pthread_mutex_destroy, "pthread_mutex_destroy");
348
349   function pthread_mutex_lock (mutex : access pthread_mutex_t) return int;
350   pragma Import (C, pthread_mutex_lock, "pthread_mutex_lock");
351
352   function pthread_mutex_unlock (mutex : access pthread_mutex_t) return int;
353   pragma Import (C, pthread_mutex_unlock, "pthread_mutex_unlock");
354
355   function pthread_condattr_init
356     (attr : access pthread_condattr_t) return int;
357   pragma Import (C, pthread_condattr_init, "pthread_condattr_init");
358
359   function pthread_condattr_destroy
360     (attr : access pthread_condattr_t) return int;
361   pragma Import (C, pthread_condattr_destroy, "pthread_condattr_destroy");
362
363   function pthread_cond_init
364     (cond : access pthread_cond_t;
365      attr : access pthread_condattr_t) return int;
366   pragma Import (C, pthread_cond_init, "pthread_cond_init");
367
368   function pthread_cond_destroy (cond : access pthread_cond_t) return int;
369   pragma Import (C, pthread_cond_destroy, "pthread_cond_destroy");
370
371   function pthread_cond_signal (cond : access pthread_cond_t) return int;
372   pragma Import (C, pthread_cond_signal, "pthread_cond_signal");
373
374   function pthread_cond_wait
375     (cond  : access pthread_cond_t;
376      mutex : access pthread_mutex_t) return int;
377   pragma Import (C, pthread_cond_wait, "pthread_cond_wait");
378
379   function pthread_cond_timedwait
380     (cond    : access pthread_cond_t;
381      mutex   : access pthread_mutex_t;
382      abstime : access timespec) return int;
383   pragma Import (C, pthread_cond_timedwait, "pthread_cond_timedwait");
384
385   Relative_Timed_Wait : constant Boolean := False;
386   --  pthread_cond_timedwait requires an absolute delay time
387
388   ----------------------------
389   --  POSIX.1c  Section 13  --
390   ----------------------------
391
392   PTHREAD_PRIO_NONE    : constant := 0;
393   PTHREAD_PRIO_PROTECT : constant := 0;
394   PTHREAD_PRIO_INHERIT : constant := 0;
395
396   function pthread_mutexattr_setprotocol
397     (attr     : access pthread_mutexattr_t;
398      protocol : int) return int;
399   pragma Import (C, pthread_mutexattr_setprotocol);
400
401   function pthread_mutexattr_setprioceiling
402     (attr        : access pthread_mutexattr_t;
403      prioceiling : int) return int;
404   pragma Import (C, pthread_mutexattr_setprioceiling);
405
406   type Array_5_Int is array (0 .. 5) of int;
407   type struct_sched_param is record
408      sched_priority : int;
409      sched_policy   : int;
410      sched_reserved : Array_5_Int;
411   end record;
412
413   function pthread_setschedparam
414     (thread : pthread_t;
415      policy : int;
416      param  : access struct_sched_param) return int;
417   pragma Import (C, pthread_setschedparam, "pthread_setschedparam");
418
419   function pthread_attr_setscope
420     (attr            : access pthread_attr_t;
421      contentionscope : int) return int;
422   pragma Import (C, pthread_attr_setscope, "pthread_attr_setscope");
423
424   function pthread_attr_setinheritsched
425     (attr            : access pthread_attr_t;
426      inheritsched : int) return int;
427   pragma Import (C, pthread_attr_setinheritsched);
428
429   function pthread_attr_setschedpolicy
430     (attr   : access pthread_attr_t;
431      policy : int) return int;
432   pragma Import (C, pthread_attr_setschedpolicy);
433
434   function pthread_attr_setschedparam
435     (attr        : access pthread_attr_t;
436      sched_param : int) return int;
437   pragma Import (C, pthread_attr_setschedparam);
438
439   function sched_yield return int;
440   --  AiX have a nonstandard sched_yield.
441
442   ---------------------------
443   -- P1003.1c - Section 16 --
444   ---------------------------
445
446   function pthread_attr_init (attributes : access pthread_attr_t) return int;
447   pragma Import (C, pthread_attr_init, "pthread_attr_init");
448
449   function pthread_attr_destroy
450     (attributes : access pthread_attr_t) return int;
451   pragma Import (C, pthread_attr_destroy, "pthread_attr_destroy");
452
453   function pthread_attr_setdetachstate
454     (attr        : access pthread_attr_t;
455      detachstate : int) return int;
456   pragma Import (C, pthread_attr_setdetachstate);
457
458   function pthread_attr_setstacksize
459     (attr      : access pthread_attr_t;
460      stacksize : size_t) return int;
461   pragma Import (C, pthread_attr_setstacksize);
462
463   function pthread_create
464     (thread        : access pthread_t;
465      attributes    : access pthread_attr_t;
466      start_routine : Thread_Body;
467      arg           : System.Address)
468     return int;
469   pragma Import (C, pthread_create, "pthread_create");
470
471   procedure pthread_exit (status : System.Address);
472   pragma Import (C, pthread_exit, "pthread_exit");
473
474   function pthread_self return pthread_t;
475   pragma Import (C, pthread_self, "pthread_self");
476
477   --------------------------
478   -- POSIX.1c  Section 17 --
479   --------------------------
480
481   function pthread_setspecific
482     (key   : pthread_key_t;
483      value : System.Address) return int;
484   pragma Import (C, pthread_setspecific, "pthread_setspecific");
485
486   function pthread_getspecific (key : pthread_key_t) return System.Address;
487   pragma Import (C, pthread_getspecific, "pthread_getspecific");
488
489   type destructor_pointer is access
490      procedure (arg : System.Address);
491
492   function pthread_key_create
493     (key        : access pthread_key_t;
494      destructor : destructor_pointer) return int;
495   pragma Import (C, pthread_key_create, "pthread_key_create");
496
497private
498
499   type sigset_t is record
500      losigs : unsigned_long;
501      hisigs : unsigned_long;
502   end record;
503   pragma Convention (C_Pass_By_Copy, sigset_t);
504
505   type pid_t is new int;
506
507   type time_t is new long;
508
509   type timespec is record
510      tv_sec  : time_t;
511      tv_nsec : long;
512   end record;
513   pragma Convention (C, timespec);
514
515   type clockid_t is new int;
516   CLOCK_REALTIME : constant clockid_t := 0;
517
518   type struct_timeval is record
519      tv_sec  : long;
520      tv_usec : long;
521   end record;
522   pragma Convention (C, struct_timeval);
523
524   type pthread_attr_t is new System.Address;
525   pragma Convention (C, pthread_attr_t);
526   --  typedef struct __pt_attr        *pthread_attr_t;
527
528   type pthread_condattr_t is new System.Address;
529   pragma Convention (C, pthread_condattr_t);
530   --  typedef struct __pt_attr        *pthread_condattr_t;
531
532   type pthread_mutexattr_t is new System.Address;
533   pragma Convention (C, pthread_mutexattr_t);
534   --  typedef struct __pt_attr        *pthread_mutexattr_t;
535
536   type pthread_t is new System.Address;
537   pragma Convention (C, pthread_t);
538   --  typedef void    *pthread_t;
539
540   type ptq_queue;
541   type ptq_queue_ptr is access all ptq_queue;
542
543   type ptq_queue is record
544      ptq_next : ptq_queue_ptr;
545      ptq_prev : ptq_queue_ptr;
546   end record;
547
548   type Array_3_Int is array (0 .. 3) of int;
549   type pthread_mutex_t is record
550        link        : ptq_queue;
551        ptmtx_lock  : int;
552        ptmtx_flags : long;
553        protocol    : int;
554        prioceiling : int;
555        ptmtx_owner : pthread_t;
556        mtx_id      : int;
557        attr        : pthread_attr_t;
558        mtx_kind    : int;
559        lock_cpt    : int;
560        reserved    : Array_3_Int;
561   end record;
562   pragma Convention (C, pthread_mutex_t);
563   type pthread_mutex_t_ptr is access pthread_mutex_t;
564
565   type pthread_cond_t is record
566      link         : ptq_queue;
567      ptcv_lock    : int;
568      ptcv_flags   : long;
569      ptcv_waiters : ptq_queue;
570      cv_id        : int;
571      attr         : pthread_attr_t;
572      mutex        : pthread_mutex_t_ptr;
573      cptwait      : int;
574      reserved     : int;
575   end record;
576   pragma Convention (C, pthread_cond_t);
577
578   type pthread_key_t is new unsigned;
579
580end System.OS_Interface;
581