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-2006, 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 long
is new Long_Integer;
52 type unsigned_long
is mod 2 ** long
'Size;
53 type size_t
is mod 2 ** Standard
'Address_Size;
59 function errno
return int
;
60 pragma Import
(C
, errno
, "errnoGet");
62 EINTR
: constant := 4;
63 EAGAIN
: constant := 35;
64 ENOMEM
: constant := 12;
65 EINVAL
: constant := 22;
66 ETIMEDOUT
: constant := 60;
68 FUNC_ERR
: constant := -1;
70 ----------------------------
71 -- Signals and Interrupts --
72 ----------------------------
74 NSIG
: constant := 32;
75 -- Number of signals on the target OS
76 type Signal
is new int
range 0 .. Interfaces
.C
."-" (NSIG
, 1);
78 Max_HW_Interrupt
: constant := System
.VxWorks
.Num_HW_Interrupts
- 1;
79 type HW_Interrupt
is new int
range 0 .. Max_HW_Interrupt
;
81 Max_Interrupt
: constant := Max_HW_Interrupt
;
83 SIGILL
: constant := 4; -- illegal instruction (not reset)
84 SIGABRT
: constant := 6; -- used by abort, replace SIGIOT in the future
85 SIGFPE
: constant := 8; -- floating point exception
86 SIGBUS
: constant := 10; -- bus error
87 SIGSEGV
: constant := 11; -- segmentation violation
89 -----------------------------------
90 -- Signal processing definitions --
91 -----------------------------------
93 -- The how in sigprocmask().
94 SIG_BLOCK
: constant := 1;
95 SIG_UNBLOCK
: constant := 2;
96 SIG_SETMASK
: constant := 3;
98 -- The sa_flags in struct sigaction.
99 SA_SIGINFO
: constant := 16#
0002#
;
100 SA_ONSTACK
: constant := 16#
0004#
;
102 SIG_DFL
: constant := 0;
103 SIG_IGN
: constant := 1;
105 type sigset_t
is private;
107 type struct_sigaction
is record
108 sa_handler
: System
.Address
;
112 pragma Convention
(C
, struct_sigaction
);
113 type struct_sigaction_ptr
is access all struct_sigaction
;
115 function sigaddset
(set
: access sigset_t
; sig
: Signal
) return int
;
116 pragma Import
(C
, sigaddset
, "sigaddset");
118 function sigdelset
(set
: access sigset_t
; sig
: Signal
) return int
;
119 pragma Import
(C
, sigdelset
, "sigdelset");
121 function sigfillset
(set
: access sigset_t
) return int
;
122 pragma Import
(C
, sigfillset
, "sigfillset");
124 function sigismember
(set
: access sigset_t
; sig
: Signal
) return int
;
125 pragma Import
(C
, sigismember
, "sigismember");
127 function sigemptyset
(set
: access sigset_t
) return int
;
128 pragma Import
(C
, sigemptyset
, "sigemptyset");
132 act
: struct_sigaction_ptr
;
133 oact
: struct_sigaction_ptr
) return int
;
134 pragma Import
(C
, sigaction
, "sigaction");
136 type isr_address
is access procedure (sig
: int
);
138 function c_signal
(sig
: Signal
; handler
: isr_address
) return isr_address
;
139 pragma Import
(C
, c_signal
, "signal");
141 function sigwait
(set
: access sigset_t
; sig
: access Signal
) return int
;
142 pragma Inline
(sigwait
);
144 function pthread_sigmask
146 set
: access sigset_t
;
147 oset
: access sigset_t
) return int
;
148 pragma Import
(C
, pthread_sigmask
, "sigprocmask");
150 type t_id
is new long
;
151 subtype Thread_Id
is t_id
;
153 function kill
(pid
: t_id
; sig
: Signal
) return int
;
154 pragma Inline
(kill
);
156 function getpid
return t_id
;
157 pragma Import
(C
, getpid
, "taskIdSelf");
158 -- VxWorks doesn't have getpid; taskIdSelf is the equivalent routine.
164 type time_t
is new unsigned_long
;
166 type timespec
is record
170 pragma Convention
(C
, timespec
);
172 type clockid_t
is private;
174 CLOCK_REALTIME
: constant clockid_t
; -- System wide realtime clock
176 function To_Duration
(TS
: timespec
) return Duration;
177 pragma Inline
(To_Duration
);
179 function To_Timespec
(D
: Duration) return timespec
;
180 pragma Inline
(To_Timespec
);
182 function To_Clock_Ticks
(D
: Duration) return int
;
183 -- Convert a duration value (in seconds) into clock ticks
185 function clock_gettime
186 (clock_id
: clockid_t
; tp
: access timespec
) return int
;
187 pragma Import
(C
, clock_gettime
, "clock_gettime");
189 type ULONG
is new unsigned_long
;
191 procedure tickSet
(ticks
: ULONG
);
192 pragma Import
(C
, tickSet
, "tickSet");
194 function tickGet
return ULONG
;
195 pragma Import
(C
, tickGet
, "tickGet");
197 ----------------------
198 -- Utility Routines --
199 ----------------------
201 function To_VxWorks_Priority
(Priority
: in int
) return int
;
202 pragma Inline
(To_VxWorks_Priority
);
203 -- Convenience routine to convert between VxWorks priority and Ada priority
205 --------------------------
206 -- VxWorks specific API --
207 --------------------------
209 subtype STATUS
is int
;
210 -- Equivalent of the C type STATUS
212 OK
: constant STATUS
:= 0;
213 ERROR
: constant STATUS
:= Interfaces
.C
.int
(-1);
215 function taskIdVerify
(tid
: t_id
) return STATUS
;
216 pragma Import
(C
, taskIdVerify
, "taskIdVerify");
218 function taskIdSelf
return t_id
;
219 pragma Import
(C
, taskIdSelf
, "taskIdSelf");
221 function taskSuspend
(tid
: t_id
) return int
;
222 pragma Import
(C
, taskSuspend
, "taskSuspend");
224 function taskResume
(tid
: t_id
) return int
;
225 pragma Import
(C
, taskResume
, "taskResume");
227 function taskIsSuspended
(tid
: t_id
) return int
;
228 pragma Import
(C
, taskIsSuspended
, "taskIsSuspended");
230 function taskDelay
(ticks
: int
) return int
;
231 procedure taskDelay
(ticks
: int
);
232 pragma Import
(C
, taskDelay
, "taskDelay");
234 function sysClkRateGet
return int
;
235 pragma Import
(C
, sysClkRateGet
, "sysClkRateGet");
237 -- VxWorks 5.x specific functions
240 (tid
: t_id
; pVar
: access System
.Address
) return int
;
241 pragma Import
(C
, taskVarAdd
, "taskVarAdd");
243 function taskVarDelete
244 (tid
: t_id
; pVar
: access System
.Address
) return int
;
245 pragma Import
(C
, taskVarDelete
, "taskVarDelete");
249 pVar
: access System
.Address
;
250 value
: System
.Address
) return int
;
251 pragma Import
(C
, taskVarSet
, "taskVarSet");
255 pVar
: access System
.Address
) return int
;
256 pragma Import
(C
, taskVarGet
, "taskVarGet");
258 -- VxWorks 6.x specific functions
260 function tlsKeyCreate
return int
;
261 pragma Import
(C
, tlsKeyCreate
, "tlsKeyCreate");
263 function tlsValueGet
(key
: int
) return System
.Address
;
264 pragma Import
(C
, tlsValueGet
, "tlsValueGet");
266 function tlsValueSet
(key
: int
; value
: System
.Address
) return STATUS
;
267 pragma Import
(C
, tlsValueSet
, "tlsValueSet");
269 -- Option flags for taskSpawn
271 VX_UNBREAKABLE
: constant := 16#
0002#
;
272 VX_FP_PRIVATE_ENV
: constant := 16#
0080#
;
273 VX_NO_STACK_FILL
: constant := 16#
0100#
;
275 function VX_FP_TASK
return int
;
276 pragma Inline
(VX_FP_TASK
);
279 (name
: System
.Address
; -- Pointer to task name
283 start_routine
: System
.Address
;
284 arg1
: System
.Address
;
293 arg10
: int
:= 0) return t_id
;
294 pragma Import
(C
, taskSpawn
, "taskSpawn");
296 procedure taskDelete
(tid
: t_id
);
297 pragma Import
(C
, taskDelete
, "taskDelete");
299 function Set_Time_Slice
(ticks
: int
) return int
;
300 pragma Inline
(Set_Time_Slice
);
301 -- Calls kernelTimeSlice under VxWorks 5.x
302 -- Do nothing under VxWorks 6.x
304 function taskPriorityGet
(tid
: t_id
; pPriority
: access int
) return int
;
305 pragma Import
(C
, taskPriorityGet
, "taskPriorityGet");
307 function taskPrioritySet
(tid
: t_id
; newPriority
: int
) return int
;
308 pragma Import
(C
, taskPrioritySet
, "taskPrioritySet");
310 -- Semaphore creation flags
312 SEM_Q_FIFO
: constant := 0;
313 SEM_Q_PRIORITY
: constant := 1;
314 SEM_DELETE_SAFE
: constant := 4; -- only valid for binary semaphore
315 SEM_INVERSION_SAFE
: constant := 8; -- only valid for binary semaphore
317 -- Semaphore initial state flags
319 SEM_EMPTY
: constant := 0;
320 SEM_FULL
: constant := 1;
322 -- Semaphore take (semTake) time constants
324 WAIT_FOREVER
: constant := -1;
325 NO_WAIT
: constant := 0;
327 -- Error codes (errno). The lower level 16 bits are the error code, with
328 -- the upper 16 bits representing the module number in which the error
329 -- occurred. By convention, the module number is 0 for UNIX errors. VxWorks
330 -- reserves module numbers 1-500, with the remaining module numbers being
331 -- available for user applications.
333 M_objLib
: constant := 61 * 2**16;
334 -- semTake() failure with ticks = NO_WAIT
335 S_objLib_OBJ_UNAVAILABLE
: constant := M_objLib
+ 2;
336 -- semTake() timeout with ticks > NO_WAIT
337 S_objLib_OBJ_TIMEOUT
: constant := M_objLib
+ 4;
339 type SEM_ID
is new System
.Address
;
340 -- typedef struct semaphore *SEM_ID;
342 -- We use two different kinds of VxWorks semaphores: mutex and binary
343 -- semaphores. A null ID is returned when a semaphore cannot be created.
345 function semBCreate
(options
: int
; initial_state
: int
) return SEM_ID
;
346 pragma Import
(C
, semBCreate
, "semBCreate");
347 -- Create a binary semaphore. Return ID, or 0 if memory could not
350 function semMCreate
(options
: int
) return SEM_ID
;
351 pragma Import
(C
, semMCreate
, "semMCreate");
353 function semDelete
(Sem
: SEM_ID
) return int
;
354 pragma Import
(C
, semDelete
, "semDelete");
355 -- Delete a semaphore
357 function semGive
(Sem
: SEM_ID
) return int
;
358 pragma Import
(C
, semGive
, "semGive");
360 function semTake
(Sem
: SEM_ID
; timeout
: int
) return int
;
361 pragma Import
(C
, semTake
, "semTake");
362 -- Attempt to take binary semaphore. Error is returned if operation
365 function semFlush
(SemID
: SEM_ID
) return STATUS
;
366 pragma Import
(C
, semFlush
, "semFlush");
367 -- Release all threads blocked on the semaphore
370 type sigset_t
is new long
;
372 type pid_t
is new int
;
374 ERROR_PID
: constant pid_t
:= -1;
376 type clockid_t
is new int
;
377 CLOCK_REALTIME
: constant clockid_t
:= 0;
379 end System
.OS_Interface
;