Mercurial > hg > CbC > CbC_gcc
comparison gcc/ada/libgnarl/s-intman__qnx.adb @ 131:84e7813d76e9
gcc-8.2
author | mir3636 |
---|---|
date | Thu, 25 Oct 2018 07:37:49 +0900 |
parents | |
children | 1830386684a0 |
comparison
equal
deleted
inserted
replaced
111:04ced10e8804 | 131:84e7813d76e9 |
---|---|
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 -- -- | |
9 -- Copyright (C) 1992-2018, Free Software Foundation, Inc. -- | |
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 QNX/Neutrino threads 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 procedure Signal_Trampoline | |
80 (signo : Signal; | |
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 | |
87 -- information). | |
88 | |
89 procedure Map_Signal | |
90 (signo : Signal; | |
91 siginfo : System.Address; | |
92 ucontext : System.Address); | |
93 pragma Import (C, Map_Signal, "__gnat_map_signal"); | |
94 | |
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: | |
99 | |
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" | |
107 -- system handler) | |
108 | |
109 procedure Notify_Exception | |
110 (signo : Signal; | |
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. | |
117 | |
118 ---------------------- | |
119 -- Notify_Exception -- | |
120 ---------------------- | |
121 | |
122 Signal_Mask : aliased sigset_t; | |
123 -- The set of signals handled by Notify_Exception | |
124 | |
125 procedure Notify_Exception | |
126 (signo : Signal; | |
127 siginfo : System.Address; | |
128 ucontext : System.Address) | |
129 is | |
130 Result : Interfaces.C.int; | |
131 | |
132 begin | |
133 -- With the __builtin_longjmp, the signal mask is not restored, so we | |
134 -- need to restore it explicitly. | |
135 | |
136 Result := pthread_sigmask (SIG_UNBLOCK, Signal_Mask'Access, null); | |
137 pragma Assert (Result = 0); | |
138 | |
139 -- Perform the necessary context adjustments prior to a raise | |
140 -- from a signal handler. | |
141 | |
142 Adjust_Context_For_Raise (signo, ucontext); | |
143 | |
144 -- Check that treatment of exception propagation here is consistent with | |
145 -- treatment of the abort signal in System.Task_Primitives.Operations. | |
146 | |
147 Signal_Trampoline (signo, siginfo, ucontext, Map_Signal'Address); | |
148 end Notify_Exception; | |
149 | |
150 ---------------- | |
151 -- Initialize -- | |
152 ---------------- | |
153 | |
154 Initialized : Boolean := False; | |
155 | |
156 procedure Initialize is | |
157 act : aliased struct_sigaction; | |
158 old_act : aliased struct_sigaction; | |
159 Result : System.OS_Interface.int; | |
160 | |
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 | |
164 | |
165 begin | |
166 if Initialized then | |
167 return; | |
168 end if; | |
169 | |
170 Initialized := True; | |
171 | |
172 -- Need to call pthread_init very early because it is doing signal | |
173 -- initializations. | |
174 | |
175 pthread_init; | |
176 | |
177 Abort_Task_Interrupt := SIGADAABORT; | |
178 | |
179 act.sa_handler := Notify_Exception'Address; | |
180 | |
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. | |
185 | |
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. | |
189 | |
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 | |
192 -- the Signal. | |
193 | |
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. | |
198 | |
199 -- Since SA_NODEFER is obsolete, instead we reset explicitly the mask | |
200 -- in the exception handler. | |
201 | |
202 Result := sigemptyset (Signal_Mask'Access); | |
203 pragma Assert (Result = 0); | |
204 | |
205 -- Add signals that map to Ada exceptions to the mask | |
206 | |
207 for J in Exception_Interrupts'Range loop | |
208 if State (Exception_Interrupts (J)) /= Default then | |
209 Result := | |
210 sigaddset (Signal_Mask'Access, Signal (Exception_Interrupts (J))); | |
211 pragma Assert (Result = 0); | |
212 end if; | |
213 end loop; | |
214 | |
215 act.sa_mask := Signal_Mask; | |
216 | |
217 pragma Assert (Keep_Unmasked = (Interrupt_ID'Range => False)); | |
218 pragma Assert (Reserve = (Interrupt_ID'Range => False)); | |
219 | |
220 -- Process state of exception signals | |
221 | |
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; | |
226 | |
227 if State (Exception_Interrupts (J)) /= Default then | |
228 act.sa_flags := SA_SIGINFO; | |
229 | |
230 if Use_Alternate_Stack | |
231 and then Exception_Interrupts (J) = SIGSEGV | |
232 then | |
233 act.sa_flags := act.sa_flags + SA_ONSTACK; | |
234 end if; | |
235 | |
236 Result := | |
237 sigaction | |
238 (Signal (Exception_Interrupts (J)), act'Unchecked_Access, | |
239 old_act'Unchecked_Access); | |
240 pragma Assert (Result = 0); | |
241 end if; | |
242 end if; | |
243 end loop; | |
244 | |
245 if State (Abort_Task_Interrupt) /= User then | |
246 Keep_Unmasked (Abort_Task_Interrupt) := True; | |
247 Reserve (Abort_Task_Interrupt) := True; | |
248 end if; | |
249 | |
250 -- Set SIGINT to unmasked state as long as it is not in "User" state. | |
251 -- Check for Unreserve_All_Interrupts last. | |
252 | |
253 if State (SIGINT) /= User then | |
254 Keep_Unmasked (SIGINT) := True; | |
255 Reserve (SIGINT) := True; | |
256 end if; | |
257 | |
258 -- Check all signals for state that requires keeping them unmasked and | |
259 -- reserved. | |
260 | |
261 for J in Interrupt_ID'Range loop | |
262 if State (J) = Default or else State (J) = Runtime then | |
263 Keep_Unmasked (J) := True; | |
264 Reserve (J) := True; | |
265 end if; | |
266 end loop; | |
267 | |
268 -- Add the set of signals that must always be unmasked for this target | |
269 | |
270 for J in Unmasked'Range loop | |
271 Keep_Unmasked (Interrupt_ID (Unmasked (J))) := True; | |
272 Reserve (Interrupt_ID (Unmasked (J))) := True; | |
273 end loop; | |
274 | |
275 -- Add target-specific reserved signals | |
276 | |
277 if Reserved'Length > 0 then | |
278 for J in Reserved'Range loop | |
279 Reserve (Interrupt_ID (Reserved (J))) := True; | |
280 end loop; | |
281 end if; | |
282 | |
283 -- Process pragma Unreserve_All_Interrupts. This overrides any settings | |
284 -- due to pragma Interrupt_State: | |
285 | |
286 if Unreserve_All_Interrupts /= 0 then | |
287 Keep_Unmasked (SIGINT) := False; | |
288 Reserve (SIGINT) := False; | |
289 end if; | |
290 | |
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. | |
294 | |
295 Reserve (0) := True; | |
296 end Initialize; | |
297 | |
298 end System.Interrupt_Management; |