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-2014, 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 that are
36 -- 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
;
206 -- Thread_Id and t_id are VxWorks identifiers for tasks. This value,
207 -- although represented as a Long_Integer, is in fact an address. With
208 -- some BSPs, this address can have a value sufficiently high that the
209 -- Thread_Id becomes negative: this should not be considered as an error.
211 function kill
(pid
: t_id
; sig
: Signal
) return int
;
212 pragma Inline
(kill
);
214 function getpid
return t_id
renames System
.VxWorks
.Ext
.getpid
;
216 function Task_Stop
(tid
: t_id
) return int
217 renames System
.VxWorks
.Ext
.Task_Stop
;
218 -- If we are in the kernel space, stop the task whose t_id is given in
219 -- parameter in such a way that it can be examined by the debugger. This
220 -- typically maps to taskSuspend on VxWorks 5 and to taskStop on VxWorks 6.
222 function Task_Cont
(tid
: t_id
) return int
223 renames System
.VxWorks
.Ext
.Task_Cont
;
224 -- If we are in the kernel space, continue the task whose t_id is given
225 -- in parameter if it has been stopped previously to be examined by the
226 -- debugger (e.g. by taskStop). It typically maps to taskResume on VxWorks
227 -- 5 and to taskCont on VxWorks 6.
229 function Int_Lock
return int
renames System
.VxWorks
.Ext
.Int_Lock
;
230 -- If we are in the kernel space, lock interrupts. It typically maps to
233 function Int_Unlock
return int
renames System
.VxWorks
.Ext
.Int_Unlock
;
234 -- If we are in the kernel space, unlock interrupts. It typically maps to
241 type time_t
is new unsigned_long
;
243 type timespec
is record
247 pragma Convention
(C
, timespec
);
249 type clockid_t
is new int
;
251 function To_Duration
(TS
: timespec
) return Duration;
252 pragma Inline
(To_Duration
);
254 function To_Timespec
(D
: Duration) return timespec
;
255 pragma Inline
(To_Timespec
);
257 function To_Clock_Ticks
(D
: Duration) return int
;
258 -- Convert a duration value (in seconds) into clock ticks
260 function clock_gettime
261 (clock_id
: clockid_t
; tp
: access timespec
) return int
;
262 pragma Import
(C
, clock_gettime
, "clock_gettime");
264 ----------------------
265 -- Utility Routines --
266 ----------------------
268 function To_VxWorks_Priority
(Priority
: int
) return int
;
269 pragma Inline
(To_VxWorks_Priority
);
270 -- Convenience routine to convert between VxWorks priority and Ada priority
272 --------------------------
273 -- VxWorks specific API --
274 --------------------------
276 subtype STATUS
is int
;
277 -- Equivalent of the C type STATUS
279 OK
: constant STATUS
:= 0;
280 ERROR
: constant STATUS
:= Interfaces
.C
.int
(-1);
282 function taskIdVerify
(tid
: t_id
) return STATUS
;
283 pragma Import
(C
, taskIdVerify
, "taskIdVerify");
285 function taskIdSelf
return t_id
;
286 pragma Import
(C
, taskIdSelf
, "taskIdSelf");
288 function taskOptionsGet
(tid
: t_id
; pOptions
: access int
) return int
;
289 pragma Import
(C
, taskOptionsGet
, "taskOptionsGet");
291 function taskSuspend
(tid
: t_id
) return int
;
292 pragma Import
(C
, taskSuspend
, "taskSuspend");
294 function taskResume
(tid
: t_id
) return int
;
295 pragma Import
(C
, taskResume
, "taskResume");
297 function taskIsSuspended
(tid
: t_id
) return int
;
298 pragma Import
(C
, taskIsSuspended
, "taskIsSuspended");
300 function taskDelay
(ticks
: int
) return int
;
301 procedure taskDelay
(ticks
: int
);
302 pragma Import
(C
, taskDelay
, "taskDelay");
304 function sysClkRateGet
return int
;
305 pragma Import
(C
, sysClkRateGet
, "sysClkRateGet");
307 -- VxWorks 5.x specific functions
308 -- Must not be called from run-time for versions that do not support
309 -- taskVarLib: eg VxWorks 6 RTPs
312 (tid
: t_id
; pVar
: access System
.Address
) return int
;
313 pragma Import
(C
, taskVarAdd
, "taskVarAdd");
315 function taskVarDelete
316 (tid
: t_id
; pVar
: access System
.Address
) return int
;
317 pragma Import
(C
, taskVarDelete
, "taskVarDelete");
321 pVar
: access System
.Address
;
322 value
: System
.Address
) return int
;
323 pragma Import
(C
, taskVarSet
, "taskVarSet");
327 pVar
: access System
.Address
) return int
;
328 pragma Import
(C
, taskVarGet
, "taskVarGet");
330 -- VxWorks 6.x specific functions
332 -- Can only be called from the VxWorks 6 run-time libary that supports
333 -- tlsLib, and not by the VxWorks 6.6 SMP library
335 function tlsKeyCreate
return int
;
336 pragma Import
(C
, tlsKeyCreate
, "tlsKeyCreate");
338 function tlsValueGet
(key
: int
) return System
.Address
;
339 pragma Import
(C
, tlsValueGet
, "tlsValueGet");
341 function tlsValueSet
(key
: int
; value
: System
.Address
) return STATUS
;
342 pragma Import
(C
, tlsValueSet
, "tlsValueSet");
344 -- Option flags for taskSpawn
346 VX_UNBREAKABLE
: constant := 16#
0002#
;
347 VX_FP_PRIVATE_ENV
: constant := 16#
0080#
;
348 VX_NO_STACK_FILL
: constant := 16#
0100#
;
351 (name
: System
.Address
; -- Pointer to task name
355 start_routine
: System
.Address
;
356 arg1
: System
.Address
;
365 arg10
: int
:= 0) return t_id
;
366 pragma Import
(C
, taskSpawn
, "taskSpawn");
368 procedure taskDelete
(tid
: t_id
);
369 pragma Import
(C
, taskDelete
, "taskDelete");
371 function Set_Time_Slice
(ticks
: int
) return int
372 renames System
.VxWorks
.Ext
.Set_Time_Slice
;
373 -- Calls kernelTimeSlice under VxWorks 5.x, VxWorks 653, or in VxWorks 6
374 -- kernel apps. Returns ERROR for RTPs, VxWorks 5 /CERT
376 function taskPriorityGet
(tid
: t_id
; pPriority
: access int
) return int
;
377 pragma Import
(C
, taskPriorityGet
, "taskPriorityGet");
379 function taskPrioritySet
(tid
: t_id
; newPriority
: int
) return int
;
380 pragma Import
(C
, taskPrioritySet
, "taskPrioritySet");
382 -- Semaphore creation flags
384 SEM_Q_FIFO
: constant := 0;
385 SEM_Q_PRIORITY
: constant := 1;
386 SEM_DELETE_SAFE
: constant := 4; -- only valid for binary semaphore
387 SEM_INVERSION_SAFE
: constant := 8; -- only valid for binary semaphore
389 -- Semaphore initial state flags
391 SEM_EMPTY
: constant := 0;
392 SEM_FULL
: constant := 1;
394 -- Semaphore take (semTake) time constants
396 WAIT_FOREVER
: constant := -1;
397 NO_WAIT
: constant := 0;
399 -- Error codes (errno). The lower level 16 bits are the error code, with
400 -- the upper 16 bits representing the module number in which the error
401 -- occurred. By convention, the module number is 0 for UNIX errors. VxWorks
402 -- reserves module numbers 1-500, with the remaining module numbers being
403 -- available for user applications.
405 M_objLib
: constant := 61 * 2**16;
406 -- semTake() failure with ticks = NO_WAIT
407 S_objLib_OBJ_UNAVAILABLE
: constant := M_objLib
+ 2;
408 -- semTake() timeout with ticks > NO_WAIT
409 S_objLib_OBJ_TIMEOUT
: constant := M_objLib
+ 4;
411 subtype SEM_ID
is System
.VxWorks
.Ext
.SEM_ID
;
412 -- typedef struct semaphore *SEM_ID;
414 -- We use two different kinds of VxWorks semaphores: mutex and binary
415 -- semaphores. A null ID is returned when a semaphore cannot be created.
417 function semBCreate
(options
: int
; initial_state
: int
) return SEM_ID
;
418 pragma Import
(C
, semBCreate
, "semBCreate");
419 -- Create a binary semaphore. Return ID, or 0 if memory could not
422 function semMCreate
(options
: int
) return SEM_ID
;
423 pragma Import
(C
, semMCreate
, "semMCreate");
425 function semDelete
(Sem
: SEM_ID
) return int
426 renames System
.VxWorks
.Ext
.semDelete
;
427 -- Delete a semaphore
429 function semGive
(Sem
: SEM_ID
) return int
;
430 pragma Import
(C
, semGive
, "semGive");
432 function semTake
(Sem
: SEM_ID
; timeout
: int
) return int
;
433 pragma Import
(C
, semTake
, "semTake");
434 -- Attempt to take binary semaphore. Error is returned if operation
437 function semFlush
(SemID
: SEM_ID
) return STATUS
;
438 pragma Import
(C
, semFlush
, "semFlush");
439 -- Release all threads blocked on the semaphore
441 ------------------------------------------------------------
442 -- Binary Semaphore Wrapper to Support interrupt Tasks --
443 ------------------------------------------------------------
445 type Binary_Semaphore_Id
is new Long_Integer;
447 function Binary_Semaphore_Create
return Binary_Semaphore_Id
;
448 pragma Inline
(Binary_Semaphore_Create
);
450 function Binary_Semaphore_Delete
(ID
: Binary_Semaphore_Id
) return int
;
451 pragma Inline
(Binary_Semaphore_Delete
);
453 function Binary_Semaphore_Obtain
(ID
: Binary_Semaphore_Id
) return int
;
454 pragma Inline
(Binary_Semaphore_Obtain
);
456 function Binary_Semaphore_Release
(ID
: Binary_Semaphore_Id
) return int
;
457 pragma Inline
(Binary_Semaphore_Release
);
459 function Binary_Semaphore_Flush
(ID
: Binary_Semaphore_Id
) return int
;
460 pragma Inline
(Binary_Semaphore_Flush
);
462 ------------------------------------------------------------
463 -- Hardware Interrupt Wrappers to Support Interrupt Tasks --
464 ------------------------------------------------------------
466 type Interrupt_Handler
is access procedure (parameter
: System
.Address
);
467 pragma Convention
(C
, Interrupt_Handler
);
469 type Interrupt_Vector
is new System
.Address
;
471 function Interrupt_Connect
472 (Vector
: Interrupt_Vector
;
473 Handler
: Interrupt_Handler
;
474 Parameter
: System
.Address
:= System
.Null_Address
) return int
;
475 pragma Inline
(Interrupt_Connect
);
476 -- Use this to set up an user handler. The routine installs a user handler
477 -- which is invoked after the OS has saved enough context for a high-level
478 -- language routine to be safely invoked.
480 function Interrupt_Context
return int
;
481 pragma Inline
(Interrupt_Context
);
482 -- Return 1 if executing in an interrupt context; return 0 if executing in
485 function Interrupt_Number_To_Vector
(intNum
: int
) return Interrupt_Vector
;
486 pragma Inline
(Interrupt_Number_To_Vector
);
487 -- Convert a logical interrupt number to the hardware interrupt vector
488 -- number used to connect the interrupt.
490 --------------------------------
491 -- Processor Affinity for SMP --
492 --------------------------------
494 function taskCpuAffinitySet
(tid
: t_id
; CPU
: int
) return int
495 renames System
.VxWorks
.Ext
.taskCpuAffinitySet
;
496 -- For SMP run-times the affinity to CPU.
497 -- For uniprocessor systems return ERROR status.
499 function taskMaskAffinitySet
(tid
: t_id
; CPU_Set
: unsigned
) return int
500 renames System
.VxWorks
.Ext
.taskMaskAffinitySet
;
501 -- For SMP run-times the affinity to CPU_Set.
502 -- For uniprocessor systems return ERROR status.
504 ---------------------
505 -- Multiprocessors --
506 ---------------------
508 function Current_CPU
return Multiprocessors
.CPU
;
509 -- Return the id of the current CPU
512 type pid_t
is new int
;
514 ERROR_PID
: constant pid_t
:= -1;
516 type sigset_t
is new System
.VxWorks
.Ext
.sigset_t
;
517 end System
.OS_Interface
;