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-2005, AdaCore --
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 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;
113 sig : access Signal) return int
118 Result := sigwait (set);
125 sig.all := Signal (Result);
129 -- DCE_THREADS does not have pthread_kill. Instead, we just ignore it.
131 function pthread_kill (thread : pthread_t; sig : Signal) return int is
132 pragma Unreferenced (thread, sig);
137 --------------------------
138 -- POSIX.1c Section 11 --
139 --------------------------
141 -- For all following functions, DCE Threads has a non standard behavior.
142 -- It sets errno but the standard Posix requires it to be returned.
144 function pthread_mutexattr_init
145 (attr : access pthread_mutexattr_t) return int
147 function pthread_mutexattr_create
148 (attr : access pthread_mutexattr_t) return int;
149 pragma Import (C, pthread_mutexattr_create, "pthread_mutexattr_create");
152 if pthread_mutexattr_create (attr) /= 0 then
157 end pthread_mutexattr_init;
159 function pthread_mutexattr_destroy
160 (attr : access pthread_mutexattr_t) return int
162 function pthread_mutexattr_delete
163 (attr : access pthread_mutexattr_t) return int;
164 pragma Import (C, pthread_mutexattr_delete, "pthread_mutexattr_delete");
167 if pthread_mutexattr_delete (attr) /= 0 then
172 end pthread_mutexattr_destroy;
174 function pthread_mutex_init
175 (mutex : access pthread_mutex_t;
176 attr : access pthread_mutexattr_t) return int
178 function pthread_mutex_init_base
179 (mutex : access pthread_mutex_t;
180 attr : pthread_mutexattr_t) return int;
181 pragma Import (C, pthread_mutex_init_base, "pthread_mutex_init");
184 if pthread_mutex_init_base (mutex, attr.all) /= 0 then
189 end pthread_mutex_init;
191 function pthread_mutex_destroy
192 (mutex : access pthread_mutex_t) return int
194 function pthread_mutex_destroy_base
195 (mutex : access pthread_mutex_t) return int;
196 pragma Import (C, pthread_mutex_destroy_base, "pthread_mutex_destroy");
199 if pthread_mutex_destroy_base (mutex) /= 0 then
204 end pthread_mutex_destroy;
206 function pthread_mutex_lock
207 (mutex : access pthread_mutex_t) return int
209 function pthread_mutex_lock_base
210 (mutex : access pthread_mutex_t) return int;
211 pragma Import (C, pthread_mutex_lock_base, "pthread_mutex_lock");
214 if pthread_mutex_lock_base (mutex) /= 0 then
219 end pthread_mutex_lock;
221 function pthread_mutex_unlock
222 (mutex : access pthread_mutex_t) return int
224 function pthread_mutex_unlock_base
225 (mutex : access pthread_mutex_t) return int;
226 pragma Import (C, pthread_mutex_unlock_base, "pthread_mutex_unlock");
229 if pthread_mutex_unlock_base (mutex) /= 0 then
234 end pthread_mutex_unlock;
236 function pthread_condattr_init
237 (attr : access pthread_condattr_t) return int
239 function pthread_condattr_create
240 (attr : access pthread_condattr_t) return int;
241 pragma Import (C, pthread_condattr_create, "pthread_condattr_create");
244 if pthread_condattr_create (attr) /= 0 then
249 end pthread_condattr_init;
251 function pthread_condattr_destroy
252 (attr : access pthread_condattr_t) return int
254 function pthread_condattr_delete
255 (attr : access pthread_condattr_t) return int;
256 pragma Import (C, pthread_condattr_delete, "pthread_condattr_delete");
259 if pthread_condattr_delete (attr) /= 0 then
264 end pthread_condattr_destroy;
266 function pthread_cond_init
267 (cond : access pthread_cond_t;
268 attr : access pthread_condattr_t) return int
270 function pthread_cond_init_base
271 (cond : access pthread_cond_t;
272 attr : pthread_condattr_t) return int;
273 pragma Import (C, pthread_cond_init_base, "pthread_cond_init");
276 if pthread_cond_init_base (cond, attr.all) /= 0 then
281 end pthread_cond_init;
283 function pthread_cond_destroy
284 (cond : access pthread_cond_t) return int
286 function pthread_cond_destroy_base
287 (cond : access pthread_cond_t) return int;
288 pragma Import (C, pthread_cond_destroy_base, "pthread_cond_destroy");
291 if pthread_cond_destroy_base (cond) /= 0 then
296 end pthread_cond_destroy;
298 function pthread_cond_signal
299 (cond : access pthread_cond_t) return int
301 function pthread_cond_signal_base
302 (cond : access pthread_cond_t) return int;
303 pragma Import (C, pthread_cond_signal_base, "pthread_cond_signal");
306 if pthread_cond_signal_base (cond) /= 0 then
311 end pthread_cond_signal;
313 function pthread_cond_wait
314 (cond : access pthread_cond_t;
315 mutex : access pthread_mutex_t) return int
317 function pthread_cond_wait_base
318 (cond : access pthread_cond_t;
319 mutex : access pthread_mutex_t) return int;
320 pragma Import (C, pthread_cond_wait_base, "pthread_cond_wait");
323 if pthread_cond_wait_base (cond, mutex) /= 0 then
328 end pthread_cond_wait;
330 function pthread_cond_timedwait
331 (cond : access pthread_cond_t;
332 mutex : access pthread_mutex_t;
333 abstime : access timespec) return int
335 function pthread_cond_timedwait_base
336 (cond : access pthread_cond_t;
337 mutex : access pthread_mutex_t;
338 abstime : access timespec) return int;
339 pragma Import (C, pthread_cond_timedwait_base, "pthread_cond_timedwait");
342 if pthread_cond_timedwait_base (cond, mutex, abstime) /= 0 then
343 if errno = EAGAIN then
351 end pthread_cond_timedwait;
353 ----------------------------
354 -- POSIX.1c Section 13 --
355 ----------------------------
357 function pthread_setschedparam
360 param : access struct_sched_param) return int
362 function pthread_setscheduler
365 priority : int) return int;
366 pragma Import (C, pthread_setscheduler, "pthread_setscheduler");
369 if pthread_setscheduler (thread, policy, param.sched_priority) = -1 then
374 end pthread_setschedparam;
376 function sched_yield return int is
377 procedure pthread_yield;
378 pragma Import (C, pthread_yield, "pthread_yield");
384 -----------------------------
385 -- P1003.1c - Section 16 --
386 -----------------------------
388 function pthread_attr_init
389 (attributes : access pthread_attr_t) return int
391 function pthread_attr_create
392 (attributes : access pthread_attr_t) return int;
393 pragma Import (C, pthread_attr_create, "pthread_attr_create");
396 if pthread_attr_create (attributes) /= 0 then
401 end pthread_attr_init;
403 function pthread_attr_destroy
404 (attributes : access pthread_attr_t) return int
406 function pthread_attr_delete
407 (attributes : access pthread_attr_t) return int;
408 pragma Import (C, pthread_attr_delete, "pthread_attr_delete");
411 if pthread_attr_delete (attributes) /= 0 then
416 end pthread_attr_destroy;
418 function pthread_attr_setstacksize
419 (attr : access pthread_attr_t;
420 stacksize : size_t) return int
422 function pthread_attr_setstacksize_base
423 (attr : access pthread_attr_t;
424 stacksize : size_t) return int;
425 pragma Import (C, pthread_attr_setstacksize_base,
426 "pthread_attr_setstacksize");
429 if pthread_attr_setstacksize_base (attr, stacksize) /= 0 then
434 end pthread_attr_setstacksize;
436 function pthread_create
437 (thread : access pthread_t;
438 attributes : access pthread_attr_t;
439 start_routine : Thread_Body;
440 arg : System.Address) return int
442 function pthread_create_base
443 (thread : access pthread_t;
444 attributes : pthread_attr_t;
445 start_routine : Thread_Body;
446 arg : System.Address) return int;
447 pragma Import (C, pthread_create_base, "pthread_create");
450 if pthread_create_base
451 (thread, attributes.all, start_routine, arg) /= 0
459 --------------------------
460 -- POSIX.1c Section 17 --
461 --------------------------
463 function pthread_setspecific
464 (key : pthread_key_t;
465 value : System.Address) return int
467 function pthread_setspecific_base
468 (key : pthread_key_t;
469 value : System.Address) return int;
470 pragma Import (C, pthread_setspecific_base, "pthread_setspecific");
473 if pthread_setspecific_base (key, value) /= 0 then
478 end pthread_setspecific;
480 function pthread_getspecific (key : pthread_key_t) return System.Address is
481 function pthread_getspecific_base
482 (key : pthread_key_t;
483 value : access System.Address) return int;
484 pragma Import (C, pthread_getspecific_base, "pthread_getspecific");
485 Addr : aliased System.Address;
488 if pthread_getspecific_base (key, Addr'Access) /= 0 then
489 return System.Null_Address;
493 end pthread_getspecific;
495 function pthread_key_create
496 (key : access pthread_key_t;
497 destructor : destructor_pointer) return int
499 function pthread_keycreate
500 (key : access pthread_key_t;
501 destructor : destructor_pointer) return int;
502 pragma Import (C, pthread_keycreate, "pthread_keycreate");
505 if pthread_keycreate (key, destructor) /= 0 then
510 end pthread_key_create;
512 function Get_Stack_Base (thread : pthread_t) return Address is
513 pragma Warnings (Off, thread);
518 procedure pthread_init is
523 function intr_attach (sig : int; handler : isr_address) return long is
524 function c_signal (sig : int; handler : isr_address) return long;
525 pragma Import (C, c_signal, "signal");
527 return c_signal (sig, handler);
530 end System.OS_Interface;