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-2008, 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 2, or (at your option) any later ver- --
14 -- sion. GNARL 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. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNARL; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, USA. --
22 -- As a special exception, if other files instantiate generics from this --
23 -- unit, or you link this unit with other files to produce an executable, --
24 -- this unit does not by itself cause the resulting executable to be --
25 -- covered by the GNU General Public License. This exception does not --
26 -- however invalidate any other reasons why the executable file might be --
27 -- covered by the GNU Public License. --
29 -- GNARL was developed by the GNARL team at Florida State University. --
30 -- Extensive contributions were provided by Ada Core Technologies, Inc. --
32 ------------------------------------------------------------------------------
34 -- This is the POSIX threads version of this package
36 -- Make a careful study of all signals available under the OS, to see which
37 -- need to be reserved, kept always unmasked, or kept always unmasked. Be on
38 -- the lookout for special signals that may be used by the thread library.
40 -- Since this is a multi target file, the signal <-> exception mapping
41 -- is simple minded. If you need a more precise and target specific
42 -- signal handling, create a new s-intman.adb that will fit your needs.
44 -- This file assumes that:
46 -- SIGFPE, SIGILL, SIGSEGV and SIGBUS exist. They are mapped as follows:
47 -- SIGPFE => Constraint_Error
48 -- SIGILL => Program_Error
49 -- SIGSEGV => Storage_Error
50 -- SIGBUS => Storage_Error
52 -- SIGINT exists and will be kept unmasked unless the pragma
53 -- Unreserve_All_Interrupts is specified anywhere in the application.
55 -- System.OS_Interface contains the following:
56 -- SIGADAABORT: the signal that will be used to abort tasks.
57 -- Unmasked: the OS specific set of signals that should be unmasked in
58 -- all the threads. SIGADAABORT is unmasked by
60 -- Reserved: the OS specific set of signals that are reserved.
62 with System
.Task_Primitives
;
64 package body System
.Interrupt_Management
is
67 use System
.OS_Interface
;
69 type Interrupt_List
is array (Interrupt_ID
range <>) of Interrupt_ID
;
70 Exception_Interrupts
: constant Interrupt_List
:=
71 (SIGFPE
, SIGILL
, SIGSEGV
, SIGBUS
);
73 Unreserve_All_Interrupts
: Interfaces
.C
.int
;
75 (C
, Unreserve_All_Interrupts
, "__gl_unreserve_all_interrupts");
77 -----------------------
78 -- Local Subprograms --
79 -----------------------
81 function State
(Int
: Interrupt_ID
) return Character;
82 pragma Import
(C
, State
, "__gnat_get_interrupt_state");
83 -- Get interrupt state. Defined in init.c The input argument is the
84 -- interrupt number, and the result is one of the following:
86 User
: constant Character := 'u';
87 Runtime
: constant Character := 'r';
88 Default
: constant Character := 's';
89 -- 'n' this interrupt not set by any Interrupt_State pragma
90 -- 'u' Interrupt_State pragma set state to User
91 -- 'r' Interrupt_State pragma set state to Runtime
92 -- 's' Interrupt_State pragma set state to System (use "default"
95 procedure Notify_Exception
97 siginfo
: System
.Address
;
98 ucontext
: System
.Address
);
99 -- This function identifies the Ada exception to be raised using the
100 -- information when the system received a synchronous signal. Since this
101 -- function is machine and OS dependent, different code has to be provided
102 -- for different target.
104 ----------------------
105 -- Notify_Exception --
106 ----------------------
108 Signal_Mask
: aliased sigset_t
;
109 -- The set of signals handled by Notify_Exception
111 procedure Notify_Exception
113 siginfo
: System
.Address
;
114 ucontext
: System
.Address
)
116 pragma Unreferenced
(siginfo
);
118 Result
: Interfaces
.C
.int
;
121 -- With the __builtin_longjmp, the signal mask is not restored, so we
122 -- need to restore it explicitly.
124 Result
:= pthread_sigmask
(SIG_UNBLOCK
, Signal_Mask
'Access, null);
125 pragma Assert
(Result
= 0);
127 -- Perform the necessary context adjustments prior to a raise
128 -- from a signal handler.
130 Adjust_Context_For_Raise
(signo
, ucontext
);
132 -- Check that treatment of exception propagation here is consistent with
133 -- treatment of the abort signal in System.Task_Primitives.Operations.
137 raise Constraint_Error
;
147 end Notify_Exception
;
153 Initialized
: Boolean := False;
155 procedure Initialize
is
156 act
: aliased struct_sigaction
;
157 old_act
: aliased struct_sigaction
;
158 Result
: System
.OS_Interface
.int
;
160 Use_Alternate_Stack
: constant Boolean :=
161 System
.Task_Primitives
.Alternate_Stack_Size
/= 0;
162 -- Whether to use an alternate signal stack for stack overflows
171 -- Need to call pthread_init very early because it is doing signal
176 Abort_Task_Interrupt
:= SIGADAABORT
;
178 act
.sa_handler
:= Notify_Exception
'Address;
180 -- Setting SA_SIGINFO asks the kernel to pass more than just the signal
181 -- number argument to the handler when it is called. The set of extra
182 -- parameters includes a pointer to the interrupted context, which the
183 -- ZCX propagation scheme needs.
185 -- Most man pages for sigaction mention that sa_sigaction should be set
186 -- instead of sa_handler when SA_SIGINFO is on. In practice, the two
187 -- fields are actually union'ed and located at the same offset.
189 -- On some targets, we set sa_flags to SA_NODEFER so that during the
190 -- handler execution we do not change the Signal_Mask to be masked for
193 -- This is a temporary fix to the problem that the Signal_Mask is not
194 -- restored after the exception (longjmp) from the handler. The right
195 -- fix should be made in sigsetjmp so that we save the Signal_Set and
196 -- restore it after a longjmp.
198 -- Since SA_NODEFER is obsolete, instead we reset explicitly the mask
199 -- in the exception handler.
201 Result
:= sigemptyset
(Signal_Mask
'Access);
202 pragma Assert
(Result
= 0);
204 -- Add signals that map to Ada exceptions to the mask
206 for J
in Exception_Interrupts
'Range loop
207 if State
(Exception_Interrupts
(J
)) /= Default
then
209 sigaddset
(Signal_Mask
'Access, Signal
(Exception_Interrupts
(J
)));
210 pragma Assert
(Result
= 0);
214 act
.sa_mask
:= Signal_Mask
;
216 pragma Assert
(Keep_Unmasked
= (Interrupt_ID
'Range => False));
217 pragma Assert
(Reserve
= (Interrupt_ID
'Range => False));
219 -- Process state of exception signals
221 for J
in Exception_Interrupts
'Range loop
222 if State
(Exception_Interrupts
(J
)) /= User
then
223 Keep_Unmasked
(Exception_Interrupts
(J
)) := True;
224 Reserve
(Exception_Interrupts
(J
)) := True;
226 if State
(Exception_Interrupts
(J
)) /= Default
then
227 act
.sa_flags
:= SA_SIGINFO
;
229 if Use_Alternate_Stack
230 and then Exception_Interrupts
(J
) = SIGSEGV
232 act
.sa_flags
:= act
.sa_flags
+ SA_ONSTACK
;
237 (Signal
(Exception_Interrupts
(J
)), act
'Unchecked_Access,
238 old_act
'Unchecked_Access);
239 pragma Assert
(Result
= 0);
244 if State
(Abort_Task_Interrupt
) /= User
then
245 Keep_Unmasked
(Abort_Task_Interrupt
) := True;
246 Reserve
(Abort_Task_Interrupt
) := True;
249 -- Set SIGINT to unmasked state as long as it is not in "User" state.
250 -- Check for Unreserve_All_Interrupts last.
252 if State
(SIGINT
) /= User
then
253 Keep_Unmasked
(SIGINT
) := True;
254 Reserve
(SIGINT
) := True;
257 -- Check all signals for state that requires keeping them unmasked and
260 for J
in Interrupt_ID
'Range loop
261 if State
(J
) = Default
or else State
(J
) = Runtime
then
262 Keep_Unmasked
(J
) := True;
267 -- Add the set of signals that must always be unmasked for this target
269 for J
in Unmasked
'Range loop
270 Keep_Unmasked
(Interrupt_ID
(Unmasked
(J
))) := True;
271 Reserve
(Interrupt_ID
(Unmasked
(J
))) := True;
274 -- Add target-specific reserved signals
276 for J
in Reserved
'Range loop
277 Reserve
(Interrupt_ID
(Reserved
(J
))) := True;
280 -- Process pragma Unreserve_All_Interrupts. This overrides any settings
281 -- due to pragma Interrupt_State:
283 if Unreserve_All_Interrupts
/= 0 then
284 Keep_Unmasked
(SIGINT
) := False;
285 Reserve
(SIGINT
) := False;
288 -- We do not really have Signal 0. We just use this value to identify
289 -- non-existent signals (see s-intnam.ads). Therefore, Signal should not
290 -- be used in all signal related operations hence mark it as reserved.
295 end System
.Interrupt_Management
;