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-2007, 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 ------------------------
77 -- To_Target_Priority --
78 ------------------------
80 function To_Target_Priority
81 (Prio : System.Any_Priority) return Interfaces.C.int
84 return Interfaces.C.int (Prio);
85 end To_Target_Priority;
91 function To_Timespec (D : Duration) return timespec is
96 S := time_t (Long_Long_Integer (D));
97 F := D - Duration (S);
99 -- If F has negative value due to a round-up, adjust for positive F
107 return timespec'(tv_sec => S,
108 tv_nsec => long (Long_Long_Integer (F * 10#1#E9)));
111 -------------------------
112 -- POSIX.1c Section 3 --
113 -------------------------
116 (set : access sigset_t;
120 function sigwait_base
121 (set : access sigset_t;
122 value : System.Address)
124 pragma Import (C, sigwait_base, "sigwait");
127 sig.all := sigwait_base (set, Null_Address);
136 --------------------------
137 -- POSIX.1c Section 11 --
138 --------------------------
140 -- For all the following functions, LynxOS threads has the POSIX Draft 4
141 -- begavior; 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 reltime : access timespec) return int
359 function pthread_cond_timedwait_base
360 (cond : access pthread_cond_t;
361 mutex : access pthread_mutex_t;
362 reltime : access timespec) return int;
363 pragma Import (C, pthread_cond_timedwait_base, "pthread_cond_timedwait");
366 if pthread_cond_timedwait_base (cond, mutex, reltime) /= 0 then
367 if errno = EAGAIN then
375 end pthread_cond_timedwait;
377 --------------------------
378 -- POSIX.1c Section 13 --
379 --------------------------
381 function pthread_setschedparam
384 param : access struct_sched_param)
387 function pthread_setscheduler
392 pragma Import (C, pthread_setscheduler, "pthread_setscheduler");
395 if pthread_setscheduler (thread, policy, param.sched_priority) = -1 then
400 end pthread_setschedparam;
402 function pthread_mutexattr_setprotocol
403 (attr : access pthread_mutexattr_t;
407 pragma Unreferenced (attr, protocol);
410 end pthread_mutexattr_setprotocol;
412 function pthread_mutexattr_setprioceiling
413 (attr : access pthread_mutexattr_t;
417 pragma Unreferenced (attr, prioceiling);
420 end pthread_mutexattr_setprioceiling;
422 function pthread_attr_setscope
423 (attr : access pthread_attr_t;
424 contentionscope : int)
427 pragma Unreferenced (attr, contentionscope);
430 end pthread_attr_setscope;
432 function sched_yield return int is
433 procedure pthread_yield;
434 pragma Import (C, pthread_yield, "pthread_yield");
441 -----------------------------
442 -- P1003.1c - Section 16 --
443 -----------------------------
445 function pthread_attr_setdetachstate
446 (attr : access pthread_attr_t;
450 pragma Unreferenced (attr, detachstate);
453 end pthread_attr_setdetachstate;
455 function pthread_create
456 (thread : access pthread_t;
457 attributes : access pthread_attr_t;
458 start_routine : Thread_Body;
459 arg : System.Address)
462 -- The LynxOS pthread_create doesn't seems to work.
463 -- Workaround : We're using st_new instead.
465 -- function pthread_create_base
466 -- (thread : access pthread_t;
467 -- attributes : pthread_attr_t;
468 -- start_routine : Thread_Body;
469 -- arg : System.Address)
471 -- pragma Import (C, pthread_create_base, "pthread_create");
473 St : aliased st_t := attributes.st;
476 (start_routine : Thread_Body;
477 arg : System.Address;
478 attributes : access st_t;
479 thread : access pthread_t)
481 pragma Import (C, st_new, "st_new");
484 -- Following code would be used if above commented function worked
486 -- if pthread_create_base
487 -- (thread, attributes.all, start_routine, arg) /= 0 then
489 if st_new (start_routine, arg, St'Access, thread) /= 0 then
496 function pthread_detach (thread : pthread_t) return int is
497 aliased_thread : aliased pthread_t := thread;
499 function pthread_detach_base (thread : access pthread_t) return int;
500 pragma Import (C, pthread_detach_base, "pthread_detach");
503 if pthread_detach_base (aliased_thread'Access) /= 0 then
510 --------------------------
511 -- POSIX.1c Section 17 --
512 --------------------------
514 function pthread_setspecific
515 (key : pthread_key_t;
516 value : System.Address)
519 function pthread_setspecific_base
520 (key : pthread_key_t;
521 value : System.Address)
523 pragma Import (C, pthread_setspecific_base, "pthread_setspecific");
526 if pthread_setspecific_base (key, value) /= 0 then
531 end pthread_setspecific;
533 function pthread_getspecific (key : pthread_key_t) return System.Address is
534 procedure pthread_getspecific_base
535 (key : pthread_key_t;
536 value : access System.Address);
537 pragma Import (C, pthread_getspecific_base, "pthread_getspecific");
539 value : aliased System.Address := System.Null_Address;
542 pthread_getspecific_base (key, value'Unchecked_Access);
544 end pthread_getspecific;
546 function Get_Stack_Base (thread : pthread_t) return Address is
547 pragma Warnings (Off, thread);
553 function pthread_key_create
554 (key : access pthread_key_t;
555 destructor : destructor_pointer)
558 function pthread_keycreate
559 (key : access pthread_key_t;
560 destructor : destructor_pointer)
562 pragma Import (C, pthread_keycreate, "pthread_keycreate");
565 if pthread_keycreate (key, destructor) /= 0 then
570 end pthread_key_create;
572 procedure pthread_init is
577 end System.OS_Interface;