1 ------------------------------------------------------------------------------
3 -- GNU ADA 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-2003, Ada Core Technologies --
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, 59 Temple Place - Suite 330, Boston, --
21 -- MA 02111-1307, 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 DCE version of this package.
36 -- Currently HP-UX and SNI use this file
39 -- Turn off polling, we do not want ATC polling to take place during
40 -- tasking operations. It causes infinite loops and other problems.
42 -- This package encapsulates all direct interfaces to OS services
43 -- that are needed by children of System.
45 with Interfaces.C; use Interfaces.C;
47 package body System.OS_Interface is
53 function To_Duration (TS : timespec) return Duration is
55 return Duration (TS.tv_sec) + Duration (TS.tv_nsec) / 10#1#E9;
62 function To_Timespec (D : Duration) return timespec is
67 S := time_t (Long_Long_Integer (D));
68 F := D - Duration (S);
70 -- If F has negative value due to a round-up, adjust for positive F
77 return timespec'(tv_sec => S,
78 tv_nsec => long (Long_Long_Integer (F * 10#1#E9)));
81 function To_Duration (TV : struct_timeval) return Duration is
83 return Duration (TV.tv_sec) + Duration (TV.tv_usec) / 10#1#E6;
86 function To_Timeval (D : Duration) return struct_timeval is
90 S := time_t (Long_Long_Integer (D));
91 F := D - Duration (S);
93 -- If F has negative value due to a round-up, adjust for positive F
104 tv_usec => time_t (Long_Long_Integer (F * 10#1#E6)));
107 ---------------------------
108 -- POSIX.1c Section 3 --
109 ---------------------------
112 (set : access sigset_t;
119 Result := sigwait (set);
126 sig.all := Signal (Result);
130 -- DCE_THREADS does not have pthread_kill. Instead, we just ignore it.
132 function pthread_kill (thread : pthread_t; sig : Signal) return int is
133 pragma Unreferenced (thread, sig);
138 ----------------------------
139 -- POSIX.1c Section 11 --
140 ----------------------------
142 -- For all the following functions, DCE Threads has a non standard
143 -- behavior: it sets errno but the standard Posix requires it to be
146 function pthread_mutexattr_init
147 (attr : access pthread_mutexattr_t)
150 function pthread_mutexattr_create
151 (attr : access pthread_mutexattr_t)
153 pragma Import (C, pthread_mutexattr_create, "pthread_mutexattr_create");
156 if pthread_mutexattr_create (attr) /= 0 then
161 end pthread_mutexattr_init;
163 function pthread_mutexattr_destroy
164 (attr : access pthread_mutexattr_t)
167 function pthread_mutexattr_delete
168 (attr : access pthread_mutexattr_t)
170 pragma Import (C, pthread_mutexattr_delete, "pthread_mutexattr_delete");
173 if pthread_mutexattr_delete (attr) /= 0 then
178 end pthread_mutexattr_destroy;
180 function pthread_mutex_init
181 (mutex : access pthread_mutex_t;
182 attr : access pthread_mutexattr_t)
185 function pthread_mutex_init_base
186 (mutex : access pthread_mutex_t;
187 attr : pthread_mutexattr_t)
189 pragma Import (C, pthread_mutex_init_base, "pthread_mutex_init");
192 if pthread_mutex_init_base (mutex, attr.all) /= 0 then
197 end pthread_mutex_init;
199 function pthread_mutex_destroy
200 (mutex : access pthread_mutex_t)
203 function pthread_mutex_destroy_base
204 (mutex : access pthread_mutex_t)
206 pragma Import (C, pthread_mutex_destroy_base, "pthread_mutex_destroy");
209 if pthread_mutex_destroy_base (mutex) /= 0 then
214 end pthread_mutex_destroy;
216 function pthread_mutex_lock
217 (mutex : access pthread_mutex_t)
220 function pthread_mutex_lock_base
221 (mutex : access pthread_mutex_t)
223 pragma Import (C, pthread_mutex_lock_base, "pthread_mutex_lock");
226 if pthread_mutex_lock_base (mutex) /= 0 then
231 end pthread_mutex_lock;
233 function pthread_mutex_unlock
234 (mutex : access pthread_mutex_t)
237 function pthread_mutex_unlock_base
238 (mutex : access pthread_mutex_t)
240 pragma Import (C, pthread_mutex_unlock_base, "pthread_mutex_unlock");
243 if pthread_mutex_unlock_base (mutex) /= 0 then
248 end pthread_mutex_unlock;
250 function pthread_condattr_init
251 (attr : access pthread_condattr_t)
254 function pthread_condattr_create
255 (attr : access pthread_condattr_t)
257 pragma Import (C, pthread_condattr_create, "pthread_condattr_create");
260 if pthread_condattr_create (attr) /= 0 then
265 end pthread_condattr_init;
267 function pthread_condattr_destroy
268 (attr : access pthread_condattr_t)
271 function pthread_condattr_delete
272 (attr : access pthread_condattr_t)
274 pragma Import (C, pthread_condattr_delete, "pthread_condattr_delete");
277 if pthread_condattr_delete (attr) /= 0 then
282 end pthread_condattr_destroy;
284 function pthread_cond_init
285 (cond : access pthread_cond_t;
286 attr : access pthread_condattr_t)
289 function pthread_cond_init_base
290 (cond : access pthread_cond_t;
291 attr : pthread_condattr_t)
293 pragma Import (C, pthread_cond_init_base, "pthread_cond_init");
296 if pthread_cond_init_base (cond, attr.all) /= 0 then
301 end pthread_cond_init;
303 function pthread_cond_destroy
304 (cond : access pthread_cond_t)
307 function pthread_cond_destroy_base
308 (cond : access pthread_cond_t)
310 pragma Import (C, pthread_cond_destroy_base, "pthread_cond_destroy");
313 if pthread_cond_destroy_base (cond) /= 0 then
318 end pthread_cond_destroy;
320 function pthread_cond_signal
321 (cond : access pthread_cond_t)
324 function pthread_cond_signal_base
325 (cond : access pthread_cond_t)
327 pragma Import (C, pthread_cond_signal_base, "pthread_cond_signal");
330 if pthread_cond_signal_base (cond) /= 0 then
335 end pthread_cond_signal;
337 function pthread_cond_wait
338 (cond : access pthread_cond_t;
339 mutex : access pthread_mutex_t)
342 function pthread_cond_wait_base
343 (cond : access pthread_cond_t;
344 mutex : access pthread_mutex_t)
346 pragma Import (C, pthread_cond_wait_base, "pthread_cond_wait");
349 if pthread_cond_wait_base (cond, mutex) /= 0 then
354 end pthread_cond_wait;
356 function pthread_cond_timedwait
357 (cond : access pthread_cond_t;
358 mutex : access pthread_mutex_t;
359 abstime : access timespec)
362 function pthread_cond_timedwait_base
363 (cond : access pthread_cond_t;
364 mutex : access pthread_mutex_t;
365 abstime : access timespec)
367 pragma Import (C, pthread_cond_timedwait_base, "pthread_cond_timedwait");
370 if pthread_cond_timedwait_base (cond, mutex, abstime) /= 0 then
371 if errno = EAGAIN then
379 end pthread_cond_timedwait;
381 ----------------------------
382 -- POSIX.1c Section 13 --
383 ----------------------------
385 function pthread_setschedparam
388 param : access struct_sched_param) return int
390 function pthread_setscheduler
395 pragma Import (C, pthread_setscheduler, "pthread_setscheduler");
398 if pthread_setscheduler (thread, policy, param.sched_priority) = -1 then
403 end pthread_setschedparam;
405 function sched_yield return int is
406 procedure pthread_yield;
407 pragma Import (C, pthread_yield, "pthread_yield");
413 -----------------------------
414 -- P1003.1c - Section 16 --
415 -----------------------------
417 function pthread_attr_init (attributes : access pthread_attr_t) return int
419 function pthread_attr_create
420 (attributes : access pthread_attr_t)
422 pragma Import (C, pthread_attr_create, "pthread_attr_create");
425 if pthread_attr_create (attributes) /= 0 then
430 end pthread_attr_init;
432 function pthread_attr_destroy
433 (attributes : access pthread_attr_t) return int
435 function pthread_attr_delete
436 (attributes : access pthread_attr_t)
438 pragma Import (C, pthread_attr_delete, "pthread_attr_delete");
441 if pthread_attr_delete (attributes) /= 0 then
446 end pthread_attr_destroy;
448 function pthread_attr_setstacksize
449 (attr : access pthread_attr_t;
450 stacksize : size_t) return int
452 function pthread_attr_setstacksize_base
453 (attr : access pthread_attr_t;
456 pragma Import (C, pthread_attr_setstacksize_base,
457 "pthread_attr_setstacksize");
460 if pthread_attr_setstacksize_base (attr, stacksize) /= 0 then
465 end pthread_attr_setstacksize;
467 function pthread_create
468 (thread : access pthread_t;
469 attributes : access pthread_attr_t;
470 start_routine : Thread_Body;
471 arg : System.Address) return int
473 function pthread_create_base
474 (thread : access pthread_t;
475 attributes : pthread_attr_t;
476 start_routine : Thread_Body;
477 arg : System.Address)
479 pragma Import (C, pthread_create_base, "pthread_create");
482 if pthread_create_base
483 (thread, attributes.all, start_routine, arg) /= 0
491 ----------------------------
492 -- POSIX.1c Section 17 --
493 ----------------------------
495 function pthread_setspecific
496 (key : pthread_key_t;
497 value : System.Address) return int
499 function pthread_setspecific_base
500 (key : pthread_key_t;
501 value : System.Address) return int;
502 pragma Import (C, pthread_setspecific_base, "pthread_setspecific");
505 if pthread_setspecific_base (key, value) /= 0 then
510 end pthread_setspecific;
512 function pthread_getspecific (key : pthread_key_t) return System.Address is
513 function pthread_getspecific_base
514 (key : pthread_key_t;
515 value : access System.Address) return int;
516 pragma Import (C, pthread_getspecific_base, "pthread_getspecific");
517 Addr : aliased System.Address;
520 if pthread_getspecific_base (key, Addr'Access) /= 0 then
521 return System.Null_Address;
525 end pthread_getspecific;
527 function pthread_key_create
528 (key : access pthread_key_t;
529 destructor : destructor_pointer) return int
531 function pthread_keycreate
532 (key : access pthread_key_t;
533 destructor : destructor_pointer) return int;
534 pragma Import (C, pthread_keycreate, "pthread_keycreate");
537 if pthread_keycreate (key, destructor) /= 0 then
542 end pthread_key_create;
544 function Get_Stack_Base (thread : pthread_t) return Address is
545 pragma Warnings (Off, thread);
551 procedure pthread_init is
556 function intr_attach (sig : int; handler : isr_address) return long is
557 function c_signal (sig : int; handler : isr_address) return long;
558 pragma Import (C, c_signal, "signal");
561 return c_signal (sig, handler);
564 end System.OS_Interface;