]>
Commit | Line | Data |
---|---|---|
16707e90 AC |
1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
3 | -- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS -- | |
4 | -- -- | |
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 -- | |
6 | -- -- | |
7 | -- B o d y -- | |
8 | -- -- | |
4b490c1e | 9 | -- Copyright (C) 1992-2020, Free Software Foundation, Inc. -- |
16707e90 AC |
10 | -- -- |
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. -- | |
17 | -- -- | |
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. -- | |
21 | -- -- | |
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/>. -- | |
26 | -- -- | |
27 | -- GNARL was developed by the GNARL team at Florida State University. -- | |
28 | -- Extensive contributions were provided by Ada Core Technologies, Inc. -- | |
29 | -- -- | |
30 | ------------------------------------------------------------------------------ | |
31 | ||
32 | -- This is the LynxOS version of this package | |
33 | ||
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. | |
37 | ||
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. | |
41 | ||
42 | -- This file assumes that: | |
43 | ||
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 | |
49 | ||
50 | -- SIGINT exists and will be kept unmasked unless the pragma | |
51 | -- Unreserve_All_Interrupts is specified anywhere in the application. | |
52 | ||
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 | |
57 | -- default | |
58 | -- Reserved: the OS specific set of signals that are reserved. | |
59 | ||
60 | with System.Task_Primitives; | |
61 | ||
62 | package body System.Interrupt_Management is | |
63 | ||
64 | use Interfaces.C; | |
65 | use System.OS_Interface; | |
66 | ||
67 | type Interrupt_List is array (Interrupt_ID range <>) of Interrupt_ID; | |
68 | Exception_Interrupts : constant Interrupt_List := | |
69 | (SIGFPE, SIGILL, SIGSEGV, SIGBUS); | |
70 | ||
71 | Unreserve_All_Interrupts : Interfaces.C.int; | |
72 | pragma Import | |
73 | (C, Unreserve_All_Interrupts, "__gl_unreserve_all_interrupts"); | |
74 | ||
75 | ----------------------- | |
76 | -- Local Subprograms -- | |
77 | ----------------------- | |
78 | ||
79 | function State (Int : Interrupt_ID) return Character; | |
80 | pragma Import (C, State, "__gnat_get_interrupt_state"); | |
81 | -- Get interrupt state. Defined in init.c The input argument is the | |
82 | -- interrupt number, and the result is one of the following: | |
83 | ||
84 | User : constant Character := 'u'; | |
85 | Runtime : constant Character := 'r'; | |
86 | Default : constant Character := 's'; | |
87 | -- 'n' this interrupt not set by any Interrupt_State pragma | |
88 | -- 'u' Interrupt_State pragma set state to User | |
89 | -- 'r' Interrupt_State pragma set state to Runtime | |
90 | -- 's' Interrupt_State pragma set state to System (use "default" | |
91 | -- system handler) | |
92 | ||
93 | procedure Notify_Exception | |
94 | (signo : Signal; | |
95 | siginfo : System.Address; | |
96 | ucontext : System.Address); | |
97 | -- This function identifies the Ada exception to be raised using the | |
98 | -- information when the system received a synchronous signal. Since this | |
99 | -- function is machine and OS dependent, different code has to be provided | |
100 | -- for different target. | |
101 | ||
102 | ---------------------- | |
103 | -- Notify_Exception -- | |
104 | ---------------------- | |
105 | ||
106 | Signal_Mask : aliased sigset_t; | |
107 | -- The set of signals handled by Notify_Exception | |
108 | ||
109 | procedure Notify_Exception | |
110 | (signo : Signal; | |
111 | siginfo : System.Address; | |
112 | ucontext : System.Address) | |
113 | is | |
114 | pragma Unreferenced (siginfo); | |
115 | ||
116 | Result : Interfaces.C.int; | |
117 | ||
118 | begin | |
119 | -- With the __builtin_longjmp, the signal mask is not restored, so we | |
120 | -- need to restore it explicitly. | |
121 | ||
122 | Result := pthread_sigmask (SIG_UNBLOCK, Signal_Mask'Access, null); | |
123 | pragma Assert (Result = 0); | |
124 | ||
125 | -- Perform the necessary context adjustments prior to a raise | |
126 | -- from a signal handler. | |
127 | ||
128 | Adjust_Context_For_Raise (signo, ucontext); | |
129 | ||
130 | -- Check that treatment of exception propagation here is consistent with | |
131 | -- treatment of the abort signal in System.Task_Primitives.Operations. | |
132 | ||
133 | case signo is | |
134 | when SIGFPE => raise Constraint_Error; | |
135 | when SIGILL => raise Program_Error; | |
136 | when SIGSEGV => raise Storage_Error; | |
137 | when SIGBUS => raise Storage_Error; | |
138 | when others => null; | |
139 | end case; | |
140 | end Notify_Exception; | |
141 | ||
142 | ---------------- | |
143 | -- Initialize -- | |
144 | ---------------- | |
145 | ||
146 | Initialized : Boolean := False; | |
147 | ||
148 | procedure Initialize is | |
149 | act : aliased struct_sigaction; | |
150 | old_act : aliased struct_sigaction; | |
151 | Result : System.OS_Interface.int; | |
152 | ||
153 | Use_Alternate_Stack : constant Boolean := | |
154 | System.Task_Primitives.Alternate_Stack_Size /= 0; | |
155 | -- Whether to use an alternate signal stack for stack overflows | |
156 | ||
157 | begin | |
158 | if Initialized then | |
159 | return; | |
160 | end if; | |
161 | ||
162 | Initialized := True; | |
163 | ||
164 | -- Need to call pthread_init very early because it is doing signal | |
165 | -- initializations. | |
166 | ||
167 | pthread_init; | |
168 | ||
169 | Abort_Task_Interrupt := SIGADAABORT; | |
170 | ||
171 | act.sa_handler := Notify_Exception'Address; | |
172 | ||
173 | -- Setting SA_SIGINFO asks the kernel to pass more than just the signal | |
174 | -- number argument to the handler when it is called. The set of extra | |
175 | -- parameters includes a pointer to the interrupted context, which the | |
176 | -- ZCX propagation scheme needs. | |
177 | ||
178 | -- Most man pages for sigaction mention that sa_sigaction should be set | |
179 | -- instead of sa_handler when SA_SIGINFO is on. In practice, the two | |
180 | -- fields are actually union'ed and located at the same offset. | |
181 | ||
182 | -- On some targets, we set sa_flags to SA_NODEFER so that during the | |
183 | -- handler execution we do not change the Signal_Mask to be masked for | |
184 | -- the Signal. | |
185 | ||
186 | -- This is a temporary fix to the problem that the Signal_Mask is not | |
187 | -- restored after the exception (longjmp) from the handler. The right | |
188 | -- fix should be made in sigsetjmp so that we save the Signal_Set and | |
189 | -- restore it after a longjmp. | |
190 | ||
191 | -- Since SA_NODEFER is obsolete, instead we reset explicitly the mask | |
192 | -- in the exception handler. | |
193 | ||
194 | Result := sigemptyset (Signal_Mask'Access); | |
195 | pragma Assert (Result = 0); | |
196 | ||
197 | -- Add signals that map to Ada exceptions to the mask | |
198 | ||
199 | for J in Exception_Interrupts'Range loop | |
200 | if State (Exception_Interrupts (J)) /= Default then | |
201 | Result := | |
202 | sigaddset (Signal_Mask'Access, Signal (Exception_Interrupts (J))); | |
203 | pragma Assert (Result = 0); | |
204 | end if; | |
205 | end loop; | |
206 | ||
207 | act.sa_mask := Signal_Mask; | |
208 | ||
209 | pragma Assert (Keep_Unmasked = (Interrupt_ID'Range => False)); | |
210 | pragma Assert (Reserve = (Interrupt_ID'Range => False)); | |
211 | ||
212 | -- Process state of exception signals | |
213 | ||
214 | for J in Exception_Interrupts'Range loop | |
215 | if State (Exception_Interrupts (J)) /= User then | |
216 | Keep_Unmasked (Exception_Interrupts (J)) := True; | |
217 | Reserve (Exception_Interrupts (J)) := True; | |
218 | ||
219 | if State (Exception_Interrupts (J)) /= Default then | |
220 | -- This file is identical to s-intman-posix.adb, except that we | |
221 | -- don't set the SA_SIGINFO flag in act.sa_flags, because | |
222 | -- LynxOS does not support that. If SA_SIGINFO is set, then | |
223 | -- sigaction fails, returning -1. | |
224 | act.sa_flags := 0; | |
225 | ||
226 | if Use_Alternate_Stack | |
227 | and then Exception_Interrupts (J) = SIGSEGV | |
228 | then | |
229 | act.sa_flags := act.sa_flags + SA_ONSTACK; | |
230 | end if; | |
231 | ||
232 | Result := | |
233 | sigaction | |
234 | (Signal (Exception_Interrupts (J)), act'Unchecked_Access, | |
235 | old_act'Unchecked_Access); | |
236 | pragma Assert (Result = 0); | |
237 | end if; | |
238 | end if; | |
239 | end loop; | |
240 | ||
241 | if State (Abort_Task_Interrupt) /= User then | |
242 | Keep_Unmasked (Abort_Task_Interrupt) := True; | |
243 | Reserve (Abort_Task_Interrupt) := True; | |
244 | end if; | |
245 | ||
246 | -- Set SIGINT to unmasked state as long as it is not in "User" state. | |
247 | -- Check for Unreserve_All_Interrupts last. | |
248 | ||
249 | if State (SIGINT) /= User then | |
250 | Keep_Unmasked (SIGINT) := True; | |
251 | Reserve (SIGINT) := True; | |
252 | end if; | |
253 | ||
254 | -- Check all signals for state that requires keeping them unmasked and | |
255 | -- reserved. | |
256 | ||
257 | for J in Interrupt_ID'Range loop | |
258 | if State (J) = Default or else State (J) = Runtime then | |
259 | Keep_Unmasked (J) := True; | |
260 | Reserve (J) := True; | |
261 | end if; | |
262 | end loop; | |
263 | ||
264 | -- Add the set of signals that must always be unmasked for this target | |
265 | ||
266 | for J in Unmasked'Range loop | |
267 | Keep_Unmasked (Interrupt_ID (Unmasked (J))) := True; | |
268 | Reserve (Interrupt_ID (Unmasked (J))) := True; | |
269 | end loop; | |
270 | ||
271 | -- Add target-specific reserved signals | |
272 | ||
273 | for J in Reserved'Range loop | |
274 | Reserve (Interrupt_ID (Reserved (J))) := True; | |
275 | end loop; | |
276 | ||
277 | -- Process pragma Unreserve_All_Interrupts. This overrides any settings | |
278 | -- due to pragma Interrupt_State: | |
279 | ||
280 | if Unreserve_All_Interrupts /= 0 then | |
281 | Keep_Unmasked (SIGINT) := False; | |
282 | Reserve (SIGINT) := False; | |
283 | end if; | |
284 | ||
285 | -- We do not really have Signal 0. We just use this value to identify | |
286 | -- non-existent signals (see s-intnam.ads). Therefore, Signal should not | |
287 | -- be used in all signal related operations hence mark it as reserved. | |
288 | ||
289 | Reserve (0) := True; | |
290 | end Initialize; | |
291 | ||
292 | end System.Interrupt_Management; |