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-2017, Florida State University --
10 -- Copyright (C) 1995-2024, 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.
44 with System
.VxWorks
.Ext
;
45 with System
.Multiprocessors
;
46 with System
.Parameters
;
48 package System
.OS_Interface
is
51 package SVE
renames System
.VxWorks
.Ext
;
53 subtype int
is Interfaces
.C
.int
;
54 subtype unsigned
is Interfaces
.C
.unsigned
;
55 subtype short
is Short_Integer;
56 type unsigned_int
is mod 2 ** int
'Size;
57 type long
is new Long_Integer;
58 type unsigned_long
is mod 2 ** long
'Size;
59 type long_long
is new Long_Long_Integer;
60 type unsigned_long_long
is mod 2 ** long_long
'Size;
61 type size_t
is mod 2 ** Standard
'Address_Size;
63 subtype STATUS
is SVE
.STATUS
;
64 subtype BOOL
is SVE
.BOOL
;
65 subtype vx_freq_t
is SVE
.vx_freq_t
;
71 function errno
return int
;
72 pragma Import
(C
, errno
, "errnoGet");
74 EINTR
: constant := 4;
75 EAGAIN
: constant := 35;
76 ENOMEM
: constant := 12;
77 EINVAL
: constant := 22;
78 ETIMEDOUT
: constant := 60;
80 FUNC_ERR
: constant := -1;
82 ----------------------------
83 -- Signals and interrupts --
84 ----------------------------
86 NSIG
: constant := 64;
87 -- Number of signals on the target OS
88 type Signal
is new int
range 0 .. Interfaces
.C
."-" (NSIG
, 1);
90 Max_HW_Interrupt
: constant := System
.VxWorks
.Num_HW_Interrupts
- 1;
91 type HW_Interrupt
is new int
range 0 .. Max_HW_Interrupt
;
93 Max_Interrupt
: constant := Max_HW_Interrupt
;
94 subtype Interrupt_Range
is Natural range 0 .. Max_HW_Interrupt
;
97 -- Signals common to Vxworks 5.x and 6.x
99 SIGILL
: constant := 4; -- illegal instruction (not reset when caught)
100 SIGABRT
: constant := 6; -- used by abort, replace SIGIOT in the future
101 SIGFPE
: constant := 8; -- floating point exception
102 SIGBUS
: constant := 10; -- bus error
103 SIGSEGV
: constant := 11; -- segmentation violation
105 -- Signals specific to VxWorks 6.x
107 SIGHUP
: constant := 1; -- hangup
108 SIGINT
: constant := 2; -- interrupt
109 SIGQUIT
: constant := 3; -- quit
110 SIGTRAP
: constant := 5; -- trace trap (not reset when caught)
111 SIGEMT
: constant := 7; -- EMT instruction
112 SIGKILL
: constant := 9; -- kill
113 SIGFMT
: constant := 12; -- STACK FORMAT ERROR (not posix)
114 SIGPIPE
: constant := 13; -- write on a pipe with no one to read it
115 SIGALRM
: constant := 14; -- alarm clock
116 SIGTERM
: constant := 15; -- software termination signal from kill
117 SIGCNCL
: constant := 16; -- pthreads cancellation signal
118 SIGSTOP
: constant := 17; -- sendable stop signal not from tty
119 SIGTSTP
: constant := 18; -- stop signal from tty
120 SIGCONT
: constant := 19; -- continue a stopped process
121 SIGCHLD
: constant := 20; -- to parent on child stop or exit
122 SIGTTIN
: constant := 21; -- to readers pgrp upon background tty read
123 SIGTTOU
: constant := 22; -- like TTIN for output
125 SIGRES1
: constant := 23; -- reserved signal number (Not POSIX)
126 SIGRES2
: constant := 24; -- reserved signal number (Not POSIX)
127 SIGRES3
: constant := 25; -- reserved signal number (Not POSIX)
128 SIGRES4
: constant := 26; -- reserved signal number (Not POSIX)
129 SIGRES5
: constant := 27; -- reserved signal number (Not POSIX)
130 SIGRES6
: constant := 28; -- reserved signal number (Not POSIX)
131 SIGRES7
: constant := 29; -- reserved signal number (Not POSIX)
133 SIGUSR1
: constant := 30; -- user defined signal 1
134 SIGUSR2
: constant := 31; -- user defined signal 2
136 SIGPOLL
: constant := 32; -- pollable event
137 SIGPROF
: constant := 33; -- profiling timer expired
138 SIGSYS
: constant := 34; -- bad system call
139 SIGURG
: constant := 35; -- high bandwidth data is available at socket
140 SIGVTALRM
: constant := 36; -- virtual timer expired
141 SIGXCPU
: constant := 37; -- CPU time limit exceeded
142 SIGXFSZ
: constant := 38; -- file size time limit exceeded
144 SIGEVTS
: constant := 39; -- signal event thread send
145 SIGEVTD
: constant := 40; -- signal event thread delete
147 SIGRTMIN
: constant := 48; -- Realtime signal min
148 SIGRTMAX
: constant := 63; -- Realtime signal max
150 -----------------------------------
151 -- Signal processing definitions --
152 -----------------------------------
154 -- The how in sigprocmask()
156 SIG_BLOCK
: constant := 1;
157 SIG_UNBLOCK
: constant := 2;
158 SIG_SETMASK
: constant := 3;
160 -- The sa_flags in struct sigaction
162 SA_SIGINFO
: constant := 16#
0002#
;
163 SA_ONSTACK
: constant := 16#
0004#
;
165 SIG_DFL
: constant := 0;
166 SIG_IGN
: constant := 1;
168 type sigset_t
is private;
170 type struct_sigaction
is record
171 sa_handler
: System
.Address
;
175 pragma Convention
(C
, struct_sigaction
);
176 type struct_sigaction_ptr
is access all struct_sigaction
;
178 function sigaddset
(set
: access sigset_t
; sig
: Signal
) return int
;
179 pragma Import
(C
, sigaddset
, "sigaddset");
181 function sigdelset
(set
: access sigset_t
; sig
: Signal
) return int
;
182 pragma Import
(C
, sigdelset
, "sigdelset");
184 function sigfillset
(set
: access sigset_t
) return int
;
185 pragma Import
(C
, sigfillset
, "sigfillset");
187 function sigismember
(set
: access sigset_t
; sig
: Signal
) return int
;
188 pragma Import
(C
, sigismember
, "sigismember");
190 function sigemptyset
(set
: access sigset_t
) return int
;
191 pragma Import
(C
, sigemptyset
, "sigemptyset");
195 act
: struct_sigaction_ptr
;
196 oact
: struct_sigaction_ptr
) return int
;
197 pragma Import
(C
, sigaction
, "sigaction");
199 type isr_address
is access procedure (sig
: int
);
200 pragma Convention
(C
, isr_address
);
202 function c_signal
(sig
: Signal
; handler
: isr_address
) return isr_address
;
203 pragma Import
(C
, c_signal
, "signal");
205 function pthread_sigmask
207 set
: access sigset_t
;
208 oset
: access sigset_t
) return int
;
209 pragma Import
(C
, pthread_sigmask
, "sigprocmask");
211 subtype t_id
is SVE
.t_id
;
212 subtype Thread_Id
is t_id
;
213 -- Thread_Id and t_id are VxWorks identifiers for tasks. This value,
214 -- although represented as a Long_Integer, is in fact an address. With
215 -- some BSPs, this address can have a value sufficiently high that the
216 -- Thread_Id becomes negative: this should not be considered as an error.
218 function kill
(pid
: t_id
; sig
: Signal
) return int
;
219 pragma Inline
(kill
);
221 function getpid
return t_id
renames SVE
.getpid
;
223 function Task_Stop
(tid
: t_id
) return STATUS
renames SVE
.Task_Stop
;
224 -- If we are in the kernel space, stop the task whose t_id is given in
225 -- parameter in such a way that it can be examined by the debugger. This
226 -- typically maps to taskSuspend on VxWorks 5 and to taskStop on VxWorks 6.
228 function Task_Cont
(tid
: t_id
) return STATUS
renames SVE
.Task_Cont
;
229 -- If we are in the kernel space, continue the task whose t_id is given
230 -- in parameter if it has been stopped previously to be examined by the
231 -- debugger (e.g. by taskStop). It typically maps to taskResume on VxWorks
232 -- 5 and to taskCont on VxWorks 6.
234 function Int_Lock
return int
renames SVE
.Int_Lock
;
235 -- If we are in the kernel space, lock interrupts. It typically maps to
238 procedure Int_Unlock
(Old
: int
) renames SVE
.Int_Unlock
;
239 -- If we are in the kernel space, unlock interrupts. It typically maps to
240 -- intUnlock. The parameter Old is only used on PowerPC where it contains
241 -- the returned value from Int_Lock (the old MPSR).
247 type time_t
is range -2 ** (System
.Parameters
.time_t_bits
- 1)
248 .. 2 ** (System
.Parameters
.time_t_bits
- 1) - 1;
249 -- Time_t here used to be unsigned to match the VxWorks header declaration.
250 -- The header declaration has changed in newer releases and is now signed
253 type timespec
is record
257 pragma Convention
(C
, timespec
);
259 type clockid_t
is new int
;
261 function To_Duration
(TS
: timespec
) return Duration;
262 pragma Inline
(To_Duration
);
264 function To_Timespec
(D
: Duration) return timespec
;
265 pragma Inline
(To_Timespec
);
266 -- Convert a Duration value to a timespec value. Note that in VxWorks,
267 -- timespec is always non-negative (since time_t is defined above as
268 -- unsigned long). This means that there is a potential problem if a
269 -- negative argument is passed for D. However, in actual usage, the
270 -- value of the input argument D is always non-negative, so no problem
271 -- arises in practice.
273 function To_Clock_Ticks
(D
: Duration) return int
;
274 -- Convert a duration value (in seconds) into clock ticks
276 function clock_gettime
277 (clock_id
: clockid_t
; tp
: access timespec
) return int
;
278 pragma Import
(C
, clock_gettime
, "clock_gettime");
280 ----------------------
281 -- Utility Routines --
282 ----------------------
284 function To_VxWorks_Priority
(Priority
: int
) return int
;
285 pragma Inline
(To_VxWorks_Priority
);
286 -- Convenience routine to convert between VxWorks priority and Ada priority
288 --------------------------
289 -- VxWorks specific API --
290 --------------------------
292 function taskIdVerify
(tid
: t_id
) return STATUS
;
293 pragma Import
(C
, taskIdVerify
, "taskIdVerify");
295 function taskIdSelf
return t_id
;
296 pragma Import
(C
, taskIdSelf
, "taskIdSelf");
298 function taskOptionsGet
(tid
: t_id
; pOptions
: access int
) return STATUS
;
299 pragma Import
(C
, taskOptionsGet
, "taskOptionsGet");
301 function taskSuspend
(tid
: t_id
) return STATUS
;
302 pragma Import
(C
, taskSuspend
, "taskSuspend");
304 function taskResume
(tid
: t_id
) return STATUS
;
305 pragma Import
(C
, taskResume
, "taskResume");
307 function taskIsSuspended
(tid
: t_id
) return BOOL
;
308 pragma Import
(C
, taskIsSuspended
, "taskIsSuspended");
310 function taskDelay
(ticks
: int
) return STATUS
;
311 pragma Import
(C
, taskDelay
, "taskDelay");
313 function sysClkRateGet
return vx_freq_t
;
314 pragma Import
(C
, sysClkRateGet
, "sysClkRateGet");
316 -- VxWorks 5.x specific functions
317 -- Must not be called from run-time for versions that do not support
318 -- taskVarLib: eg VxWorks 6 RTPs
321 (tid
: t_id
; pVar
: access System
.Address
) return STATUS
;
322 pragma Import
(C
, taskVarAdd
, "taskVarAdd");
324 function taskVarDelete
325 (tid
: t_id
; pVar
: access System
.Address
) return STATUS
;
326 pragma Import
(C
, taskVarDelete
, "taskVarDelete");
330 pVar
: access System
.Address
;
331 value
: System
.Address
) return STATUS
;
332 pragma Import
(C
, taskVarSet
, "taskVarSet");
336 pVar
: access System
.Address
) return int
;
337 pragma Import
(C
, taskVarGet
, "taskVarGet");
339 -- VxWorks 6.x specific functions
341 -- Can only be called from the VxWorks 6 run-time libary that supports
342 -- tlsLib, and not by the VxWorks 6.6 SMP library
344 function tlsKeyCreate
return int
;
345 pragma Import
(C
, tlsKeyCreate
, "tlsKeyCreate");
347 function tlsValueGet
(key
: int
) return System
.Address
;
348 pragma Import
(C
, tlsValueGet
, "tlsValueGet");
350 function tlsValueSet
(key
: int
; value
: System
.Address
) return STATUS
;
351 pragma Import
(C
, tlsValueSet
, "tlsValueSet");
353 -- Option flags for taskSpawn
355 VX_UNBREAKABLE
: constant := 16#
0002#
;
356 VX_FP_PRIVATE_ENV
: constant := 16#
0080#
;
357 VX_NO_STACK_FILL
: constant := 16#
0100#
;
360 (name
: System
.Address
; -- Pointer to task name
364 start_routine
: System
.Address
;
365 arg1
: System
.Address
;
374 arg10
: int
:= 0) return t_id
;
375 pragma Import
(C
, taskSpawn
, "taskSpawn");
377 procedure taskDelete
(tid
: t_id
);
378 pragma Import
(C
, taskDelete
, "taskDelete");
380 function Set_Time_Slice
(ticks
: int
) return STATUS
renames
382 -- Calls kernelTimeSlice under VxWorks 5.x, VxWorks 653, or in VxWorks 6
383 -- kernel apps. Returns ERROR for RTPs, VxWorks 5 /CERT
385 function taskPriorityGet
(tid
: t_id
; pPriority
: access int
) return STATUS
;
386 pragma Import
(C
, taskPriorityGet
, "taskPriorityGet");
388 function taskPrioritySet
(tid
: t_id
; newPriority
: int
) return STATUS
;
389 pragma Import
(C
, taskPrioritySet
, "taskPrioritySet");
391 -- Semaphore creation flags
393 SEM_Q_FIFO
: constant := 0;
394 SEM_Q_PRIORITY
: constant := 1;
395 SEM_DELETE_SAFE
: constant := 4; -- only valid for binary semaphore
396 SEM_INVERSION_SAFE
: constant := 8; -- only valid for binary semaphore
398 -- Semaphore initial state flags
400 SEM_EMPTY
: constant := 0;
401 SEM_FULL
: constant := 1;
403 -- Semaphore take (semTake) time constants
405 WAIT_FOREVER
: constant := -1;
406 NO_WAIT
: constant := 0;
408 -- Error codes (errno). The lower level 16 bits are the error code, with
409 -- the upper 16 bits representing the module number in which the error
410 -- occurred. By convention, the module number is 0 for UNIX errors. VxWorks
411 -- reserves module numbers 1-500, with the remaining module numbers being
412 -- available for user applications.
414 M_objLib
: constant := 61 * 2**16;
415 -- semTake() failure with ticks = NO_WAIT
416 S_objLib_OBJ_UNAVAILABLE
: constant := M_objLib
+ 2;
417 -- semTake() timeout with ticks > NO_WAIT
418 S_objLib_OBJ_TIMEOUT
: constant := M_objLib
+ 4;
420 subtype SEM_ID
is SVE
.SEM_ID
;
421 -- typedef struct semaphore *SEM_ID;
423 -- We use two different kinds of VxWorks semaphores: mutex and binary
424 -- semaphores. A null ID is returned when a semaphore cannot be created.
426 function semBCreate
(options
: int
; initial_state
: int
) return SEM_ID
;
427 pragma Import
(C
, semBCreate
, "semBCreate");
428 -- Create a binary semaphore. Return ID, or 0 if memory could not
431 function semMCreate
(options
: int
) return SEM_ID
;
432 pragma Import
(C
, semMCreate
, "semMCreate");
434 function semDelete
(Sem
: SEM_ID
) return STATUS
renames SVE
.semDelete
;
435 -- Delete a semaphore
437 function semGive
(Sem
: SEM_ID
) return STATUS
;
438 pragma Import
(C
, semGive
, "semGive");
440 function semTake
(Sem
: SEM_ID
; timeout
: int
) return STATUS
;
441 pragma Import
(C
, semTake
, "semTake");
442 -- Attempt to take binary semaphore. Error is returned if operation
445 function semFlush
(SemID
: SEM_ID
) return STATUS
;
446 pragma Import
(C
, semFlush
, "semFlush");
447 -- Release all threads blocked on the semaphore
449 ------------------------------------------------------------
450 -- Binary Semaphore Wrapper to Support interrupt Tasks --
451 ------------------------------------------------------------
453 type Binary_Semaphore_Id
is new Long_Integer;
455 function Binary_Semaphore_Create
return Binary_Semaphore_Id
;
456 pragma Inline
(Binary_Semaphore_Create
);
458 function Binary_Semaphore_Delete
(ID
: Binary_Semaphore_Id
) return STATUS
;
459 pragma Inline
(Binary_Semaphore_Delete
);
461 function Binary_Semaphore_Obtain
(ID
: Binary_Semaphore_Id
) return STATUS
;
462 pragma Inline
(Binary_Semaphore_Obtain
);
464 function Binary_Semaphore_Release
(ID
: Binary_Semaphore_Id
) return STATUS
;
465 pragma Inline
(Binary_Semaphore_Release
);
467 function Binary_Semaphore_Flush
(ID
: Binary_Semaphore_Id
) return STATUS
;
468 pragma Inline
(Binary_Semaphore_Flush
);
470 ------------------------------------------------------------
471 -- Hardware Interrupt Wrappers to Support Interrupt Tasks --
472 ------------------------------------------------------------
474 type Interrupt_Handler
is access procedure (parameter
: System
.Address
);
475 pragma Convention
(C
, Interrupt_Handler
);
477 type Interrupt_Vector
is new System
.Address
;
479 function Interrupt_Connect
480 (Vector
: Interrupt_Vector
;
481 Handler
: Interrupt_Handler
;
482 Parameter
: System
.Address
:= System
.Null_Address
) return STATUS
;
483 pragma Inline
(Interrupt_Connect
);
484 -- Use this to set up an user handler. The routine installs a user handler
485 -- which is invoked after the OS has saved enough context for a high-level
486 -- language routine to be safely invoked.
488 function Interrupt_Context
return BOOL
;
489 pragma Inline
(Interrupt_Context
);
490 -- Return 1 (TRUE) if executing in an interrupt context;
491 -- return 0 (FALSE) if executing in a task context.
493 function Interrupt_Number_To_Vector
(intNum
: int
) return Interrupt_Vector
;
494 pragma Inline
(Interrupt_Number_To_Vector
);
495 -- Convert a logical interrupt number to the hardware interrupt vector
496 -- number used to connect the interrupt.
498 --------------------------------
499 -- Processor Affinity for SMP --
500 --------------------------------
502 function taskCpuAffinitySet
(tid
: t_id
; CPU
: int
) return int
503 renames SVE
.taskCpuAffinitySet
;
504 -- For SMP run-times the affinity to CPU.
505 -- For uniprocessor systems return ERROR status.
507 function taskMaskAffinitySet
(tid
: t_id
; CPU_Set
: unsigned
) return int
508 renames SVE
.taskMaskAffinitySet
;
509 -- For SMP run-times the affinity to CPU_Set.
510 -- For uniprocessor systems return ERROR status.
512 ---------------------
513 -- Multiprocessors --
514 ---------------------
516 function Current_CPU
return Multiprocessors
.CPU
;
517 -- Return the id of the current CPU
520 type pid_t
is new int
;
522 ERROR_PID
: constant pid_t
:= -1;
524 type sigset_t
is new SVE
.sigset_t
;
525 end System
.OS_Interface
;