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-2011, 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 3, 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. --
19 -- As a special exception under Section 7 of GPL version 3, you are granted --
20 -- additional permissions described in the GCC Runtime Library Exception, --
21 -- version 3.1, as published by the Free Software Foundation. --
23 -- You should have received a copy of the GNU General Public License and --
24 -- a copy of the GCC Runtime Library Exception along with this program; --
25 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
26 -- <http://www.gnu.org/licenses/>. --
28 -- GNARL was developed by the GNARL team at Florida State University. --
29 -- Extensive contributions were provided by Ada Core Technologies, Inc. --
31 ------------------------------------------------------------------------------
33 -- This is the VxWorks version of this package
35 -- This package encapsulates all direct interfaces to OS services
36 -- that are needed by the tasking run-time (libgnarl).
38 -- PLEASE DO NOT add any with-clauses to this package or remove the pragma
39 -- Preelaborate. This package is designed to be a bottom-level (leaf) package.
43 with System
.VxWorks
.Ext
;
44 with System
.Multiprocessors
;
46 package System
.OS_Interface
is
49 subtype int
is Interfaces
.C
.int
;
50 subtype unsigned
is Interfaces
.C
.unsigned
;
51 subtype short
is Short_Integer;
52 type unsigned_int
is mod 2 ** int
'Size;
53 type long
is new Long_Integer;
54 type unsigned_long
is mod 2 ** long
'Size;
55 type long_long
is new Long_Long_Integer;
56 type unsigned_long_long
is mod 2 ** long_long
'Size;
57 type size_t
is mod 2 ** Standard
'Address_Size;
63 function errno
return int
;
64 pragma Import
(C
, errno
, "errnoGet");
66 EINTR
: constant := 4;
67 EAGAIN
: constant := 35;
68 ENOMEM
: constant := 12;
69 EINVAL
: constant := 22;
70 ETIMEDOUT
: constant := 60;
72 FUNC_ERR
: constant := -1;
74 ----------------------------
75 -- Signals and interrupts --
76 ----------------------------
78 NSIG
: constant := 64;
79 -- Number of signals on the target OS
80 type Signal
is new int
range 0 .. Interfaces
.C
."-" (NSIG
, 1);
82 Max_HW_Interrupt
: constant := System
.VxWorks
.Num_HW_Interrupts
- 1;
83 type HW_Interrupt
is new int
range 0 .. Max_HW_Interrupt
;
85 Max_Interrupt
: constant := Max_HW_Interrupt
;
87 -- Signals common to Vxworks 5.x and 6.x
89 SIGILL
: constant := 4; -- illegal instruction (not reset when caught)
90 SIGABRT
: constant := 6; -- used by abort, replace SIGIOT in the future
91 SIGFPE
: constant := 8; -- floating point exception
92 SIGBUS
: constant := 10; -- bus error
93 SIGSEGV
: constant := 11; -- segmentation violation
95 -- Signals specific to VxWorks 6.x
97 SIGHUP
: constant := 1; -- hangup
98 SIGINT
: constant := 2; -- interrupt
99 SIGQUIT
: constant := 3; -- quit
100 SIGTRAP
: constant := 5; -- trace trap (not reset when caught)
101 SIGEMT
: constant := 7; -- EMT instruction
102 SIGKILL
: constant := 9; -- kill
103 SIGFMT
: constant := 12; -- STACK FORMAT ERROR (not posix)
104 SIGPIPE
: constant := 13; -- write on a pipe with no one to read it
105 SIGALRM
: constant := 14; -- alarm clock
106 SIGTERM
: constant := 15; -- software termination signal from kill
107 SIGCNCL
: constant := 16; -- pthreads cancellation signal
108 SIGSTOP
: constant := 17; -- sendable stop signal not from tty
109 SIGTSTP
: constant := 18; -- stop signal from tty
110 SIGCONT
: constant := 19; -- continue a stopped process
111 SIGCHLD
: constant := 20; -- to parent on child stop or exit
112 SIGTTIN
: constant := 21; -- to readers pgrp upon background tty read
113 SIGTTOU
: constant := 22; -- like TTIN for output
115 SIGRES1
: constant := 23; -- reserved signal number (Not POSIX)
116 SIGRES2
: constant := 24; -- reserved signal number (Not POSIX)
117 SIGRES3
: constant := 25; -- reserved signal number (Not POSIX)
118 SIGRES4
: constant := 26; -- reserved signal number (Not POSIX)
119 SIGRES5
: constant := 27; -- reserved signal number (Not POSIX)
120 SIGRES6
: constant := 28; -- reserved signal number (Not POSIX)
121 SIGRES7
: constant := 29; -- reserved signal number (Not POSIX)
123 SIGUSR1
: constant := 30; -- user defined signal 1
124 SIGUSR2
: constant := 31; -- user defined signal 2
126 SIGPOLL
: constant := 32; -- pollable event
127 SIGPROF
: constant := 33; -- profiling timer expired
128 SIGSYS
: constant := 34; -- bad system call
129 SIGURG
: constant := 35; -- high bandwidth data is available at socket
130 SIGVTALRM
: constant := 36; -- virtual timer expired
131 SIGXCPU
: constant := 37; -- CPU time limit exceeded
132 SIGXFSZ
: constant := 38; -- file size time limit exceeded
134 SIGEVTS
: constant := 39; -- signal event thread send
135 SIGEVTD
: constant := 40; -- signal event thread delete
137 SIGRTMIN
: constant := 48; -- Realtime signal min
138 SIGRTMAX
: constant := 63; -- Realtime signal max
140 -----------------------------------
141 -- Signal processing definitions --
142 -----------------------------------
144 -- The how in sigprocmask()
146 SIG_BLOCK
: constant := 1;
147 SIG_UNBLOCK
: constant := 2;
148 SIG_SETMASK
: constant := 3;
150 -- The sa_flags in struct sigaction
152 SA_SIGINFO
: constant := 16#
0002#
;
153 SA_ONSTACK
: constant := 16#
0004#
;
155 SIG_DFL
: constant := 0;
156 SIG_IGN
: constant := 1;
158 type sigset_t
is private;
160 type struct_sigaction
is record
161 sa_handler
: System
.Address
;
165 pragma Convention
(C
, struct_sigaction
);
166 type struct_sigaction_ptr
is access all struct_sigaction
;
168 function sigaddset
(set
: access sigset_t
; sig
: Signal
) return int
;
169 pragma Import
(C
, sigaddset
, "sigaddset");
171 function sigdelset
(set
: access sigset_t
; sig
: Signal
) return int
;
172 pragma Import
(C
, sigdelset
, "sigdelset");
174 function sigfillset
(set
: access sigset_t
) return int
;
175 pragma Import
(C
, sigfillset
, "sigfillset");
177 function sigismember
(set
: access sigset_t
; sig
: Signal
) return int
;
178 pragma Import
(C
, sigismember
, "sigismember");
180 function sigemptyset
(set
: access sigset_t
) return int
;
181 pragma Import
(C
, sigemptyset
, "sigemptyset");
185 act
: struct_sigaction_ptr
;
186 oact
: struct_sigaction_ptr
) return int
;
187 pragma Import
(C
, sigaction
, "sigaction");
189 type isr_address
is access procedure (sig
: int
);
190 pragma Convention
(C
, isr_address
);
192 function c_signal
(sig
: Signal
; handler
: isr_address
) return isr_address
;
193 pragma Import
(C
, c_signal
, "signal");
195 function sigwait
(set
: access sigset_t
; sig
: access Signal
) return int
;
196 pragma Inline
(sigwait
);
198 function pthread_sigmask
200 set
: access sigset_t
;
201 oset
: access sigset_t
) return int
;
202 pragma Import
(C
, pthread_sigmask
, "sigprocmask");
204 subtype t_id
is System
.VxWorks
.Ext
.t_id
;
205 subtype Thread_Id
is t_id
;
207 function kill
(pid
: t_id
; sig
: Signal
) return int
;
208 pragma Inline
(kill
);
210 function getpid
return t_id
renames System
.VxWorks
.Ext
.getpid
;
212 function Task_Stop
(tid
: t_id
) return int
213 renames System
.VxWorks
.Ext
.Task_Stop
;
214 -- If we are in the kernel space, stop the task whose t_id is
215 -- given in parameter in such a way that it can be examined by the
216 -- debugger. This typically maps to taskSuspend on VxWorks 5 and
217 -- to taskStop on VxWorks 6.
219 function Task_Cont
(tid
: t_id
) return int
220 renames System
.VxWorks
.Ext
.Task_Cont
;
221 -- If we are in the kernel space, continue the task whose t_id is
222 -- given in parameter if it has been stopped previously to be examined
223 -- by the debugger (e.g. by taskStop). It typically maps to taskResume
224 -- on VxWorks 5 and to taskCont on VxWorks 6.
226 function Int_Lock
return int
renames System
.VxWorks
.Ext
.Int_Lock
;
227 -- If we are in the kernel space, lock interrupts. It typically maps to
230 function Int_Unlock
return int
renames System
.VxWorks
.Ext
.Int_Unlock
;
231 -- If we are in the kernel space, unlock interrupts. It typically maps to
238 type time_t
is new unsigned_long
;
240 type timespec
is record
244 pragma Convention
(C
, timespec
);
246 type clockid_t
is new int
;
248 function To_Duration
(TS
: timespec
) return Duration;
249 pragma Inline
(To_Duration
);
251 function To_Timespec
(D
: Duration) return timespec
;
252 pragma Inline
(To_Timespec
);
254 function To_Clock_Ticks
(D
: Duration) return int
;
255 -- Convert a duration value (in seconds) into clock ticks
257 function clock_gettime
258 (clock_id
: clockid_t
; tp
: access timespec
) return int
;
259 pragma Import
(C
, clock_gettime
, "clock_gettime");
261 ----------------------
262 -- Utility Routines --
263 ----------------------
265 function To_VxWorks_Priority
(Priority
: int
) return int
;
266 pragma Inline
(To_VxWorks_Priority
);
267 -- Convenience routine to convert between VxWorks priority and Ada priority
269 --------------------------
270 -- VxWorks specific API --
271 --------------------------
273 subtype STATUS
is int
;
274 -- Equivalent of the C type STATUS
276 OK
: constant STATUS
:= 0;
277 ERROR
: constant STATUS
:= Interfaces
.C
.int
(-1);
279 function taskIdVerify
(tid
: t_id
) return STATUS
;
280 pragma Import
(C
, taskIdVerify
, "taskIdVerify");
282 function taskIdSelf
return t_id
;
283 pragma Import
(C
, taskIdSelf
, "taskIdSelf");
285 function taskOptionsGet
(tid
: t_id
; pOptions
: access int
) return int
;
286 pragma Import
(C
, taskOptionsGet
, "taskOptionsGet");
288 function taskSuspend
(tid
: t_id
) return int
;
289 pragma Import
(C
, taskSuspend
, "taskSuspend");
291 function taskResume
(tid
: t_id
) return int
;
292 pragma Import
(C
, taskResume
, "taskResume");
294 function taskIsSuspended
(tid
: t_id
) return int
;
295 pragma Import
(C
, taskIsSuspended
, "taskIsSuspended");
297 function taskDelay
(ticks
: int
) return int
;
298 procedure taskDelay
(ticks
: int
);
299 pragma Import
(C
, taskDelay
, "taskDelay");
301 function sysClkRateGet
return int
;
302 pragma Import
(C
, sysClkRateGet
, "sysClkRateGet");
304 -- VxWorks 5.x specific functions
305 -- Must not be called from run-time for versions that do not support
306 -- taskVarLib: eg VxWorks 6 RTPs
309 (tid
: t_id
; pVar
: access System
.Address
) return int
;
310 pragma Import
(C
, taskVarAdd
, "taskVarAdd");
312 function taskVarDelete
313 (tid
: t_id
; pVar
: access System
.Address
) return int
;
314 pragma Import
(C
, taskVarDelete
, "taskVarDelete");
318 pVar
: access System
.Address
;
319 value
: System
.Address
) return int
;
320 pragma Import
(C
, taskVarSet
, "taskVarSet");
324 pVar
: access System
.Address
) return int
;
325 pragma Import
(C
, taskVarGet
, "taskVarGet");
327 -- VxWorks 6.x specific functions
328 -- Can only be called from the VxWorks 6 run-time libary that supports
329 -- tlsLib, and not by the VxWorks 6.6 SMP library
331 function tlsKeyCreate
return int
;
332 pragma Import
(C
, tlsKeyCreate
, "tlsKeyCreate");
334 function tlsValueGet
(key
: int
) return System
.Address
;
335 pragma Import
(C
, tlsValueGet
, "tlsValueGet");
337 function tlsValueSet
(key
: int
; value
: System
.Address
) return STATUS
;
338 pragma Import
(C
, tlsValueSet
, "tlsValueSet");
340 -- Option flags for taskSpawn
342 VX_UNBREAKABLE
: constant := 16#
0002#
;
343 VX_FP_PRIVATE_ENV
: constant := 16#
0080#
;
344 VX_NO_STACK_FILL
: constant := 16#
0100#
;
347 (name
: System
.Address
; -- Pointer to task name
351 start_routine
: System
.Address
;
352 arg1
: System
.Address
;
361 arg10
: int
:= 0) return t_id
;
362 pragma Import
(C
, taskSpawn
, "taskSpawn");
364 procedure taskDelete
(tid
: t_id
);
365 pragma Import
(C
, taskDelete
, "taskDelete");
367 function Set_Time_Slice
(ticks
: int
) return int
368 renames System
.VxWorks
.Ext
.Set_Time_Slice
;
369 -- Calls kernelTimeSlice under VxWorks 5.x, VxWorks 653, or in VxWorks 6
370 -- kernel apps. Returns ERROR for RTPs, VxWorks 5 /CERT
372 function taskPriorityGet
(tid
: t_id
; pPriority
: access int
) return int
;
373 pragma Import
(C
, taskPriorityGet
, "taskPriorityGet");
375 function taskPrioritySet
(tid
: t_id
; newPriority
: int
) return int
;
376 pragma Import
(C
, taskPrioritySet
, "taskPrioritySet");
378 -- Semaphore creation flags
380 SEM_Q_FIFO
: constant := 0;
381 SEM_Q_PRIORITY
: constant := 1;
382 SEM_DELETE_SAFE
: constant := 4; -- only valid for binary semaphore
383 SEM_INVERSION_SAFE
: constant := 8; -- only valid for binary semaphore
385 -- Semaphore initial state flags
387 SEM_EMPTY
: constant := 0;
388 SEM_FULL
: constant := 1;
390 -- Semaphore take (semTake) time constants
392 WAIT_FOREVER
: constant := -1;
393 NO_WAIT
: constant := 0;
395 -- Error codes (errno). The lower level 16 bits are the error code, with
396 -- the upper 16 bits representing the module number in which the error
397 -- occurred. By convention, the module number is 0 for UNIX errors. VxWorks
398 -- reserves module numbers 1-500, with the remaining module numbers being
399 -- available for user applications.
401 M_objLib
: constant := 61 * 2**16;
402 -- semTake() failure with ticks = NO_WAIT
403 S_objLib_OBJ_UNAVAILABLE
: constant := M_objLib
+ 2;
404 -- semTake() timeout with ticks > NO_WAIT
405 S_objLib_OBJ_TIMEOUT
: constant := M_objLib
+ 4;
407 subtype SEM_ID
is System
.VxWorks
.Ext
.SEM_ID
;
408 -- typedef struct semaphore *SEM_ID;
410 -- We use two different kinds of VxWorks semaphores: mutex and binary
411 -- semaphores. A null ID is returned when a semaphore cannot be created.
413 function semBCreate
(options
: int
; initial_state
: int
) return SEM_ID
;
414 pragma Import
(C
, semBCreate
, "semBCreate");
415 -- Create a binary semaphore. Return ID, or 0 if memory could not
418 function semMCreate
(options
: int
) return SEM_ID
;
419 pragma Import
(C
, semMCreate
, "semMCreate");
421 function semDelete
(Sem
: SEM_ID
) return int
422 renames System
.VxWorks
.Ext
.semDelete
;
423 -- Delete a semaphore
425 function semGive
(Sem
: SEM_ID
) return int
;
426 pragma Import
(C
, semGive
, "semGive");
428 function semTake
(Sem
: SEM_ID
; timeout
: int
) return int
;
429 pragma Import
(C
, semTake
, "semTake");
430 -- Attempt to take binary semaphore. Error is returned if operation
433 function semFlush
(SemID
: SEM_ID
) return STATUS
;
434 pragma Import
(C
, semFlush
, "semFlush");
435 -- Release all threads blocked on the semaphore
437 ------------------------------------------------------------
438 -- Binary Semaphore Wrapper to Support interrupt Tasks --
439 ------------------------------------------------------------
441 type Binary_Semaphore_Id
is new Long_Integer;
443 function Binary_Semaphore_Create
return Binary_Semaphore_Id
;
444 pragma Inline
(Binary_Semaphore_Create
);
446 function Binary_Semaphore_Delete
(ID
: Binary_Semaphore_Id
) return int
;
447 pragma Inline
(Binary_Semaphore_Delete
);
449 function Binary_Semaphore_Obtain
(ID
: Binary_Semaphore_Id
) return int
;
450 pragma Inline
(Binary_Semaphore_Obtain
);
452 function Binary_Semaphore_Release
(ID
: Binary_Semaphore_Id
) return int
;
453 pragma Inline
(Binary_Semaphore_Release
);
455 function Binary_Semaphore_Flush
(ID
: Binary_Semaphore_Id
) return int
;
456 pragma Inline
(Binary_Semaphore_Flush
);
458 ------------------------------------------------------------
459 -- Hardware Interrupt Wrappers to Support Interrupt Tasks --
460 ------------------------------------------------------------
462 type Interrupt_Handler
is access procedure (parameter
: System
.Address
);
463 pragma Convention
(C
, Interrupt_Handler
);
465 type Interrupt_Vector
is new System
.Address
;
467 function Interrupt_Connect
468 (Vector
: Interrupt_Vector
;
469 Handler
: Interrupt_Handler
;
470 Parameter
: System
.Address
:= System
.Null_Address
) return int
;
471 pragma Inline
(Interrupt_Connect
);
472 -- Use this to set up an user handler. The routine installs a user
473 -- handler which is invoked after the OS has saved enough context for a
474 -- high-level language routine to be safely invoked.
476 function Interrupt_Context
return int
;
477 pragma Inline
(Interrupt_Context
);
478 -- Return 1 if executing in an interrupt context; return 0 if executing in
481 function Interrupt_Number_To_Vector
(intNum
: int
) return Interrupt_Vector
;
482 pragma Inline
(Interrupt_Number_To_Vector
);
483 -- Convert a logical interrupt number to the hardware interrupt vector
484 -- number used to connect the interrupt.
486 --------------------------------
487 -- Processor Affinity for SMP --
488 --------------------------------
490 function taskCpuAffinitySet
(tid
: t_id
; CPU
: int
) return int
491 renames System
.VxWorks
.Ext
.taskCpuAffinitySet
;
492 -- For SMP run-times the affinity to CPU.
493 -- For uniprocessor systems return ERROR status.
495 function taskMaskAffinitySet
(tid
: t_id
; CPU_Set
: unsigned
) return int
496 renames System
.VxWorks
.Ext
.taskMaskAffinitySet
;
497 -- For SMP run-times the affinity to CPU_Set.
498 -- For uniprocessor systems return ERROR status.
500 ---------------------
501 -- Multiprocessors --
502 ---------------------
504 function Current_CPU
return Multiprocessors
.CPU
;
505 -- Return the id of the current CPU
508 type pid_t
is new int
;
510 ERROR_PID
: constant pid_t
:= -1;
512 type sigset_t
is new System
.VxWorks
.Ext
.sigset_t
;
513 end System
.OS_Interface
;