1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
5 -- S Y S T E M . I N T E R R U P T _ M A N A G E M E N T --
9 -- Copyright (C) 1992-2018, Free Software Foundation, Inc. --
11 -- GNARL is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. --
18 -- As a special exception under Section 7 of GPL version 3, you are granted --
19 -- additional permissions described in the GCC Runtime Library Exception, --
20 -- version 3.1, as published by the Free Software Foundation. --
22 -- You should have received a copy of the GNU General Public License and --
23 -- a copy of the GCC Runtime Library Exception along with this program; --
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
25 -- <http://www.gnu.org/licenses/>. --
27 -- GNARL was developed by the GNARL team at Florida State University. --
28 -- Extensive contributions were provided by Ada Core Technologies, Inc. --
30 ------------------------------------------------------------------------------
32 -- This is the QNX/Neutrino threads version of this package
34 -- Make a careful study of all signals available under the OS, to see which
35 -- need to be reserved, kept always unmasked, or kept always unmasked. Be on
36 -- the lookout for special signals that may be used by the thread library.
38 -- Since this is a multi target file, the signal <-> exception mapping
39 -- is simple minded. If you need a more precise and target specific
40 -- signal handling, create a new s-intman.adb that will fit your needs.
42 -- This file assumes that:
44 -- SIGFPE, SIGILL, SIGSEGV and SIGBUS exist. They are mapped as follows:
45 -- SIGPFE => Constraint_Error
46 -- SIGILL => Program_Error
47 -- SIGSEGV => Storage_Error
48 -- SIGBUS => Storage_Error
50 -- SIGINT exists and will be kept unmasked unless the pragma
51 -- Unreserve_All_Interrupts is specified anywhere in the application.
53 -- System.OS_Interface contains the following:
54 -- SIGADAABORT: the signal that will be used to abort tasks.
55 -- Unmasked: the OS specific set of signals that should be unmasked in
56 -- all the threads. SIGADAABORT is unmasked by
58 -- Reserved: the OS specific set of signals that are reserved.
60 with System
.Task_Primitives
;
62 package body System
.Interrupt_Management
is
65 use System
.OS_Interface
;
67 type Interrupt_List
is array (Interrupt_ID
range <>) of Interrupt_ID
;
68 Exception_Interrupts
: constant Interrupt_List
:=
69 (SIGFPE
, SIGILL
, SIGSEGV
, SIGBUS
);
71 Unreserve_All_Interrupts
: Interfaces
.C
.int
;
73 (C
, Unreserve_All_Interrupts
, "__gl_unreserve_all_interrupts");
75 -----------------------
76 -- Local Subprograms --
77 -----------------------
79 procedure Signal_Trampoline
81 siginfo
: System
.Address
;
82 ucontext
: System
.Address
;
83 handler
: System
.Address
);
84 pragma Import
(C
, Signal_Trampoline
, "__gnat_sigtramp");
85 -- Pass the real handler to a speical function that handles unwinding by
86 -- skipping over the kernel signal frame (which doesn't contain any unwind
91 siginfo
: System
.Address
;
92 ucontext
: System
.Address
);
93 pragma Import
(C
, Map_Signal
, "__gnat_map_signal");
95 function State
(Int
: Interrupt_ID
) return Character;
96 pragma Import
(C
, State
, "__gnat_get_interrupt_state");
97 -- Get interrupt state. Defined in init.c The input argument is the
98 -- interrupt number, and the result is one of the following:
100 User
: constant Character := 'u';
101 Runtime
: constant Character := 'r';
102 Default
: constant Character := 's';
103 -- 'n' this interrupt not set by any Interrupt_State pragma
104 -- 'u' Interrupt_State pragma set state to User
105 -- 'r' Interrupt_State pragma set state to Runtime
106 -- 's' Interrupt_State pragma set state to System (use "default"
109 procedure Notify_Exception
111 siginfo
: System
.Address
;
112 ucontext
: System
.Address
);
113 -- This function identifies the Ada exception to be raised using the
114 -- information when the system received a synchronous signal. Since this
115 -- function is machine and OS dependent, different code has to be provided
116 -- for different target.
118 ----------------------
119 -- Notify_Exception --
120 ----------------------
122 Signal_Mask
: aliased sigset_t
;
123 -- The set of signals handled by Notify_Exception
125 procedure Notify_Exception
127 siginfo
: System
.Address
;
128 ucontext
: System
.Address
)
130 Result
: Interfaces
.C
.int
;
133 -- With the __builtin_longjmp, the signal mask is not restored, so we
134 -- need to restore it explicitly.
136 Result
:= pthread_sigmask
(SIG_UNBLOCK
, Signal_Mask
'Access, null);
137 pragma Assert
(Result
= 0);
139 -- Perform the necessary context adjustments prior to a raise
140 -- from a signal handler.
142 Adjust_Context_For_Raise
(signo
, ucontext
);
144 -- Check that treatment of exception propagation here is consistent with
145 -- treatment of the abort signal in System.Task_Primitives.Operations.
147 Signal_Trampoline
(signo
, siginfo
, ucontext
, Map_Signal
'Address);
148 end Notify_Exception
;
154 Initialized
: Boolean := False;
156 procedure Initialize
is
157 act
: aliased struct_sigaction
;
158 old_act
: aliased struct_sigaction
;
159 Result
: System
.OS_Interface
.int
;
161 Use_Alternate_Stack
: constant Boolean :=
162 System
.Task_Primitives
.Alternate_Stack_Size
/= 0;
163 -- Whether to use an alternate signal stack for stack overflows
172 -- Need to call pthread_init very early because it is doing signal
177 Abort_Task_Interrupt
:= SIGADAABORT
;
179 act
.sa_handler
:= Notify_Exception
'Address;
181 -- Setting SA_SIGINFO asks the kernel to pass more than just the signal
182 -- number argument to the handler when it is called. The set of extra
183 -- parameters includes a pointer to the interrupted context, which the
184 -- ZCX propagation scheme needs.
186 -- Most man pages for sigaction mention that sa_sigaction should be set
187 -- instead of sa_handler when SA_SIGINFO is on. In practice, the two
188 -- fields are actually union'ed and located at the same offset.
190 -- On some targets, we set sa_flags to SA_NODEFER so that during the
191 -- handler execution we do not change the Signal_Mask to be masked for
194 -- This is a temporary fix to the problem that the Signal_Mask is not
195 -- restored after the exception (longjmp) from the handler. The right
196 -- fix should be made in sigsetjmp so that we save the Signal_Set and
197 -- restore it after a longjmp.
199 -- Since SA_NODEFER is obsolete, instead we reset explicitly the mask
200 -- in the exception handler.
202 Result
:= sigemptyset
(Signal_Mask
'Access);
203 pragma Assert
(Result
= 0);
205 -- Add signals that map to Ada exceptions to the mask
207 for J
in Exception_Interrupts
'Range loop
208 if State
(Exception_Interrupts
(J
)) /= Default
then
210 sigaddset
(Signal_Mask
'Access, Signal
(Exception_Interrupts
(J
)));
211 pragma Assert
(Result
= 0);
215 act
.sa_mask
:= Signal_Mask
;
217 pragma Assert
(Keep_Unmasked
= (Interrupt_ID
'Range => False));
218 pragma Assert
(Reserve
= (Interrupt_ID
'Range => False));
220 -- Process state of exception signals
222 for J
in Exception_Interrupts
'Range loop
223 if State
(Exception_Interrupts
(J
)) /= User
then
224 Keep_Unmasked
(Exception_Interrupts
(J
)) := True;
225 Reserve
(Exception_Interrupts
(J
)) := True;
227 if State
(Exception_Interrupts
(J
)) /= Default
then
228 act
.sa_flags
:= SA_SIGINFO
;
230 if Use_Alternate_Stack
231 and then Exception_Interrupts
(J
) = SIGSEGV
233 act
.sa_flags
:= act
.sa_flags
+ SA_ONSTACK
;
238 (Signal
(Exception_Interrupts
(J
)), act
'Unchecked_Access,
239 old_act
'Unchecked_Access);
240 pragma Assert
(Result
= 0);
245 if State
(Abort_Task_Interrupt
) /= User
then
246 Keep_Unmasked
(Abort_Task_Interrupt
) := True;
247 Reserve
(Abort_Task_Interrupt
) := True;
250 -- Set SIGINT to unmasked state as long as it is not in "User" state.
251 -- Check for Unreserve_All_Interrupts last.
253 if State
(SIGINT
) /= User
then
254 Keep_Unmasked
(SIGINT
) := True;
255 Reserve
(SIGINT
) := True;
258 -- Check all signals for state that requires keeping them unmasked and
261 for J
in Interrupt_ID
'Range loop
262 if State
(J
) = Default
or else State
(J
) = Runtime
then
263 Keep_Unmasked
(J
) := True;
268 -- Add the set of signals that must always be unmasked for this target
270 for J
in Unmasked
'Range loop
271 Keep_Unmasked
(Interrupt_ID
(Unmasked
(J
))) := True;
272 Reserve
(Interrupt_ID
(Unmasked
(J
))) := True;
275 -- Add target-specific reserved signals
277 if Reserved
'Length > 0 then
278 for J
in Reserved
'Range loop
279 Reserve
(Interrupt_ID
(Reserved
(J
))) := True;
283 -- Process pragma Unreserve_All_Interrupts. This overrides any settings
284 -- due to pragma Interrupt_State:
286 if Unreserve_All_Interrupts
/= 0 then
287 Keep_Unmasked
(SIGINT
) := False;
288 Reserve
(SIGINT
) := False;
291 -- We do not really have Signal 0. We just use this value to identify
292 -- non-existent signals (see s-intnam.ads). Therefore, Signal should not
293 -- be used in all signal related operations hence mark it as reserved.
298 end System
.Interrupt_Management
;