annotate gcc/ada/libgnarl/s-intman__lynxos.adb @ 131:84e7813d76e9

gcc-8.2
author mir3636
date Thu, 25 Oct 2018 07:37:49 +0900
parents 04ced10e8804
children 1830386684a0
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
111
kono
parents:
diff changeset
1 ------------------------------------------------------------------------------
kono
parents:
diff changeset
2 -- --
kono
parents:
diff changeset
3 -- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
kono
parents:
diff changeset
4 -- --
kono
parents:
diff changeset
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 --
kono
parents:
diff changeset
6 -- --
kono
parents:
diff changeset
7 -- B o d y --
kono
parents:
diff changeset
8 -- --
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
9 -- Copyright (C) 1992-2018, Free Software Foundation, Inc. --
111
kono
parents:
diff changeset
10 -- --
kono
parents:
diff changeset
11 -- GNARL is free software; you can redistribute it and/or modify it under --
kono
parents:
diff changeset
12 -- terms of the GNU General Public License as published by the Free Soft- --
kono
parents:
diff changeset
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
kono
parents:
diff changeset
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
kono
parents:
diff changeset
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
kono
parents:
diff changeset
16 -- or FITNESS FOR A PARTICULAR PURPOSE. --
kono
parents:
diff changeset
17 -- --
kono
parents:
diff changeset
18 -- As a special exception under Section 7 of GPL version 3, you are granted --
kono
parents:
diff changeset
19 -- additional permissions described in the GCC Runtime Library Exception, --
kono
parents:
diff changeset
20 -- version 3.1, as published by the Free Software Foundation. --
kono
parents:
diff changeset
21 -- --
kono
parents:
diff changeset
22 -- You should have received a copy of the GNU General Public License and --
kono
parents:
diff changeset
23 -- a copy of the GCC Runtime Library Exception along with this program; --
kono
parents:
diff changeset
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
kono
parents:
diff changeset
25 -- <http://www.gnu.org/licenses/>. --
kono
parents:
diff changeset
26 -- --
kono
parents:
diff changeset
27 -- GNARL was developed by the GNARL team at Florida State University. --
kono
parents:
diff changeset
28 -- Extensive contributions were provided by Ada Core Technologies, Inc. --
kono
parents:
diff changeset
29 -- --
kono
parents:
diff changeset
30 ------------------------------------------------------------------------------
kono
parents:
diff changeset
31
kono
parents:
diff changeset
32 -- This is the LynxOS version of this package
kono
parents:
diff changeset
33
kono
parents:
diff changeset
34 -- Make a careful study of all signals available under the OS, to see which
kono
parents:
diff changeset
35 -- need to be reserved, kept always unmasked, or kept always unmasked. Be on
kono
parents:
diff changeset
36 -- the lookout for special signals that may be used by the thread library.
kono
parents:
diff changeset
37
kono
parents:
diff changeset
38 -- Since this is a multi target file, the signal <-> exception mapping
kono
parents:
diff changeset
39 -- is simple minded. If you need a more precise and target specific
kono
parents:
diff changeset
40 -- signal handling, create a new s-intman.adb that will fit your needs.
kono
parents:
diff changeset
41
kono
parents:
diff changeset
42 -- This file assumes that:
kono
parents:
diff changeset
43
kono
parents:
diff changeset
44 -- SIGFPE, SIGILL, SIGSEGV and SIGBUS exist. They are mapped as follows:
kono
parents:
diff changeset
45 -- SIGPFE => Constraint_Error
kono
parents:
diff changeset
46 -- SIGILL => Program_Error
kono
parents:
diff changeset
47 -- SIGSEGV => Storage_Error
kono
parents:
diff changeset
48 -- SIGBUS => Storage_Error
kono
parents:
diff changeset
49
kono
parents:
diff changeset
50 -- SIGINT exists and will be kept unmasked unless the pragma
kono
parents:
diff changeset
51 -- Unreserve_All_Interrupts is specified anywhere in the application.
kono
parents:
diff changeset
52
kono
parents:
diff changeset
53 -- System.OS_Interface contains the following:
kono
parents:
diff changeset
54 -- SIGADAABORT: the signal that will be used to abort tasks.
kono
parents:
diff changeset
55 -- Unmasked: the OS specific set of signals that should be unmasked in
kono
parents:
diff changeset
56 -- all the threads. SIGADAABORT is unmasked by
kono
parents:
diff changeset
57 -- default
kono
parents:
diff changeset
58 -- Reserved: the OS specific set of signals that are reserved.
kono
parents:
diff changeset
59
kono
parents:
diff changeset
60 with System.Task_Primitives;
kono
parents:
diff changeset
61
kono
parents:
diff changeset
62 package body System.Interrupt_Management is
kono
parents:
diff changeset
63
kono
parents:
diff changeset
64 use Interfaces.C;
kono
parents:
diff changeset
65 use System.OS_Interface;
kono
parents:
diff changeset
66
kono
parents:
diff changeset
67 type Interrupt_List is array (Interrupt_ID range <>) of Interrupt_ID;
kono
parents:
diff changeset
68 Exception_Interrupts : constant Interrupt_List :=
kono
parents:
diff changeset
69 (SIGFPE, SIGILL, SIGSEGV, SIGBUS);
kono
parents:
diff changeset
70
kono
parents:
diff changeset
71 Unreserve_All_Interrupts : Interfaces.C.int;
kono
parents:
diff changeset
72 pragma Import
kono
parents:
diff changeset
73 (C, Unreserve_All_Interrupts, "__gl_unreserve_all_interrupts");
kono
parents:
diff changeset
74
kono
parents:
diff changeset
75 -----------------------
kono
parents:
diff changeset
76 -- Local Subprograms --
kono
parents:
diff changeset
77 -----------------------
kono
parents:
diff changeset
78
kono
parents:
diff changeset
79 function State (Int : Interrupt_ID) return Character;
kono
parents:
diff changeset
80 pragma Import (C, State, "__gnat_get_interrupt_state");
kono
parents:
diff changeset
81 -- Get interrupt state. Defined in init.c The input argument is the
kono
parents:
diff changeset
82 -- interrupt number, and the result is one of the following:
kono
parents:
diff changeset
83
kono
parents:
diff changeset
84 User : constant Character := 'u';
kono
parents:
diff changeset
85 Runtime : constant Character := 'r';
kono
parents:
diff changeset
86 Default : constant Character := 's';
kono
parents:
diff changeset
87 -- 'n' this interrupt not set by any Interrupt_State pragma
kono
parents:
diff changeset
88 -- 'u' Interrupt_State pragma set state to User
kono
parents:
diff changeset
89 -- 'r' Interrupt_State pragma set state to Runtime
kono
parents:
diff changeset
90 -- 's' Interrupt_State pragma set state to System (use "default"
kono
parents:
diff changeset
91 -- system handler)
kono
parents:
diff changeset
92
kono
parents:
diff changeset
93 procedure Notify_Exception
kono
parents:
diff changeset
94 (signo : Signal;
kono
parents:
diff changeset
95 siginfo : System.Address;
kono
parents:
diff changeset
96 ucontext : System.Address);
kono
parents:
diff changeset
97 -- This function identifies the Ada exception to be raised using the
kono
parents:
diff changeset
98 -- information when the system received a synchronous signal. Since this
kono
parents:
diff changeset
99 -- function is machine and OS dependent, different code has to be provided
kono
parents:
diff changeset
100 -- for different target.
kono
parents:
diff changeset
101
kono
parents:
diff changeset
102 ----------------------
kono
parents:
diff changeset
103 -- Notify_Exception --
kono
parents:
diff changeset
104 ----------------------
kono
parents:
diff changeset
105
kono
parents:
diff changeset
106 Signal_Mask : aliased sigset_t;
kono
parents:
diff changeset
107 -- The set of signals handled by Notify_Exception
kono
parents:
diff changeset
108
kono
parents:
diff changeset
109 procedure Notify_Exception
kono
parents:
diff changeset
110 (signo : Signal;
kono
parents:
diff changeset
111 siginfo : System.Address;
kono
parents:
diff changeset
112 ucontext : System.Address)
kono
parents:
diff changeset
113 is
kono
parents:
diff changeset
114 pragma Unreferenced (siginfo);
kono
parents:
diff changeset
115
kono
parents:
diff changeset
116 Result : Interfaces.C.int;
kono
parents:
diff changeset
117
kono
parents:
diff changeset
118 begin
kono
parents:
diff changeset
119 -- With the __builtin_longjmp, the signal mask is not restored, so we
kono
parents:
diff changeset
120 -- need to restore it explicitly.
kono
parents:
diff changeset
121
kono
parents:
diff changeset
122 Result := pthread_sigmask (SIG_UNBLOCK, Signal_Mask'Access, null);
kono
parents:
diff changeset
123 pragma Assert (Result = 0);
kono
parents:
diff changeset
124
kono
parents:
diff changeset
125 -- Perform the necessary context adjustments prior to a raise
kono
parents:
diff changeset
126 -- from a signal handler.
kono
parents:
diff changeset
127
kono
parents:
diff changeset
128 Adjust_Context_For_Raise (signo, ucontext);
kono
parents:
diff changeset
129
kono
parents:
diff changeset
130 -- Check that treatment of exception propagation here is consistent with
kono
parents:
diff changeset
131 -- treatment of the abort signal in System.Task_Primitives.Operations.
kono
parents:
diff changeset
132
kono
parents:
diff changeset
133 case signo is
kono
parents:
diff changeset
134 when SIGFPE => raise Constraint_Error;
kono
parents:
diff changeset
135 when SIGILL => raise Program_Error;
kono
parents:
diff changeset
136 when SIGSEGV => raise Storage_Error;
kono
parents:
diff changeset
137 when SIGBUS => raise Storage_Error;
kono
parents:
diff changeset
138 when others => null;
kono
parents:
diff changeset
139 end case;
kono
parents:
diff changeset
140 end Notify_Exception;
kono
parents:
diff changeset
141
kono
parents:
diff changeset
142 ----------------
kono
parents:
diff changeset
143 -- Initialize --
kono
parents:
diff changeset
144 ----------------
kono
parents:
diff changeset
145
kono
parents:
diff changeset
146 Initialized : Boolean := False;
kono
parents:
diff changeset
147
kono
parents:
diff changeset
148 procedure Initialize is
kono
parents:
diff changeset
149 act : aliased struct_sigaction;
kono
parents:
diff changeset
150 old_act : aliased struct_sigaction;
kono
parents:
diff changeset
151 Result : System.OS_Interface.int;
kono
parents:
diff changeset
152
kono
parents:
diff changeset
153 Use_Alternate_Stack : constant Boolean :=
kono
parents:
diff changeset
154 System.Task_Primitives.Alternate_Stack_Size /= 0;
kono
parents:
diff changeset
155 -- Whether to use an alternate signal stack for stack overflows
kono
parents:
diff changeset
156
kono
parents:
diff changeset
157 begin
kono
parents:
diff changeset
158 if Initialized then
kono
parents:
diff changeset
159 return;
kono
parents:
diff changeset
160 end if;
kono
parents:
diff changeset
161
kono
parents:
diff changeset
162 Initialized := True;
kono
parents:
diff changeset
163
kono
parents:
diff changeset
164 -- Need to call pthread_init very early because it is doing signal
kono
parents:
diff changeset
165 -- initializations.
kono
parents:
diff changeset
166
kono
parents:
diff changeset
167 pthread_init;
kono
parents:
diff changeset
168
kono
parents:
diff changeset
169 Abort_Task_Interrupt := SIGADAABORT;
kono
parents:
diff changeset
170
kono
parents:
diff changeset
171 act.sa_handler := Notify_Exception'Address;
kono
parents:
diff changeset
172
kono
parents:
diff changeset
173 -- Setting SA_SIGINFO asks the kernel to pass more than just the signal
kono
parents:
diff changeset
174 -- number argument to the handler when it is called. The set of extra
kono
parents:
diff changeset
175 -- parameters includes a pointer to the interrupted context, which the
kono
parents:
diff changeset
176 -- ZCX propagation scheme needs.
kono
parents:
diff changeset
177
kono
parents:
diff changeset
178 -- Most man pages for sigaction mention that sa_sigaction should be set
kono
parents:
diff changeset
179 -- instead of sa_handler when SA_SIGINFO is on. In practice, the two
kono
parents:
diff changeset
180 -- fields are actually union'ed and located at the same offset.
kono
parents:
diff changeset
181
kono
parents:
diff changeset
182 -- On some targets, we set sa_flags to SA_NODEFER so that during the
kono
parents:
diff changeset
183 -- handler execution we do not change the Signal_Mask to be masked for
kono
parents:
diff changeset
184 -- the Signal.
kono
parents:
diff changeset
185
kono
parents:
diff changeset
186 -- This is a temporary fix to the problem that the Signal_Mask is not
kono
parents:
diff changeset
187 -- restored after the exception (longjmp) from the handler. The right
kono
parents:
diff changeset
188 -- fix should be made in sigsetjmp so that we save the Signal_Set and
kono
parents:
diff changeset
189 -- restore it after a longjmp.
kono
parents:
diff changeset
190
kono
parents:
diff changeset
191 -- Since SA_NODEFER is obsolete, instead we reset explicitly the mask
kono
parents:
diff changeset
192 -- in the exception handler.
kono
parents:
diff changeset
193
kono
parents:
diff changeset
194 Result := sigemptyset (Signal_Mask'Access);
kono
parents:
diff changeset
195 pragma Assert (Result = 0);
kono
parents:
diff changeset
196
kono
parents:
diff changeset
197 -- Add signals that map to Ada exceptions to the mask
kono
parents:
diff changeset
198
kono
parents:
diff changeset
199 for J in Exception_Interrupts'Range loop
kono
parents:
diff changeset
200 if State (Exception_Interrupts (J)) /= Default then
kono
parents:
diff changeset
201 Result :=
kono
parents:
diff changeset
202 sigaddset (Signal_Mask'Access, Signal (Exception_Interrupts (J)));
kono
parents:
diff changeset
203 pragma Assert (Result = 0);
kono
parents:
diff changeset
204 end if;
kono
parents:
diff changeset
205 end loop;
kono
parents:
diff changeset
206
kono
parents:
diff changeset
207 act.sa_mask := Signal_Mask;
kono
parents:
diff changeset
208
kono
parents:
diff changeset
209 pragma Assert (Keep_Unmasked = (Interrupt_ID'Range => False));
kono
parents:
diff changeset
210 pragma Assert (Reserve = (Interrupt_ID'Range => False));
kono
parents:
diff changeset
211
kono
parents:
diff changeset
212 -- Process state of exception signals
kono
parents:
diff changeset
213
kono
parents:
diff changeset
214 for J in Exception_Interrupts'Range loop
kono
parents:
diff changeset
215 if State (Exception_Interrupts (J)) /= User then
kono
parents:
diff changeset
216 Keep_Unmasked (Exception_Interrupts (J)) := True;
kono
parents:
diff changeset
217 Reserve (Exception_Interrupts (J)) := True;
kono
parents:
diff changeset
218
kono
parents:
diff changeset
219 if State (Exception_Interrupts (J)) /= Default then
kono
parents:
diff changeset
220 -- This file is identical to s-intman-posix.adb, except that we
kono
parents:
diff changeset
221 -- don't set the SA_SIGINFO flag in act.sa_flags, because
kono
parents:
diff changeset
222 -- LynxOS does not support that. If SA_SIGINFO is set, then
kono
parents:
diff changeset
223 -- sigaction fails, returning -1.
kono
parents:
diff changeset
224 act.sa_flags := 0;
kono
parents:
diff changeset
225
kono
parents:
diff changeset
226 if Use_Alternate_Stack
kono
parents:
diff changeset
227 and then Exception_Interrupts (J) = SIGSEGV
kono
parents:
diff changeset
228 then
kono
parents:
diff changeset
229 act.sa_flags := act.sa_flags + SA_ONSTACK;
kono
parents:
diff changeset
230 end if;
kono
parents:
diff changeset
231
kono
parents:
diff changeset
232 Result :=
kono
parents:
diff changeset
233 sigaction
kono
parents:
diff changeset
234 (Signal (Exception_Interrupts (J)), act'Unchecked_Access,
kono
parents:
diff changeset
235 old_act'Unchecked_Access);
kono
parents:
diff changeset
236 pragma Assert (Result = 0);
kono
parents:
diff changeset
237 end if;
kono
parents:
diff changeset
238 end if;
kono
parents:
diff changeset
239 end loop;
kono
parents:
diff changeset
240
kono
parents:
diff changeset
241 if State (Abort_Task_Interrupt) /= User then
kono
parents:
diff changeset
242 Keep_Unmasked (Abort_Task_Interrupt) := True;
kono
parents:
diff changeset
243 Reserve (Abort_Task_Interrupt) := True;
kono
parents:
diff changeset
244 end if;
kono
parents:
diff changeset
245
kono
parents:
diff changeset
246 -- Set SIGINT to unmasked state as long as it is not in "User" state.
kono
parents:
diff changeset
247 -- Check for Unreserve_All_Interrupts last.
kono
parents:
diff changeset
248
kono
parents:
diff changeset
249 if State (SIGINT) /= User then
kono
parents:
diff changeset
250 Keep_Unmasked (SIGINT) := True;
kono
parents:
diff changeset
251 Reserve (SIGINT) := True;
kono
parents:
diff changeset
252 end if;
kono
parents:
diff changeset
253
kono
parents:
diff changeset
254 -- Check all signals for state that requires keeping them unmasked and
kono
parents:
diff changeset
255 -- reserved.
kono
parents:
diff changeset
256
kono
parents:
diff changeset
257 for J in Interrupt_ID'Range loop
kono
parents:
diff changeset
258 if State (J) = Default or else State (J) = Runtime then
kono
parents:
diff changeset
259 Keep_Unmasked (J) := True;
kono
parents:
diff changeset
260 Reserve (J) := True;
kono
parents:
diff changeset
261 end if;
kono
parents:
diff changeset
262 end loop;
kono
parents:
diff changeset
263
kono
parents:
diff changeset
264 -- Add the set of signals that must always be unmasked for this target
kono
parents:
diff changeset
265
kono
parents:
diff changeset
266 for J in Unmasked'Range loop
kono
parents:
diff changeset
267 Keep_Unmasked (Interrupt_ID (Unmasked (J))) := True;
kono
parents:
diff changeset
268 Reserve (Interrupt_ID (Unmasked (J))) := True;
kono
parents:
diff changeset
269 end loop;
kono
parents:
diff changeset
270
kono
parents:
diff changeset
271 -- Add target-specific reserved signals
kono
parents:
diff changeset
272
kono
parents:
diff changeset
273 for J in Reserved'Range loop
kono
parents:
diff changeset
274 Reserve (Interrupt_ID (Reserved (J))) := True;
kono
parents:
diff changeset
275 end loop;
kono
parents:
diff changeset
276
kono
parents:
diff changeset
277 -- Process pragma Unreserve_All_Interrupts. This overrides any settings
kono
parents:
diff changeset
278 -- due to pragma Interrupt_State:
kono
parents:
diff changeset
279
kono
parents:
diff changeset
280 if Unreserve_All_Interrupts /= 0 then
kono
parents:
diff changeset
281 Keep_Unmasked (SIGINT) := False;
kono
parents:
diff changeset
282 Reserve (SIGINT) := False;
kono
parents:
diff changeset
283 end if;
kono
parents:
diff changeset
284
kono
parents:
diff changeset
285 -- We do not really have Signal 0. We just use this value to identify
kono
parents:
diff changeset
286 -- non-existent signals (see s-intnam.ads). Therefore, Signal should not
kono
parents:
diff changeset
287 -- be used in all signal related operations hence mark it as reserved.
kono
parents:
diff changeset
288
kono
parents:
diff changeset
289 Reserve (0) := True;
kono
parents:
diff changeset
290 end Initialize;
kono
parents:
diff changeset
291
kono
parents:
diff changeset
292 end System.Interrupt_Management;