pragma Polling (Off);
with Interfaces.C;
package body System.OS_Interface is
use Interfaces.C;
function To_Duration (TS : timespec) return Duration is
begin
return Duration (TS.tv_sec) + Duration (TS.tv_nsec) / 10#1#E9;
end To_Duration;
function To_Duration (TV : struct_timeval) return Duration is
begin
return Duration (TV.tv_sec) + Duration (TV.tv_usec) / 10#1#E6;
end To_Duration;
function To_Timespec (D : Duration) return timespec is
S : time_t;
F : Duration;
begin
S := time_t (Long_Long_Integer (D));
F := D - Duration (S);
if F < 0.0 then
S := S - 1;
F := F + 1.0;
end if;
return timespec'(tv_sec => S,
tv_nsec => long (Long_Long_Integer (F * 10#1#E9)));
end To_Timespec;
function To_Timeval (D : Duration) return struct_timeval is
S : long;
F : Duration;
begin
S := long (Long_Long_Integer (D));
F := D - Duration (S);
if F < 0.0 then
S := S - 1;
F := F + 1.0;
end if;
return
struct_timeval'
(tv_sec => S,
tv_usec => long (Long_Long_Integer (F * 10#1#E6)));
end To_Timeval;
function sigwait
(set : access sigset_t;
sig : access Signal) return int
is
Result : int;
function sigwait_base (set : access sigset_t) return int;
pragma Import (C, sigwait_base, "sigwait");
begin
Result := sigwait_base (set);
if Result = -1 then
sig.all := 0;
return errno;
end if;
sig.all := Signal (Result);
return 0;
end sigwait;
function pthread_mutex_lock (mutex : access pthread_mutex_t) return int is
function pthread_mutex_lock_base
(mutex : access pthread_mutex_t) return int;
pragma Import (C, pthread_mutex_lock_base, "pthread_mutex_lock");
Result : int;
begin
Result := pthread_mutex_lock_base (mutex);
if Result /= 0 then
return errno;
end if;
return 0;
end pthread_mutex_lock;
function pthread_mutex_unlock
(mutex : access pthread_mutex_t) return int
is
function pthread_mutex_unlock_base
(mutex : access pthread_mutex_t) return int;
pragma Import (C, pthread_mutex_unlock_base, "pthread_mutex_unlock");
Result : int;
begin
Result := pthread_mutex_unlock_base (mutex);
if Result /= 0 then
return errno;
end if;
return 0;
end pthread_mutex_unlock;
function pthread_cond_wait
(cond : access pthread_cond_t;
mutex : access pthread_mutex_t) return int
is
function pthread_cond_wait_base
(cond : access pthread_cond_t;
mutex : access pthread_mutex_t) return int;
pragma Import (C, pthread_cond_wait_base, "pthread_cond_wait");
Result : int;
begin
Result := pthread_cond_wait_base (cond, mutex);
if Result = EINTR then
return 0;
else
return Result;
end if;
end pthread_cond_wait;
function pthread_cond_timedwait
(cond : access pthread_cond_t;
mutex : access pthread_mutex_t;
abstime : access timespec) return int
is
function pthread_cond_timedwait_base
(cond : access pthread_cond_t;
mutex : access pthread_mutex_t;
abstime : access timespec) return int;
pragma Import (C, pthread_cond_timedwait_base, "pthread_cond_timedwait");
Result : int;
begin
Result := pthread_cond_timedwait_base (cond, mutex, abstime);
if Result = -1 then
if errno = EAGAIN then
return ETIMEDOUT;
else
return EINVAL;
end if;
end if;
return 0;
end pthread_cond_timedwait;
function pthread_setschedparam
(thread : pthread_t;
policy : int;
param : access struct_sched_param) return int
is
function pthread_setschedattr
(thread : pthread_t;
attr : pthread_attr_t) return int;
pragma Import (C, pthread_setschedattr, "pthread_setschedattr");
attr : aliased pthread_attr_t;
Result : int;
begin
Result := pthread_attr_init (attr'Access);
if Result /= 0 then
return Result;
end if;
attr.sched := policy;
attr.prio := param.sched_priority;
Result := pthread_setschedattr (thread, attr);
if Result /= 0 then
return Result;
end if;
Result := pthread_attr_destroy (attr'Access);
if Result /= 0 then
return Result;
else
return 0;
end if;
end pthread_setschedparam;
function pthread_getspecific (key : pthread_key_t) return System.Address is
function pthread_getspecific_base
(key : pthread_key_t;
value : access System.Address) return int;
pragma Import (C, pthread_getspecific_base, "pthread_getspecific");
Tmp : aliased System.Address;
Result : int;
begin
Result := pthread_getspecific_base (key, Tmp'Access);
if Result /= 0 then
return System.Null_Address;
end if;
return Tmp;
end pthread_getspecific;
function pthread_attr_setdetachstate
(attr : access pthread_attr_t;
detachstate : int) return int
is
function pthread_attr_setdetachstate_base
(attr : access pthread_attr_t;
detachstate : access int) return int;
pragma Import
(C, pthread_attr_setdetachstate_base, "pthread_attr_setdetachstate");
Tmp : aliased int := detachstate;
begin
return pthread_attr_setdetachstate_base (attr, Tmp'Access);
end pthread_attr_setdetachstate;
function sched_yield return int is
procedure sched_yield_base (arg : System.Address);
pragma Import (C, sched_yield_base, "pthread_yield");
begin
sched_yield_base (System.Null_Address);
return 0;
end sched_yield;
function Get_Stack_Base (thread : pthread_t) return Address is
begin
return thread.stack_base;
end Get_Stack_Base;
end System.OS_Interface;