pragma Polling (Off);
with Interfaces.C; use Interfaces.C;
with System.VxWorks;
with Unchecked_Conversion;
package body System.OS_Interface is
use System.VxWorks;
VX_UNBREAKABLE : constant := 16#0002#;
VX_FP_TASK : constant := 16#0008#;
VX_FP_PRIVATE_ENV : constant := 16#0080#;
VX_NO_STACK_FILL : constant := 16#0100#;
function taskSpawn
(name : System.Address; priority : int;
options : int;
stacksize : size_t;
start_routine : Thread_Body;
arg1 : System.Address;
arg2 : int := 0;
arg3 : int := 0;
arg4 : int := 0;
arg5 : int := 0;
arg6 : int := 0;
arg7 : int := 0;
arg8 : int := 0;
arg9 : int := 0;
arg10 : int := 0) return pthread_t;
pragma Import (C, taskSpawn, "taskSpawn");
procedure taskDelete (tid : pthread_t);
pragma Import (C, taskDelete, "taskDelete");
POSIX_SCHED_FIFO_LOW_PRI : constant := 0;
POSIX_SCHED_FIFO_HIGH_PRI : constant := 255;
POSIX_SCHED_RR_LOW_PRI : constant := 0;
POSIX_SCHED_RR_HIGH_PRI : constant := 255;
SCHED_FIFO_LOW_PRI : constant := 255;
SCHED_FIFO_HIGH_PRI : constant := 0;
SCHED_RR_LOW_PRI : constant := 255;
SCHED_RR_HIGH_PRI : constant := 0;
posixPriorityNumbering : int;
pragma Import (C, posixPriorityNumbering, "posixPriorityNumbering");
function kernelTimeSlice (ticks : int) return int;
pragma Import (C, kernelTimeSlice, "kernelTimeSlice");
function taskPriorityGet
(tid : pthread_t;
pPriority : access int)
return int;
pragma Import (C, taskPriorityGet, "taskPriorityGet");
function taskPrioritySet
(tid : pthread_t;
newPriority : int)
return int;
pragma Import (C, taskPrioritySet, "taskPrioritySet");
function To_Wind_TCB_Ptr is
new Unchecked_Conversion (pthread_t, Wind_TCB_Ptr);
M_objLib : constant := 61 * 2**16;
S_objLib_OBJ_UNAVAILABLE : constant := M_objLib + 2;
S_objLib_OBJ_TIMEOUT : constant := M_objLib + 4;
function semMCreate
(options : int) return SEM_ID;
pragma Import (C, semMCreate, "semMCreate");
function taskLock return int;
pragma Import (C, taskLock, "taskLock");
function taskUnlock return int;
pragma Import (C, taskUnlock, "taskUnlock");
function To_Vxworks_Priority (Priority : in int) return int;
pragma Inline (To_Vxworks_Priority);
function To_Posix_Priority (Priority : in int) return int;
pragma Inline (To_Posix_Priority);
function To_Vxworks_Priority (Priority : in int) return int is
begin
return SCHED_FIFO_LOW_PRI - Priority;
end To_Vxworks_Priority;
function To_Posix_Priority (Priority : in int) return int is
begin
return SCHED_FIFO_LOW_PRI - Priority;
end To_Posix_Priority;
procedure pthread_init is
begin
Keys_Created := 0;
Time_Slice := -1;
end pthread_init;
function sigwait
(set : access sigset_t;
sig : access Signal) return int
is
Result : Interfaces.C.int;
function sigwaitinfo
(set : access sigset_t; sigvalue : System.Address) return int;
pragma Import (C, sigwaitinfo, "sigwaitinfo");
begin
Result := sigwaitinfo (set, System.Null_Address);
if Result /= -1 then
sig.all := Signal (Result);
return 0;
else
sig.all := 0;
return errno;
end if;
end sigwait;
function pthread_mutexattr_init
(attr : access pthread_mutexattr_t) return int is
begin
attr.Flags := int (SEM_Q_PRIORITY + SEM_INVERSION_SAFE);
attr.Prio_Ceiling := POSIX_SCHED_FIFO_HIGH_PRI;
attr.Protocol := PTHREAD_PRIO_INHERIT;
return 0;
end pthread_mutexattr_init;
function pthread_mutexattr_destroy
(attr : access pthread_mutexattr_t) return int is
begin
attr.Flags := 0;
attr.Prio_Ceiling := POSIX_SCHED_FIFO_HIGH_PRI;
attr.Protocol := PTHREAD_PRIO_INHERIT;
return 0;
end pthread_mutexattr_destroy;
function pthread_mutex_init
(mutex : access pthread_mutex_t;
attr : access pthread_mutexattr_t) return int
is
Result : int := 0;
begin
mutex.Mutex := semMCreate (attr.Flags);
mutex.Prio_Ceiling := attr.Prio_Ceiling;
mutex.Protocol := attr.Protocol;
if mutex.Mutex = 0 then
Result := errno;
end if;
return Result;
end pthread_mutex_init;
function pthread_mutex_destroy
(mutex : access pthread_mutex_t) return int
is
Result : STATUS;
begin
Result := semDelete (mutex.Mutex);
if Result /= 0 then
Result := errno;
end if;
mutex.Mutex := 0; mutex.Prio_Ceiling := POSIX_SCHED_FIFO_HIGH_PRI;
mutex.Protocol := PTHREAD_PRIO_INHERIT;
return Result;
end pthread_mutex_destroy;
function pthread_mutex_lock
(mutex : access pthread_mutex_t) return int
is
Result : int;
WTCB_Ptr : Wind_TCB_Ptr;
begin
WTCB_Ptr := To_Wind_TCB_Ptr (taskIdSelf);
if WTCB_Ptr = null then
return errno;
end if;
if mutex.Protocol = PTHREAD_PRIO_PROTECT and then
To_Posix_Priority (WTCB_Ptr.Priority) > mutex.Prio_Ceiling
then
return EINVAL;
end if;
Result := semTake (mutex.Mutex, WAIT_FOREVER);
if Result /= 0 then
Result := errno;
end if;
return Result;
end pthread_mutex_lock;
function pthread_mutex_unlock
(mutex : access pthread_mutex_t) return int
is
Result : int;
begin
Result := semGive (mutex.Mutex);
if Result /= 0 then
Result := errno;
end if;
return Result;
end pthread_mutex_unlock;
function pthread_condattr_init
(attr : access pthread_condattr_t) return int is
begin
attr.Flags := SEM_Q_PRIORITY;
return 0;
end pthread_condattr_init;
function pthread_condattr_destroy
(attr : access pthread_condattr_t) return int is
begin
attr.Flags := 0;
return 0;
end pthread_condattr_destroy;
function pthread_cond_init
(cond : access pthread_cond_t;
attr : access pthread_condattr_t) return int
is
Result : int := 0;
begin
cond.Sem := semBCreate (attr.Flags, SEM_EMPTY);
cond.Waiting := 0;
if cond.Sem = 0 then
Result := errno;
end if;
return Result;
end pthread_cond_init;
function pthread_cond_destroy (cond : access pthread_cond_t) return int is
Result : int;
begin
Result := semDelete (cond.Sem);
if Result /= 0 then
Result := errno;
end if;
return Result;
end pthread_cond_destroy;
function pthread_cond_signal
(cond : access pthread_cond_t) return int
is
Result : int := 0;
Status : int;
begin
Status := taskLock;
if cond.Waiting > 0 then
Result := semGive (cond.Sem);
cond.Waiting := cond.Waiting - 1;
if Result /= 0 then
Result := errno;
end if;
end if;
Status := taskUnlock;
return Result;
end pthread_cond_signal;
function pthread_cond_wait
(cond : access pthread_cond_t;
mutex : access pthread_mutex_t) return int
is
Result : int;
Status : int;
begin
Status := taskLock;
Result := semGive (mutex.Mutex);
cond.Waiting := cond.Waiting + 1;
Result := semTake (cond.Sem, WAIT_FOREVER);
if Result /= 0 then
cond.Waiting := cond.Waiting - 1;
Result := EINVAL;
end if;
Status := semTake (mutex.Mutex, WAIT_FOREVER);
if Status /= 0 then
Result := EINVAL;
end if;
Status := taskUnlock;
return Result;
end pthread_cond_wait;
function pthread_cond_timedwait
(cond : access pthread_cond_t;
mutex : access pthread_mutex_t;
abstime : access timespec) return int
is
Result : int;
Status : int;
Ticks : int;
TS : aliased timespec;
begin
Status := clock_gettime (CLOCK_REALTIME, TS'Unchecked_Access);
Ticks := To_Clock_Ticks (To_Duration (abstime.all) - To_Duration (TS));
if Ticks <= 0 then
Status := taskDelay (0);
return ETIMEDOUT;
end if;
Status := taskLock;
Result := semGive (mutex.Mutex);
cond.Waiting := cond.Waiting + 1;
Result := semTake (cond.Sem, Ticks);
if Result /= 0 then
if errno = S_objLib_OBJ_TIMEOUT then
Result := ETIMEDOUT;
else
Result := EINVAL;
end if;
cond.Waiting := cond.Waiting - 1;
end if;
Status := semTake (mutex.Mutex, WAIT_FOREVER);
if Status /= 0 then
Result := EINVAL;
end if;
Status := taskUnlock;
return Result;
end pthread_cond_timedwait;
function pthread_mutexattr_setprotocol
(attr : access pthread_mutexattr_t;
protocol : int) return int is
begin
if protocol < PTHREAD_PRIO_NONE
or protocol > PTHREAD_PRIO_PROTECT
then
return EINVAL;
end if;
attr.Protocol := protocol;
return 0;
end pthread_mutexattr_setprotocol;
function pthread_mutexattr_setprioceiling
(attr : access pthread_mutexattr_t;
prioceiling : int) return int is
begin
attr.Prio_Ceiling := prioceiling;
return 0;
end pthread_mutexattr_setprioceiling;
function pthread_setschedparam
(thread : pthread_t;
policy : int;
param : access struct_sched_param) return int
is
Result : int;
begin
Result := taskPrioritySet (thread,
To_Vxworks_Priority (param.sched_priority));
return 0;
end pthread_setschedparam;
function sched_yield return int is
begin
return taskDelay (0);
end sched_yield;
function pthread_sched_rr_set_interval (usecs : int) return int is
Result : int := 0;
D_Slice : Duration;
begin
Time_Slice := usecs;
if Time_Slice > 0 then
D_Slice := Duration (Time_Slice) / Duration (1_000_000.0);
Result := kernelTimeSlice (To_Clock_Ticks (D_Slice));
else
if Time_Slice = 0 then
Result := kernelTimeSlice (0);
end if;
end if;
return Result;
end pthread_sched_rr_set_interval;
function pthread_attr_init (attr : access pthread_attr_t) return int is
begin
attr.Stacksize := 100000; attr.Detachstate := PTHREAD_CREATE_DETACHED;
attr.Priority := POSIX_SCHED_FIFO_LOW_PRI;
attr.Taskname := System.Null_Address;
return 0;
end pthread_attr_init;
function pthread_attr_destroy (attr : access pthread_attr_t) return int is
begin
attr.Stacksize := 0;
attr.Detachstate := 0;
attr.Priority := POSIX_SCHED_FIFO_LOW_PRI;
attr.Taskname := System.Null_Address;
return 0;
end pthread_attr_destroy;
function pthread_attr_setdetachstate
(attr : access pthread_attr_t;
detachstate : int) return int is
begin
attr.Detachstate := detachstate;
return 0;
end pthread_attr_setdetachstate;
function pthread_attr_setstacksize
(attr : access pthread_attr_t;
stacksize : size_t) return int is
begin
attr.Stacksize := stacksize;
return 0;
end pthread_attr_setstacksize;
function pthread_attr_setname_np
(attr : access pthread_attr_t;
name : System.Address) return int is
begin
attr.Taskname := name;
return 0;
end pthread_attr_setname_np;
function pthread_create
(thread : access pthread_t;
attr : access pthread_attr_t;
start_routine : Thread_Body;
arg : System.Address) return int is
begin
thread.all := taskSpawn (attr.Taskname,
To_Vxworks_Priority (attr.Priority), VX_FP_TASK, attr.Stacksize,
start_routine, arg);
if thread.all = -1 then
return -1;
else
return 0;
end if;
end pthread_create;
function pthread_detach (thread : pthread_t) return int is
begin
return 0;
end pthread_detach;
procedure pthread_exit (status : System.Address) is
begin
taskDelete (0);
end pthread_exit;
function pthread_self return pthread_t is
begin
return taskIdSelf;
end pthread_self;
function pthread_equal (t1 : pthread_t; t2 : pthread_t) return int is
begin
if t1 = t2 then
return 1;
else
return 0;
end if;
end pthread_equal;
function pthread_setspecific
(key : pthread_key_t;
value : System.Address) return int
is
Result : int;
begin
if Integer (key) not in Key_Storage'Range then
return EINVAL;
end if;
Key_Storage (Integer (key)) := value;
Result := taskVarAdd (taskIdSelf, Key_Storage (Integer (key))'Access);
Result := taskVarSet (taskIdSelf,
Key_Storage (Integer (key))'Access, value);
return Result;
end pthread_setspecific;
function pthread_getspecific (key : pthread_key_t) return System.Address is
begin
return Key_Storage (Integer (key));
end pthread_getspecific;
function pthread_key_create
(key : access pthread_key_t;
destructor : destructor_pointer) return int is
begin
Keys_Created := Keys_Created + 1;
if Keys_Created not in Key_Storage'Range then
return ENOMEM;
end if;
key.all := pthread_key_t (Keys_Created);
return 0;
end pthread_key_create;
function To_Duration (TS : timespec) return Duration is
begin
return Duration (TS.ts_sec) + Duration (TS.ts_nsec) / 10#1#E9;
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' (ts_sec => S,
ts_nsec => long (Long_Long_Integer (F * 10#1#E9)));
end To_Timespec;
function To_Clock_Ticks (D : Duration) return int is
Ticks : Long_Long_Integer;
Rate_Duration : Duration;
Ticks_Duration : Duration;
begin
Rate_Duration := Duration (sysClkRateGet);
if D > (Duration'Last / Rate_Duration) then
Ticks := Long_Long_Integer (int'Last);
else
Ticks_Duration := D * Rate_Duration;
Ticks := Long_Long_Integer (Ticks_Duration);
if Ticks_Duration > Duration (Ticks) then
Ticks := Ticks + 1;
end if;
if Ticks > Long_Long_Integer (int'Last) then
Ticks := Long_Long_Integer (int'Last);
end if;
end if;
return int (Ticks);
end To_Clock_Ticks;
end System.OS_Interface;