| ------------------------------------------------------------------------------ |
| -- -- |
| -- 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-2006, 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 version of this package |
| |
| -- This package encapsulates all direct interfaces to OS services |
| -- that are needed by children of System. |
| |
| -- 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 long is new Long_Integer; |
| type unsigned_long is mod 2 ** 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 := 32; |
| -- 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; |
| |
| 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 |
| |
| ----------------------------------- |
| -- 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); |
| |
| 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 Import (C, getpid, "taskIdSelf"); |
| -- VxWorks doesn't have getpid; taskIdSelf is the equivalent routine. |
| |
| ---------- |
| -- 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 : in 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 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 VX_FP_TASK return int; |
| pragma Inline (VX_FP_TASK); |
| |
| 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 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; |
