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-2012, 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-- As a special exception under Section 7 of GPL version 3, you are granted --
20-- additional permissions described in the GCC Runtime Library Exception,   --
21-- version 3.1, as published by the Free Software Foundation.               --
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 the HP-UX 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
41with Ada.Unchecked_Conversion;
42
43with Interfaces.C;
44
45package System.OS_Interface is
46   pragma Preelaborate;
47
48   pragma Linker_Options ("-lcma");
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   ETIME     : constant := 52;
72   ETIMEDOUT : constant := 238;
73
74   FUNC_ERR : constant := -1;
75
76   -------------
77   -- Signals --
78   -------------
79
80   Max_Interrupt : constant := 44;
81   type Signal is new int range 0 .. Max_Interrupt;
82   for Signal'Size use int'Size;
83
84   SIGHUP     : constant := 1; --  hangup
85   SIGINT     : constant := 2; --  interrupt (rubout)
86   SIGQUIT    : constant := 3; --  quit (ASCD FS)
87   SIGILL     : constant := 4; --  illegal instruction (not reset)
88   SIGTRAP    : constant := 5; --  trace trap (not reset)
89   SIGIOT     : constant := 6; --  IOT instruction
90   SIGABRT    : constant := 6; --  used by abort, replace SIGIOT in the  future
91   SIGEMT     : constant := 7; --  EMT instruction
92   SIGFPE     : constant := 8; --  floating point exception
93   SIGKILL    : constant := 9; --  kill (cannot be caught or ignored)
94   SIGBUS     : constant := 10; --  bus error
95   SIGSEGV    : constant := 11; --  segmentation violation
96   SIGSYS     : constant := 12; --  bad argument to system call
97   SIGPIPE    : constant := 13; --  write on a pipe with no one to read it
98   SIGALRM    : constant := 14; --  alarm clock
99   SIGTERM    : constant := 15; --  software termination signal from kill
100   SIGUSR1    : constant := 16; --  user defined signal 1
101   SIGUSR2    : constant := 17; --  user defined signal 2
102   SIGCLD     : constant := 18; --  alias for SIGCHLD
103   SIGCHLD    : constant := 18; --  child status change
104   SIGPWR     : constant := 19; --  power-fail restart
105   SIGVTALRM  : constant := 20; --  virtual timer alarm
106   SIGPROF    : constant := 21; --  profiling timer alarm
107   SIGIO      : constant := 22; --  asynchronous I/O
108   SIGPOLL    : constant := 22; --  pollable event occurred
109   SIGWINCH   : constant := 23; --  window size change
110   SIGSTOP    : constant := 24; --  stop (cannot be caught or ignored)
111   SIGTSTP    : constant := 25; --  user stop requested from tty
112   SIGCONT    : constant := 26; --  stopped process has been continued
113   SIGTTIN    : constant := 27; --  background tty read attempted
114   SIGTTOU    : constant := 28; --  background tty write attempted
115   SIGURG     : constant := 29; --  urgent condition on IO channel
116   SIGLOST    : constant := 30; --  remote lock lost  (NFS)
117   SIGDIL     : constant := 32; --  DIL signal
118   SIGXCPU    : constant := 33; --  CPU time limit exceeded (setrlimit)
119   SIGXFSZ    : constant := 34; --  file size limit exceeded (setrlimit)
120
121   SIGADAABORT : constant := SIGABRT;
122   --  Note: on other targets, we usually use SIGABRT, but on HP/UX, it
123   --  appears that SIGABRT can't be used in sigwait(), so we use SIGTERM.
124
125   type Signal_Set is array (Natural range <>) of Signal;
126
127   Unmasked    : constant Signal_Set :=
128     (SIGBUS, SIGTRAP, SIGTTIN, SIGTTOU, SIGTSTP);
129
130   Reserved    : constant Signal_Set := (SIGKILL, SIGSTOP);
131
132   type sigset_t is private;
133
134   type isr_address is access procedure (sig : int);
135   pragma Convention (C, isr_address);
136
137   function intr_attach (sig : int; handler : isr_address) return long;
138
139   Intr_Attach_Reset : constant Boolean := True;
140   --  True if intr_attach is reset after an interrupt handler is called
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 Signal_Handler is access procedure (signo : Signal);
158
159   type struct_sigaction is record
160      sa_handler : System.Address;
161      sa_mask    : sigset_t;
162      sa_flags   : int;
163   end record;
164   pragma Convention (C, struct_sigaction);
165   type struct_sigaction_ptr is access all struct_sigaction;
166
167   SA_RESTART  : constant  := 16#40#;
168   SA_SIGINFO  : constant  := 16#10#;
169   SA_ONSTACK  : constant  := 16#01#;
170
171   SIG_BLOCK   : constant  := 0;
172   SIG_UNBLOCK : constant  := 1;
173   SIG_SETMASK : constant  := 2;
174
175   SIG_DFL : constant := 0;
176   SIG_IGN : constant := 1;
177   SIG_ERR : constant := -1;
178
179   function sigaction
180     (sig  : Signal;
181      act  : struct_sigaction_ptr;
182      oact : struct_sigaction_ptr) return int;
183   pragma Import (C, sigaction, "sigaction");
184
185   ----------
186   -- Time --
187   ----------
188
189   type timespec is private;
190
191   function nanosleep (rqtp, rmtp : access timespec) return int;
192   pragma Import (C, nanosleep);
193
194   type clockid_t is new int;
195
196   function Clock_Gettime
197     (Clock_Id : clockid_t; Tp : access timespec) return int;
198   pragma Import (C, Clock_Gettime);
199
200   function To_Duration (TS : timespec) return Duration;
201   pragma Inline (To_Duration);
202
203   function To_Timespec (D : Duration) return timespec;
204   pragma Inline (To_Timespec);
205
206   -------------------------
207   -- Priority Scheduling --
208   -------------------------
209
210   SCHED_FIFO  : constant := 0;
211   SCHED_RR    : constant := 1;
212   SCHED_OTHER : constant := 2;
213
214   -------------
215   -- Process --
216   -------------
217
218   type pid_t is private;
219
220   function kill (pid : pid_t; sig : Signal) return int;
221   pragma Import (C, kill, "kill");
222
223   function getpid return pid_t;
224   pragma Import (C, getpid, "getpid");
225
226   -------------
227   -- Threads --
228   -------------
229
230   type Thread_Body is access
231     function (arg : System.Address) return System.Address;
232   pragma Convention (C, Thread_Body);
233
234   function Thread_Body_Access is new
235     Ada.Unchecked_Conversion (System.Address, Thread_Body);
236
237   type pthread_t           is private;
238   subtype Thread_Id        is pthread_t;
239
240   type pthread_mutex_t     is limited private;
241   type pthread_cond_t      is limited private;
242   type pthread_attr_t      is limited private;
243   type pthread_mutexattr_t is limited private;
244   type pthread_condattr_t  is limited private;
245   type pthread_key_t       is private;
246
247   --  Read/Write lock not supported on HPUX. To add support both types
248   --  pthread_rwlock_t and pthread_rwlockattr_t must properly be defined
249   --  with the associated routines pthread_rwlock_[init/destroy] and
250   --  pthread_rwlock_[rdlock/wrlock/unlock].
251
252   subtype pthread_rwlock_t     is pthread_mutex_t;
253   subtype pthread_rwlockattr_t is pthread_mutexattr_t;
254
255   -----------
256   -- Stack --
257   -----------
258
259   function Get_Stack_Base (thread : pthread_t) return Address;
260   pragma Inline (Get_Stack_Base);
261   --  This is a dummy procedure to share some GNULLI files
262
263   ---------------------------------------
264   -- Nonstandard Thread Initialization --
265   ---------------------------------------
266
267   procedure pthread_init;
268   pragma Inline (pthread_init);
269   --  This is a dummy procedure to share some GNULLI files
270
271   -------------------------
272   -- POSIX.1c  Section 3 --
273   -------------------------
274
275   function sigwait (set : access sigset_t) return int;
276   pragma Import (C, sigwait, "cma_sigwait");
277
278   function sigwait
279     (set : access sigset_t;
280      sig : access Signal) return int;
281   pragma Inline (sigwait);
282   --  DCE_THREADS has a nonstandard sigwait
283
284   function pthread_kill
285     (thread : pthread_t;
286      sig    : Signal) return int;
287   pragma Inline (pthread_kill);
288   --  DCE_THREADS doesn't have pthread_kill
289
290   function pthread_sigmask
291     (how  : int;
292      set  : access sigset_t;
293      oset : access sigset_t) return int;
294   --  DCE THREADS does not have pthread_sigmask. Instead, it uses sigprocmask
295   --  to do the signal handling when the thread library is sucked in.
296   pragma Import (C, pthread_sigmask, "sigprocmask");
297
298   --------------------------
299   -- POSIX.1c  Section 11 --
300   --------------------------
301
302   function pthread_mutexattr_init
303     (attr : access pthread_mutexattr_t) return int;
304   --  DCE_THREADS has a nonstandard pthread_mutexattr_init
305
306   function pthread_mutexattr_destroy
307     (attr : access pthread_mutexattr_t) return int;
308   --  DCE_THREADS has a nonstandard pthread_mutexattr_destroy
309
310   function pthread_mutex_init
311     (mutex : access pthread_mutex_t;
312      attr  : access pthread_mutexattr_t) return int;
313   --  DCE_THREADS has a nonstandard pthread_mutex_init
314
315   function pthread_mutex_destroy (mutex : access pthread_mutex_t) return int;
316   --  DCE_THREADS has a nonstandard pthread_mutex_destroy
317
318   function pthread_mutex_lock (mutex : access pthread_mutex_t) return int;
319   pragma Inline (pthread_mutex_lock);
320   --  DCE_THREADS has nonstandard pthread_mutex_lock
321
322   function pthread_mutex_unlock (mutex : access pthread_mutex_t) return int;
323   pragma Inline (pthread_mutex_unlock);
324   --  DCE_THREADS has nonstandard pthread_mutex_lock
325
326   function pthread_condattr_init
327     (attr : access pthread_condattr_t) return int;
328   --  DCE_THREADS has nonstandard pthread_condattr_init
329
330   function pthread_condattr_destroy
331     (attr : access pthread_condattr_t) return int;
332   --  DCE_THREADS has nonstandard pthread_condattr_destroy
333
334   function pthread_cond_init
335     (cond : access pthread_cond_t;
336      attr : access pthread_condattr_t) return int;
337   --  DCE_THREADS has nonstandard pthread_cond_init
338
339   function pthread_cond_destroy (cond : access pthread_cond_t) return int;
340   --  DCE_THREADS has nonstandard pthread_cond_destroy
341
342   function pthread_cond_signal (cond : access pthread_cond_t) return int;
343   pragma Inline (pthread_cond_signal);
344   --  DCE_THREADS has nonstandard pthread_cond_signal
345
346   function pthread_cond_wait
347     (cond  : access pthread_cond_t;
348      mutex : access pthread_mutex_t) return int;
349   pragma Inline (pthread_cond_wait);
350   --  DCE_THREADS has a nonstandard pthread_cond_wait
351
352   function pthread_cond_timedwait
353     (cond    : access pthread_cond_t;
354      mutex   : access pthread_mutex_t;
355      abstime : access timespec) return int;
356   pragma Inline (pthread_cond_timedwait);
357   --  DCE_THREADS has a nonstandard pthread_cond_timedwait
358
359   --------------------------
360   -- POSIX.1c  Section 13 --
361   --------------------------
362
363   type struct_sched_param is record
364      sched_priority : int;  --  scheduling priority
365   end record;
366
367   function pthread_setschedparam
368     (thread : pthread_t;
369      policy : int;
370      param  : access struct_sched_param) return int;
371   pragma Inline (pthread_setschedparam);
372   --  DCE_THREADS has a nonstandard pthread_setschedparam
373
374   function sched_yield return int;
375   pragma Inline (sched_yield);
376   --  DCE_THREADS has a nonstandard sched_yield
377
378   ---------------------------
379   -- P1003.1c - Section 16 --
380   ---------------------------
381
382   function pthread_attr_init (attributes : access pthread_attr_t) return int;
383   pragma Inline (pthread_attr_init);
384   --  DCE_THREADS has a nonstandard pthread_attr_init
385
386   function pthread_attr_destroy
387     (attributes : access pthread_attr_t) return int;
388   pragma Inline (pthread_attr_destroy);
389   --  DCE_THREADS has a nonstandard pthread_attr_destroy
390
391   function pthread_attr_setstacksize
392     (attr      : access pthread_attr_t;
393      stacksize : size_t) return int;
394   pragma Inline (pthread_attr_setstacksize);
395   --  DCE_THREADS has a nonstandard pthread_attr_setstacksize
396
397   function pthread_create
398     (thread        : access pthread_t;
399      attributes    : access pthread_attr_t;
400      start_routine : Thread_Body;
401      arg           : System.Address) return int;
402   pragma Inline (pthread_create);
403   --  DCE_THREADS has a nonstandard pthread_create
404
405   procedure pthread_detach (thread : access pthread_t);
406   pragma Import (C, pthread_detach);
407
408   procedure pthread_exit (status : System.Address);
409   pragma Import (C, pthread_exit, "pthread_exit");
410
411   function pthread_self return pthread_t;
412   pragma Import (C, pthread_self, "pthread_self");
413
414   --------------------------
415   -- POSIX.1c  Section 17 --
416   --------------------------
417
418   function pthread_setspecific
419     (key   : pthread_key_t;
420      value : System.Address) return int;
421   pragma Inline (pthread_setspecific);
422   --  DCE_THREADS has a nonstandard pthread_setspecific
423
424   function pthread_getspecific (key : pthread_key_t) return System.Address;
425   pragma Inline (pthread_getspecific);
426   --  DCE_THREADS has a nonstandard pthread_getspecific
427
428   type destructor_pointer is access procedure (arg : System.Address);
429   pragma Convention (C, destructor_pointer);
430
431   function pthread_key_create
432     (key        : access pthread_key_t;
433      destructor : destructor_pointer) return int;
434   pragma Inline (pthread_key_create);
435   --  DCE_THREADS has a nonstandard pthread_key_create
436
437private
438
439   type array_type_1 is array (Integer range 0 .. 7) of unsigned_long;
440   type sigset_t is record
441      X_X_sigbits : array_type_1;
442   end record;
443   pragma Convention (C, sigset_t);
444
445   type pid_t is new int;
446
447   type time_t is new long;
448
449   type timespec is record
450      tv_sec  : time_t;
451      tv_nsec : long;
452   end record;
453   pragma Convention (C, timespec);
454
455   CLOCK_REALTIME : constant clockid_t := 1;
456
457   type cma_t_address is new System.Address;
458
459   type cma_t_handle is record
460      field1 : cma_t_address;
461      field2 : Short_Integer;
462      field3 : Short_Integer;
463   end record;
464   for cma_t_handle'Size use 64;
465
466   type pthread_attr_t is new cma_t_handle;
467   pragma Convention (C_Pass_By_Copy, pthread_attr_t);
468
469   type pthread_condattr_t is new cma_t_handle;
470   pragma Convention (C_Pass_By_Copy, pthread_condattr_t);
471
472   type pthread_mutexattr_t is new cma_t_handle;
473   pragma Convention (C_Pass_By_Copy, pthread_mutexattr_t);
474
475   type pthread_t is new cma_t_handle;
476   pragma Convention (C_Pass_By_Copy, pthread_t);
477
478   type pthread_mutex_t is new cma_t_handle;
479   pragma Convention (C_Pass_By_Copy, pthread_mutex_t);
480
481   type pthread_cond_t is new cma_t_handle;
482   pragma Convention (C_Pass_By_Copy, pthread_cond_t);
483
484   type pthread_key_t is new int;
485
486end System.OS_Interface;
487