]>
Commit | Line | Data |
---|---|---|
e6e7bf38 | 1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
96d7aa32 | 3 | -- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS -- |
e6e7bf38 | 4 | -- -- |
35e3878c | 5 | -- SYSTEM.INTERRUPT_MANAGEMENT.OPERATIONS -- |
e6e7bf38 | 6 | -- -- |
7 | -- B o d y -- | |
8 | -- -- | |
6e2e029f | 9 | -- Copyright (C) 1991-2017, Florida State University -- |
10 | -- Copyright (C) 1995-2017, AdaCore -- | |
e6e7bf38 | 11 | -- -- |
3ce44058 | 12 | -- GNAT is free software; you can redistribute it and/or modify it under -- |
e6e7bf38 | 13 | -- terms of the GNU General Public License as published by the Free Soft- -- |
3ce44058 | 14 | -- ware Foundation; either version 3, or (at your option) any later ver- -- |
15 | -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- | |
e6e7bf38 | 16 | -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- |
3ce44058 | 17 | -- or FITNESS FOR A PARTICULAR PURPOSE. -- |
18 | -- -- | |
19 | -- As a special exception under Section 7 of GPL version 3, you are granted -- | |
20 | -- additional permissions described in the GCC Runtime Library Exception, -- | |
21 | -- version 3.1, as published by the Free Software Foundation. -- | |
22 | -- -- | |
23 | -- You should have received a copy of the GNU General Public License and -- | |
24 | -- a copy of the GCC Runtime Library Exception along with this program; -- | |
25 | -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- | |
26 | -- <http://www.gnu.org/licenses/>. -- | |
e6e7bf38 | 27 | -- -- |
9dfe12ae | 28 | -- GNARL was developed by the GNARL team at Florida State University. -- |
29 | -- Extensive contributions were provided by Ada Core Technologies, Inc. -- | |
e6e7bf38 | 30 | -- -- |
31 | ------------------------------------------------------------------------------ | |
32 | ||
35e3878c | 33 | -- This is a POSIX-like version of this package |
34 | ||
35 | -- Note: this file can only be used for POSIX compliant systems | |
e6e7bf38 | 36 | |
37 | with Interfaces.C; | |
e6e7bf38 | 38 | |
39 | with System.OS_Interface; | |
e6e7bf38 | 40 | with System.Storage_Elements; |
e6e7bf38 | 41 | |
e6e7bf38 | 42 | package body System.Interrupt_Management.Operations is |
43 | ||
44 | use Interfaces.C; | |
45 | use System.OS_Interface; | |
46 | ||
e6e7bf38 | 47 | --------------------- |
48 | -- Local Variables -- | |
49 | --------------------- | |
50 | ||
51 | Initial_Action : array (Signal) of aliased struct_sigaction; | |
52 | ||
53 | Default_Action : aliased struct_sigaction; | |
ed683f94 | 54 | pragma Warnings (Off, Default_Action); |
e6e7bf38 | 55 | |
ed683f94 | 56 | Ignore_Action : aliased struct_sigaction; |
e6e7bf38 | 57 | |
58 | ---------------------------- | |
59 | -- Thread_Block_Interrupt -- | |
60 | ---------------------------- | |
61 | ||
62 | procedure Thread_Block_Interrupt | |
63 | (Interrupt : Interrupt_ID) | |
64 | is | |
65 | Result : Interfaces.C.int; | |
66 | Mask : aliased sigset_t; | |
e6e7bf38 | 67 | begin |
68 | Result := sigemptyset (Mask'Access); | |
69 | pragma Assert (Result = 0); | |
70 | Result := sigaddset (Mask'Access, Signal (Interrupt)); | |
71 | pragma Assert (Result = 0); | |
682b5967 | 72 | Result := pthread_sigmask (SIG_BLOCK, Mask'Access, null); |
e6e7bf38 | 73 | pragma Assert (Result = 0); |
74 | end Thread_Block_Interrupt; | |
75 | ||
76 | ------------------------------ | |
77 | -- Thread_Unblock_Interrupt -- | |
78 | ------------------------------ | |
79 | ||
80 | procedure Thread_Unblock_Interrupt | |
81 | (Interrupt : Interrupt_ID) | |
82 | is | |
83 | Mask : aliased sigset_t; | |
84 | Result : Interfaces.C.int; | |
e6e7bf38 | 85 | begin |
86 | Result := sigemptyset (Mask'Access); | |
87 | pragma Assert (Result = 0); | |
88 | Result := sigaddset (Mask'Access, Signal (Interrupt)); | |
89 | pragma Assert (Result = 0); | |
682b5967 | 90 | Result := pthread_sigmask (SIG_UNBLOCK, Mask'Access, null); |
e6e7bf38 | 91 | pragma Assert (Result = 0); |
92 | end Thread_Unblock_Interrupt; | |
93 | ||
94 | ------------------------ | |
95 | -- Set_Interrupt_Mask -- | |
96 | ------------------------ | |
97 | ||
98 | procedure Set_Interrupt_Mask (Mask : access Interrupt_Mask) is | |
4fea14f7 | 99 | Result : Interfaces.C.int; |
e6e7bf38 | 100 | begin |
4fea14f7 | 101 | Result := pthread_sigmask (SIG_SETMASK, Mask, null); |
e6e7bf38 | 102 | pragma Assert (Result = 0); |
103 | end Set_Interrupt_Mask; | |
104 | ||
105 | procedure Set_Interrupt_Mask | |
106 | (Mask : access Interrupt_Mask; | |
107 | OMask : access Interrupt_Mask) | |
108 | is | |
109 | Result : Interfaces.C.int; | |
e6e7bf38 | 110 | begin |
4fea14f7 | 111 | Result := pthread_sigmask (SIG_SETMASK, Mask, OMask); |
e6e7bf38 | 112 | pragma Assert (Result = 0); |
113 | end Set_Interrupt_Mask; | |
114 | ||
115 | ------------------------ | |
116 | -- Get_Interrupt_Mask -- | |
117 | ------------------------ | |
118 | ||
119 | procedure Get_Interrupt_Mask (Mask : access Interrupt_Mask) is | |
120 | Result : Interfaces.C.int; | |
e6e7bf38 | 121 | begin |
4fea14f7 | 122 | Result := pthread_sigmask (SIG_SETMASK, null, Mask); |
e6e7bf38 | 123 | pragma Assert (Result = 0); |
124 | end Get_Interrupt_Mask; | |
125 | ||
126 | -------------------- | |
127 | -- Interrupt_Wait -- | |
128 | -------------------- | |
129 | ||
130 | function Interrupt_Wait | |
ed683f94 | 131 | (Mask : access Interrupt_Mask) return Interrupt_ID |
e6e7bf38 | 132 | is |
133 | Result : Interfaces.C.int; | |
134 | Sig : aliased Signal; | |
ed683f94 | 135 | |
e6e7bf38 | 136 | begin |
137 | Result := sigwait (Mask, Sig'Access); | |
138 | ||
139 | if Result /= 0 then | |
140 | return 0; | |
141 | end if; | |
142 | ||
143 | return Interrupt_ID (Sig); | |
144 | end Interrupt_Wait; | |
145 | ||
146 | ---------------------------- | |
147 | -- Install_Default_Action -- | |
148 | ---------------------------- | |
149 | ||
150 | procedure Install_Default_Action (Interrupt : Interrupt_ID) is | |
151 | Result : Interfaces.C.int; | |
e6e7bf38 | 152 | begin |
153 | Result := sigaction | |
154 | (Signal (Interrupt), | |
155 | Initial_Action (Signal (Interrupt))'Access, null); | |
156 | pragma Assert (Result = 0); | |
157 | end Install_Default_Action; | |
158 | ||
159 | --------------------------- | |
160 | -- Install_Ignore_Action -- | |
161 | --------------------------- | |
162 | ||
163 | procedure Install_Ignore_Action (Interrupt : Interrupt_ID) is | |
164 | Result : Interfaces.C.int; | |
e6e7bf38 | 165 | begin |
166 | Result := sigaction (Signal (Interrupt), Ignore_Action'Access, null); | |
167 | pragma Assert (Result = 0); | |
168 | end Install_Ignore_Action; | |
169 | ||
170 | ------------------------- | |
171 | -- Fill_Interrupt_Mask -- | |
172 | ------------------------- | |
173 | ||
174 | procedure Fill_Interrupt_Mask (Mask : access Interrupt_Mask) is | |
175 | Result : Interfaces.C.int; | |
e6e7bf38 | 176 | begin |
177 | Result := sigfillset (Mask); | |
178 | pragma Assert (Result = 0); | |
179 | end Fill_Interrupt_Mask; | |
180 | ||
181 | -------------------------- | |
182 | -- Empty_Interrupt_Mask -- | |
183 | -------------------------- | |
184 | ||
185 | procedure Empty_Interrupt_Mask (Mask : access Interrupt_Mask) is | |
186 | Result : Interfaces.C.int; | |
e6e7bf38 | 187 | begin |
188 | Result := sigemptyset (Mask); | |
189 | pragma Assert (Result = 0); | |
190 | end Empty_Interrupt_Mask; | |
191 | ||
192 | --------------------------- | |
193 | -- Add_To_Interrupt_Mask -- | |
194 | --------------------------- | |
195 | ||
196 | procedure Add_To_Interrupt_Mask | |
197 | (Mask : access Interrupt_Mask; | |
198 | Interrupt : Interrupt_ID) | |
199 | is | |
200 | Result : Interfaces.C.int; | |
e6e7bf38 | 201 | begin |
202 | Result := sigaddset (Mask, Signal (Interrupt)); | |
203 | pragma Assert (Result = 0); | |
204 | end Add_To_Interrupt_Mask; | |
205 | ||
206 | -------------------------------- | |
207 | -- Delete_From_Interrupt_Mask -- | |
208 | -------------------------------- | |
209 | ||
210 | procedure Delete_From_Interrupt_Mask | |
211 | (Mask : access Interrupt_Mask; | |
212 | Interrupt : Interrupt_ID) | |
213 | is | |
214 | Result : Interfaces.C.int; | |
e6e7bf38 | 215 | begin |
216 | Result := sigdelset (Mask, Signal (Interrupt)); | |
217 | pragma Assert (Result = 0); | |
218 | end Delete_From_Interrupt_Mask; | |
219 | ||
220 | --------------- | |
221 | -- Is_Member -- | |
222 | --------------- | |
223 | ||
224 | function Is_Member | |
225 | (Mask : access Interrupt_Mask; | |
226 | Interrupt : Interrupt_ID) return Boolean | |
227 | is | |
228 | Result : Interfaces.C.int; | |
e6e7bf38 | 229 | begin |
230 | Result := sigismember (Mask, Signal (Interrupt)); | |
231 | pragma Assert (Result = 0 or else Result = 1); | |
232 | return Result = 1; | |
233 | end Is_Member; | |
234 | ||
235 | ------------------------- | |
236 | -- Copy_Interrupt_Mask -- | |
237 | ------------------------- | |
238 | ||
239 | procedure Copy_Interrupt_Mask | |
240 | (X : out Interrupt_Mask; | |
96d7aa32 | 241 | Y : Interrupt_Mask) is |
e6e7bf38 | 242 | begin |
243 | X := Y; | |
244 | end Copy_Interrupt_Mask; | |
245 | ||
246 | ---------------------------- | |
247 | -- Interrupt_Self_Process -- | |
248 | ---------------------------- | |
249 | ||
250 | procedure Interrupt_Self_Process (Interrupt : Interrupt_ID) is | |
251 | Result : Interfaces.C.int; | |
e6e7bf38 | 252 | begin |
253 | Result := kill (getpid, Signal (Interrupt)); | |
254 | pragma Assert (Result = 0); | |
255 | end Interrupt_Self_Process; | |
256 | ||
96d7aa32 | 257 | -------------------------- |
258 | -- Setup_Interrupt_Mask -- | |
259 | -------------------------- | |
260 | ||
261 | procedure Setup_Interrupt_Mask is | |
262 | begin | |
263 | -- Mask task for all signals. The original mask of the Environment task | |
264 | -- will be recovered by Interrupt_Manager task during the elaboration | |
265 | -- of s-interr.adb. | |
266 | ||
267 | Set_Interrupt_Mask (All_Tasks_Mask'Access); | |
268 | end Setup_Interrupt_Mask; | |
269 | ||
e6e7bf38 | 270 | begin |
e6e7bf38 | 271 | declare |
272 | mask : aliased sigset_t; | |
273 | allmask : aliased sigset_t; | |
274 | Result : Interfaces.C.int; | |
275 | ||
276 | begin | |
51e69f04 | 277 | Interrupt_Management.Initialize; |
278 | ||
e6e7bf38 | 279 | for Sig in 1 .. Signal'Last loop |
280 | Result := sigaction | |
682b5967 | 281 | (Sig, null, Initial_Action (Sig)'Access); |
e6e7bf38 | 282 | |
283 | -- ??? [assert 1] | |
284 | -- we can't check Result here since sigaction will fail on | |
285 | -- SIGKILL, SIGSTOP, and possibly other signals | |
286 | -- pragma Assert (Result = 0); | |
287 | ||
288 | end loop; | |
289 | ||
560edc4a | 290 | -- Setup the masks to be exported |
e6e7bf38 | 291 | |
292 | Result := sigemptyset (mask'Access); | |
293 | pragma Assert (Result = 0); | |
294 | ||
295 | Result := sigfillset (allmask'Access); | |
296 | pragma Assert (Result = 0); | |
297 | ||
298 | Default_Action.sa_flags := 0; | |
299 | Default_Action.sa_mask := mask; | |
300 | Default_Action.sa_handler := | |
301 | Storage_Elements.To_Address | |
302 | (Storage_Elements.Integer_Address (SIG_DFL)); | |
303 | ||
304 | Ignore_Action.sa_flags := 0; | |
305 | Ignore_Action.sa_mask := mask; | |
306 | Ignore_Action.sa_handler := | |
307 | Storage_Elements.To_Address | |
308 | (Storage_Elements.Integer_Address (SIG_IGN)); | |
309 | ||
cf428c6c | 310 | for J in Interrupt_ID loop |
1d46fb33 | 311 | if Keep_Unmasked (J) then |
cf428c6c | 312 | Result := sigaddset (mask'Access, Signal (J)); |
e6e7bf38 | 313 | pragma Assert (Result = 0); |
cf428c6c | 314 | Result := sigdelset (allmask'Access, Signal (J)); |
e6e7bf38 | 315 | pragma Assert (Result = 0); |
316 | end if; | |
317 | end loop; | |
318 | ||
319 | -- The Keep_Unmasked signals should be unmasked for Environment task | |
320 | ||
682b5967 | 321 | Result := pthread_sigmask (SIG_UNBLOCK, mask'Access, null); |
e6e7bf38 | 322 | pragma Assert (Result = 0); |
323 | ||
324 | -- Get the signal mask of the Environment Task | |
325 | ||
682b5967 | 326 | Result := pthread_sigmask (SIG_SETMASK, null, mask'Access); |
e6e7bf38 | 327 | pragma Assert (Result = 0); |
328 | ||
329 | -- Setup the constants exported | |
330 | ||
331 | Environment_Mask := Interrupt_Mask (mask); | |
332 | ||
333 | All_Tasks_Mask := Interrupt_Mask (allmask); | |
334 | end; | |
335 | ||
336 | end System.Interrupt_Management.Operations; |