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.
43 with System
.VxWorks
.Ext
;
44 with System
.Multiprocessors
;
45 with System
.Parameters
;
47 package System
.OS_Interface
is
50 package SVE
renames System
.VxWorks
.Ext
;
52 subtype int
is Interfaces
.C
.int
;
53 subtype unsigned
is Interfaces
.C
.unsigned
;
54 subtype short
is Short_Integer;
55 type unsigned_int
is mod 2 ** int
'Size;
56 type long
is new Long_Integer;
57 type unsigned_long
is mod 2 ** long
'Size;
58 type long_long
is new Long_Long_Integer;
59 type unsigned_long_long
is mod 2 ** long_long
'Size;
60 type size_t
is mod 2 ** Standard
'Address_Size;
62 subtype STATUS
is SVE
.STATUS
;
63 subtype BOOL
is SVE
.BOOL
;
64 subtype vx_freq_t
is SVE
.vx_freq_t
;
70 function errno
return int
;
71 pragma Import
(C
, errno
, "errnoGet");
73 EINTR
: constant := 4;
74 EAGAIN
: constant := 35;
75 ENOMEM
: constant := 12;
76 EINVAL
: constant := 22;
77 ETIMEDOUT
: constant := 60;
79 FUNC_ERR
: constant := -1;
81 ----------------------------
82 -- Signals and interrupts --
83 ----------------------------
85 NSIG
: constant := 64;
86 -- Number of signals on the target OS
87 type Signal
is new int
range 0 .. Interfaces
.C
."-" (NSIG
, 1);
89 Max_HW_Interrupt
: constant := System
.VxWorks
.Num_HW_Interrupts
- 1;
90 type HW_Interrupt
is new int
range 0 .. Max_HW_Interrupt
;
92 Max_Interrupt
: constant := Max_HW_Interrupt
;
93 subtype Interrupt_Range
is Natural range 0 .. Max_HW_Interrupt
;
96 -- Signals common to Vxworks 5.x and 6.x
98 SIGILL
: constant := 4; -- illegal instruction (not reset when caught)
99 SIGABRT
: constant := 6; -- used by abort, replace SIGIOT in the future
100 SIGFPE
: constant := 8; -- floating point exception
101 SIGBUS
: constant := 10; -- bus error
102 SIGSEGV
: constant := 11; -- segmentation violation
104 -- Signals specific to VxWorks 6.x
106 SIGHUP
: constant := 1; -- hangup
107 SIGINT
: constant := 2; -- interrupt
108 SIGQUIT
: constant := 3; -- quit
109 SIGTRAP
: constant := 5; -- trace trap (not reset when caught)
110 SIGEMT
: constant := 7; -- EMT instruction
111 SIGKILL
: constant := 9; -- kill
112 SIGFMT
: constant := 12; -- STACK FORMAT ERROR (not posix)
113 SIGPIPE
: constant := 13; -- write on a pipe with no one to read it
114 SIGALRM
: constant := 14; -- alarm clock
115 SIGTERM
: constant := 15; -- software termination signal from kill
116 SIGCNCL
: constant := 16; -- pthreads cancellation signal
117 SIGSTOP
: constant := 17; -- sendable stop signal not from tty
118 SIGTSTP
: constant := 18; -- stop signal from tty
119 SIGCONT
: constant := 19; -- continue a stopped process
120 SIGCHLD
: constant := 20; -- to parent on child stop or exit
121 SIGTTIN
: constant := 21; -- to readers pgrp upon background tty read
122 SIGTTOU
: constant := 22; -- like TTIN for output
124 SIGRES1
: constant := 23; -- reserved signal number (Not POSIX)
125 SIGRES2
: constant := 24; -- reserved signal number (Not POSIX)
126 SIGRES3
: constant := 25; -- reserved signal number (Not POSIX)
127 SIGRES4
: constant := 26; -- reserved signal number (Not POSIX)
128 SIGRES5
: constant := 27; -- reserved signal number (Not POSIX)
129 SIGRES6
: constant := 28; -- reserved signal number (Not POSIX)
130 SIGRES7
: constant := 29; -- reserved signal number (Not POSIX)
132 SIGUSR1
: constant := 30; -- user defined signal 1
133 SIGUSR2
: constant := 31; -- user defined signal 2
135 SIGPOLL
: constant := 32; -- pollable event
136 SIGPROF
: constant := 33; -- profiling timer expired
137 SIGSYS
: constant := 34; -- bad system call
138 SIGURG
: constant := 35; -- high bandwidth data is available at socket
139 SIGVTALRM
: constant := 36; -- virtual timer expired
140 SIGXCPU
: constant := 37; -- CPU time limit exceeded
141 SIGXFSZ
: constant := 38; -- file size time limit exceeded
143 SIGEVTS
: constant := 39; -- signal event thread send
144 SIGEVTD
: constant := 40; -- signal event thread delete
146 SIGRTMIN
: constant := 48; -- Realtime signal min
147 SIGRTMAX
: constant := 63; -- Realtime signal max
149 -----------------------------------
150 -- Signal processing definitions --
151 -----------------------------------
153 -- The how in sigprocmask()
155 SIG_BLOCK
: constant := 1;
156 SIG_UNBLOCK
: constant := 2;
157 SIG_SETMASK
: constant := 3;
159 -- The sa_flags in struct sigaction
161 SA_SIGINFO
: constant := 16#
0002#
;
162 SA_ONSTACK
: constant := 16#
0004#
;
164 SIG_DFL
: constant := 0;
165 SIG_IGN
: constant := 1;
167 type sigset_t
is private;
169 type struct_sigaction
is record
170 sa_handler
: System
.Address
;
174 pragma Convention
(C
, struct_sigaction
);
175 type struct_sigaction_ptr
is access all struct_sigaction
;
177 function sigaddset
(set
: access sigset_t
; sig
: Signal
) return int
;
178 pragma Import
(C
, sigaddset
, "sigaddset");
180 function sigdelset
(set
: access sigset_t
; sig
: Signal
) return int
;
181 pragma Import
(C
, sigdelset
, "sigdelset");
183 function sigfillset
(set
: access sigset_t
) return int
;
184 pragma Import
(C
, sigfillset
, "sigfillset");
186 function sigismember
(set
: access sigset_t
; sig
: Signal
) return int
;
187 pragma Import
(C
, sigismember
, "sigismember");
189 function sigemptyset
(set
: access sigset_t
) return int
;
190 pragma Import
(C
, sigemptyset
, "sigemptyset");
194 act
: struct_sigaction_ptr
;
195 oact
: struct_sigaction_ptr
) return int
;
196 pragma Import
(C
, sigaction
, "sigaction");
198 type isr_address
is access procedure (sig
: int
);
199 pragma Convention
(C
, isr_address
);
201 function c_signal
(sig
: Signal
; handler
: isr_address
) return isr_address
;
202 pragma Import
(C
, c_signal
, "signal");
204 function pthread_sigmask
206 set
: access sigset_t
;
207 oset
: access sigset_t
) return int
;
208 pragma Import
(C
, pthread_sigmask
, "sigprocmask");
210 subtype t_id
is SVE
.t_id
;
211 subtype Thread_Id
is t_id
;
212 -- Thread_Id and t_id are VxWorks identifiers for tasks. This value,
213 -- although represented as a Long_Integer, is in fact an address. With
214 -- some BSPs, this address can have a value sufficiently high that the
215 -- Thread_Id becomes negative: this should not be considered as an error.
217 function kill
(pid
: t_id
; sig
: Signal
) return int
;
218 pragma Inline
(kill
);
220 function getpid
return t_id
renames SVE
.getpid
;
222 function Task_Stop
(tid
: t_id
) return STATUS
renames SVE
.Task_Stop
;
223 -- If we are in the kernel space, stop the task whose t_id is given in
224 -- parameter in such a way that it can be examined by the debugger. This
225 -- typically maps to taskSuspend on VxWorks 5 and to taskStop on VxWorks 6.
227 function Task_Cont
(tid
: t_id
) return STATUS
renames SVE
.Task_Cont
;
228 -- If we are in the kernel space, continue the task whose t_id is given
229 -- in parameter if it has been stopped previously to be examined by the
230 -- debugger (e.g. by taskStop). It typically maps to taskResume on VxWorks
231 -- 5 and to taskCont on VxWorks 6.
233 function Int_Lock
return int
renames SVE
.Int_Lock
;
234 -- If we are in the kernel space, lock interrupts. It typically maps to
237 procedure Int_Unlock
(Old
: int
) renames SVE
.Int_Unlock
;
238 -- If we are in the kernel space, unlock interrupts. It typically maps to
239 -- intUnlock. The parameter Old is only used on PowerPC where it contains
240 -- the returned value from Int_Lock (the old MPSR).
246 type time_t
is range -2 ** (System
.Parameters
.time_t_bits
- 1)
247 .. 2 ** (System
.Parameters
.time_t_bits
- 1) - 1;
248 -- Time_t here used to be unsigned to match the VxWorks header declaration.
249 -- The header declaration has changed in newer releases and is now signed
252 type timespec
is record
256 pragma Convention
(C
, timespec
);
258 type clockid_t
is new int
;
260 function To_Duration
(TS
: timespec
) return Duration;
261 pragma Inline
(To_Duration
);
263 function To_Timespec
(D
: Duration) return timespec
;
264 pragma Inline
(To_Timespec
);
265 -- Convert a Duration value to a timespec value. Note that in VxWorks,
266 -- timespec is always non-negative (since time_t is defined above as
267 -- unsigned long). This means that there is a potential problem if a
268 -- negative argument is passed for D. However, in actual usage, the
269 -- value of the input argument D is always non-negative, so no problem
270 -- arises in practice.
272 function To_Clock_Ticks
(D
: Duration) return int
;
273 -- Convert a duration value (in seconds) into clock ticks
275 function clock_gettime
276 (clock_id
: clockid_t
; tp
: access timespec
) return int
;
277 pragma Import
(C
, clock_gettime
, "clock_gettime");
279 ----------------------
280 -- Utility Routines --
281 ----------------------
283 function To_VxWorks_Priority
(Priority
: int
) return int
;
284 pragma Inline
(To_VxWorks_Priority
);
285 -- Convenience routine to convert between VxWorks priority and Ada priority
287 --------------------------
288 -- VxWorks specific API --
289 --------------------------
291 function taskIdVerify
(tid
: t_id
) return STATUS
;
292 pragma Import
(C
, taskIdVerify
, "taskIdVerify");
294 function taskIdSelf
return t_id
;
295 pragma Import
(C
, taskIdSelf
, "taskIdSelf");
297 function taskOptionsGet
(tid
: t_id
; pOptions
: access int
) return STATUS
;
298 pragma Import
(C
, taskOptionsGet
, "taskOptionsGet");
300 function taskSuspend
(tid
: t_id
) return STATUS
;
301 pragma Import
(C
, taskSuspend
, "taskSuspend");
303 function taskResume
(tid
: t_id
) return STATUS
;
304 pragma Import
(C
, taskResume
, "taskResume");
306 function taskIsSuspended
(tid
: t_id
) return BOOL
;
307 pragma Import
(C
, taskIsSuspended
, "taskIsSuspended");
309 function taskDelay
(ticks
: int
) return STATUS
;
310 pragma Import
(C
, taskDelay
, "taskDelay");
312 function sysClkRateGet
return vx_freq_t
;
313 pragma Import
(C
, sysClkRateGet
, "sysClkRateGet");
315 -- VxWorks 5.x specific functions
316 -- Must not be called from run-time for versions that do not support
317 -- taskVarLib: eg VxWorks 6 RTPs
320 (tid
: t_id
; pVar
: access System
.Address
) return STATUS
;
321 pragma Import
(C
, taskVarAdd
, "taskVarAdd");
323 function taskVarDelete
324 (tid
: t_id
; pVar
: access System
.Address
) return STATUS
;
325 pragma Import
(C
, taskVarDelete
, "taskVarDelete");
329 pVar
: access System
.Address
;
330 value
: System
.Address
) return STATUS
;
331 pragma Import
(C
, taskVarSet
, "taskVarSet");
335 pVar
: access System
.Address
) return int
;
336 pragma Import
(C
, taskVarGet
, "taskVarGet");
338 -- VxWorks 6.x specific functions
340 -- Can only be called from the VxWorks 6 run-time libary that supports
341 -- tlsLib, and not by the VxWorks 6.6 SMP library
343 function tlsKeyCreate
return int
;
344 pragma Import
(C
, tlsKeyCreate
, "tlsKeyCreate");
346 function tlsValueGet
(key
: int
) return System
.Address
;
347 pragma Import
(C
, tlsValueGet
, "tlsValueGet");
349 function tlsValueSet
(key
: int
; value
: System
.Address
) return STATUS
;
350 pragma Import
(C
, tlsValueSet
, "tlsValueSet");
352 -- Option flags for taskSpawn
354 VX_UNBREAKABLE
: constant := 16#
0002#
;
355 VX_FP_PRIVATE_ENV
: constant := 16#
0080#
;
356 VX_NO_STACK_FILL
: constant := 16#
0100#
;
359 (name
: System
.Address
; -- Pointer to task name
363 start_routine
: System
.Address
;
364 arg1
: System
.Address
;
373 arg10
: int
:= 0) return t_id
;
374 pragma Import
(C
, taskSpawn
, "taskSpawn");
376 procedure taskDelete
(tid
: t_id
);
377 pragma Import
(C
, taskDelete
, "taskDelete");
379 function Set_Time_Slice
(ticks
: int
) return STATUS
renames
381 -- Calls kernelTimeSlice under VxWorks 5.x, VxWorks 653, or in VxWorks 6
382 -- kernel apps. Returns ERROR for RTPs, VxWorks 5 /CERT
384 function taskPriorityGet
(tid
: t_id
; pPriority
: access int
) return STATUS
;
385 pragma Import
(C
, taskPriorityGet
, "taskPriorityGet");
387 function taskPrioritySet
(tid
: t_id
; newPriority
: int
) return STATUS
;
388 pragma Import
(C
, taskPrioritySet
, "taskPrioritySet");
390 -- Semaphore creation flags
392 SEM_Q_FIFO
: constant := 0;
393 SEM_Q_PRIORITY
: constant := 1;
394 SEM_DELETE_SAFE
: constant := 4; -- only valid for binary semaphore
395 SEM_INVERSION_SAFE
: constant := 8; -- only valid for binary semaphore
397 -- Semaphore initial state flags
399 SEM_EMPTY
: constant := 0;
400 SEM_FULL
: constant := 1;
402 -- Semaphore take (semTake) time constants
404 WAIT_FOREVER
: constant := -1;
405 NO_WAIT
: constant := 0;
407 -- Error codes (errno). The lower level 16 bits are the error code, with
408 -- the upper 16 bits representing the module number in which the error
409 -- occurred. By convention, the module number is 0 for UNIX errors. VxWorks
410 -- reserves module numbers 1-500, with the remaining module numbers being
411 -- available for user applications.
413 M_objLib
: constant := 61 * 2**16;
414 -- semTake() failure with ticks = NO_WAIT
415 S_objLib_OBJ_UNAVAILABLE
: constant := M_objLib
+ 2;
416 -- semTake() timeout with ticks > NO_WAIT
417 S_objLib_OBJ_TIMEOUT
: constant := M_objLib
+ 4;
419 subtype SEM_ID
is SVE
.SEM_ID
;
420 -- typedef struct semaphore *SEM_ID;
422 -- We use two different kinds of VxWorks semaphores: mutex and binary
423 -- semaphores. A null ID is returned when a semaphore cannot be created.
425 function semBCreate
(options
: int
; initial_state
: int
) return SEM_ID
;
426 pragma Import
(C
, semBCreate
, "semBCreate");
427 -- Create a binary semaphore. Return ID, or 0 if memory could not
430 function semMCreate
(options
: int
) return SEM_ID
;
431 pragma Import
(C
, semMCreate
, "semMCreate");
433 function semDelete
(Sem
: SEM_ID
) return STATUS
renames SVE
.semDelete
;
434 -- Delete a semaphore
436 function semGive
(Sem
: SEM_ID
) return STATUS
;
437 pragma Import
(C
, semGive
, "semGive");
439 function semTake
(Sem
: SEM_ID
; timeout
: int
) return STATUS
;
440 pragma Import
(C
, semTake
, "semTake");
441 -- Attempt to take binary semaphore. Error is returned if operation
444 function semFlush
(SemID
: SEM_ID
) return STATUS
;
445 pragma Import
(C
, semFlush
, "semFlush");
446 -- Release all threads blocked on the semaphore
448 ------------------------------------------------------------
449 -- Binary Semaphore Wrapper to Support interrupt Tasks --
450 ------------------------------------------------------------
452 type Binary_Semaphore_Id
is new Long_Integer;
454 function Binary_Semaphore_Create
return Binary_Semaphore_Id
;
455 pragma Inline
(Binary_Semaphore_Create
);
457 function Binary_Semaphore_Delete
(ID
: Binary_Semaphore_Id
) return STATUS
;
458 pragma Inline
(Binary_Semaphore_Delete
);
460 function Binary_Semaphore_Obtain
(ID
: Binary_Semaphore_Id
) return STATUS
;
461 pragma Inline
(Binary_Semaphore_Obtain
);
463 function Binary_Semaphore_Release
(ID
: Binary_Semaphore_Id
) return STATUS
;
464 pragma Inline
(Binary_Semaphore_Release
);
466 function Binary_Semaphore_Flush
(ID
: Binary_Semaphore_Id
) return STATUS
;
467 pragma Inline
(Binary_Semaphore_Flush
);
469 ------------------------------------------------------------
470 -- Hardware Interrupt Wrappers to Support Interrupt Tasks --
471 ------------------------------------------------------------
473 type Interrupt_Handler
is access procedure (parameter
: System
.Address
);
474 pragma Convention
(C
, Interrupt_Handler
);
476 type Interrupt_Vector
is new System
.Address
;
478 function Interrupt_Connect
479 (Vector
: Interrupt_Vector
;
480 Handler
: Interrupt_Handler
;
481 Parameter
: System
.Address
:= System
.Null_Address
) return STATUS
;
482 pragma Inline
(Interrupt_Connect
);
483 -- Use this to set up an user handler. The routine installs a user handler
484 -- which is invoked after the OS has saved enough context for a high-level
485 -- language routine to be safely invoked.
487 function Interrupt_Context
return BOOL
;
488 pragma Inline
(Interrupt_Context
);
489 -- Return 1 (TRUE) if executing in an interrupt context;
490 -- return 0 (FALSE) if executing in a task context.
492 function Interrupt_Number_To_Vector
(intNum
: int
) return Interrupt_Vector
;
493 pragma Inline
(Interrupt_Number_To_Vector
);
494 -- Convert a logical interrupt number to the hardware interrupt vector
495 -- number used to connect the interrupt.
497 --------------------------------
498 -- Processor Affinity for SMP --
499 --------------------------------
501 function taskCpuAffinitySet
(tid
: t_id
; CPU
: int
) return int
502 renames SVE
.taskCpuAffinitySet
;
503 -- For SMP run-times the affinity to CPU.
504 -- For uniprocessor systems return ERROR status.
506 function taskMaskAffinitySet
(tid
: t_id
; CPU_Set
: unsigned
) return int
507 renames SVE
.taskMaskAffinitySet
;
508 -- For SMP run-times the affinity to CPU_Set.
509 -- For uniprocessor systems return ERROR status.
511 ---------------------
512 -- Multiprocessors --
513 ---------------------
515 function Current_CPU
return Multiprocessors
.CPU
;
516 -- Return the id of the current CPU
519 type pid_t
is new int
;
521 ERROR_PID
: constant pid_t
:= -1;
523 type sigset_t
is new SVE
.sigset_t
;
524 end System
.OS_Interface
;