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-2007, Free Software Foundation, Inc. --
12 -- GNARL 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 2, or (at your option) any later ver- --
15 -- sion. GNARL 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. See the GNU General Public License --
18 -- for more details. You should have received a copy of the GNU General --
19 -- Public License distributed with GNARL; see file COPYING. If not, write --
20 -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
21 -- Boston, MA 02110-1301, USA. --
23 -- As a special exception, if other files instantiate generics from this --
24 -- unit, or you link this unit with other files to produce an executable, --
25 -- this unit does not by itself cause the resulting executable to be --
26 -- covered by the GNU General Public License. This exception does not --
27 -- however invalidate any other reasons why the executable file might be --
28 -- covered by the GNU Public License. --
30 -- GNARL was developed by the GNARL team at Florida State University. --
31 -- Extensive contributions were provided by Ada Core Technologies, Inc. --
33 ------------------------------------------------------------------------------
35 -- This is the VxWorks version of this package
37 -- This package encapsulates all direct interfaces to OS services
38 -- that are needed by children of System.
40 -- PLEASE DO NOT add any with-clauses to this package or remove the pragma
41 -- Preelaborate. This package is designed to be a bottom-level (leaf) package.
46 package System
.OS_Interface
is
49 subtype int
is Interfaces
.C
.int
;
50 subtype short
is Short_Integer;
51 type unsigned_int
is mod 2 ** int
'Size;
52 type long
is new Long_Integer;
53 type unsigned_long
is mod 2 ** long
'Size;
54 type size_t
is mod 2 ** Standard
'Address_Size;
60 function errno
return int
;
61 pragma Import
(C
, errno
, "errnoGet");
63 EINTR
: constant := 4;
64 EAGAIN
: constant := 35;
65 ENOMEM
: constant := 12;
66 EINVAL
: constant := 22;
67 ETIMEDOUT
: constant := 60;
69 FUNC_ERR
: constant := -1;
71 ----------------------------
72 -- Signals and Interrupts --
73 ----------------------------
75 NSIG
: constant := 32;
76 -- Number of signals on the target OS
77 type Signal
is new int
range 0 .. Interfaces
.C
."-" (NSIG
, 1);
79 Max_HW_Interrupt
: constant := System
.VxWorks
.Num_HW_Interrupts
- 1;
80 type HW_Interrupt
is new int
range 0 .. Max_HW_Interrupt
;
82 Max_Interrupt
: constant := Max_HW_Interrupt
;
84 SIGILL
: constant := 4; -- illegal instruction (not reset)
85 SIGABRT
: constant := 6; -- used by abort, replace SIGIOT in the future
86 SIGFPE
: constant := 8; -- floating point exception
87 SIGBUS
: constant := 10; -- bus error
88 SIGSEGV
: constant := 11; -- segmentation violation
90 -----------------------------------
91 -- Signal processing definitions --
92 -----------------------------------
94 -- The how in sigprocmask()
96 SIG_BLOCK
: constant := 1;
97 SIG_UNBLOCK
: constant := 2;
98 SIG_SETMASK
: constant := 3;
100 -- The sa_flags in struct sigaction
102 SA_SIGINFO
: constant := 16#
0002#
;
103 SA_ONSTACK
: constant := 16#
0004#
;
105 SIG_DFL
: constant := 0;
106 SIG_IGN
: constant := 1;
108 type sigset_t
is private;
110 type struct_sigaction
is record
111 sa_handler
: System
.Address
;
115 pragma Convention
(C
, struct_sigaction
);
116 type struct_sigaction_ptr
is access all struct_sigaction
;
118 function sigaddset
(set
: access sigset_t
; sig
: Signal
) return int
;
119 pragma Import
(C
, sigaddset
, "sigaddset");
121 function sigdelset
(set
: access sigset_t
; sig
: Signal
) return int
;
122 pragma Import
(C
, sigdelset
, "sigdelset");
124 function sigfillset
(set
: access sigset_t
) return int
;
125 pragma Import
(C
, sigfillset
, "sigfillset");
127 function sigismember
(set
: access sigset_t
; sig
: Signal
) return int
;
128 pragma Import
(C
, sigismember
, "sigismember");
130 function sigemptyset
(set
: access sigset_t
) return int
;
131 pragma Import
(C
, sigemptyset
, "sigemptyset");
135 act
: struct_sigaction_ptr
;
136 oact
: struct_sigaction_ptr
) return int
;
137 pragma Import
(C
, sigaction
, "sigaction");
139 type isr_address
is access procedure (sig
: int
);
141 function c_signal
(sig
: Signal
; handler
: isr_address
) return isr_address
;
142 pragma Import
(C
, c_signal
, "signal");
144 function sigwait
(set
: access sigset_t
; sig
: access Signal
) return int
;
145 pragma Inline
(sigwait
);
147 function pthread_sigmask
149 set
: access sigset_t
;
150 oset
: access sigset_t
) return int
;
151 pragma Import
(C
, pthread_sigmask
, "sigprocmask");
153 type t_id
is new long
;
154 subtype Thread_Id
is t_id
;
156 function kill
(pid
: t_id
; sig
: Signal
) return int
;
157 pragma Inline
(kill
);
159 function getpid
return t_id
;
160 pragma Inline
(getpid
);
162 function Task_Stop
(tid
: t_id
) return int
;
163 pragma Inline
(Task_Stop
);
164 -- If we are in the kernel space, stop the task whose t_id is
165 -- given in parameter in such a way that it can be examined by the
166 -- debugger. This typically maps to taskSuspend on VxWorks 5 and
167 -- to taskStop on VxWorks 6.
169 function Task_Cont
(tid
: t_id
) return int
;
170 pragma Inline
(Task_Cont
);
171 -- If we are in the kernel space, continue the task whose t_id is
172 -- given in parameter if it has been stopped previously to be examined
173 -- by the debugger (e.g. by taskStop). It typically maps to taskResume
174 -- on VxWorks 5 and to taskCont on VxWorks 6.
176 function Int_Lock
return int
;
177 pragma Inline
(Int_Lock
);
178 -- If we are in the kernel space, lock interrupts. It typically maps to
181 function Int_Unlock
return int
;
182 pragma Inline
(Int_Unlock
);
183 -- If we are in the kernel space, unlock interrupts. It typically maps to
190 type time_t
is new unsigned_long
;
192 type timespec
is record
196 pragma Convention
(C
, timespec
);
198 type clockid_t
is private;
200 CLOCK_REALTIME
: constant clockid_t
; -- System wide realtime clock
202 function To_Duration
(TS
: timespec
) return Duration;
203 pragma Inline
(To_Duration
);
205 function To_Timespec
(D
: Duration) return timespec
;
206 pragma Inline
(To_Timespec
);
208 function To_Clock_Ticks
(D
: Duration) return int
;
209 -- Convert a duration value (in seconds) into clock ticks
211 function clock_gettime
212 (clock_id
: clockid_t
; tp
: access timespec
) return int
;
213 pragma Import
(C
, clock_gettime
, "clock_gettime");
215 type ULONG
is new unsigned_long
;
217 procedure tickSet
(ticks
: ULONG
);
218 pragma Import
(C
, tickSet
, "tickSet");
220 function tickGet
return ULONG
;
221 pragma Import
(C
, tickGet
, "tickGet");
223 ----------------------
224 -- Utility Routines --
225 ----------------------
227 function To_VxWorks_Priority
(Priority
: int
) return int
;
228 pragma Inline
(To_VxWorks_Priority
);
229 -- Convenience routine to convert between VxWorks priority and Ada priority
231 --------------------------
232 -- VxWorks specific API --
233 --------------------------
235 subtype STATUS
is int
;
236 -- Equivalent of the C type STATUS
238 OK
: constant STATUS
:= 0;
239 ERROR
: constant STATUS
:= Interfaces
.C
.int
(-1);
241 function taskIdVerify
(tid
: t_id
) return STATUS
;
242 pragma Import
(C
, taskIdVerify
, "taskIdVerify");
244 function taskIdSelf
return t_id
;
245 pragma Import
(C
, taskIdSelf
, "taskIdSelf");
247 function taskOptionsGet
(tid
: t_id
; pOptions
: access int
) return int
;
248 pragma Import
(C
, taskOptionsGet
, "taskOptionsGet");
250 function taskSuspend
(tid
: t_id
) return int
;
251 pragma Import
(C
, taskSuspend
, "taskSuspend");
253 function taskResume
(tid
: t_id
) return int
;
254 pragma Import
(C
, taskResume
, "taskResume");
256 function taskIsSuspended
(tid
: t_id
) return int
;
257 pragma Import
(C
, taskIsSuspended
, "taskIsSuspended");
259 function taskDelay
(ticks
: int
) return int
;
260 procedure taskDelay
(ticks
: int
);
261 pragma Import
(C
, taskDelay
, "taskDelay");
263 function sysClkRateGet
return int
;
264 pragma Import
(C
, sysClkRateGet
, "sysClkRateGet");
266 -- VxWorks 5.x specific functions
269 (tid
: t_id
; pVar
: access System
.Address
) return int
;
270 pragma Import
(C
, taskVarAdd
, "taskVarAdd");
272 function taskVarDelete
273 (tid
: t_id
; pVar
: access System
.Address
) return int
;
274 pragma Import
(C
, taskVarDelete
, "taskVarDelete");
278 pVar
: access System
.Address
;
279 value
: System
.Address
) return int
;
280 pragma Import
(C
, taskVarSet
, "taskVarSet");
284 pVar
: access System
.Address
) return int
;
285 pragma Import
(C
, taskVarGet
, "taskVarGet");
287 -- VxWorks 6.x specific functions
289 function tlsKeyCreate
return int
;
290 pragma Import
(C
, tlsKeyCreate
, "tlsKeyCreate");
292 function tlsValueGet
(key
: int
) return System
.Address
;
293 pragma Import
(C
, tlsValueGet
, "tlsValueGet");
295 function tlsValueSet
(key
: int
; value
: System
.Address
) return STATUS
;
296 pragma Import
(C
, tlsValueSet
, "tlsValueSet");
298 -- Option flags for taskSpawn
300 VX_UNBREAKABLE
: constant := 16#
0002#
;
301 VX_FP_PRIVATE_ENV
: constant := 16#
0080#
;
302 VX_NO_STACK_FILL
: constant := 16#
0100#
;
305 (name
: System
.Address
; -- Pointer to task name
309 start_routine
: System
.Address
;
310 arg1
: System
.Address
;
319 arg10
: int
:= 0) return t_id
;
320 pragma Import
(C
, taskSpawn
, "taskSpawn");
322 procedure taskDelete
(tid
: t_id
);
323 pragma Import
(C
, taskDelete
, "taskDelete");
325 function Set_Time_Slice
(ticks
: int
) return int
;
326 pragma Inline
(Set_Time_Slice
);
327 -- Calls kernelTimeSlice under VxWorks 5.x
328 -- Do nothing under VxWorks 6.x
330 function taskPriorityGet
(tid
: t_id
; pPriority
: access int
) return int
;
331 pragma Import
(C
, taskPriorityGet
, "taskPriorityGet");
333 function taskPrioritySet
(tid
: t_id
; newPriority
: int
) return int
;
334 pragma Import
(C
, taskPrioritySet
, "taskPrioritySet");
336 -- Semaphore creation flags
338 SEM_Q_FIFO
: constant := 0;
339 SEM_Q_PRIORITY
: constant := 1;
340 SEM_DELETE_SAFE
: constant := 4; -- only valid for binary semaphore
341 SEM_INVERSION_SAFE
: constant := 8; -- only valid for binary semaphore
343 -- Semaphore initial state flags
345 SEM_EMPTY
: constant := 0;
346 SEM_FULL
: constant := 1;
348 -- Semaphore take (semTake) time constants
350 WAIT_FOREVER
: constant := -1;
351 NO_WAIT
: constant := 0;
353 -- Error codes (errno). The lower level 16 bits are the error code, with
354 -- the upper 16 bits representing the module number in which the error
355 -- occurred. By convention, the module number is 0 for UNIX errors. VxWorks
356 -- reserves module numbers 1-500, with the remaining module numbers being
357 -- available for user applications.
359 M_objLib
: constant := 61 * 2**16;
360 -- semTake() failure with ticks = NO_WAIT
361 S_objLib_OBJ_UNAVAILABLE
: constant := M_objLib
+ 2;
362 -- semTake() timeout with ticks > NO_WAIT
363 S_objLib_OBJ_TIMEOUT
: constant := M_objLib
+ 4;
365 type SEM_ID
is new System
.Address
;
366 -- typedef struct semaphore *SEM_ID;
368 -- We use two different kinds of VxWorks semaphores: mutex and binary
369 -- semaphores. A null ID is returned when a semaphore cannot be created.
371 function semBCreate
(options
: int
; initial_state
: int
) return SEM_ID
;
372 pragma Import
(C
, semBCreate
, "semBCreate");
373 -- Create a binary semaphore. Return ID, or 0 if memory could not
376 function semMCreate
(options
: int
) return SEM_ID
;
377 pragma Import
(C
, semMCreate
, "semMCreate");
379 function semDelete
(Sem
: SEM_ID
) return int
;
380 pragma Import
(C
, semDelete
, "semDelete");
381 -- Delete a semaphore
383 function semGive
(Sem
: SEM_ID
) return int
;
384 pragma Import
(C
, semGive
, "semGive");
386 function semTake
(Sem
: SEM_ID
; timeout
: int
) return int
;
387 pragma Import
(C
, semTake
, "semTake");
388 -- Attempt to take binary semaphore. Error is returned if operation
391 function semFlush
(SemID
: SEM_ID
) return STATUS
;
392 pragma Import
(C
, semFlush
, "semFlush");
393 -- Release all threads blocked on the semaphore
396 type sigset_t
is new long
;
398 type pid_t
is new int
;
400 ERROR_PID
: constant pid_t
:= -1;
402 type clockid_t
is new int
;
403 CLOCK_REALTIME
: constant clockid_t
:= 0;
405 end System
.OS_Interface
;