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) 1999-2006, Free Software Foundation, Inc. --
11 -- GNARL is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 2, or (at your option) any later ver- --
14 -- sion. GNARL is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNARL; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, USA. --
22 -- As a special exception, if other files instantiate generics from this --
23 -- unit, or you link this unit with other files to produce an executable, --
24 -- this unit does not by itself cause the resulting executable to be --
25 -- covered by the GNU General Public License. This exception does not --
26 -- however invalidate any other reasons why the executable file might be --
27 -- covered by the GNU Public License. --
29 -- GNARL was developed by the GNARL team at Florida State University. --
30 -- Extensive contributions were provided by Ada Core Technologies, Inc. --
32 ------------------------------------------------------------------------------
34 -- This is a LynxOS (Native) version of this package
37 -- Turn off polling, we do not want ATC polling to take place during
38 -- tasking operations. It causes infinite loops and other problems.
40 package body System
.OS_Interface
is
48 function clock_gettime
49 (clock_id
: clockid_t
;
53 function clock_gettime_base
54 (clock_id
: clockid_t
;
57 pragma Import
(C
, clock_gettime_base
, "clock_gettime");
60 if clock_gettime_base
(clock_id
, tp
) /= 0 then
71 function To_Duration
(TS
: timespec
) return Duration is
73 return Duration (TS
.tv_sec
) + Duration (TS
.tv_nsec
) / 10#
1#E9
;
76 function To_Duration
(TV
: struct_timeval
) return Duration is
78 return Duration (TV
.tv_sec
) + Duration (TV
.tv_usec
) / 10#
1#E6
;
81 ------------------------
82 -- To_Target_Priority --
83 ------------------------
85 function To_Target_Priority
86 (Prio
: System
.Any_Priority
) return Interfaces
.C
.int
89 return Interfaces
.C
.int
(Prio
);
90 end To_Target_Priority
;
96 function To_Timespec
(D
: Duration) return timespec
is
101 S
:= time_t
(Long_Long_Integer (D
));
102 F
:= D
- Duration (S
);
104 -- If F has negative value due to a round-up, adjust for positive F
112 return timespec
'(tv_sec => S,
113 tv_nsec => long (Long_Long_Integer (F * 10#1#E9)));
120 function To_Timeval (D : Duration) return struct_timeval is
125 S := time_t (Long_Long_Integer (D));
126 F := D - Duration (S);
128 -- If F has negative value due to a round-up, adjust for positive F
136 return struct_timeval'(tv_sec
=> S
,
137 tv_usec
=> time_t
(Long_Long_Integer (F
* 10#
1#E6
)));
140 -------------------------
141 -- POSIX.1c Section 3 --
142 -------------------------
145 (set
: access sigset_t
;
149 function sigwait_base
150 (set
: access sigset_t
;
151 value
: System
.Address
)
153 pragma Import
(C
, sigwait_base
, "sigwait");
156 sig
.all := sigwait_base
(set
, Null_Address
);
165 --------------------------
166 -- POSIX.1c Section 11 --
167 --------------------------
169 -- For all the following functions, LynxOS threads has the POSIX Draft 4
170 -- begavior; it sets errno but the standard Posix requires it to be
173 function pthread_mutexattr_init
174 (attr
: access pthread_mutexattr_t
)
177 function pthread_mutexattr_create
178 (attr
: access pthread_mutexattr_t
)
180 pragma Import
(C
, pthread_mutexattr_create
, "pthread_mutexattr_create");
183 if pthread_mutexattr_create
(attr
) /= 0 then
188 end pthread_mutexattr_init
;
190 function pthread_mutexattr_destroy
191 (attr
: access pthread_mutexattr_t
)
194 function pthread_mutexattr_delete
195 (attr
: access pthread_mutexattr_t
)
197 pragma Import
(C
, pthread_mutexattr_delete
, "pthread_mutexattr_delete");
200 if pthread_mutexattr_delete
(attr
) /= 0 then
205 end pthread_mutexattr_destroy
;
207 function pthread_mutex_init
208 (mutex
: access pthread_mutex_t
;
209 attr
: access pthread_mutexattr_t
)
212 function pthread_mutex_init_base
213 (mutex
: access pthread_mutex_t
;
214 attr
: pthread_mutexattr_t
)
216 pragma Import
(C
, pthread_mutex_init_base
, "pthread_mutex_init");
219 if pthread_mutex_init_base
(mutex
, attr
.all) /= 0 then
224 end pthread_mutex_init
;
226 function pthread_mutex_destroy
227 (mutex
: access pthread_mutex_t
)
230 function pthread_mutex_destroy_base
231 (mutex
: access pthread_mutex_t
)
233 pragma Import
(C
, pthread_mutex_destroy_base
, "pthread_mutex_destroy");
236 if pthread_mutex_destroy_base
(mutex
) /= 0 then
241 end pthread_mutex_destroy
;
243 function pthread_mutex_lock
244 (mutex
: access pthread_mutex_t
)
247 function pthread_mutex_lock_base
248 (mutex
: access pthread_mutex_t
)
250 pragma Import
(C
, pthread_mutex_lock_base
, "pthread_mutex_lock");
253 if pthread_mutex_lock_base
(mutex
) /= 0 then
258 end pthread_mutex_lock
;
260 function pthread_mutex_unlock
261 (mutex
: access pthread_mutex_t
)
264 function pthread_mutex_unlock_base
265 (mutex
: access pthread_mutex_t
)
267 pragma Import
(C
, pthread_mutex_unlock_base
, "pthread_mutex_unlock");
270 if pthread_mutex_unlock_base
(mutex
) /= 0 then
275 end pthread_mutex_unlock
;
277 function pthread_condattr_init
278 (attr
: access pthread_condattr_t
)
281 function pthread_condattr_create
282 (attr
: access pthread_condattr_t
)
284 pragma Import
(C
, pthread_condattr_create
, "pthread_condattr_create");
287 if pthread_condattr_create
(attr
) /= 0 then
292 end pthread_condattr_init
;
294 function pthread_condattr_destroy
295 (attr
: access pthread_condattr_t
)
298 function pthread_condattr_delete
299 (attr
: access pthread_condattr_t
)
301 pragma Import
(C
, pthread_condattr_delete
, "pthread_condattr_delete");
304 if pthread_condattr_delete
(attr
) /= 0 then
309 end pthread_condattr_destroy
;
311 function pthread_cond_init
312 (cond
: access pthread_cond_t
;
313 attr
: access pthread_condattr_t
)
316 function pthread_cond_init_base
317 (cond
: access pthread_cond_t
;
318 attr
: pthread_condattr_t
)
320 pragma Import
(C
, pthread_cond_init_base
, "pthread_cond_init");
323 if pthread_cond_init_base
(cond
, attr
.all) /= 0 then
328 end pthread_cond_init
;
330 function pthread_cond_destroy
331 (cond
: access pthread_cond_t
)
334 function pthread_cond_destroy_base
335 (cond
: access pthread_cond_t
)
337 pragma Import
(C
, pthread_cond_destroy_base
, "pthread_cond_destroy");
340 if pthread_cond_destroy_base
(cond
) /= 0 then
345 end pthread_cond_destroy
;
347 function pthread_cond_signal
348 (cond
: access pthread_cond_t
)
351 function pthread_cond_signal_base
352 (cond
: access pthread_cond_t
)
354 pragma Import
(C
, pthread_cond_signal_base
, "pthread_cond_signal");
357 if pthread_cond_signal_base
(cond
) /= 0 then
362 end pthread_cond_signal
;
364 function pthread_cond_wait
365 (cond
: access pthread_cond_t
;
366 mutex
: access pthread_mutex_t
)
369 function pthread_cond_wait_base
370 (cond
: access pthread_cond_t
;
371 mutex
: access pthread_mutex_t
)
373 pragma Import
(C
, pthread_cond_wait_base
, "pthread_cond_wait");
376 if pthread_cond_wait_base
(cond
, mutex
) /= 0 then
381 end pthread_cond_wait
;
383 function pthread_cond_timedwait
384 (cond
: access pthread_cond_t
;
385 mutex
: access pthread_mutex_t
;
386 reltime
: access timespec
) return int
388 function pthread_cond_timedwait_base
389 (cond
: access pthread_cond_t
;
390 mutex
: access pthread_mutex_t
;
391 reltime
: access timespec
) return int
;
392 pragma Import
(C
, pthread_cond_timedwait_base
, "pthread_cond_timedwait");
395 if pthread_cond_timedwait_base
(cond
, mutex
, reltime
) /= 0 then
396 if errno
= EAGAIN
then
404 end pthread_cond_timedwait
;
406 --------------------------
407 -- POSIX.1c Section 13 --
408 --------------------------
410 function pthread_setschedparam
413 param
: access struct_sched_param
)
416 function pthread_setscheduler
421 pragma Import
(C
, pthread_setscheduler
, "pthread_setscheduler");
424 if pthread_setscheduler
(thread
, policy
, param
.sched_priority
) = -1 then
429 end pthread_setschedparam
;
431 function pthread_mutexattr_setprotocol
432 (attr
: access pthread_mutexattr_t
;
436 pragma Unreferenced
(attr
, protocol
);
439 end pthread_mutexattr_setprotocol
;
441 function pthread_mutexattr_setprioceiling
442 (attr
: access pthread_mutexattr_t
;
446 pragma Unreferenced
(attr
, prioceiling
);
449 end pthread_mutexattr_setprioceiling
;
451 function pthread_attr_setscope
452 (attr
: access pthread_attr_t
;
453 contentionscope
: int
)
456 pragma Unreferenced
(attr
, contentionscope
);
459 end pthread_attr_setscope
;
461 function sched_yield
return int
is
462 procedure pthread_yield
;
463 pragma Import
(C
, pthread_yield
, "pthread_yield");
470 -----------------------------
471 -- P1003.1c - Section 16 --
472 -----------------------------
474 function pthread_attr_setdetachstate
475 (attr
: access pthread_attr_t
;
479 pragma Unreferenced
(attr
, detachstate
);
482 end pthread_attr_setdetachstate
;
484 function pthread_create
485 (thread
: access pthread_t
;
486 attributes
: access pthread_attr_t
;
487 start_routine
: Thread_Body
;
488 arg
: System
.Address
)
491 -- The LynxOS pthread_create doesn't seems to work.
492 -- Workaround : We're using st_new instead.
494 -- function pthread_create_base
495 -- (thread : access pthread_t;
496 -- attributes : pthread_attr_t;
497 -- start_routine : Thread_Body;
498 -- arg : System.Address)
500 -- pragma Import (C, pthread_create_base, "pthread_create");
502 St
: aliased st_t
:= attributes
.st
;
505 (start_routine
: Thread_Body
;
506 arg
: System
.Address
;
507 attributes
: access st_t
;
508 thread
: access pthread_t
)
510 pragma Import
(C
, st_new
, "st_new");
513 -- Following code would be used if above commented function worked
515 -- if pthread_create_base
516 -- (thread, attributes.all, start_routine, arg) /= 0 then
518 if st_new
(start_routine
, arg
, St
'Access, thread
) /= 0 then
525 function pthread_detach
(thread
: pthread_t
) return int
is
526 aliased_thread
: aliased pthread_t
:= thread
;
528 function pthread_detach_base
(thread
: access pthread_t
) return int
;
529 pragma Import
(C
, pthread_detach_base
, "pthread_detach");
532 if pthread_detach_base
(aliased_thread
'Access) /= 0 then
539 --------------------------
540 -- POSIX.1c Section 17 --
541 --------------------------
543 function pthread_setspecific
544 (key
: pthread_key_t
;
545 value
: System
.Address
)
548 function pthread_setspecific_base
549 (key
: pthread_key_t
;
550 value
: System
.Address
)
552 pragma Import
(C
, pthread_setspecific_base
, "pthread_setspecific");
555 if pthread_setspecific_base
(key
, value
) /= 0 then
560 end pthread_setspecific
;
562 function pthread_getspecific
(key
: pthread_key_t
) return System
.Address
is
563 procedure pthread_getspecific_base
564 (key
: pthread_key_t
;
565 value
: access System
.Address
);
566 pragma Import
(C
, pthread_getspecific_base
, "pthread_getspecific");
568 value
: aliased System
.Address
:= System
.Null_Address
;
571 pthread_getspecific_base
(key
, value
'Unchecked_Access);
573 end pthread_getspecific
;
575 function Get_Stack_Base
(thread
: pthread_t
) return Address
is
576 pragma Warnings
(Off
, thread
);
582 function pthread_key_create
583 (key
: access pthread_key_t
;
584 destructor
: destructor_pointer
)
587 function pthread_keycreate
588 (key
: access pthread_key_t
;
589 destructor
: destructor_pointer
)
591 pragma Import
(C
, pthread_keycreate
, "pthread_keycreate");
594 if pthread_keycreate
(key
, destructor
) /= 0 then
599 end pthread_key_create
;
601 procedure pthread_init
is
606 end System
.OS_Interface
;