1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
5 -- SYSTEM.INTERRUPT_MANAGEMENT.OPERATIONS --
9 -- Copyright (C) 1991-1994, Florida State University --
10 -- Copyright (C) 1995-2008, AdaCore --
12 -- GNARL is free software; you can redistribute it and/or modify it under --
13 -- terms of the GNU General Public License as published by the Free Soft- --
14 -- ware Foundation; either version 2, or (at your option) any later ver- --
15 -- sion. GNARL is distributed in the hope that it will be useful, but WITH- --
16 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
17 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
18 -- for more details. You should have received a copy of the GNU General --
19 -- Public License distributed with GNARL; see file COPYING. If not, write --
20 -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
21 -- Boston, MA 02110-1301, USA. --
23 -- As a special exception, if other files instantiate generics from this --
24 -- unit, or you link this unit with other files to produce an executable, --
25 -- this unit does not by itself cause the resulting executable to be --
26 -- covered by the GNU General Public License. This exception does not --
27 -- however invalidate any other reasons why the executable file might be --
28 -- covered by the GNU Public License. --
30 -- GNARL was developed by the GNARL team at Florida State University. --
31 -- Extensive contributions were provided by Ada Core Technologies, Inc. --
33 ------------------------------------------------------------------------------
35 -- This is a POSIX-like version of this package
37 -- Note: this file can only be used for POSIX compliant systems
41 with System.OS_Interface;
42 with System.Storage_Elements;
44 package body System.Interrupt_Management.Operations is
47 use System.OS_Interface;
53 Initial_Action : array (Signal) of aliased struct_sigaction;
55 Default_Action : aliased struct_sigaction;
56 pragma Warnings (Off, Default_Action);
58 Ignore_Action : aliased struct_sigaction;
60 ----------------------------
61 -- Thread_Block_Interrupt --
62 ----------------------------
64 procedure Thread_Block_Interrupt
65 (Interrupt : Interrupt_ID)
67 Result : Interfaces.C.int;
68 Mask : aliased sigset_t;
70 Result := sigemptyset (Mask'Access);
71 pragma Assert (Result = 0);
72 Result := sigaddset (Mask'Access, Signal (Interrupt));
73 pragma Assert (Result = 0);
74 Result := pthread_sigmask (SIG_BLOCK, Mask'Access, null);
75 pragma Assert (Result = 0);
76 end Thread_Block_Interrupt;
78 ------------------------------
79 -- Thread_Unblock_Interrupt --
80 ------------------------------
82 procedure Thread_Unblock_Interrupt
83 (Interrupt : Interrupt_ID)
85 Mask : aliased sigset_t;
86 Result : Interfaces.C.int;
88 Result := sigemptyset (Mask'Access);
89 pragma Assert (Result = 0);
90 Result := sigaddset (Mask'Access, Signal (Interrupt));
91 pragma Assert (Result = 0);
92 Result := pthread_sigmask (SIG_UNBLOCK, Mask'Access, null);
93 pragma Assert (Result = 0);
94 end Thread_Unblock_Interrupt;
96 ------------------------
97 -- Set_Interrupt_Mask --
98 ------------------------
100 procedure Set_Interrupt_Mask (Mask : access Interrupt_Mask) is
101 Result : Interfaces.C.int;
103 Result := pthread_sigmask (SIG_SETMASK, Mask, null);
104 pragma Assert (Result = 0);
105 end Set_Interrupt_Mask;
107 procedure Set_Interrupt_Mask
108 (Mask : access Interrupt_Mask;
109 OMask : access Interrupt_Mask)
111 Result : Interfaces.C.int;
113 Result := pthread_sigmask (SIG_SETMASK, Mask, OMask);
114 pragma Assert (Result = 0);
115 end Set_Interrupt_Mask;
117 ------------------------
118 -- Get_Interrupt_Mask --
119 ------------------------
121 procedure Get_Interrupt_Mask (Mask : access Interrupt_Mask) is
122 Result : Interfaces.C.int;
124 Result := pthread_sigmask (SIG_SETMASK, null, Mask);
125 pragma Assert (Result = 0);
126 end Get_Interrupt_Mask;
132 function Interrupt_Wait
133 (Mask : access Interrupt_Mask) return Interrupt_ID
135 Result : Interfaces.C.int;
136 Sig : aliased Signal;
139 Result := sigwait (Mask, Sig'Access);
145 return Interrupt_ID (Sig);
148 ----------------------------
149 -- Install_Default_Action --
150 ----------------------------
152 procedure Install_Default_Action (Interrupt : Interrupt_ID) is
153 Result : Interfaces.C.int;
157 Initial_Action (Signal (Interrupt))'Access, null);
158 pragma Assert (Result = 0);
159 end Install_Default_Action;
161 ---------------------------
162 -- Install_Ignore_Action --
163 ---------------------------
165 procedure Install_Ignore_Action (Interrupt : Interrupt_ID) is
166 Result : Interfaces.C.int;
168 Result := sigaction (Signal (Interrupt), Ignore_Action'Access, null);
169 pragma Assert (Result = 0);
170 end Install_Ignore_Action;
172 -------------------------
173 -- Fill_Interrupt_Mask --
174 -------------------------
176 procedure Fill_Interrupt_Mask (Mask : access Interrupt_Mask) is
177 Result : Interfaces.C.int;
179 Result := sigfillset (Mask);
180 pragma Assert (Result = 0);
181 end Fill_Interrupt_Mask;
183 --------------------------
184 -- Empty_Interrupt_Mask --
185 --------------------------
187 procedure Empty_Interrupt_Mask (Mask : access Interrupt_Mask) is
188 Result : Interfaces.C.int;
190 Result := sigemptyset (Mask);
191 pragma Assert (Result = 0);
192 end Empty_Interrupt_Mask;
194 ---------------------------
195 -- Add_To_Interrupt_Mask --
196 ---------------------------
198 procedure Add_To_Interrupt_Mask
199 (Mask : access Interrupt_Mask;
200 Interrupt : Interrupt_ID)
202 Result : Interfaces.C.int;
204 Result := sigaddset (Mask, Signal (Interrupt));
205 pragma Assert (Result = 0);
206 end Add_To_Interrupt_Mask;
208 --------------------------------
209 -- Delete_From_Interrupt_Mask --
210 --------------------------------
212 procedure Delete_From_Interrupt_Mask
213 (Mask : access Interrupt_Mask;
214 Interrupt : Interrupt_ID)
216 Result : Interfaces.C.int;
218 Result := sigdelset (Mask, Signal (Interrupt));
219 pragma Assert (Result = 0);
220 end Delete_From_Interrupt_Mask;
227 (Mask : access Interrupt_Mask;
228 Interrupt : Interrupt_ID) return Boolean
230 Result : Interfaces.C.int;
232 Result := sigismember (Mask, Signal (Interrupt));
233 pragma Assert (Result = 0 or else Result = 1);
237 -------------------------
238 -- Copy_Interrupt_Mask --
239 -------------------------
241 procedure Copy_Interrupt_Mask
242 (X : out Interrupt_Mask;
243 Y : Interrupt_Mask) is
246 end Copy_Interrupt_Mask;
248 ----------------------------
249 -- Interrupt_Self_Process --
250 ----------------------------
252 procedure Interrupt_Self_Process (Interrupt : Interrupt_ID) is
253 Result : Interfaces.C.int;
255 Result := kill (getpid, Signal (Interrupt));
256 pragma Assert (Result = 0);
257 end Interrupt_Self_Process;
259 --------------------------
260 -- Setup_Interrupt_Mask --
261 --------------------------
263 procedure Setup_Interrupt_Mask is
265 -- Mask task for all signals. The original mask of the Environment task
266 -- will be recovered by Interrupt_Manager task during the elaboration
269 Set_Interrupt_Mask (All_Tasks_Mask'Access);
270 end Setup_Interrupt_Mask;
274 mask : aliased sigset_t;
275 allmask : aliased sigset_t;
276 Result : Interfaces.C.int;
279 Interrupt_Management.Initialize;
281 for Sig in 1 .. Signal'Last loop
283 (Sig, null, Initial_Action (Sig)'Access);
286 -- we can't check Result here since sigaction will fail on
287 -- SIGKILL, SIGSTOP, and possibly other signals
288 -- pragma Assert (Result = 0);
292 -- Setup the masks to be exported
294 Result := sigemptyset (mask'Access);
295 pragma Assert (Result = 0);
297 Result := sigfillset (allmask'Access);
298 pragma Assert (Result = 0);
300 Default_Action.sa_flags := 0;
301 Default_Action.sa_mask := mask;
302 Default_Action.sa_handler :=
303 Storage_Elements.To_Address
304 (Storage_Elements.Integer_Address (SIG_DFL));
306 Ignore_Action.sa_flags := 0;
307 Ignore_Action.sa_mask := mask;
308 Ignore_Action.sa_handler :=
309 Storage_Elements.To_Address
310 (Storage_Elements.Integer_Address (SIG_IGN));
312 for J in Interrupt_ID loop
313 if Keep_Unmasked (J) then
314 Result := sigaddset (mask'Access, Signal (J));
315 pragma Assert (Result = 0);
316 Result := sigdelset (allmask'Access, Signal (J));
317 pragma Assert (Result = 0);
321 -- The Keep_Unmasked signals should be unmasked for Environment task
323 Result := pthread_sigmask (SIG_UNBLOCK, mask'Access, null);
324 pragma Assert (Result = 0);
326 -- Get the signal mask of the Environment Task
328 Result := pthread_sigmask (SIG_SETMASK, null, mask'Access);
329 pragma Assert (Result = 0);
331 -- Setup the constants exported
333 Environment_Mask := Interrupt_Mask (mask);
335 All_Tasks_Mask := Interrupt_Mask (allmask);
338 end System.Interrupt_Management.Operations;