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-2023, AdaCore --
12 -- GNAT 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 3, or (at your option) any later ver- --
15 -- sion. GNAT 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. --
19 -- As a special exception under Section 7 of GPL version 3, you are granted --
20 -- additional permissions described in the GCC Runtime Library Exception, --
21 -- version 3.1, as published by the Free Software Foundation. --
23 -- You should have received a copy of the GNU General Public License and --
24 -- a copy of the GCC Runtime Library Exception along with this program; --
25 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
26 -- <http://www.gnu.org/licenses/>. --
28 -- GNARL was developed by the GNARL team at Florida State University. --
29 -- Extensive contributions were provided by Ada Core Technologies, Inc. --
31 ------------------------------------------------------------------------------
33 -- This is a DCE version of this package.
34 -- Currently HP-UX and SNI use this file
36 -- This package encapsulates all direct interfaces to OS services
37 -- that are needed by children of System.
39 with Interfaces
.C
; use Interfaces
.C
;
41 package body System
.OS_Interface
is
47 function To_Duration
(TS
: timespec
) return Duration is
49 return Duration (TS
.tv_sec
) + Duration (TS
.tv_nsec
) / 10#
1#E9
;
56 function To_Timespec
(D
: Duration) return timespec
is
61 S
:= time_t
(Long_Long_Integer (D
));
62 F
:= D
- Duration (S
);
64 -- If F has negative value due to a round-up, adjust for positive F
71 return timespec
'(tv_sec => S,
72 tv_nsec => long (Long_Long_Integer (F * 10#1#E9)));
75 -------------------------
76 -- POSIX.1c Section 3 --
77 -------------------------
80 (set : access sigset_t;
81 sig : access Signal) return int
86 Result := sigwait (set);
93 sig.all := Signal (Result);
97 -- DCE_THREADS does not have pthread_kill. Instead, we just ignore it
99 function pthread_kill (thread : pthread_t; sig : Signal) return int is
100 pragma Unreferenced (thread, sig);
105 --------------------------
106 -- POSIX.1c Section 11 --
107 --------------------------
109 -- For all following functions, DCE Threads has a non standard behavior.
110 -- It sets errno but the standard Posix requires it to be returned.
112 function pthread_mutexattr_init
113 (attr : access pthread_mutexattr_t) return int
115 function pthread_mutexattr_create
116 (attr : access pthread_mutexattr_t) return int;
117 pragma Import (C, pthread_mutexattr_create, "pthread_mutexattr_create");
120 if pthread_mutexattr_create (attr) /= 0 then
125 end pthread_mutexattr_init;
127 function pthread_mutexattr_destroy
128 (attr : access pthread_mutexattr_t) return int
130 function pthread_mutexattr_delete
131 (attr : access pthread_mutexattr_t) return int;
132 pragma Import (C, pthread_mutexattr_delete, "pthread_mutexattr_delete");
135 if pthread_mutexattr_delete (attr) /= 0 then
140 end pthread_mutexattr_destroy;
142 function pthread_mutex_init
143 (mutex : access pthread_mutex_t;
144 attr : access pthread_mutexattr_t) return int
146 function pthread_mutex_init_base
147 (mutex : access pthread_mutex_t;
148 attr : pthread_mutexattr_t) return int;
149 pragma Import (C, pthread_mutex_init_base, "pthread_mutex_init");
152 if pthread_mutex_init_base (mutex, attr.all) /= 0 then
157 end pthread_mutex_init;
159 function pthread_mutex_destroy
160 (mutex : access pthread_mutex_t) return int
162 function pthread_mutex_destroy_base
163 (mutex : access pthread_mutex_t) return int;
164 pragma Import (C, pthread_mutex_destroy_base, "pthread_mutex_destroy");
167 if pthread_mutex_destroy_base (mutex) /= 0 then
172 end pthread_mutex_destroy;
174 function pthread_mutex_lock
175 (mutex : access pthread_mutex_t) return int
177 function pthread_mutex_lock_base
178 (mutex : access pthread_mutex_t) return int;
179 pragma Import (C, pthread_mutex_lock_base, "pthread_mutex_lock");
182 if pthread_mutex_lock_base (mutex) /= 0 then
187 end pthread_mutex_lock;
189 function pthread_mutex_unlock
190 (mutex : access pthread_mutex_t) return int
192 function pthread_mutex_unlock_base
193 (mutex : access pthread_mutex_t) return int;
194 pragma Import (C, pthread_mutex_unlock_base, "pthread_mutex_unlock");
197 if pthread_mutex_unlock_base (mutex) /= 0 then
202 end pthread_mutex_unlock;
204 function pthread_condattr_init
205 (attr : access pthread_condattr_t) return int
207 function pthread_condattr_create
208 (attr : access pthread_condattr_t) return int;
209 pragma Import (C, pthread_condattr_create, "pthread_condattr_create");
212 if pthread_condattr_create (attr) /= 0 then
217 end pthread_condattr_init;
219 function pthread_condattr_destroy
220 (attr : access pthread_condattr_t) return int
222 function pthread_condattr_delete
223 (attr : access pthread_condattr_t) return int;
224 pragma Import (C, pthread_condattr_delete, "pthread_condattr_delete");
227 if pthread_condattr_delete (attr) /= 0 then
232 end pthread_condattr_destroy;
234 function pthread_cond_init
235 (cond : access pthread_cond_t;
236 attr : access pthread_condattr_t) return int
238 function pthread_cond_init_base
239 (cond : access pthread_cond_t;
240 attr : pthread_condattr_t) return int;
241 pragma Import (C, pthread_cond_init_base, "pthread_cond_init");
244 if pthread_cond_init_base (cond, attr.all) /= 0 then
249 end pthread_cond_init;
251 function pthread_cond_destroy
252 (cond : access pthread_cond_t) return int
254 function pthread_cond_destroy_base
255 (cond : access pthread_cond_t) return int;
256 pragma Import (C, pthread_cond_destroy_base, "pthread_cond_destroy");
259 if pthread_cond_destroy_base (cond) /= 0 then
264 end pthread_cond_destroy;
266 function pthread_cond_signal
267 (cond : access pthread_cond_t) return int
269 function pthread_cond_signal_base
270 (cond : access pthread_cond_t) return int;
271 pragma Import (C, pthread_cond_signal_base, "pthread_cond_signal");
274 if pthread_cond_signal_base (cond) /= 0 then
279 end pthread_cond_signal;
281 function pthread_cond_wait
282 (cond : access pthread_cond_t;
283 mutex : access pthread_mutex_t) return int
285 function pthread_cond_wait_base
286 (cond : access pthread_cond_t;
287 mutex : access pthread_mutex_t) return int;
288 pragma Import (C, pthread_cond_wait_base, "pthread_cond_wait");
291 if pthread_cond_wait_base (cond, mutex) /= 0 then
296 end pthread_cond_wait;
298 function pthread_cond_timedwait
299 (cond : access pthread_cond_t;
300 mutex : access pthread_mutex_t;
301 abstime : access timespec) return int
303 function pthread_cond_timedwait_base
304 (cond : access pthread_cond_t;
305 mutex : access pthread_mutex_t;
306 abstime : access timespec) return int;
307 pragma Import (C, pthread_cond_timedwait_base, "pthread_cond_timedwait");
310 if pthread_cond_timedwait_base (cond, mutex, abstime) /= 0 then
311 return (if errno = EAGAIN then ETIMEDOUT else errno);
315 end pthread_cond_timedwait;
317 ----------------------------
318 -- POSIX.1c Section 13 --
319 ----------------------------
321 function pthread_setschedparam
324 param : access struct_sched_param) return int
326 function pthread_setscheduler
329 priority : int) return int;
330 pragma Import (C, pthread_setscheduler, "pthread_setscheduler");
333 if pthread_setscheduler (thread, policy, param.sched_priority) = -1 then
338 end pthread_setschedparam;
340 function sched_yield return int is
341 procedure pthread_yield;
342 pragma Import (C, pthread_yield, "pthread_yield");
348 -----------------------------
349 -- P1003.1c - Section 16 --
350 -----------------------------
352 function pthread_attr_init
353 (attributes : access pthread_attr_t) return int
355 function pthread_attr_create
356 (attributes : access pthread_attr_t) return int;
357 pragma Import (C, pthread_attr_create, "pthread_attr_create");
360 if pthread_attr_create (attributes) /= 0 then
365 end pthread_attr_init;
367 function pthread_attr_destroy
368 (attributes : access pthread_attr_t) return int
370 function pthread_attr_delete
371 (attributes : access pthread_attr_t) return int;
372 pragma Import (C, pthread_attr_delete, "pthread_attr_delete");
375 if pthread_attr_delete (attributes) /= 0 then
380 end pthread_attr_destroy;
382 function pthread_attr_setstacksize
383 (attr : access pthread_attr_t;
384 stacksize : size_t) return int
386 function pthread_attr_setstacksize_base
387 (attr : access pthread_attr_t;
388 stacksize : size_t) return int;
389 pragma Import (C, pthread_attr_setstacksize_base,
390 "pthread_attr_setstacksize");
393 if pthread_attr_setstacksize_base (attr, stacksize) /= 0 then
398 end pthread_attr_setstacksize;
400 function pthread_create
401 (thread : access pthread_t;
402 attributes : access pthread_attr_t;
403 start_routine : Thread_Body;
404 arg : System.Address) return int
406 function pthread_create_base
407 (thread : access pthread_t;
408 attributes : pthread_attr_t;
409 start_routine : Thread_Body;
410 arg : System.Address) return int;
411 pragma Import (C, pthread_create_base, "pthread_create");
414 if pthread_create_base
415 (thread, attributes.all, start_routine, arg) /= 0
423 --------------------------
424 -- POSIX.1c Section 17 --
425 --------------------------
427 function pthread_setspecific
428 (key : pthread_key_t;
429 value : System.Address) return int
431 function pthread_setspecific_base
432 (key : pthread_key_t;
433 value : System.Address) return int;
434 pragma Import (C, pthread_setspecific_base, "pthread_setspecific");
437 if pthread_setspecific_base (key, value) /= 0 then
442 end pthread_setspecific;
444 function pthread_getspecific (key : pthread_key_t) return System.Address is
445 function pthread_getspecific_base
446 (key : pthread_key_t;
447 value : access System.Address) return int;
448 pragma Import (C, pthread_getspecific_base, "pthread_getspecific");
449 Addr : aliased System.Address;
452 if pthread_getspecific_base (key, Addr'Access) /= 0 then
453 return System.Null_Address;
457 end pthread_getspecific;
459 function pthread_key_create
460 (key : access pthread_key_t;
461 destructor : destructor_pointer) return int
463 function pthread_keycreate
464 (key : access pthread_key_t;
465 destructor : destructor_pointer) return int;
466 pragma Import (C, pthread_keycreate, "pthread_keycreate");
469 if pthread_keycreate (key, destructor) /= 0 then
474 end pthread_key_create;
476 function Get_Stack_Base (thread : pthread_t) return Address is
477 pragma Warnings (Off, thread);
482 procedure pthread_init is
487 function intr_attach (sig : int; handler : isr_address) return long is
488 function c_signal (sig : int; handler : isr_address) return long;
489 pragma Import (C, c_signal, "signal");
491 return c_signal (sig, handler);
494 end System.OS_Interface;