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
;