1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
5 -- S Y S T E M . O S _ I N T E R F A C E --
9 -- Copyright (C) 1991-1994, Florida State University --
10 -- Copyright (C) 1995-2008, Free Software Foundation, Inc. --
12 -- GNARL 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 2, or (at your option) any later ver- --
15 -- sion. GNARL 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. See the GNU General Public License --
18 -- for more details. You should have received a copy of the GNU General --
19 -- Public License distributed with GNARL; see file COPYING. If not, write --
20 -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
21 -- Boston, MA 02110-1301, USA. --
23 -- As a special exception, if other files instantiate generics from this --
24 -- unit, or you link this unit with other files to produce an executable, --
25 -- this unit does not by itself cause the resulting executable to be --
26 -- covered by the GNU General Public License. This exception does not --
27 -- however invalidate any other reasons why the executable file might be --
28 -- covered by the GNU Public License. --
30 -- GNARL was developed by the GNARL team at Florida State University. --
31 -- Extensive contributions were provided by Ada Core Technologies, Inc. --
33 ------------------------------------------------------------------------------
35 -- This is a LynxOS (Native) version of this package
37 -- This package encapsulates all direct interfaces to OS services
38 -- that are needed by the tasking run-time (libgnarl).
40 -- PLEASE DO NOT add any with-clauses to this package or remove the pragma
41 -- Preelaborate. This package is designed to be a bottom-level (leaf) package.
43 with Ada.Unchecked_Conversion;
47 package System.OS_Interface is
50 pragma Linker_Options ("-mthreads");
52 subtype int is Interfaces.C.int;
53 subtype char is Interfaces.C.char;
54 subtype short is Interfaces.C.short;
55 subtype long is Interfaces.C.long;
56 subtype unsigned is Interfaces.C.unsigned;
57 subtype unsigned_short is Interfaces.C.unsigned_short;
58 subtype unsigned_long is Interfaces.C.unsigned_long;
59 subtype unsigned_char is Interfaces.C.unsigned_char;
60 subtype plain_char is Interfaces.C.plain_char;
61 subtype size_t is Interfaces.C.size_t;
67 function errno return int;
68 pragma Import (C, errno, "__get_errno");
70 EAGAIN : constant := 11;
71 EINTR : constant := 4;
72 EINVAL : constant := 22;
73 ENOMEM : constant := 12;
74 ETIMEDOUT : constant := 60;
80 Max_Interrupt : constant := 63;
81 type Signal is new int range 0 .. Max_Interrupt;
82 for Signal'Size use int'Size;
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 SIGBRK : constant := 6; -- break
90 SIGIOT : constant := 6; -- IOT instruction
91 SIGABRT : constant := 6; -- used by abort, replace SIGIOT in the future
92 SIGCORE : constant := 7; -- kill with core dump
93 SIGEMT : constant := 7; -- EMT instruction
94 SIGFPE : constant := 8; -- floating point exception
95 SIGKILL : constant := 9; -- kill (cannot be caught or ignored)
96 SIGBUS : constant := 10; -- bus error
97 SIGSEGV : constant := 11; -- segmentation violation
98 SIGSYS : constant := 12; -- bad argument to system call
99 SIGPIPE : constant := 13; -- write on a pipe with no one to read it
100 SIGALRM : constant := 14; -- alarm clock
101 SIGTERM : constant := 15; -- software termination signal from kill
102 SIGURG : constant := 16; -- urgent condition on IO channel
103 SIGSTOP : constant := 17; -- stop (cannot be caught or ignored)
104 SIGTSTP : constant := 18; -- user stop requested from tty
105 SIGCONT : constant := 19; -- stopped process has been continued
106 SIGCLD : constant := 20; -- alias for SIGCHLD
107 SIGCHLD : constant := 20; -- child status change
108 SIGTTIN : constant := 21; -- background tty read attempted
109 SIGTTOU : constant := 22; -- background tty write attempted
110 SIGIO : constant := 23; -- I/O possible (Solaris SIGPOLL alias)
111 SIGPOLL : constant := 23; -- pollable event occurred
112 SIGXCPU : constant := 24; -- CPU time limit exceeded
113 SIGXFSZ : constant := 25; -- filesize limit exceeded
114 SIGVTALRM : constant := 26; -- virtual timer expired
115 SIGPROF : constant := 27; -- profiling timer expired
116 SIGWINCH : constant := 28; -- window size change
117 SIGLOST : constant := 29; -- SUN 4.1 compatibility
118 SIGUSR1 : constant := 30; -- user defined signal 1
119 SIGUSR2 : constant := 31; -- user defined signal 2
120 SIGPRIO : constant := 32; -- sent to a process with its priority or
123 SIGADAABORT : constant := SIGABRT;
124 -- Change this if you want to use another signal for task abort.
125 -- SIGTERM might be a good one.
127 type Signal_Set is array (Natural range <>) of Signal;
129 Unmasked : constant Signal_Set :=
130 (SIGTRAP, SIGTTIN, SIGTTOU, SIGTSTP, SIGPROF);
131 Reserved : constant Signal_Set := (SIGABRT, SIGKILL, SIGSTOP, SIGPRIO);
133 type sigset_t is private;
135 function sigaddset (set : access sigset_t; sig : Signal) return int;
136 pragma Import (C, sigaddset, "sigaddset");
138 function sigdelset (set : access sigset_t; sig : Signal) return int;
139 pragma Import (C, sigdelset, "sigdelset");
141 function sigfillset (set : access sigset_t) return int;
142 pragma Import (C, sigfillset, "sigfillset");
144 function sigismember (set : access sigset_t; sig : Signal) return int;
145 pragma Import (C, sigismember, "sigismember");
147 function sigemptyset (set : access sigset_t) return int;
148 pragma Import (C, sigemptyset, "sigemptyset");
150 type struct_sigaction is record
151 sa_handler : System.Address;
155 pragma Convention (C, struct_sigaction);
156 type struct_sigaction_ptr is access all struct_sigaction;
158 SA_SIGINFO : constant := 16#80#;
160 SIG_BLOCK : constant := 0;
161 SIG_UNBLOCK : constant := 1;
162 SIG_SETMASK : constant := 2;
164 SIG_DFL : constant := 0;
165 SIG_IGN : constant := 1;
169 act : struct_sigaction_ptr;
170 oact : struct_sigaction_ptr) return int;
171 pragma Import (C, sigaction, "sigaction");
177 Time_Slice_Supported : constant Boolean := True;
178 -- Indicates wether time slicing is supported
180 type timespec is private;
182 type clockid_t is private;
184 CLOCK_REALTIME : constant clockid_t;
186 function clock_gettime
187 (clock_id : clockid_t;
188 tp : access timespec) return int;
189 pragma Inline (clock_gettime);
190 -- LynxOS has non standard clock_gettime
192 function To_Duration (TS : timespec) return Duration;
193 pragma Inline (To_Duration);
195 function To_Timespec (D : Duration) return timespec;
196 pragma Inline (To_Timespec);
198 type struct_timezone is record
199 tz_minuteswest : int;
202 pragma Convention (C, struct_timezone);
203 type struct_timezone_ptr is access all struct_timezone;
205 -------------------------
206 -- Priority Scheduling --
207 -------------------------
209 SCHED_FIFO : constant := 16#00200000#;
210 SCHED_RR : constant := 16#00100000#;
211 SCHED_OTHER : constant := 16#00400000#;
213 function To_Target_Priority
214 (Prio : System.Any_Priority) return Interfaces.C.int;
215 -- Maps System.Any_Priority to a POSIX priority
221 type pid_t is private;
223 function kill (pid : pid_t; sig : Signal) return int;
224 pragma Import (C, kill, "kill");
226 function getpid return pid_t;
227 pragma Import (C, getpid, "getpid");
233 function lwp_self return System.Address;
234 -- lwp_self does not exist on this thread library, revert to pthread_self
235 -- which is the closest approximation (with getpid). This function is
236 -- needed to share 7staprop.adb across POSIX-like targets.
237 pragma Import (C, lwp_self, "pthread_self");
243 type Thread_Body is access
244 function (arg : System.Address) return System.Address;
245 pragma Convention (C, Thread_Body);
247 function Thread_Body_Access is new
248 Ada.Unchecked_Conversion (System.Address, Thread_Body);
250 type pthread_t is private;
251 subtype Thread_Id is pthread_t;
253 type pthread_mutex_t is limited private;
254 type pthread_cond_t is limited private;
255 type st_t is limited private;
256 type pthread_attr_t is limited private;
257 type pthread_mutexattr_t is limited private;
258 type pthread_condattr_t is limited private;
259 type pthread_key_t is private;
261 PTHREAD_CREATE_DETACHED : constant := 0;
263 PTHREAD_SCOPE_PROCESS : constant := 0;
264 PTHREAD_SCOPE_SYSTEM : constant := 1;
270 Stack_Base_Available : constant Boolean := False;
271 -- Indicates wether the stack base is available on this target
273 function Get_Stack_Base (thread : pthread_t) return Address;
274 pragma Inline (Get_Stack_Base);
275 -- returns the stack base of the specified thread.
276 -- Only call this function when Stack_Base_Available is True.
278 function Get_Page_Size return size_t;
279 function Get_Page_Size return Address;
280 pragma Import (C, Get_Page_Size, "getpagesize");
281 -- returns the size of a page, or 0 if this is not relevant on this
284 PROT_NONE : constant := 0;
285 PROT_READ : constant := 1;
286 PROT_WRITE : constant := 2;
287 PROT_EXEC : constant := 4;
288 PROT_USER : constant := 8;
289 PROT_ALL : constant := PROT_READ + PROT_WRITE + PROT_EXEC + PROT_USER;
291 PROT_ON : constant := PROT_READ;
292 PROT_OFF : constant := PROT_ALL;
294 function mprotect (addr : Address; len : size_t; prot : int) return int;
295 pragma Import (C, mprotect);
297 -------------------------
298 -- POSIX.1c Section 3 --
299 -------------------------
302 (set : access sigset_t;
303 sig : access Signal) return int;
304 pragma Inline (sigwait);
305 -- LynxOS has non standard sigwait
307 function pthread_kill (thread : pthread_t; sig : Signal) return int;
308 pragma Import (C, pthread_kill, "pthread_kill");
310 function pthread_sigmask
312 set : access sigset_t;
313 oset : access sigset_t) return int;
314 pragma Import (C, pthread_sigmask, "sigprocmask");
316 --------------------------
317 -- POSIX.1c Section 11 --
318 --------------------------
320 function pthread_mutexattr_init
321 (attr : access pthread_mutexattr_t) return int;
322 pragma Inline (pthread_mutexattr_init);
323 -- LynxOS has a nonstandard pthread_mutexattr_init
325 function pthread_mutexattr_destroy
326 (attr : access pthread_mutexattr_t) return int;
327 pragma Inline (pthread_mutexattr_destroy);
328 -- Lynxos has a nonstandard pthread_mutexattr_destroy
330 function pthread_mutex_init
331 (mutex : access pthread_mutex_t;
332 attr : access pthread_mutexattr_t) return int;
333 pragma Inline (pthread_mutex_init);
334 -- LynxOS has a nonstandard pthread_mutex_init
336 function pthread_mutex_destroy (mutex : access pthread_mutex_t) return int;
337 pragma Inline (pthread_mutex_destroy);
338 -- LynxOS has a nonstandard pthread_mutex_destroy
340 function pthread_mutex_lock (mutex : access pthread_mutex_t) return int;
341 pragma Inline (pthread_mutex_lock);
342 -- LynxOS has a nonstandard pthread_mutex_lock
344 function pthread_mutex_unlock (mutex : access pthread_mutex_t) return int;
345 pragma Inline (pthread_mutex_unlock);
346 -- LynxOS has a nonstandard pthread_mutex_unlock
348 function pthread_condattr_init
349 (attr : access pthread_condattr_t) return int;
350 pragma Inline (pthread_condattr_init);
351 -- LynxOS has a nonstandard pthread_condattr_init
353 function pthread_condattr_destroy
354 (attr : access pthread_condattr_t) return int;
355 pragma Inline (pthread_condattr_destroy);
356 -- LynxOS has a nonstandard pthread_condattr_destroy
358 function pthread_cond_init
359 (cond : access pthread_cond_t;
360 attr : access pthread_condattr_t) return int;
361 pragma Inline (pthread_cond_init);
362 -- LynxOS has a non standard pthread_cond_init
364 function pthread_cond_destroy (cond : access pthread_cond_t) return int;
365 pragma Inline (pthread_cond_destroy);
366 -- LynxOS has a nonstandard pthread_cond_destroy
368 function pthread_cond_signal (cond : access pthread_cond_t) return int;
369 pragma Inline (pthread_cond_signal);
370 -- LynxOS has a nonstandard pthread_cond_signal
372 function pthread_cond_wait
373 (cond : access pthread_cond_t;
374 mutex : access pthread_mutex_t) return int;
375 pragma Inline (pthread_cond_wait);
376 -- LynxOS has a nonstandard pthread_cond_wait
378 function pthread_cond_timedwait
379 (cond : access pthread_cond_t;
380 mutex : access pthread_mutex_t;
381 reltime : access timespec) return int;
382 pragma Inline (pthread_cond_timedwait);
383 -- LynxOS has a nonstandard pthrad_cond_timedwait
385 Relative_Timed_Wait : constant Boolean := True;
386 -- pthread_cond_timedwait requires a relative delay time
388 --------------------------
389 -- POSIX.1c Section 13 --
390 --------------------------
392 PTHREAD_PRIO_NONE : constant := 0;
393 PTHREAD_PRIO_INHERIT : constant := 0;
394 PTHREAD_PRIO_PROTECT : constant := 0;
396 type struct_sched_param is record
397 sched_priority : int; -- scheduling priority
400 function pthread_setschedparam
403 param : access struct_sched_param) return int;
404 pragma Inline (pthread_setschedparam);
405 -- LynxOS doesn't have pthread_setschedparam.
406 -- Instead, use pthread_setscheduler
408 function pthread_mutexattr_setprotocol
409 (attr : access pthread_mutexattr_t;
410 protocol : int) return int;
411 pragma Inline (pthread_mutexattr_setprotocol);
412 -- LynxOS doesn't have pthread_mutexattr_setprotocol
414 function pthread_mutexattr_setprioceiling
415 (attr : access pthread_mutexattr_t;
416 prioceiling : int) return int;
417 pragma Inline (pthread_mutexattr_setprioceiling);
418 -- LynxOS doesn't have pthread_mutexattr_setprioceiling
420 function pthread_attr_setscope
421 (attr : access pthread_attr_t;
422 contentionscope : int) return int;
423 -- LynxOS doesn't have pthread_attr_setscope: all threads have system scope
424 pragma Inline (pthread_attr_setscope);
426 function pthread_attr_setschedpolicy
427 (attr : access pthread_attr_t;
428 policy : int) return int;
429 pragma Import (C, pthread_attr_setschedpolicy, "pthread_attr_setsched");
431 function sched_yield return int;
432 -- pragma Import (C, sched_yield, "sched_yield");
433 pragma Inline (sched_yield);
435 ---------------------------
436 -- P1003.1c - Section 16 --
437 ---------------------------
439 function pthread_attr_init (attributes : access pthread_attr_t) return int;
440 pragma Import (C, pthread_attr_init, "pthread_attr_create");
442 function pthread_attr_destroy
443 (attributes : access pthread_attr_t) return int;
444 pragma Import (C, pthread_attr_destroy, "pthread_attr_delete");
446 function pthread_attr_setdetachstate
447 (attr : access pthread_attr_t;
448 detachstate : int) return int;
449 pragma Inline (pthread_attr_setdetachstate);
450 -- LynxOS doesn't have pthread_attr_setdetachstate
452 function pthread_attr_setstacksize
453 (attr : access pthread_attr_t;
454 stacksize : size_t) return int;
455 pragma Import (C, pthread_attr_setstacksize, "pthread_attr_setstacksize");
457 function pthread_create
458 (thread : access pthread_t;
459 attributes : access pthread_attr_t;
460 start_routine : Thread_Body;
461 arg : System.Address) return int;
462 pragma Inline (pthread_create);
463 -- LynxOS has a non standard pthread_create
465 function pthread_detach (thread : pthread_t) return int;
466 pragma Inline (pthread_detach);
468 procedure pthread_exit (status : System.Address);
469 pragma Import (C, pthread_exit, "pthread_exit");
471 function pthread_self return pthread_t;
472 pragma Import (C, pthread_self, "pthread_self");
474 --------------------------
475 -- POSIX.1c Section 17 --
476 --------------------------
478 function pthread_setspecific
479 (key : pthread_key_t;
480 value : System.Address) return int;
481 pragma Inline (pthread_setspecific);
482 -- LynxOS has a non standard pthread_setspecific
484 function pthread_getspecific (key : pthread_key_t) return System.Address;
485 pragma Inline (pthread_getspecific);
486 -- LynxOS has a non standard pthread_getspecific
488 type destructor_pointer is access procedure (arg : System.Address);
489 pragma Convention (C, destructor_pointer);
491 function pthread_key_create
492 (key : access pthread_key_t;
493 destructor : destructor_pointer) return int;
494 pragma Inline (pthread_key_create);
495 -- LynxOS has a non standard pthread_keycreate
497 procedure pthread_init;
498 -- This is a dummy procedure to share some GNULLI files
502 type sigbit_array is array (1 .. 2) of long;
503 type sigset_t is record
504 sa_sigbits : sigbit_array;
506 pragma Convention (C_Pass_By_Copy, sigset_t);
508 type pid_t is new long;
510 type time_t is new long;
512 type timespec is record
516 pragma Convention (C, timespec);
518 type clockid_t is new unsigned_char;
519 CLOCK_REALTIME : constant clockid_t := 0;
528 pragma Convention (C, st_t);
530 type pthread_attr_t is record
532 pthread_attr_scope : int; -- ignored
534 pragma Convention (C, pthread_attr_t);
536 type pthread_condattr_t is new int;
538 type pthread_mutexattr_t is new int;
540 type tid_t is new short;
541 type pthread_t is new tid_t;
543 type synch_ptr is access all pthread_mutex_t;
544 type pthread_mutex_t is record
550 pragma Convention (C, pthread_mutex_t);
552 type pthread_cond_t is new pthread_mutex_t;
554 type pthread_key_t is new int;
556 end System.OS_Interface;