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 --
11 -- Copyright (C) 1991-2001, Florida State University --
13 -- GNARL is free software; you can redistribute it and/or modify it under --
14 -- terms of the GNU General Public License as published by the Free Soft- --
15 -- ware Foundation; either version 2, or (at your option) any later ver- --
16 -- sion. GNARL is distributed in the hope that it will be useful, but WITH- --
17 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
18 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
19 -- for more details. You should have received a copy of the GNU General --
20 -- Public License distributed with GNARL; see file COPYING. If not, write --
21 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
22 -- MA 02111-1307, USA. --
24 -- As a special exception, if other files instantiate generics from this --
25 -- unit, or you link this unit with other files to produce an executable, --
26 -- this unit does not by itself cause the resulting executable to be --
27 -- covered by the GNU General Public License. This exception does not --
28 -- however invalidate any other reasons why the executable file might be --
29 -- covered by the GNU Public License. --
31 -- GNARL was developed by the GNARL team at Florida State University. It is --
32 -- now maintained by Ada Core Technologies Inc. in cooperation with Florida --
33 -- State University (http://www.gnat.com). --
35 ------------------------------------------------------------------------------
37 -- This is a DCE version of this package.
38 -- Currently HP-UX and SNI use this file
41 -- Turn off polling, we do not want ATC polling to take place during
42 -- tasking operations. It causes infinite loops and other problems.
44 -- This package encapsulates all direct interfaces to OS services
45 -- that are needed by children of System.
47 with Interfaces.C; use Interfaces.C;
49 package body System.OS_Interface is
55 function To_Duration (TS : timespec) return Duration is
57 return Duration (TS.tv_sec) + Duration (TS.tv_nsec) / 10#1#E9;
64 function To_Timespec (D : Duration) return timespec is
69 S := time_t (Long_Long_Integer (D));
70 F := D - Duration (S);
72 -- If F has negative value due to a round-up, adjust for positive F
79 return timespec' (tv_sec => S,
80 tv_nsec => long (Long_Long_Integer (F * 10#1#E9)));
83 function To_Duration (TV : struct_timeval) return Duration is
85 return Duration (TV.tv_sec) + Duration (TV.tv_usec) / 10#1#E6;
88 function To_Timeval (D : Duration) return struct_timeval is
92 S := time_t (Long_Long_Integer (D));
93 F := D - Duration (S);
95 -- If F has negative value due to a round-up, adjust for positive F
103 return struct_timeval' (tv_sec => S,
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
137 ----------------------------
138 -- POSIX.1c Section 11 --
139 ----------------------------
141 -- For all the following functions, DCE Threads has a non standard
142 -- behavior: it sets errno but the standard Posix requires it to be
145 function pthread_mutexattr_init
146 (attr : access pthread_mutexattr_t)
149 function pthread_mutexattr_create
150 (attr : access pthread_mutexattr_t)
152 pragma Import (C, pthread_mutexattr_create, "pthread_mutexattr_create");
155 if pthread_mutexattr_create (attr) /= 0 then
160 end pthread_mutexattr_init;
162 function pthread_mutexattr_destroy
163 (attr : access pthread_mutexattr_t)
166 function pthread_mutexattr_delete
167 (attr : access pthread_mutexattr_t)
169 pragma Import (C, pthread_mutexattr_delete, "pthread_mutexattr_delete");
172 if pthread_mutexattr_delete (attr) /= 0 then
177 end pthread_mutexattr_destroy;
179 function pthread_mutex_init
180 (mutex : access pthread_mutex_t;
181 attr : access pthread_mutexattr_t)
184 function pthread_mutex_init_base
185 (mutex : access pthread_mutex_t;
186 attr : pthread_mutexattr_t)
188 pragma Import (C, pthread_mutex_init_base, "pthread_mutex_init");
191 if pthread_mutex_init_base (mutex, attr.all) /= 0 then
196 end pthread_mutex_init;
198 function pthread_mutex_destroy
199 (mutex : access pthread_mutex_t)
202 function pthread_mutex_destroy_base
203 (mutex : access pthread_mutex_t)
205 pragma Import (C, pthread_mutex_destroy_base, "pthread_mutex_destroy");
208 if pthread_mutex_destroy_base (mutex) /= 0 then
213 end pthread_mutex_destroy;
215 function pthread_mutex_lock
216 (mutex : access pthread_mutex_t)
219 function pthread_mutex_lock_base
220 (mutex : access pthread_mutex_t)
222 pragma Import (C, pthread_mutex_lock_base, "pthread_mutex_lock");
225 if pthread_mutex_lock_base (mutex) /= 0 then
230 end pthread_mutex_lock;
232 function pthread_mutex_unlock
233 (mutex : access pthread_mutex_t)
236 function pthread_mutex_unlock_base
237 (mutex : access pthread_mutex_t)
239 pragma Import (C, pthread_mutex_unlock_base, "pthread_mutex_unlock");
242 if pthread_mutex_unlock_base (mutex) /= 0 then
247 end pthread_mutex_unlock;
249 function pthread_condattr_init
250 (attr : access pthread_condattr_t)
253 function pthread_condattr_create
254 (attr : access pthread_condattr_t)
256 pragma Import (C, pthread_condattr_create, "pthread_condattr_create");
259 if pthread_condattr_create (attr) /= 0 then
264 end pthread_condattr_init;
266 function pthread_condattr_destroy
267 (attr : access pthread_condattr_t)
270 function pthread_condattr_delete
271 (attr : access pthread_condattr_t)
273 pragma Import (C, pthread_condattr_delete, "pthread_condattr_delete");
276 if pthread_condattr_delete (attr) /= 0 then
281 end pthread_condattr_destroy;
283 function pthread_cond_init
284 (cond : access pthread_cond_t;
285 attr : access pthread_condattr_t)
288 function pthread_cond_init_base
289 (cond : access pthread_cond_t;
290 attr : pthread_condattr_t)
292 pragma Import (C, pthread_cond_init_base, "pthread_cond_init");
295 if pthread_cond_init_base (cond, attr.all) /= 0 then
300 end pthread_cond_init;
302 function pthread_cond_destroy
303 (cond : access pthread_cond_t)
306 function pthread_cond_destroy_base
307 (cond : access pthread_cond_t)
309 pragma Import (C, pthread_cond_destroy_base, "pthread_cond_destroy");
312 if pthread_cond_destroy_base (cond) /= 0 then
317 end pthread_cond_destroy;
319 function pthread_cond_signal
320 (cond : access pthread_cond_t)
323 function pthread_cond_signal_base
324 (cond : access pthread_cond_t)
326 pragma Import (C, pthread_cond_signal_base, "pthread_cond_signal");
329 if pthread_cond_signal_base (cond) /= 0 then
334 end pthread_cond_signal;
336 function pthread_cond_wait
337 (cond : access pthread_cond_t;
338 mutex : access pthread_mutex_t)
341 function pthread_cond_wait_base
342 (cond : access pthread_cond_t;
343 mutex : access pthread_mutex_t)
345 pragma Import (C, pthread_cond_wait_base, "pthread_cond_wait");
348 if pthread_cond_wait_base (cond, mutex) /= 0 then
353 end pthread_cond_wait;
355 function pthread_cond_timedwait
356 (cond : access pthread_cond_t;
357 mutex : access pthread_mutex_t;
358 abstime : access timespec)
361 function pthread_cond_timedwait_base
362 (cond : access pthread_cond_t;
363 mutex : access pthread_mutex_t;
364 abstime : access timespec)
366 pragma Import (C, pthread_cond_timedwait_base, "pthread_cond_timedwait");
369 if pthread_cond_timedwait_base (cond, mutex, abstime) /= 0 then
370 if errno = EAGAIN then
378 end pthread_cond_timedwait;
380 ----------------------------
381 -- POSIX.1c Section 13 --
382 ----------------------------
384 function pthread_setschedparam
387 param : access struct_sched_param) return int
389 function pthread_setscheduler
394 pragma Import (C, pthread_setscheduler, "pthread_setscheduler");
397 if pthread_setscheduler (thread, policy, param.sched_priority) = -1 then
402 end pthread_setschedparam;
404 function sched_yield return int is
405 procedure pthread_yield;
406 pragma Import (C, pthread_yield, "pthread_yield");
412 -----------------------------
413 -- P1003.1c - Section 16 --
414 -----------------------------
416 function pthread_attr_init (attributes : access pthread_attr_t) return int
418 function pthread_attr_create
419 (attributes : access pthread_attr_t)
421 pragma Import (C, pthread_attr_create, "pthread_attr_create");
424 if pthread_attr_create (attributes) /= 0 then
429 end pthread_attr_init;
431 function pthread_attr_destroy
432 (attributes : access pthread_attr_t) return int
434 function pthread_attr_delete
435 (attributes : access pthread_attr_t)
437 pragma Import (C, pthread_attr_delete, "pthread_attr_delete");
440 if pthread_attr_delete (attributes) /= 0 then
445 end pthread_attr_destroy;
447 function pthread_attr_setstacksize
448 (attr : access pthread_attr_t;
449 stacksize : size_t) return int
451 function pthread_attr_setstacksize_base
452 (attr : access pthread_attr_t;
455 pragma Import (C, pthread_attr_setstacksize_base,
456 "pthread_attr_setstacksize");
459 if pthread_attr_setstacksize_base (attr, stacksize) /= 0 then
464 end pthread_attr_setstacksize;
466 function pthread_create
467 (thread : access pthread_t;
468 attributes : access pthread_attr_t;
469 start_routine : Thread_Body;
470 arg : System.Address) return int
472 function pthread_create_base
473 (thread : access pthread_t;
474 attributes : pthread_attr_t;
475 start_routine : Thread_Body;
476 arg : System.Address)
478 pragma Import (C, pthread_create_base, "pthread_create");
481 if pthread_create_base
482 (thread, attributes.all, start_routine, arg) /= 0
490 ----------------------------
491 -- POSIX.1c Section 17 --
492 ----------------------------
494 function pthread_setspecific
495 (key : pthread_key_t;
496 value : System.Address) return int
498 function pthread_setspecific_base
499 (key : pthread_key_t;
500 value : System.Address) return int;
501 pragma Import (C, pthread_setspecific_base, "pthread_setspecific");
504 if pthread_setspecific_base (key, value) /= 0 then
509 end pthread_setspecific;
511 function pthread_getspecific (key : pthread_key_t) return System.Address is
512 function pthread_getspecific_base
513 (key : pthread_key_t;
514 value : access System.Address) return int;
515 pragma Import (C, pthread_getspecific_base, "pthread_getspecific");
516 Addr : aliased System.Address;
519 if pthread_getspecific_base (key, Addr'Access) /= 0 then
520 return System.Null_Address;
524 end pthread_getspecific;
526 function pthread_key_create
527 (key : access pthread_key_t;
528 destructor : destructor_pointer) return int
530 function pthread_keycreate
531 (key : access pthread_key_t;
532 destructor : destructor_pointer) return int;
533 pragma Import (C, pthread_keycreate, "pthread_keycreate");
536 if pthread_keycreate (key, destructor) /= 0 then
541 end pthread_key_create;
543 function Get_Stack_Base (thread : pthread_t) return Address is
548 procedure pthread_init is
553 function intr_attach (sig : int; handler : isr_address) return long is
554 function c_signal (sig : int; handler : isr_address) return long;
555 pragma Import (C, c_signal, "signal");
558 return c_signal (sig, handler);
561 end System.OS_Interface;