Low_Priority : constant := 255;
-- VxWorks native (default) lowest scheduling priority
- ------------
- -- getpid --
- ------------
-
- function getpid return t_id is
- begin
- -- VxWorks 5 (and VxWorks 6 in kernel mode) does not have a getpid
- -- function. taskIdSelf is the equivalent routine.
-
- return taskIdSelf;
- end getpid;
-
- --------------
- -- Int_Lock --
- --------------
-
- function Int_Lock return int is
- function intLock return int;
- pragma Import (C, intLock, "intLock");
- begin
- return intLock;
- end Int_Lock;
-
- ----------------
- -- Int_Unlock --
- ----------------
-
- function Int_Unlock return int is
- function intUnlock return int;
- pragma Import (C, intUnlock, "intUnlock");
- begin
- return intUnlock;
- end Int_Unlock;
-
----------
-- kill --
----------
function kill (pid : t_id; sig : Signal) return int is
- function c_kill (pid : t_id; sig : Signal) return int;
- pragma Import (C, c_kill, "kill");
begin
- return c_kill (pid, sig);
+ return System.VxWorks.Ext.kill (pid, int (sig));
end kill;
- --------------------
- -- Set_Time_Slice --
- --------------------
-
- function Set_Time_Slice (ticks : int) return int is
- function kernelTimeSlice (ticks : int) return int;
- pragma Import (C, kernelTimeSlice, "kernelTimeSlice");
- begin
- return kernelTimeSlice (ticks);
- end Set_Time_Slice;
-
-------------
-- sigwait --
-------------
end if;
end sigwait;
- ---------------
- -- Task_Cont --
- ---------------
-
- function Task_Cont (tid : t_id) return int is
- function taskResume (tid : t_id) return int;
- pragma Import (C, taskResume, "taskResume");
- begin
- return taskResume (tid);
- end Task_Cont;
-
- ---------------
- -- Task_Stop --
- ---------------
-
- function Task_Stop (tid : t_id) return int is
- function taskSuspend (tid : t_id) return int;
- pragma Import (C, taskSuspend, "taskSuspend");
- begin
- return taskSuspend (tid);
- end Task_Stop;
-
-----------------
-- To_Duration --
-----------------
-- --
-- S p e c --
-- --
--- Copyright (C) 1991-1994, Florida State University --
+-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2008, Free Software Foundation, Inc. --
-- --
-- GNARL is free software; you can redistribute it and/or modify it under --
-- --
------------------------------------------------------------------------------
--- This is the VxWorks version of this package
+-- This is the VxWorks 5.x and 6.x version of this package
-- This package encapsulates all direct interfaces to OS services
-- that are needed by the tasking run-time (libgnarl).
-- Preelaborate. This package is designed to be a bottom-level (leaf) package.
with Interfaces.C;
-
with System.VxWorks;
+with System.VxWorks.Ext;
package System.OS_Interface is
pragma Preelaborate;
- subtype int is Interfaces.C.int;
- subtype short is Short_Integer;
- type unsigned_int is mod 2 ** int'Size;
- type long is new Long_Integer;
- type unsigned_long is mod 2 ** long'Size;
- type size_t is mod 2 ** Standard'Address_Size;
+ subtype int is Interfaces.C.int;
+ subtype short is Short_Integer;
+ type unsigned_int is mod 2 ** int'Size;
+ type long is new Long_Integer;
+ type unsigned_long is mod 2 ** long'Size;
+ type long_long is new Long_Long_Integer;
+ type unsigned_long_long is mod 2 ** long_long'Size;
+ type size_t is mod 2 ** Standard'Address_Size;
-----------
-- Errno --
-- Signals and Interrupts --
----------------------------
- NSIG : constant := 32;
+ NSIG : constant := 64;
-- Number of signals on the target OS
type Signal is new int range 0 .. Interfaces.C."-" (NSIG, 1);
Max_Interrupt : constant := Max_HW_Interrupt;
- SIGILL : constant := 4; -- illegal instruction (not reset)
- SIGABRT : constant := 6; -- used by abort, replace SIGIOT in the future
- SIGFPE : constant := 8; -- floating point exception
- SIGBUS : constant := 10; -- bus error
- SIGSEGV : constant := 11; -- segmentation violation
+ -- Signals common to Vxworks 5.x and 6.x
+
+ SIGILL : constant := 4; -- illegal instruction (not reset when caught)
+ SIGABRT : constant := 6; -- used by abort, replace SIGIOT in the future
+ SIGFPE : constant := 8; -- floating point exception
+ SIGBUS : constant := 10; -- bus error
+ SIGSEGV : constant := 11; -- segmentation violation
+
+ -- Signals specific to VxWorks 6.x
+
+ SIGHUP : constant := 1; -- hangup
+ SIGINT : constant := 2; -- interrupt
+ SIGQUIT : constant := 3; -- quit
+ SIGTRAP : constant := 5; -- trace trap (not reset when caught)
+ SIGEMT : constant := 7; -- EMT instruction
+ SIGKILL : constant := 9; -- kill
+ SIGFMT : constant := 12; -- STACK FORMAT ERROR (not posix)
+ SIGPIPE : constant := 13; -- write on a pipe with no one to read it
+ SIGALRM : constant := 14; -- alarm clock
+ SIGTERM : constant := 15; -- software termination signal from kill
+ SIGCNCL : constant := 16; -- pthreads cancellation signal
+ SIGSTOP : constant := 17; -- sendable stop signal not from tty
+ SIGTSTP : constant := 18; -- stop signal from tty
+ SIGCONT : constant := 19; -- continue a stopped process
+ SIGCHLD : constant := 20; -- to parent on child stop or exit
+ SIGTTIN : constant := 21; -- to readers pgrp upon background tty read
+ SIGTTOU : constant := 22; -- like TTIN for output
+
+ SIGRES1 : constant := 23; -- reserved signal number (Not POSIX)
+ SIGRES2 : constant := 24; -- reserved signal number (Not POSIX)
+ SIGRES3 : constant := 25; -- reserved signal number (Not POSIX)
+ SIGRES4 : constant := 26; -- reserved signal number (Not POSIX)
+ SIGRES5 : constant := 27; -- reserved signal number (Not POSIX)
+ SIGRES6 : constant := 28; -- reserved signal number (Not POSIX)
+ SIGRES7 : constant := 29; -- reserved signal number (Not POSIX)
+
+ SIGUSR1 : constant := 30; -- user defined signal 1
+ SIGUSR2 : constant := 31; -- user defined signal 2
+
+ SIGPOLL : constant := 32; -- pollable event
+ SIGPROF : constant := 33; -- profiling timer expired
+ SIGSYS : constant := 34; -- bad system call
+ SIGURG : constant := 35; -- high bandwidth data is available at socket
+ SIGVTALRM : constant := 36; -- virtual timer expired
+ SIGXCPU : constant := 37; -- CPU time limit exceeded
+ SIGXFSZ : constant := 38; -- file size time limit exceeded
+
+ SIGEVTS : constant := 39; -- signal event thread send
+ SIGEVTD : constant := 40; -- signal event thread delete
+
+ SIGRTMIN : constant := 48; -- Realtime signal min
+ SIGRTMAX : constant := 63; -- Realtime signal max
-----------------------------------
-- Signal processing definitions --
-- The sa_flags in struct sigaction
- SA_SIGINFO : constant := 16#0002#;
- SA_ONSTACK : constant := 16#0004#;
+ SA_SIGINFO : constant := 16#0002#;
+ SA_ONSTACK : constant := 16#0004#;
SIG_DFL : constant := 0;
SIG_IGN : constant := 1;
oset : access sigset_t) return int;
pragma Import (C, pthread_sigmask, "sigprocmask");
- type t_id is new long;
+ subtype t_id is System.VxWorks.Ext.t_id;
subtype Thread_Id is t_id;
function kill (pid : t_id; sig : Signal) return int;
pragma Inline (kill);
- function getpid return t_id;
- pragma Inline (getpid);
+ function getpid return t_id renames System.VxWorks.Ext.getpid;
- function Task_Stop (tid : t_id) return int;
- pragma Inline (Task_Stop);
+ function Task_Stop (tid : t_id) return int
+ renames System.VxWorks.Ext.Task_Stop;
-- If we are in the kernel space, stop the task whose t_id is
-- given in parameter in such a way that it can be examined by the
-- debugger. This typically maps to taskSuspend on VxWorks 5 and
-- to taskStop on VxWorks 6.
- function Task_Cont (tid : t_id) return int;
- pragma Inline (Task_Cont);
+ function Task_Cont (tid : t_id) return int
+ renames System.VxWorks.Ext.Task_Cont;
-- If we are in the kernel space, continue the task whose t_id is
-- given in parameter if it has been stopped previously to be examined
-- by the debugger (e.g. by taskStop). It typically maps to taskResume
-- on VxWorks 5 and to taskCont on VxWorks 6.
- function Int_Lock return int;
- pragma Inline (Int_Lock);
+ function Int_Lock return int renames System.VxWorks.Ext.Int_Lock;
-- If we are in the kernel space, lock interrupts. It typically maps to
-- intLock.
- function Int_Unlock return int;
- pragma Inline (Int_Unlock);
+ function Int_Unlock return int renames System.VxWorks.Ext.Int_Unlock;
-- If we are in the kernel space, unlock interrupts. It typically maps to
-- intUnlock.
(clock_id : clockid_t; tp : access timespec) return int;
pragma Import (C, clock_gettime, "clock_gettime");
- type ULONG is new unsigned_long;
-
- procedure tickSet (ticks : ULONG);
- pragma Import (C, tickSet, "tickSet");
-
- function tickGet return ULONG;
- pragma Import (C, tickGet, "tickGet");
-
----------------------
-- Utility Routines --
----------------------
procedure taskDelete (tid : t_id);
pragma Import (C, taskDelete, "taskDelete");
- function Set_Time_Slice (ticks : int) return int;
- pragma Inline (Set_Time_Slice);
+ function Set_Time_Slice (ticks : int) return int
+ renames System.VxWorks.Ext.Set_Time_Slice;
-- Calls kernelTimeSlice under VxWorks 5.x
-- Do nothing under VxWorks 6.x
-- Release all threads blocked on the semaphore
private
- type sigset_t is new long;
+ type sigset_t is new unsigned_long_long;
type pid_t is new int;
+++ /dev/null
-------------------------------------------------------------------------------
--- --
--- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
--- --
--- S Y S T E M . O S _ I N T E R F A C E --
--- --
--- S p e c --
--- --
--- Copyright (C) 1991-1994, Florida State University --
--- Copyright (C) 1995-2008, Free Software Foundation, Inc. --
--- --
--- GNARL is free software; you can redistribute it and/or modify it under --
--- terms of the GNU General Public License as published by the Free Soft- --
--- ware Foundation; either version 2, or (at your option) any later ver- --
--- sion. GNARL is distributed in the hope that it will be useful, but WITH- --
--- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
--- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
--- for more details. You should have received a copy of the GNU General --
--- Public License distributed with GNARL; see file COPYING. If not, write --
--- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
--- Boston, MA 02110-1301, USA. --
--- --
--- As a special exception, if other files instantiate generics from this --
--- unit, or you link this unit with other files to produce an executable, --
--- this unit does not by itself cause the resulting executable to be --
--- covered by the GNU General Public License. This exception does not --
--- however invalidate any other reasons why the executable file might be --
--- covered by the GNU Public License. --
--- --
--- GNARL was developed by the GNARL team at Florida State University. --
--- Extensive contributions were provided by Ada Core Technologies, Inc. --
--- --
-------------------------------------------------------------------------------
-
--- This is the VxWorks 6.x version of this package
-
--- This package encapsulates all direct interfaces to OS services
--- that are needed by the tasking run-time (libgnarl).
-
--- PLEASE DO NOT add any with-clauses to this package or remove the pragma
--- Preelaborate. This package is designed to be a bottom-level (leaf) package.
-
-with Interfaces.C;
-with System.VxWorks;
-
-package System.OS_Interface is
- pragma Preelaborate;
-
- subtype int is Interfaces.C.int;
- subtype short is Short_Integer;
- type unsigned_int is mod 2 ** int'Size;
- type long is new Long_Integer;
- type unsigned_long is mod 2 ** long'Size;
- type long_long is new Long_Long_Integer;
- type unsigned_long_long is mod 2 ** long_long'Size;
- type size_t is mod 2 ** Standard'Address_Size;
-
- -----------
- -- Errno --
- -----------
-
- function errno return int;
- pragma Import (C, errno, "errnoGet");
-
- EINTR : constant := 4;
- EAGAIN : constant := 35;
- ENOMEM : constant := 12;
- EINVAL : constant := 22;
- ETIMEDOUT : constant := 60;
-
- FUNC_ERR : constant := -1;
-
- ----------------------------
- -- Signals and Interrupts --
- ----------------------------
-
- NSIG : constant := 64;
- -- Number of signals on the target OS
- type Signal is new int range 0 .. Interfaces.C."-" (NSIG, 1);
-
- Max_HW_Interrupt : constant := System.VxWorks.Num_HW_Interrupts - 1;
- type HW_Interrupt is new int range 0 .. Max_HW_Interrupt;
-
- Max_Interrupt : constant := Max_HW_Interrupt;
-
- SIGHUP : constant := 1; -- hangup
- SIGINT : constant := 2; -- interrupt
- SIGQUIT : constant := 3; -- quit
- SIGILL : constant := 4; -- illegal instruction (not reset when caught)
- SIGTRAP : constant := 5; -- trace trap (not reset when caught)
- SIGABRT : constant := 6; -- used by abort, replace SIGIOT in the future
- SIGEMT : constant := 7; -- EMT instruction
- SIGFPE : constant := 8; -- floating point exception
- SIGKILL : constant := 9; -- kill
- SIGBUS : constant := 10; -- bus error
- SIGSEGV : constant := 11; -- segmentation violation
- SIGFMT : constant := 12; -- STACK FORMAT ERROR (not posix)
- SIGPIPE : constant := 13; -- write on a pipe with no one to read it
- SIGALRM : constant := 14; -- alarm clock
- SIGTERM : constant := 15; -- software termination signal from kill
- SIGCNCL : constant := 16; -- pthreads cancellation signal
- SIGSTOP : constant := 17; -- sendable stop signal not from tty
- SIGTSTP : constant := 18; -- stop signal from tty
- SIGCONT : constant := 19; -- continue a stopped process
- SIGCHLD : constant := 20; -- to parent on child stop or exit
- SIGTTIN : constant := 21; -- to readers pgrp upon background tty read
- SIGTTOU : constant := 22; -- like TTIN for output
-
- SIGRES1 : constant := 23; -- reserved signal number (Not POSIX)
- SIGRES2 : constant := 24; -- reserved signal number (Not POSIX)
- SIGRES3 : constant := 25; -- reserved signal number (Not POSIX)
- SIGRES4 : constant := 26; -- reserved signal number (Not POSIX)
- SIGRES5 : constant := 27; -- reserved signal number (Not POSIX)
- SIGRES6 : constant := 28; -- reserved signal number (Not POSIX)
- SIGRES7 : constant := 29; -- reserved signal number (Not POSIX)
-
- SIGUSR1 : constant := 30; -- user defined signal 1
- SIGUSR2 : constant := 31; -- user defined signal 2
-
- SIGPOLL : constant := 32; -- pollable event
- SIGPROF : constant := 33; -- profiling timer expired
- SIGSYS : constant := 34; -- bad system call
- SIGURG : constant := 35; -- high bandwidth data is available at socket
- SIGVTALRM : constant := 36; -- virtual timer expired
- SIGXCPU : constant := 37; -- CPU time limit exceeded
- SIGXFSZ : constant := 38; -- file size time limit exceeded
-
- SIGEVTS : constant := 39; -- signal event thread send
- SIGEVTD : constant := 40; -- signal event thread delete
-
- SIGRTMIN : constant := 48; -- Realtime signal min
- SIGRTMAX : constant := 63; -- Realtime signal max
-
- -----------------------------------
- -- Signal processing definitions --
- -----------------------------------
-
- -- The how in sigprocmask()
- SIG_BLOCK : constant := 1;
- SIG_UNBLOCK : constant := 2;
- SIG_SETMASK : constant := 3;
-
- -- The sa_flags in struct sigaction
- SA_SIGINFO : constant := 16#0002#;
- SA_ONSTACK : constant := 16#0004#;
-
- SIG_DFL : constant := 0;
- SIG_IGN : constant := 1;
-
- type sigset_t is private;
-
- type struct_sigaction is record
- sa_handler : System.Address;
- sa_mask : sigset_t;
- sa_flags : int;
- end record;
- pragma Convention (C, struct_sigaction);
- type struct_sigaction_ptr is access all struct_sigaction;
-
- function sigaddset (set : access sigset_t; sig : Signal) return int;
- pragma Import (C, sigaddset, "sigaddset");
-
- function sigdelset (set : access sigset_t; sig : Signal) return int;
- pragma Import (C, sigdelset, "sigdelset");
-
- function sigfillset (set : access sigset_t) return int;
- pragma Import (C, sigfillset, "sigfillset");
-
- function sigismember (set : access sigset_t; sig : Signal) return int;
- pragma Import (C, sigismember, "sigismember");
-
- function sigemptyset (set : access sigset_t) return int;
- pragma Import (C, sigemptyset, "sigemptyset");
-
- function sigaction
- (sig : Signal;
- act : struct_sigaction_ptr;
- oact : struct_sigaction_ptr) return int;
- pragma Import (C, sigaction, "sigaction");
-
- type isr_address is access procedure (sig : int);
- pragma Convention (C, isr_address);
-
- function c_signal (sig : Signal; handler : isr_address) return isr_address;
- pragma Import (C, c_signal, "signal");
-
- function sigwait (set : access sigset_t; sig : access Signal) return int;
- pragma Inline (sigwait);
-
- function pthread_sigmask
- (how : int;
- set : access sigset_t;
- oset : access sigset_t) return int;
- pragma Import (C, pthread_sigmask, "sigprocmask");
-
- type t_id is new long;
- subtype Thread_Id is t_id;
-
- function kill (pid : t_id; sig : Signal) return int;
- pragma Inline (kill);
-
- function getpid return t_id;
- pragma Inline (getpid);
-
- function Task_Stop (tid : t_id) return int;
- pragma Inline (Task_Stop);
- -- If we are in the kernel space, continue the task whose t_id is
- -- given in parameter if it has been stopped previously to be examined
- -- by the debugger (e.g. by taskStop). It typically maps to taskResume
- -- on VxWorks 5 and to taskCont on VxWorks 6.
-
- function Task_Cont (tid : t_id) return int;
- pragma Inline (Task_Cont);
- -- If we are in the kernel space, lock interrupts. It typically maps to
- -- intLock.
-
- function Int_Lock return int;
- pragma Inline (Int_Lock);
- -- If we are in the kernel space, lock interrupts. It typically maps to
- -- intLock.
-
- function Int_Unlock return int;
- pragma Inline (Int_Unlock);
- -- If we are in the kernel space, unlock interrupts. It typically maps to
- -- intUnlock.
-
- ----------
- -- Time --
- ----------
-
- type time_t is new unsigned_long;
-
- type timespec is record
- ts_sec : time_t;
- ts_nsec : long;
- end record;
- pragma Convention (C, timespec);
-
- type clockid_t is private;
-
- CLOCK_REALTIME : constant clockid_t; -- System wide realtime clock
-
- function To_Duration (TS : timespec) return Duration;
- pragma Inline (To_Duration);
-
- function To_Timespec (D : Duration) return timespec;
- pragma Inline (To_Timespec);
-
- function To_Clock_Ticks (D : Duration) return int;
- -- Convert a duration value (in seconds) into clock ticks
-
- function clock_gettime
- (clock_id : clockid_t; tp : access timespec) return int;
- pragma Import (C, clock_gettime, "clock_gettime");
-
- type ULONG is new unsigned_long;
-
- procedure tickSet (ticks : ULONG);
- pragma Import (C, tickSet, "tickSet");
-
- function tickGet return ULONG;
- pragma Import (C, tickGet, "tickGet");
-
- ----------------------
- -- Utility Routines --
- ----------------------
-
- function To_VxWorks_Priority (Priority : int) return int;
- pragma Inline (To_VxWorks_Priority);
- -- Convenience routine to convert between VxWorks priority and Ada priority
-
- --------------------------
- -- VxWorks specific API --
- --------------------------
-
- subtype STATUS is int;
- -- Equivalent of the C type STATUS
-
- OK : constant STATUS := 0;
- ERROR : constant STATUS := Interfaces.C.int (-1);
-
- function taskIdVerify (tid : t_id) return STATUS;
- pragma Import (C, taskIdVerify, "taskIdVerify");
-
- function taskIdSelf return t_id;
- pragma Import (C, taskIdSelf, "taskIdSelf");
-
- function taskOptionsGet (tid : t_id; pOptions : access int) return int;
- pragma Import (C, taskOptionsGet, "taskOptionsGet");
-
- function taskSuspend (tid : t_id) return int;
- pragma Import (C, taskSuspend, "taskSuspend");
-
- function taskResume (tid : t_id) return int;
- pragma Import (C, taskResume, "taskResume");
-
- function taskIsSuspended (tid : t_id) return int;
- pragma Import (C, taskIsSuspended, "taskIsSuspended");
-
- function taskDelay (ticks : int) return int;
- procedure taskDelay (ticks : int);
- pragma Import (C, taskDelay, "taskDelay");
-
- function sysClkRateGet return int;
- pragma Import (C, sysClkRateGet, "sysClkRateGet");
-
- -- VxWorks 5.x specific functions
-
- function taskVarAdd
- (tid : t_id; pVar : access System.Address) return int;
- pragma Import (C, taskVarAdd, "taskVarAdd");
-
- function taskVarDelete
- (tid : t_id; pVar : access System.Address) return int;
- pragma Import (C, taskVarDelete, "taskVarDelete");
-
- function taskVarSet
- (tid : t_id;
- pVar : access System.Address;
- value : System.Address) return int;
- pragma Import (C, taskVarSet, "taskVarSet");
-
- function taskVarGet
- (tid : t_id;
- pVar : access System.Address) return int;
- pragma Import (C, taskVarGet, "taskVarGet");
-
- -- VxWorks 6.x specific functions
-
- function tlsKeyCreate return int;
- pragma Import (C, tlsKeyCreate, "tlsKeyCreate");
-
- function tlsValueGet (key : int) return System.Address;
- pragma Import (C, tlsValueGet, "tlsValueGet");
-
- function tlsValueSet (key : int; value : System.Address) return STATUS;
- pragma Import (C, tlsValueSet, "tlsValueSet");
-
- -- Option flags for taskSpawn
-
- VX_UNBREAKABLE : constant := 16#0002#;
- VX_FP_PRIVATE_ENV : constant := 16#0080#;
- VX_NO_STACK_FILL : constant := 16#0100#;
-
- function taskSpawn
- (name : System.Address; -- Pointer to task name
- priority : int;
- options : int;
- stacksize : size_t;
- start_routine : System.Address;
- 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 t_id;
- pragma Import (C, taskSpawn, "taskSpawn");
-
- procedure taskDelete (tid : t_id);
- pragma Import (C, taskDelete, "taskDelete");
-
- function Set_Time_Slice (ticks : int) return int;
- pragma Inline (Set_Time_Slice);
- -- Calls kernelTimeSlice under VxWorks 5.x
- -- Do nothing under VxWorks 6.x
-
- function taskPriorityGet (tid : t_id; pPriority : access int) return int;
- pragma Import (C, taskPriorityGet, "taskPriorityGet");
-
- function taskPrioritySet (tid : t_id; newPriority : int) return int;
- pragma Import (C, taskPrioritySet, "taskPrioritySet");
-
- -- Semaphore creation flags
-
- SEM_Q_FIFO : constant := 0;
- SEM_Q_PRIORITY : constant := 1;
- SEM_DELETE_SAFE : constant := 4; -- only valid for binary semaphore
- SEM_INVERSION_SAFE : constant := 8; -- only valid for binary semaphore
-
- -- Semaphore initial state flags
-
- SEM_EMPTY : constant := 0;
- SEM_FULL : constant := 1;
-
- -- Semaphore take (semTake) time constants
-
- WAIT_FOREVER : constant := -1;
- NO_WAIT : constant := 0;
-
- -- Error codes (errno). The lower level 16 bits are the error code, with
- -- the upper 16 bits representing the module number in which the error
- -- occurred. By convention, the module number is 0 for UNIX errors. VxWorks
- -- reserves module numbers 1-500, with the remaining module numbers being
- -- available for user applications.
-
- M_objLib : constant := 61 * 2**16;
- -- semTake() failure with ticks = NO_WAIT
- S_objLib_OBJ_UNAVAILABLE : constant := M_objLib + 2;
- -- semTake() timeout with ticks > NO_WAIT
- S_objLib_OBJ_TIMEOUT : constant := M_objLib + 4;
-
- type SEM_ID is new System.Address;
- -- typedef struct semaphore *SEM_ID;
-
- -- We use two different kinds of VxWorks semaphores: mutex and binary
- -- semaphores. A null ID is returned when a semaphore cannot be created.
-
- function semBCreate (options : int; initial_state : int) return SEM_ID;
- pragma Import (C, semBCreate, "semBCreate");
- -- Create a binary semaphore. Return ID, or 0 if memory could not
- -- be allocated.
-
- function semMCreate (options : int) return SEM_ID;
- pragma Import (C, semMCreate, "semMCreate");
-
- function semDelete (Sem : SEM_ID) return int;
- pragma Import (C, semDelete, "semDelete");
- -- Delete a semaphore
-
- function semGive (Sem : SEM_ID) return int;
- pragma Import (C, semGive, "semGive");
-
- function semTake (Sem : SEM_ID; timeout : int) return int;
- pragma Import (C, semTake, "semTake");
- -- Attempt to take binary semaphore. Error is returned if operation
- -- times out
-
- function semFlush (SemID : SEM_ID) return STATUS;
- pragma Import (C, semFlush, "semFlush");
- -- Release all threads blocked on the semaphore
-
-private
- type sigset_t is new unsigned_long_long;
-
- type pid_t is new int;
-
- ERROR_PID : constant pid_t := -1;
-
- type clockid_t is new int;
- CLOCK_REALTIME : constant clockid_t := 0;
-
-end System.OS_Interface;
-- on. For example when using the restricted run time, it is replaced by
-- System.Tasking.Restricted.Stages.
+with System.VxWorks.Ext;
+
package body System.Task_Primitives.Operations is
package SSL renames System.Soft_Links;
use System.Tasking;
use System.OS_Interface;
use System.Parameters;
+ use type System.VxWorks.Ext.t_id;
use type Interfaces.C.int;
subtype int is System.OS_Interface.int;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
+-- --
+-- S Y S T E M . V X W O R K S . E X T --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 2008, Free Software Foundation, Inc. --
+-- --
+-- GNARL is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 2, or (at your option) any later ver- --
+-- sion. GNARL is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
+-- for more details. You should have received a copy of the GNU General --
+-- Public License distributed with GNARL; see file COPYING. If not, write --
+-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
+-- Boston, MA 02110-1301, USA. --
+-- --
+-- As a special exception, if other files instantiate generics from this --
+-- unit, or you link this unit with other files to produce an executable, --
+-- this unit does not by itself cause the resulting executable to be --
+-- covered by the GNU General Public License. This exception does not --
+-- however invalidate any other reasons why the executable file might be --
+-- covered by the GNU Public License. --
+-- --
+------------------------------------------------------------------------------
+
+-- This package provides vxworks specific support functions needed
+-- by System.OS_Interface.
+
+-- This is the VxWorks 6 kernel version of this package
+
+with Interfaces.C;
+
+package System.VxWorks.Ext is
+ pragma Preelaborate;
+
+ type t_id is new Long_Integer;
+ subtype int is Interfaces.C.int;
+
+ function Task_Cont (tid : t_id) return int;
+ pragma Import (C, Task_Cont, "taskCont");
+
+ function Task_Stop (tid : t_id) return int;
+ pragma Import (C, Task_Stop, "taskStop");
+
+ function Int_Lock return int;
+ pragma Import (C, Int_Lock, "intLock");
+
+ function Int_Unlock return int;
+ pragma Import (C, Int_Unlock, "intUnlock");
+
+ function kill (pid : t_id; sig : int) return int;
+ pragma Import (C, kill, "kill");
+
+ function Set_Time_Slice (ticks : int) return int;
+ pragma Import (C, Set_Time_Slice, "kernelTimeSlice");
+
+ function getpid return t_id;
+ pragma Import (C, getpid, "taskIdSelf");
+
+end System.VxWorks.Ext;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
+-- --
+-- S Y S T E M . V X W O R K S . E X T --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 2008, Free Software Foundation, Inc. --
+-- --
+-- GNARL is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 2, or (at your option) any later ver- --
+-- sion. GNARL is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
+-- for more details. You should have received a copy of the GNU General --
+-- Public License distributed with GNARL; see file COPYING. If not, write --
+-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
+-- Boston, MA 02110-1301, USA. --
+-- --
+-- As a special exception, if other files instantiate generics from this --
+-- unit, or you link this unit with other files to produce an executable, --
+-- this unit does not by itself cause the resulting executable to be --
+-- covered by the GNU General Public License. This exception does not --
+-- however invalidate any other reasons why the executable file might be --
+-- covered by the GNU Public License. --
+-- --
+------------------------------------------------------------------------------
+
+-- This is the VxWorks 6 rtp version of this package
+
+package body System.VxWorks.Ext is
+
+ function Task_Cont (tid : t_id) return int is
+ pragma Unreferenced (tid);
+ begin
+ -- Operation not allowed in an RTP
+ return 0;
+ end Task_Cont;
+
+ function Task_Stop (tid : t_id) return int is
+ pragma Unreferenced (tid);
+ begin
+ -- Operation not allowed in an RTP
+ return 0;
+ end Task_Stop;
+
+ function Int_Lock return int is
+ begin
+ -- Operation not allowed in an RTP
+ return 0;
+ end Int_Lock;
+
+ function Int_Unlock return int is
+ begin
+ -- Operation not allowed in an RTP
+ return 0;
+ end Int_Unlock;
+
+ function Set_Time_Slice (ticks : int) return int is
+ pragma Unreferenced (ticks);
+ begin
+ return 0;
+ end Set_Time_Slice;
+
+end System.VxWorks.Ext;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
+-- --
+-- S Y S T E M . V X W O R K S . E X T --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 2008, Free Software Foundation, Inc. --
+-- --
+-- GNARL is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 2, or (at your option) any later ver- --
+-- sion. GNARL is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
+-- for more details. You should have received a copy of the GNU General --
+-- Public License distributed with GNARL; see file COPYING. If not, write --
+-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
+-- Boston, MA 02110-1301, USA. --
+-- --
+-- As a special exception, if other files instantiate generics from this --
+-- unit, or you link this unit with other files to produce an executable, --
+-- this unit does not by itself cause the resulting executable to be --
+-- covered by the GNU General Public License. This exception does not --
+-- however invalidate any other reasons why the executable file might be --
+-- covered by the GNU Public License. --
+-- --
+------------------------------------------------------------------------------
+
+-- This package provides vxworks specific support functions needed
+-- by System.OS_Interface.
+
+-- This is the VxWorks 6 rtp version of this package
+
+with Interfaces.C;
+
+package System.VxWorks.Ext is
+ pragma Preelaborate;
+
+ type t_id is new Long_Integer;
+ subtype int is Interfaces.C.int;
+
+ function Task_Cont (tid : t_id) return int;
+ pragma Inline (Task_Cont);
+
+ function Task_Stop (tid : t_id) return int;
+ pragma Inline (Task_Stop);
+
+ function Int_Lock return int;
+ pragma Inline (Int_Lock);
+
+ function Int_Unlock return int;
+ pragma Inline (Int_Unlock);
+
+ function kill (pid : t_id; sig : int) return int;
+ pragma Import (C, kill, "taskKill");
+
+ function Set_Time_Slice (ticks : int) return int;
+ pragma Inline (Set_Time_Slice);
+
+ function getpid return t_id;
+ pragma Import (C, getpid, "getpid");
+
+end System.VxWorks.Ext;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
+-- --
+-- S Y S T E M . V X W O R K S . E X T --
+-- --
+-- S p e c --
+-- --
+-- Copyright (C) 2008, Free Software Foundation, Inc. --
+-- --
+-- GNARL is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 2, or (at your option) any later ver- --
+-- sion. GNARL is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
+-- for more details. You should have received a copy of the GNU General --
+-- Public License distributed with GNARL; see file COPYING. If not, write --
+-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
+-- Boston, MA 02110-1301, USA. --
+-- --
+-- As a special exception, if other files instantiate generics from this --
+-- unit, or you link this unit with other files to produce an executable, --
+-- this unit does not by itself cause the resulting executable to be --
+-- covered by the GNU General Public License. This exception does not --
+-- however invalidate any other reasons why the executable file might be --
+-- covered by the GNU Public License. --
+-- --
+------------------------------------------------------------------------------
+
+-- This package provides vxworks specific support functions needed
+-- by System.OS_Interface.
+
+-- This is the VxWorks 5 version of this package
+
+with Interfaces.C;
+
+package System.VxWorks.Ext is
+ pragma Preelaborate;
+
+ type t_id is new Long_Integer;
+ subtype int is Interfaces.C.int;
+
+ function Task_Cont (tid : t_id) return int;
+ pragma Import (C, Task_Cont, "taskResume");
+
+ function Task_Stop (tid : t_id) return int;
+ pragma Import (C, Task_Stop, "taskSuspend");
+
+ function Int_Lock return int;
+ pragma Import (C, Int_Lock, "intLock");
+
+ function Int_Unlock return int;
+ pragma Import (C, Int_Unlock, "intUnlock");
+
+ function kill (pid : t_id; sig : int) return int;
+ pragma Import (C, kill, "kill");
+
+ function Set_Time_Slice (ticks : int) return int;
+ pragma Import (C, Set_Time_Slice, "kernelTimeSlice");
+
+ function getpid return t_id;
+ pragma Import (C, getpid, "taskIdSelf");
+
+end System.VxWorks.Ext;
OSDN Git Service
