]>
Commit | Line | Data |
---|---|---|
84481f76 RK |
1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
3 | -- GNU ADA 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 | -- -- | |
07fc65c4 | 9 | -- Copyright (C) 1991-2002 Florida State University -- |
84481f76 RK |
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 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, 59 Temple Place - Suite 330, Boston, -- | |
20 | -- MA 02111-1307, USA. -- | |
21 | -- -- | |
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. -- | |
28 | -- -- | |
29 | -- GNARL was developed by the GNARL team at Florida State University. It is -- | |
30 | -- now maintained by Ada Core Technologies Inc. in cooperation with Florida -- | |
31 | -- State University (http://www.gnat.com). -- | |
32 | -- -- | |
33 | ------------------------------------------------------------------------------ | |
34 | ||
35 | -- This is a Sun OS (FSU THREADS) version of this package | |
36 | ||
37 | -- PLEASE DO NOT add any dependences on other packages. ??? why not ??? | |
38 | -- This package is designed to work with or without tasking support. | |
39 | ||
40 | -- Make a careful study of all signals available under the OS, to see which | |
41 | -- need to be reserved, kept always unmasked, or kept always unmasked. Be on | |
42 | -- the lookout for special signals that may be used by the thread library. | |
43 | ||
44 | with Interfaces.C; | |
45 | -- used for int | |
46 | ||
47 | with System.Error_Reporting; | |
48 | -- used for Shutdown | |
49 | ||
50 | with System.OS_Interface; | |
51 | -- used for various Constants, Signal and types | |
52 | ||
53 | package body System.Interrupt_Management is | |
54 | ||
55 | use Interfaces.C; | |
56 | use System.Error_Reporting; | |
57 | use System.OS_Interface; | |
58 | ||
59 | type Interrupt_List is array (Interrupt_ID range <>) of Interrupt_ID; | |
60 | Exception_Interrupts : constant Interrupt_List := | |
61 | (SIGFPE, SIGILL, SIGSEGV); | |
62 | ||
63 | Unreserve_All_Interrupts : Interfaces.C.int; | |
64 | pragma Import | |
65 | (C, Unreserve_All_Interrupts, "__gl_unreserve_all_interrupts"); | |
66 | ||
67 | ----------------------- | |
68 | -- Local Subprograms -- | |
69 | ----------------------- | |
70 | ||
71 | procedure Notify_Exception | |
72 | (signo : Signal; | |
73 | info : access siginfo_t; | |
74 | context : access struct_sigcontext); | |
75 | -- This function identifies the Ada exception to be raised using | |
76 | -- the information when the system received a synchronous signal. | |
77 | -- Since this function is machine and OS dependent, different code | |
78 | -- has to be provided for different target. | |
79 | ||
80 | ---------------------- | |
81 | -- Notify_Exception -- | |
82 | ---------------------- | |
83 | ||
84 | -- The following code is intended for SunOS on Sparcstation. | |
85 | ||
86 | procedure Notify_Exception | |
87 | (signo : Signal; | |
88 | info : access siginfo_t; | |
89 | context : access struct_sigcontext) | |
90 | is | |
91 | begin | |
92 | -- As long as we are using a longjmp to return control to the | |
93 | -- exception handler on the runtime stack, we are safe. The original | |
94 | -- signal mask (the one we had before coming into this signal catching | |
95 | -- function) will be restored by the longjmp. Therefore, raising | |
96 | -- an exception in this handler should be a safe operation. | |
97 | ||
98 | -- Check that treatment of exception propagation here | |
99 | -- is consistent with treatment of the abort signal in | |
100 | -- System.Task_Primitives.Operations. | |
101 | ||
102 | case signo is | |
103 | when SIGFPE => | |
104 | case info.si_code is | |
105 | when FPE_INTOVF_TRAP | | |
106 | FPE_STARTSIG_TRAP | | |
107 | FPE_INTDIV_TRAP | | |
108 | FPE_FLTDIV_TRAP | | |
109 | FPE_FLTUND_TRAP | | |
110 | FPE_FLTOPERR_TRAP | | |
111 | FPE_FLTOVF_TRAP => | |
112 | raise Constraint_Error; | |
113 | ||
114 | when others => | |
115 | pragma Assert (Shutdown ("Unexpected SIGFPE signal")); | |
116 | null; | |
117 | end case; | |
118 | ||
119 | when SIGILL => | |
120 | case info.si_code is | |
121 | when ILL_STACK | | |
122 | ILL_ILLINSTR_FAULT | | |
123 | ILL_PRIVINSTR_FAULT => | |
124 | raise Constraint_Error; | |
125 | ||
126 | when others => | |
127 | pragma Assert (Shutdown ("Unexpected SIGILL signal")); | |
128 | null; | |
129 | end case; | |
130 | ||
131 | when SIGSEGV => | |
132 | ||
133 | -- was caused by accessing a null pointer. | |
134 | ||
135 | -- ???? Origin of this code is unclear, may be broken ??? | |
136 | ||
137 | if context.sc_o0 in 0 .. 16#2000# then | |
138 | raise Constraint_Error; | |
139 | else | |
140 | raise Storage_Error; | |
141 | end if; | |
142 | ||
143 | when others => | |
144 | pragma Assert (Shutdown ("Unexpected signal")); | |
145 | null; | |
146 | end case; | |
147 | end Notify_Exception; | |
148 | ||
149 | --------------------------- | |
150 | -- Initialize_Interrupts -- | |
151 | --------------------------- | |
152 | ||
153 | -- Nothing needs to be done on this platform | |
154 | ||
155 | procedure Initialize_Interrupts is | |
156 | begin | |
157 | null; | |
158 | end Initialize_Interrupts; | |
159 | ||
160 | ------------------------- | |
161 | -- Package Elaboration -- | |
162 | ------------------------- | |
163 | ||
164 | begin | |
165 | declare | |
166 | act : aliased struct_sigaction; | |
167 | old_act : aliased struct_sigaction; | |
168 | mask : aliased sigset_t; | |
169 | Result : Interfaces.C.int; | |
170 | ||
171 | begin | |
172 | -- Need to call pthread_init very early because it is doing signal | |
173 | -- initializations. | |
174 | ||
175 | pthread_init; | |
176 | ||
177 | -- Change the following assignment to use another signal for task abort. | |
178 | -- For example, SIGTERM might be a good one if SIGABRT is required for | |
179 | -- use elsewhere. | |
180 | ||
181 | Abort_Task_Interrupt := SIGABRT; | |
182 | ||
183 | act.sa_handler := Notify_Exception'Address; | |
184 | ||
185 | -- Set sa_flags to SA_NODEFER so that during the handler execution | |
186 | -- we do not change the Signal_Mask to be masked for the Signal. | |
187 | -- This is a temporary fix to the problem that the Signal_Mask is | |
188 | -- not restored after the exception (longjmp) from the handler. | |
189 | -- The right fix should be made in sigsetjmp so that we save | |
190 | -- the Signal_Set and restore it after a longjmp. | |
191 | ||
192 | -- In that case, this field should be changed back to 0. ??? | |
193 | ||
194 | act.sa_flags := 16; | |
195 | ||
196 | Result := sigemptyset (mask'Access); | |
197 | pragma Assert (Result = 0); | |
198 | ||
199 | for J in Exception_Interrupts'Range loop | |
200 | Result := sigaddset (mask'Access, Signal (Exception_Interrupts (J))); | |
201 | pragma Assert (Result = 0); | |
202 | end loop; | |
203 | ||
204 | act.sa_mask := mask; | |
205 | ||
206 | for J in Exception_Interrupts'Range loop | |
207 | Keep_Unmasked (Exception_Interrupts (J)) := True; | |
208 | ||
07fc65c4 GB |
209 | Result := |
210 | sigaction | |
211 | (Signal (Exception_Interrupts (J)), | |
212 | act'Unchecked_Access, | |
213 | old_act'Unchecked_Access); | |
214 | pragma Assert (Result = 0); | |
84481f76 RK |
215 | end loop; |
216 | ||
217 | Keep_Unmasked (Abort_Task_Interrupt) := True; | |
84481f76 RK |
218 | Keep_Unmasked (SIGALRM) := True; |
219 | Keep_Unmasked (SIGSTOP) := True; | |
220 | Keep_Unmasked (SIGKILL) := True; | |
84481f76 RK |
221 | |
222 | -- By keeping SIGINT unmasked, allow the user to do a Ctrl-C, but at | |
223 | -- the same time, disable the ability of handling this signal using | |
224 | -- package Ada.Interrupts. | |
225 | ||
226 | -- The pragma Unreserve_All_Interrupts allows the user the ability to | |
227 | -- change this behavior. | |
228 | ||
229 | if Unreserve_All_Interrupts = 0 then | |
230 | Keep_Unmasked (SIGINT) := True; | |
231 | end if; | |
232 | ||
233 | -- Reserve this not to interfere with thread scheduling | |
234 | ||
235 | -- ??? consider adding this to interrupt exceptions | |
236 | -- Keep_Unmasked (SIGALRM) := True; | |
237 | ||
238 | -- An earlier version had a comment about SIGALRM needing to be unmasked | |
239 | -- in at least one thread for cond_timedwait to work. | |
240 | ||
241 | -- It is unclear whether this is True for Solaris threads, FSU threads, | |
242 | -- both, or maybe just an old version of FSU threads. ???? | |
243 | ||
244 | -- Following signals should not be disturbed. Found by experiment | |
245 | ||
246 | Keep_Unmasked (SIGEMT) := True; | |
247 | Keep_Unmasked (SIGCHLD) := True; | |
248 | ||
249 | -- We do not have Signal 0 in reality. We just use this value | |
250 | -- to identify not existing signals (see s-intnam.ads). Therefore, | |
251 | -- Signal 0 should not be used in all signal related operations hence | |
252 | -- mark it as reserved. | |
253 | ||
254 | Reserve := Reserve or Keep_Unmasked or Keep_Masked; | |
255 | Reserve (0) := True; | |
256 | end; | |
257 | end System.Interrupt_Management; |