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 --
10 -- Copyright (C) 1991-2001, Florida State University --
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. It is --
31 -- now maintained by Ada Core Technologies Inc. in cooperation with Florida --
32 -- State University (http://www.gnat.com). --
34 ------------------------------------------------------------------------------
36 -- This is a DCE version of this package.
37 -- Currently HP-UX and SNI use this file
40 -- Turn off polling, we do not want ATC polling to take place during
41 -- tasking operations. It causes infinite loops and other problems.
43 -- This package encapsulates all direct interfaces to OS services
44 -- that are needed by children of System.
46 with Interfaces
.C
; use Interfaces
.C
;
48 package body System
.OS_Interface
is
54 function To_Duration
(TS
: timespec
) return Duration is
56 return Duration (TS
.tv_sec
) + Duration (TS
.tv_nsec
) / 10#
1#E9
;
63 function To_Timespec
(D
: Duration) return timespec
is
68 S
:= time_t
(Long_Long_Integer (D
));
69 F
:= D
- Duration (S
);
71 -- If F has negative value due to a round-up, adjust for positive F
78 return timespec
' (tv_sec => S,
79 tv_nsec => long (Long_Long_Integer (F * 10#1#E9)));
82 function To_Duration (TV : struct_timeval) return Duration is
84 return Duration (TV.tv_sec) + Duration (TV.tv_usec) / 10#1#E6;
87 function To_Timeval (D : Duration) return struct_timeval is
91 S := time_t (Long_Long_Integer (D));
92 F := D - Duration (S);
94 -- If F has negative value due to a round-up, adjust for positive F
102 return struct_timeval' (tv_sec
=> S
,
103 tv_usec
=> time_t
(Long_Long_Integer (F
* 10#
1#E6
)));
106 ---------------------------
107 -- POSIX.1c Section 3 --
108 ---------------------------
111 (set
: access sigset_t
;
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
136 ----------------------------
137 -- POSIX.1c Section 11 --
138 ----------------------------
140 -- For all the following functions, DCE Threads has a non standard
141 -- behavior: it sets errno but the standard Posix requires it to be
144 function pthread_mutexattr_init
145 (attr
: access pthread_mutexattr_t
)
148 function pthread_mutexattr_create
149 (attr
: access pthread_mutexattr_t
)
151 pragma Import
(C
, pthread_mutexattr_create
, "pthread_mutexattr_create");
154 if pthread_mutexattr_create
(attr
) /= 0 then
159 end pthread_mutexattr_init
;
161 function pthread_mutexattr_destroy
162 (attr
: access pthread_mutexattr_t
)
165 function pthread_mutexattr_delete
166 (attr
: access pthread_mutexattr_t
)
168 pragma Import
(C
, pthread_mutexattr_delete
, "pthread_mutexattr_delete");
171 if pthread_mutexattr_delete
(attr
) /= 0 then
176 end pthread_mutexattr_destroy
;
178 function pthread_mutex_init
179 (mutex
: access pthread_mutex_t
;
180 attr
: access pthread_mutexattr_t
)
183 function pthread_mutex_init_base
184 (mutex
: access pthread_mutex_t
;
185 attr
: pthread_mutexattr_t
)
187 pragma Import
(C
, pthread_mutex_init_base
, "pthread_mutex_init");
190 if pthread_mutex_init_base
(mutex
, attr
.all) /= 0 then
195 end pthread_mutex_init
;
197 function pthread_mutex_destroy
198 (mutex
: access pthread_mutex_t
)
201 function pthread_mutex_destroy_base
202 (mutex
: access pthread_mutex_t
)
204 pragma Import
(C
, pthread_mutex_destroy_base
, "pthread_mutex_destroy");
207 if pthread_mutex_destroy_base
(mutex
) /= 0 then
212 end pthread_mutex_destroy
;
214 function pthread_mutex_lock
215 (mutex
: access pthread_mutex_t
)
218 function pthread_mutex_lock_base
219 (mutex
: access pthread_mutex_t
)
221 pragma Import
(C
, pthread_mutex_lock_base
, "pthread_mutex_lock");
224 if pthread_mutex_lock_base
(mutex
) /= 0 then
229 end pthread_mutex_lock
;
231 function pthread_mutex_unlock
232 (mutex
: access pthread_mutex_t
)
235 function pthread_mutex_unlock_base
236 (mutex
: access pthread_mutex_t
)
238 pragma Import
(C
, pthread_mutex_unlock_base
, "pthread_mutex_unlock");
241 if pthread_mutex_unlock_base
(mutex
) /= 0 then
246 end pthread_mutex_unlock
;
248 function pthread_condattr_init
249 (attr
: access pthread_condattr_t
)
252 function pthread_condattr_create
253 (attr
: access pthread_condattr_t
)
255 pragma Import
(C
, pthread_condattr_create
, "pthread_condattr_create");
258 if pthread_condattr_create
(attr
) /= 0 then
263 end pthread_condattr_init
;
265 function pthread_condattr_destroy
266 (attr
: access pthread_condattr_t
)
269 function pthread_condattr_delete
270 (attr
: access pthread_condattr_t
)
272 pragma Import
(C
, pthread_condattr_delete
, "pthread_condattr_delete");
275 if pthread_condattr_delete
(attr
) /= 0 then
280 end pthread_condattr_destroy
;
282 function pthread_cond_init
283 (cond
: access pthread_cond_t
;
284 attr
: access pthread_condattr_t
)
287 function pthread_cond_init_base
288 (cond
: access pthread_cond_t
;
289 attr
: pthread_condattr_t
)
291 pragma Import
(C
, pthread_cond_init_base
, "pthread_cond_init");
294 if pthread_cond_init_base
(cond
, attr
.all) /= 0 then
299 end pthread_cond_init
;
301 function pthread_cond_destroy
302 (cond
: access pthread_cond_t
)
305 function pthread_cond_destroy_base
306 (cond
: access pthread_cond_t
)
308 pragma Import
(C
, pthread_cond_destroy_base
, "pthread_cond_destroy");
311 if pthread_cond_destroy_base
(cond
) /= 0 then
316 end pthread_cond_destroy
;
318 function pthread_cond_signal
319 (cond
: access pthread_cond_t
)
322 function pthread_cond_signal_base
323 (cond
: access pthread_cond_t
)
325 pragma Import
(C
, pthread_cond_signal_base
, "pthread_cond_signal");
328 if pthread_cond_signal_base
(cond
) /= 0 then
333 end pthread_cond_signal
;
335 function pthread_cond_wait
336 (cond
: access pthread_cond_t
;
337 mutex
: access pthread_mutex_t
)
340 function pthread_cond_wait_base
341 (cond
: access pthread_cond_t
;
342 mutex
: access pthread_mutex_t
)
344 pragma Import
(C
, pthread_cond_wait_base
, "pthread_cond_wait");
347 if pthread_cond_wait_base
(cond
, mutex
) /= 0 then
352 end pthread_cond_wait
;
354 function pthread_cond_timedwait
355 (cond
: access pthread_cond_t
;
356 mutex
: access pthread_mutex_t
;
357 abstime
: access timespec
)
360 function pthread_cond_timedwait_base
361 (cond
: access pthread_cond_t
;
362 mutex
: access pthread_mutex_t
;
363 abstime
: access timespec
)
365 pragma Import
(C
, pthread_cond_timedwait_base
, "pthread_cond_timedwait");
368 if pthread_cond_timedwait_base
(cond
, mutex
, abstime
) /= 0 then
369 if errno
= EAGAIN
then
377 end pthread_cond_timedwait
;
379 ----------------------------
380 -- POSIX.1c Section 13 --
381 ----------------------------
383 function pthread_setschedparam
386 param
: access struct_sched_param
) return int
388 function pthread_setscheduler
393 pragma Import
(C
, pthread_setscheduler
, "pthread_setscheduler");
396 if pthread_setscheduler
(thread
, policy
, param
.sched_priority
) = -1 then
401 end pthread_setschedparam
;
403 function sched_yield
return int
is
404 procedure pthread_yield
;
405 pragma Import
(C
, pthread_yield
, "pthread_yield");
411 -----------------------------
412 -- P1003.1c - Section 16 --
413 -----------------------------
415 function pthread_attr_init
(attributes
: access pthread_attr_t
) return int
417 function pthread_attr_create
418 (attributes
: access pthread_attr_t
)
420 pragma Import
(C
, pthread_attr_create
, "pthread_attr_create");
423 if pthread_attr_create
(attributes
) /= 0 then
428 end pthread_attr_init
;
430 function pthread_attr_destroy
431 (attributes
: access pthread_attr_t
) return int
433 function pthread_attr_delete
434 (attributes
: access pthread_attr_t
)
436 pragma Import
(C
, pthread_attr_delete
, "pthread_attr_delete");
439 if pthread_attr_delete
(attributes
) /= 0 then
444 end pthread_attr_destroy
;
446 function pthread_attr_setstacksize
447 (attr
: access pthread_attr_t
;
448 stacksize
: size_t
) return int
450 function pthread_attr_setstacksize_base
451 (attr
: access pthread_attr_t
;
454 pragma Import
(C
, pthread_attr_setstacksize_base
,
455 "pthread_attr_setstacksize");
458 if pthread_attr_setstacksize_base
(attr
, stacksize
) /= 0 then
463 end pthread_attr_setstacksize
;
465 function pthread_create
466 (thread
: access pthread_t
;
467 attributes
: access pthread_attr_t
;
468 start_routine
: Thread_Body
;
469 arg
: System
.Address
) return int
471 function pthread_create_base
472 (thread
: access pthread_t
;
473 attributes
: pthread_attr_t
;
474 start_routine
: Thread_Body
;
475 arg
: System
.Address
)
477 pragma Import
(C
, pthread_create_base
, "pthread_create");
480 if pthread_create_base
481 (thread
, attributes
.all, start_routine
, arg
) /= 0
489 ----------------------------
490 -- POSIX.1c Section 17 --
491 ----------------------------
493 function pthread_setspecific
494 (key
: pthread_key_t
;
495 value
: System
.Address
) return int
497 function pthread_setspecific_base
498 (key
: pthread_key_t
;
499 value
: System
.Address
) return int
;
500 pragma Import
(C
, pthread_setspecific_base
, "pthread_setspecific");
503 if pthread_setspecific_base
(key
, value
) /= 0 then
508 end pthread_setspecific
;
510 function pthread_getspecific
(key
: pthread_key_t
) return System
.Address
is
511 function pthread_getspecific_base
512 (key
: pthread_key_t
;
513 value
: access System
.Address
) return int
;
514 pragma Import
(C
, pthread_getspecific_base
, "pthread_getspecific");
515 Addr
: aliased System
.Address
;
518 if pthread_getspecific_base
(key
, Addr
'Access) /= 0 then
519 return System
.Null_Address
;
523 end pthread_getspecific
;
525 function pthread_key_create
526 (key
: access pthread_key_t
;
527 destructor
: destructor_pointer
) return int
529 function pthread_keycreate
530 (key
: access pthread_key_t
;
531 destructor
: destructor_pointer
) return int
;
532 pragma Import
(C
, pthread_keycreate
, "pthread_keycreate");
535 if pthread_keycreate
(key
, destructor
) /= 0 then
540 end pthread_key_create
;
542 function Get_Stack_Base
(thread
: pthread_t
) return Address
is
547 procedure pthread_init
is
552 function intr_attach
(sig
: int
; handler
: isr_address
) return long
is
553 function c_signal
(sig
: int
; handler
: isr_address
) return long
;
554 pragma Import
(C
, c_signal
, "signal");
557 return c_signal
(sig
, handler
);
560 end System
.OS_Interface
;