|
111
|
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 S --
|
|
|
6 -- --
|
|
|
7 -- B o d y --
|
|
|
8 -- --
|
|
131
|
9 -- Copyright (C) 1992-2018, Free Software Foundation, Inc. --
|
|
111
|
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 -- Invariants:
|
|
|
33
|
|
|
34 -- All user-handleable interrupts are masked at all times in all tasks/threads
|
|
|
35 -- except possibly for the Interrupt_Manager task.
|
|
|
36
|
|
|
37 -- When a user task wants to achieve masking/unmasking an interrupt, it must
|
|
|
38 -- call Block_Interrupt/Unblock_Interrupt, which will have the effect of
|
|
|
39 -- unmasking/masking the interrupt in the Interrupt_Manager task.
|
|
|
40
|
|
|
41 -- Note : Direct calls to sigaction, sigprocmask, pthread_sigsetmask or any
|
|
|
42 -- other low-level interface that changes the interrupt action or
|
|
|
43 -- interrupt mask needs a careful thought.
|
|
|
44
|
|
|
45 -- One may achieve the effect of system calls first masking RTS blocked
|
|
|
46 -- (by calling Block_Interrupt) for the interrupt under consideration.
|
|
|
47 -- This will make all the tasks in RTS blocked for the Interrupt.
|
|
|
48
|
|
|
49 -- Once we associate a Server_Task with an interrupt, the task never goes
|
|
|
50 -- away, and we never remove the association.
|
|
|
51
|
|
|
52 -- There is no more than one interrupt per Server_Task and no more than one
|
|
|
53 -- Server_Task per interrupt.
|
|
|
54
|
|
|
55 with Ada.Exceptions;
|
|
|
56 with Ada.Task_Identification;
|
|
|
57
|
|
|
58 with System.Task_Primitives;
|
|
|
59 with System.Interrupt_Management;
|
|
|
60
|
|
|
61 with System.Interrupt_Management.Operations;
|
|
|
62 pragma Elaborate_All (System.Interrupt_Management.Operations);
|
|
|
63
|
|
|
64 with System.IO;
|
|
|
65
|
|
|
66 with System.Task_Primitives.Operations;
|
|
|
67 with System.Task_Primitives.Interrupt_Operations;
|
|
|
68 with System.Storage_Elements;
|
|
|
69 with System.Tasking.Utilities;
|
|
|
70
|
|
|
71 with System.Tasking.Rendezvous;
|
|
|
72 pragma Elaborate_All (System.Tasking.Rendezvous);
|
|
|
73
|
|
|
74 with System.Tasking.Initialization;
|
|
|
75 with System.Parameters;
|
|
|
76
|
|
|
77 with Ada.Unchecked_Conversion;
|
|
|
78
|
|
|
79 package body System.Interrupts is
|
|
|
80
|
|
|
81 use Parameters;
|
|
|
82 use Tasking;
|
|
|
83
|
|
|
84 package POP renames System.Task_Primitives.Operations;
|
|
|
85 package PIO renames System.Task_Primitives.Interrupt_Operations;
|
|
|
86 package IMNG renames System.Interrupt_Management;
|
|
|
87 package IMOP renames System.Interrupt_Management.Operations;
|
|
|
88
|
|
|
89 function To_System is new Ada.Unchecked_Conversion
|
|
|
90 (Ada.Task_Identification.Task_Id, Task_Id);
|
|
|
91
|
|
|
92 -----------------
|
|
|
93 -- Local Tasks --
|
|
|
94 -----------------
|
|
|
95
|
|
|
96 -- WARNING: System.Tasking.Stages performs calls to this task with
|
|
|
97 -- low-level constructs. Do not change this spec without synchronizing it.
|
|
|
98
|
|
|
99 task Interrupt_Manager is
|
|
|
100 entry Detach_Interrupt_Entries (T : Task_Id);
|
|
|
101
|
|
|
102 entry Initialize (Mask : IMNG.Interrupt_Mask);
|
|
|
103
|
|
|
104 entry Attach_Handler
|
|
|
105 (New_Handler : Parameterless_Handler;
|
|
|
106 Interrupt : Interrupt_ID;
|
|
|
107 Static : Boolean;
|
|
|
108 Restoration : Boolean := False);
|
|
|
109
|
|
|
110 entry Exchange_Handler
|
|
|
111 (Old_Handler : out Parameterless_Handler;
|
|
|
112 New_Handler : Parameterless_Handler;
|
|
|
113 Interrupt : Interrupt_ID;
|
|
|
114 Static : Boolean);
|
|
|
115
|
|
|
116 entry Detach_Handler
|
|
|
117 (Interrupt : Interrupt_ID;
|
|
|
118 Static : Boolean);
|
|
|
119
|
|
|
120 entry Bind_Interrupt_To_Entry
|
|
|
121 (T : Task_Id;
|
|
|
122 E : Task_Entry_Index;
|
|
|
123 Interrupt : Interrupt_ID);
|
|
|
124
|
|
|
125 entry Block_Interrupt (Interrupt : Interrupt_ID);
|
|
|
126
|
|
|
127 entry Unblock_Interrupt (Interrupt : Interrupt_ID);
|
|
|
128
|
|
|
129 entry Ignore_Interrupt (Interrupt : Interrupt_ID);
|
|
|
130
|
|
|
131 entry Unignore_Interrupt (Interrupt : Interrupt_ID);
|
|
|
132
|
|
|
133 pragma Interrupt_Priority (System.Interrupt_Priority'Last);
|
|
|
134 end Interrupt_Manager;
|
|
|
135
|
|
|
136 task type Server_Task (Interrupt : Interrupt_ID) is
|
|
|
137 pragma Priority (System.Interrupt_Priority'Last);
|
|
|
138 -- Note: the above pragma Priority is strictly speaking improper since
|
|
|
139 -- it is outside the range of allowed priorities, but the compiler
|
|
|
140 -- treats system units specially and does not apply this range checking
|
|
|
141 -- rule to system units.
|
|
|
142
|
|
|
143 end Server_Task;
|
|
|
144
|
|
|
145 type Server_Task_Access is access Server_Task;
|
|
|
146
|
|
|
147 -------------------------------
|
|
|
148 -- Local Types and Variables --
|
|
|
149 -------------------------------
|
|
|
150
|
|
|
151 type Entry_Assoc is record
|
|
|
152 T : Task_Id;
|
|
|
153 E : Task_Entry_Index;
|
|
|
154 end record;
|
|
|
155
|
|
|
156 type Handler_Assoc is record
|
|
|
157 H : Parameterless_Handler;
|
|
|
158 Static : Boolean; -- Indicates static binding;
|
|
|
159 end record;
|
|
|
160
|
|
|
161 User_Handler : array (Interrupt_ID'Range) of Handler_Assoc :=
|
|
|
162 (others => (null, Static => False));
|
|
|
163 pragma Volatile_Components (User_Handler);
|
|
|
164 -- Holds the protected procedure handler (if any) and its Static
|
|
|
165 -- information for each interrupt. A handler is a Static one if it is
|
|
|
166 -- specified through the pragma Attach_Handler. Attach_Handler. Otherwise,
|
|
|
167 -- not static)
|
|
|
168
|
|
|
169 User_Entry : array (Interrupt_ID'Range) of Entry_Assoc :=
|
|
|
170 (others => (T => Null_Task, E => Null_Task_Entry));
|
|
|
171 pragma Volatile_Components (User_Entry);
|
|
|
172 -- Holds the task and entry index (if any) for each interrupt
|
|
|
173
|
|
|
174 Blocked : array (Interrupt_ID'Range) of Boolean := (others => False);
|
|
|
175 pragma Atomic_Components (Blocked);
|
|
|
176 -- True iff the corresponding interrupt is blocked in the process level
|
|
|
177
|
|
|
178 Ignored : array (Interrupt_ID'Range) of Boolean := (others => False);
|
|
|
179 pragma Atomic_Components (Ignored);
|
|
|
180 -- True iff the corresponding interrupt is blocked in the process level
|
|
|
181
|
|
|
182 Last_Unblocker :
|
|
|
183 array (Interrupt_ID'Range) of Task_Id := (others => Null_Task);
|
|
|
184 pragma Atomic_Components (Last_Unblocker);
|
|
|
185 -- Holds the ID of the last Task which Unblocked this Interrupt. It
|
|
|
186 -- contains Null_Task if no tasks have ever requested the Unblocking
|
|
|
187 -- operation or the Interrupt is currently Blocked.
|
|
|
188
|
|
|
189 Server_ID : array (Interrupt_ID'Range) of Task_Id :=
|
|
|
190 (others => Null_Task);
|
|
|
191 pragma Atomic_Components (Server_ID);
|
|
|
192 -- Holds the Task_Id of the Server_Task for each interrupt. Task_Id is
|
|
|
193 -- needed to accomplish locking per Interrupt base. Also is needed to
|
|
|
194 -- decide whether to create a new Server_Task.
|
|
|
195
|
|
|
196 -- Type and Head, Tail of the list containing Registered Interrupt
|
|
|
197 -- Handlers. These definitions are used to register the handlers
|
|
|
198 -- specified by the pragma Interrupt_Handler.
|
|
|
199
|
|
|
200 type Registered_Handler;
|
|
|
201 type R_Link is access all Registered_Handler;
|
|
|
202
|
|
|
203 type Registered_Handler is record
|
|
|
204 H : System.Address := System.Null_Address;
|
|
|
205 Next : R_Link := null;
|
|
|
206 end record;
|
|
|
207
|
|
|
208 Registered_Handler_Head : R_Link := null;
|
|
|
209 Registered_Handler_Tail : R_Link := null;
|
|
|
210
|
|
|
211 Access_Hold : Server_Task_Access;
|
|
|
212 -- Variable used to allocate Server_Task using "new"
|
|
|
213
|
|
|
214 -----------------------
|
|
|
215 -- Local Subprograms --
|
|
|
216 -----------------------
|
|
|
217
|
|
|
218 function Is_Registered (Handler : Parameterless_Handler) return Boolean;
|
|
|
219 -- See if the Handler has been "pragma"ed using Interrupt_Handler. Always
|
|
|
220 -- consider a null handler as registered.
|
|
|
221
|
|
|
222 --------------------
|
|
|
223 -- Attach_Handler --
|
|
|
224 --------------------
|
|
|
225
|
|
|
226 -- Calling this procedure with New_Handler = null and Static = True means
|
|
|
227 -- we want to detach the current handler regardless of the previous
|
|
|
228 -- handler's binding status (i.e. do not care if it is a dynamic or static
|
|
|
229 -- handler).
|
|
|
230
|
|
|
231 -- This option is needed so that during the finalization of a PO, we can
|
|
|
232 -- detach handlers attached through pragma Attach_Handler.
|
|
|
233
|
|
|
234 procedure Attach_Handler
|
|
|
235 (New_Handler : Parameterless_Handler;
|
|
|
236 Interrupt : Interrupt_ID;
|
|
|
237 Static : Boolean := False)
|
|
|
238 is
|
|
|
239 begin
|
|
|
240 if Is_Reserved (Interrupt) then
|
|
|
241 raise Program_Error with
|
|
|
242 "interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
|
|
|
243 end if;
|
|
|
244
|
|
|
245 Interrupt_Manager.Attach_Handler (New_Handler, Interrupt, Static);
|
|
|
246
|
|
|
247 end Attach_Handler;
|
|
|
248
|
|
|
249 -----------------------------
|
|
|
250 -- Bind_Interrupt_To_Entry --
|
|
|
251 -----------------------------
|
|
|
252
|
|
|
253 -- This procedure raises a Program_Error if it tries to bind an interrupt
|
|
|
254 -- to which an Entry or a Procedure is already bound.
|
|
|
255
|
|
|
256 procedure Bind_Interrupt_To_Entry
|
|
|
257 (T : Task_Id;
|
|
|
258 E : Task_Entry_Index;
|
|
|
259 Int_Ref : System.Address)
|
|
|
260 is
|
|
|
261 Interrupt : constant Interrupt_ID :=
|
|
|
262 Interrupt_ID (Storage_Elements.To_Integer (Int_Ref));
|
|
|
263
|
|
|
264 begin
|
|
|
265 if Is_Reserved (Interrupt) then
|
|
|
266 raise Program_Error with
|
|
|
267 "interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
|
|
|
268 end if;
|
|
|
269
|
|
|
270 Interrupt_Manager.Bind_Interrupt_To_Entry (T, E, Interrupt);
|
|
|
271 end Bind_Interrupt_To_Entry;
|
|
|
272
|
|
|
273 ---------------------
|
|
|
274 -- Block_Interrupt --
|
|
|
275 ---------------------
|
|
|
276
|
|
|
277 procedure Block_Interrupt (Interrupt : Interrupt_ID) is
|
|
|
278 begin
|
|
|
279 if Is_Reserved (Interrupt) then
|
|
|
280 raise Program_Error with
|
|
|
281 "interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
|
|
|
282 end if;
|
|
|
283
|
|
|
284 Interrupt_Manager.Block_Interrupt (Interrupt);
|
|
|
285 end Block_Interrupt;
|
|
|
286
|
|
|
287 ---------------------
|
|
|
288 -- Current_Handler --
|
|
|
289 ---------------------
|
|
|
290
|
|
|
291 function Current_Handler
|
|
|
292 (Interrupt : Interrupt_ID) return Parameterless_Handler
|
|
|
293 is
|
|
|
294 begin
|
|
|
295 if Is_Reserved (Interrupt) then
|
|
|
296 raise Program_Error with
|
|
|
297 "interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
|
|
|
298 end if;
|
|
|
299
|
|
|
300 -- ??? Since Parameterless_Handler is not Atomic, the current
|
|
|
301 -- implementation is wrong. We need a new service in Interrupt_Manager
|
|
|
302 -- to ensure atomicity.
|
|
|
303
|
|
|
304 return User_Handler (Interrupt).H;
|
|
|
305 end Current_Handler;
|
|
|
306
|
|
|
307 --------------------
|
|
|
308 -- Detach_Handler --
|
|
|
309 --------------------
|
|
|
310
|
|
|
311 -- Calling this procedure with Static = True means we want to Detach the
|
|
|
312 -- current handler regardless of the previous handler's binding status
|
|
|
313 -- (i.e. do not care if it is a dynamic or static handler).
|
|
|
314
|
|
|
315 -- This option is needed so that during the finalization of a PO, we can
|
|
|
316 -- detach handlers attached through pragma Attach_Handler.
|
|
|
317
|
|
|
318 procedure Detach_Handler
|
|
|
319 (Interrupt : Interrupt_ID;
|
|
|
320 Static : Boolean := False)
|
|
|
321 is
|
|
|
322 begin
|
|
|
323 if Is_Reserved (Interrupt) then
|
|
|
324 raise Program_Error with
|
|
|
325 "interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
|
|
|
326 end if;
|
|
|
327
|
|
|
328 Interrupt_Manager.Detach_Handler (Interrupt, Static);
|
|
|
329 end Detach_Handler;
|
|
|
330
|
|
|
331 ------------------------------
|
|
|
332 -- Detach_Interrupt_Entries --
|
|
|
333 ------------------------------
|
|
|
334
|
|
|
335 procedure Detach_Interrupt_Entries (T : Task_Id) is
|
|
|
336 begin
|
|
|
337 Interrupt_Manager.Detach_Interrupt_Entries (T);
|
|
|
338 end Detach_Interrupt_Entries;
|
|
|
339
|
|
|
340 ----------------------
|
|
|
341 -- Exchange_Handler --
|
|
|
342 ----------------------
|
|
|
343
|
|
|
344 -- Calling this procedure with New_Handler = null and Static = True means
|
|
|
345 -- we want to detach the current handler regardless of the previous
|
|
|
346 -- handler's binding status (i.e. do not care if it is a dynamic or static
|
|
|
347 -- handler).
|
|
|
348
|
|
|
349 -- This option is needed so that during the finalization of a PO, we can
|
|
|
350 -- detach handlers attached through pragma Attach_Handler.
|
|
|
351
|
|
|
352 procedure Exchange_Handler
|
|
|
353 (Old_Handler : out Parameterless_Handler;
|
|
|
354 New_Handler : Parameterless_Handler;
|
|
|
355 Interrupt : Interrupt_ID;
|
|
|
356 Static : Boolean := False)
|
|
|
357 is
|
|
|
358 begin
|
|
|
359 if Is_Reserved (Interrupt) then
|
|
|
360 raise Program_Error with
|
|
|
361 "interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
|
|
|
362 end if;
|
|
|
363
|
|
|
364 Interrupt_Manager.Exchange_Handler
|
|
|
365 (Old_Handler, New_Handler, Interrupt, Static);
|
|
|
366 end Exchange_Handler;
|
|
|
367
|
|
|
368 --------------
|
|
|
369 -- Finalize --
|
|
|
370 --------------
|
|
|
371
|
|
|
372 procedure Finalize (Object : in out Static_Interrupt_Protection) is
|
|
|
373 function State
|
|
|
374 (Int : System.Interrupt_Management.Interrupt_ID) return Character;
|
|
|
375 pragma Import (C, State, "__gnat_get_interrupt_state");
|
|
|
376 -- Get interrupt state for interrupt number Int. Defined in init.c
|
|
|
377
|
|
|
378 Default : constant Character := 's';
|
|
|
379 -- 's' Interrupt_State pragma set state to System (use "default"
|
|
|
380 -- system handler)
|
|
|
381
|
|
|
382 begin
|
|
|
383 -- ??? loop to be executed only when we're not doing library level
|
|
|
384 -- finalization, since in this case all interrupt tasks are gone.
|
|
|
385
|
|
|
386 -- If the Abort_Task signal is set to system, it means that we cannot
|
|
|
387 -- reset interrupt handlers since this would require sending the abort
|
|
|
388 -- signal to the Server_Task
|
|
|
389
|
|
|
390 if not Interrupt_Manager'Terminated
|
|
|
391 and then
|
|
|
392 State (System.Interrupt_Management.Abort_Task_Interrupt) /= Default
|
|
|
393 then
|
|
|
394 for N in reverse Object.Previous_Handlers'Range loop
|
|
|
395 Interrupt_Manager.Attach_Handler
|
|
|
396 (New_Handler => Object.Previous_Handlers (N).Handler,
|
|
|
397 Interrupt => Object.Previous_Handlers (N).Interrupt,
|
|
|
398 Static => Object.Previous_Handlers (N).Static,
|
|
|
399 Restoration => True);
|
|
|
400 end loop;
|
|
|
401 end if;
|
|
|
402
|
|
|
403 Tasking.Protected_Objects.Entries.Finalize
|
|
|
404 (Tasking.Protected_Objects.Entries.Protection_Entries (Object));
|
|
|
405 end Finalize;
|
|
|
406
|
|
|
407 -------------------------------------
|
|
|
408 -- Has_Interrupt_Or_Attach_Handler --
|
|
|
409 -------------------------------------
|
|
|
410
|
|
|
411 -- Need comments as to why these always return True ???
|
|
|
412
|
|
|
413 function Has_Interrupt_Or_Attach_Handler
|
|
|
414 (Object : access Dynamic_Interrupt_Protection) return Boolean
|
|
|
415 is
|
|
|
416 pragma Unreferenced (Object);
|
|
|
417 begin
|
|
|
418 return True;
|
|
|
419 end Has_Interrupt_Or_Attach_Handler;
|
|
|
420
|
|
|
421 function Has_Interrupt_Or_Attach_Handler
|
|
|
422 (Object : access Static_Interrupt_Protection) return Boolean
|
|
|
423 is
|
|
|
424 pragma Unreferenced (Object);
|
|
|
425 begin
|
|
|
426 return True;
|
|
|
427 end Has_Interrupt_Or_Attach_Handler;
|
|
|
428
|
|
|
429 ----------------------
|
|
|
430 -- Ignore_Interrupt --
|
|
|
431 ----------------------
|
|
|
432
|
|
|
433 procedure Ignore_Interrupt (Interrupt : Interrupt_ID) is
|
|
|
434 begin
|
|
|
435 if Is_Reserved (Interrupt) then
|
|
|
436 raise Program_Error with
|
|
|
437 "interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
|
|
|
438 end if;
|
|
|
439
|
|
|
440 Interrupt_Manager.Ignore_Interrupt (Interrupt);
|
|
|
441 end Ignore_Interrupt;
|
|
|
442
|
|
|
443 ----------------------
|
|
|
444 -- Install_Handlers --
|
|
|
445 ----------------------
|
|
|
446
|
|
|
447 procedure Install_Handlers
|
|
|
448 (Object : access Static_Interrupt_Protection;
|
|
|
449 New_Handlers : New_Handler_Array)
|
|
|
450 is
|
|
|
451 begin
|
|
|
452 for N in New_Handlers'Range loop
|
|
|
453
|
|
|
454 -- We need a lock around this ???
|
|
|
455
|
|
|
456 Object.Previous_Handlers (N).Interrupt := New_Handlers (N).Interrupt;
|
|
|
457 Object.Previous_Handlers (N).Static := User_Handler
|
|
|
458 (New_Handlers (N).Interrupt).Static;
|
|
|
459
|
|
|
460 -- We call Exchange_Handler and not directly Interrupt_Manager.
|
|
|
461 -- Exchange_Handler so we get the Is_Reserved check.
|
|
|
462
|
|
|
463 Exchange_Handler
|
|
|
464 (Old_Handler => Object.Previous_Handlers (N).Handler,
|
|
|
465 New_Handler => New_Handlers (N).Handler,
|
|
|
466 Interrupt => New_Handlers (N).Interrupt,
|
|
|
467 Static => True);
|
|
|
468 end loop;
|
|
|
469 end Install_Handlers;
|
|
|
470
|
|
|
471 ---------------------------------
|
|
|
472 -- Install_Restricted_Handlers --
|
|
|
473 ---------------------------------
|
|
|
474
|
|
|
475 procedure Install_Restricted_Handlers
|
|
|
476 (Prio : Any_Priority;
|
|
|
477 Handlers : New_Handler_Array)
|
|
|
478 is
|
|
|
479 pragma Unreferenced (Prio);
|
|
|
480 begin
|
|
|
481 for N in Handlers'Range loop
|
|
|
482 Attach_Handler (Handlers (N).Handler, Handlers (N).Interrupt, True);
|
|
|
483 end loop;
|
|
|
484 end Install_Restricted_Handlers;
|
|
|
485
|
|
|
486 ----------------
|
|
|
487 -- Is_Blocked --
|
|
|
488 ----------------
|
|
|
489
|
|
|
490 function Is_Blocked (Interrupt : Interrupt_ID) return Boolean is
|
|
|
491 begin
|
|
|
492 if Is_Reserved (Interrupt) then
|
|
|
493 raise Program_Error with
|
|
|
494 "interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
|
|
|
495 end if;
|
|
|
496
|
|
|
497 return Blocked (Interrupt);
|
|
|
498 end Is_Blocked;
|
|
|
499
|
|
|
500 -----------------------
|
|
|
501 -- Is_Entry_Attached --
|
|
|
502 -----------------------
|
|
|
503
|
|
|
504 function Is_Entry_Attached (Interrupt : Interrupt_ID) return Boolean is
|
|
|
505 begin
|
|
|
506 if Is_Reserved (Interrupt) then
|
|
|
507 raise Program_Error with
|
|
|
508 "interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
|
|
|
509 end if;
|
|
|
510
|
|
|
511 return User_Entry (Interrupt).T /= Null_Task;
|
|
|
512 end Is_Entry_Attached;
|
|
|
513
|
|
|
514 -------------------------
|
|
|
515 -- Is_Handler_Attached --
|
|
|
516 -------------------------
|
|
|
517
|
|
|
518 function Is_Handler_Attached (Interrupt : Interrupt_ID) return Boolean is
|
|
|
519 begin
|
|
|
520 if Is_Reserved (Interrupt) then
|
|
|
521 raise Program_Error with
|
|
|
522 "interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
|
|
|
523 end if;
|
|
|
524
|
|
|
525 return User_Handler (Interrupt).H /= null;
|
|
|
526 end Is_Handler_Attached;
|
|
|
527
|
|
|
528 ----------------
|
|
|
529 -- Is_Ignored --
|
|
|
530 ----------------
|
|
|
531
|
|
|
532 function Is_Ignored (Interrupt : Interrupt_ID) return Boolean is
|
|
|
533 begin
|
|
|
534 if Is_Reserved (Interrupt) then
|
|
|
535 raise Program_Error with
|
|
|
536 "interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
|
|
|
537 end if;
|
|
|
538
|
|
|
539 return Ignored (Interrupt);
|
|
|
540 end Is_Ignored;
|
|
|
541
|
|
|
542 -------------------
|
|
|
543 -- Is_Registered --
|
|
|
544 -------------------
|
|
|
545
|
|
|
546 function Is_Registered (Handler : Parameterless_Handler) return Boolean is
|
|
|
547
|
|
|
548 type Fat_Ptr is record
|
|
|
549 Object_Addr : System.Address;
|
|
|
550 Handler_Addr : System.Address;
|
|
|
551 end record;
|
|
|
552
|
|
|
553 function To_Fat_Ptr is new Ada.Unchecked_Conversion
|
|
|
554 (Parameterless_Handler, Fat_Ptr);
|
|
|
555
|
|
|
556 Ptr : R_Link;
|
|
|
557 Fat : Fat_Ptr;
|
|
|
558
|
|
|
559 begin
|
|
|
560 if Handler = null then
|
|
|
561 return True;
|
|
|
562 end if;
|
|
|
563
|
|
|
564 Fat := To_Fat_Ptr (Handler);
|
|
|
565
|
|
|
566 Ptr := Registered_Handler_Head;
|
|
|
567 while Ptr /= null loop
|
|
|
568 if Ptr.H = Fat.Handler_Addr then
|
|
|
569 return True;
|
|
|
570 end if;
|
|
|
571
|
|
|
572 Ptr := Ptr.Next;
|
|
|
573 end loop;
|
|
|
574
|
|
|
575 return False;
|
|
|
576 end Is_Registered;
|
|
|
577
|
|
|
578 -----------------
|
|
|
579 -- Is_Reserved --
|
|
|
580 -----------------
|
|
|
581
|
|
|
582 function Is_Reserved (Interrupt : Interrupt_ID) return Boolean is
|
|
|
583 begin
|
|
|
584 return IMNG.Reserve (IMNG.Interrupt_ID (Interrupt));
|
|
|
585 end Is_Reserved;
|
|
|
586
|
|
|
587 ---------------
|
|
|
588 -- Reference --
|
|
|
589 ---------------
|
|
|
590
|
|
|
591 function Reference (Interrupt : Interrupt_ID) return System.Address is
|
|
|
592 begin
|
|
|
593 if Is_Reserved (Interrupt) then
|
|
|
594 raise Program_Error with
|
|
|
595 "interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
|
|
|
596 end if;
|
|
|
597
|
|
|
598 return Storage_Elements.To_Address
|
|
|
599 (Storage_Elements.Integer_Address (Interrupt));
|
|
|
600 end Reference;
|
|
|
601
|
|
|
602 ---------------------------------
|
|
|
603 -- Register_Interrupt_Handler --
|
|
|
604 ---------------------------------
|
|
|
605
|
|
|
606 procedure Register_Interrupt_Handler (Handler_Addr : System.Address) is
|
|
|
607 New_Node_Ptr : R_Link;
|
|
|
608
|
|
|
609 begin
|
|
|
610 -- This routine registers the Handler as usable for Dynamic Interrupt
|
|
|
611 -- Handler. Routines attaching and detaching Handler dynamically should
|
|
|
612 -- first consult if the Handler is registered. A Program Error should
|
|
|
613 -- be raised if it is not registered.
|
|
|
614
|
|
|
615 -- The pragma Interrupt_Handler can only appear in the library level PO
|
|
|
616 -- definition and instantiation. Therefore, we do not need to implement
|
|
|
617 -- Unregistering operation. Neither we need to protect the queue
|
|
|
618 -- structure using a Lock.
|
|
|
619
|
|
|
620 pragma Assert (Handler_Addr /= System.Null_Address);
|
|
|
621
|
|
|
622 New_Node_Ptr := new Registered_Handler;
|
|
|
623 New_Node_Ptr.H := Handler_Addr;
|
|
|
624
|
|
|
625 if Registered_Handler_Head = null then
|
|
|
626 Registered_Handler_Head := New_Node_Ptr;
|
|
|
627 Registered_Handler_Tail := New_Node_Ptr;
|
|
|
628
|
|
|
629 else
|
|
|
630 Registered_Handler_Tail.Next := New_Node_Ptr;
|
|
|
631 Registered_Handler_Tail := New_Node_Ptr;
|
|
|
632 end if;
|
|
|
633 end Register_Interrupt_Handler;
|
|
|
634
|
|
|
635 -----------------------
|
|
|
636 -- Unblock_Interrupt --
|
|
|
637 -----------------------
|
|
|
638
|
|
|
639 procedure Unblock_Interrupt (Interrupt : Interrupt_ID) is
|
|
|
640 begin
|
|
|
641 if Is_Reserved (Interrupt) then
|
|
|
642 raise Program_Error with
|
|
|
643 "interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
|
|
|
644 end if;
|
|
|
645
|
|
|
646 Interrupt_Manager.Unblock_Interrupt (Interrupt);
|
|
|
647 end Unblock_Interrupt;
|
|
|
648
|
|
|
649 ------------------
|
|
|
650 -- Unblocked_By --
|
|
|
651 ------------------
|
|
|
652
|
|
|
653 function Unblocked_By
|
|
|
654 (Interrupt : Interrupt_ID) return System.Tasking.Task_Id
|
|
|
655 is
|
|
|
656 begin
|
|
|
657 if Is_Reserved (Interrupt) then
|
|
|
658 raise Program_Error with
|
|
|
659 "interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
|
|
|
660 end if;
|
|
|
661
|
|
|
662 return Last_Unblocker (Interrupt);
|
|
|
663 end Unblocked_By;
|
|
|
664
|
|
|
665 ------------------------
|
|
|
666 -- Unignore_Interrupt --
|
|
|
667 ------------------------
|
|
|
668
|
|
|
669 procedure Unignore_Interrupt (Interrupt : Interrupt_ID) is
|
|
|
670 begin
|
|
|
671 if Is_Reserved (Interrupt) then
|
|
|
672 raise Program_Error with
|
|
|
673 "interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
|
|
|
674 end if;
|
|
|
675
|
|
|
676 Interrupt_Manager.Unignore_Interrupt (Interrupt);
|
|
|
677 end Unignore_Interrupt;
|
|
|
678
|
|
|
679 -----------------------
|
|
|
680 -- Interrupt_Manager --
|
|
|
681 -----------------------
|
|
|
682
|
|
|
683 task body Interrupt_Manager is
|
|
|
684 -- By making this task independent of master, when the process
|
|
|
685 -- goes away, the Interrupt_Manager will terminate gracefully.
|
|
|
686
|
|
|
687 Ignore : constant Boolean := System.Tasking.Utilities.Make_Independent;
|
|
|
688
|
|
|
689 ---------------------
|
|
|
690 -- Local Variables --
|
|
|
691 ---------------------
|
|
|
692
|
|
|
693 Intwait_Mask : aliased IMNG.Interrupt_Mask;
|
|
|
694 Ret_Interrupt : Interrupt_ID;
|
|
|
695 Old_Mask : aliased IMNG.Interrupt_Mask;
|
|
|
696 Old_Handler : Parameterless_Handler;
|
|
|
697
|
|
|
698 --------------------
|
|
|
699 -- Local Routines --
|
|
|
700 --------------------
|
|
|
701
|
|
|
702 procedure Bind_Handler (Interrupt : Interrupt_ID);
|
|
|
703 -- This procedure does not do anything if the Interrupt is blocked.
|
|
|
704 -- Otherwise, we have to interrupt Server_Task for status change through
|
|
|
705 -- Wakeup interrupt.
|
|
|
706
|
|
|
707 procedure Unbind_Handler (Interrupt : Interrupt_ID);
|
|
|
708 -- This procedure does not do anything if the Interrupt is blocked.
|
|
|
709 -- Otherwise, we have to interrupt Server_Task for status change
|
|
|
710 -- through abort interrupt.
|
|
|
711
|
|
|
712 procedure Unprotected_Exchange_Handler
|
|
|
713 (Old_Handler : out Parameterless_Handler;
|
|
|
714 New_Handler : Parameterless_Handler;
|
|
|
715 Interrupt : Interrupt_ID;
|
|
|
716 Static : Boolean;
|
|
|
717 Restoration : Boolean := False);
|
|
|
718
|
|
|
719 procedure Unprotected_Detach_Handler
|
|
|
720 (Interrupt : Interrupt_ID;
|
|
|
721 Static : Boolean);
|
|
|
722
|
|
|
723 ------------------
|
|
|
724 -- Bind_Handler --
|
|
|
725 ------------------
|
|
|
726
|
|
|
727 procedure Bind_Handler (Interrupt : Interrupt_ID) is
|
|
|
728 begin
|
|
|
729 if not Blocked (Interrupt) then
|
|
|
730
|
|
|
731 -- Mask this task for the given Interrupt so that all tasks
|
|
|
732 -- are masked for the Interrupt and the actual delivery of the
|
|
|
733 -- Interrupt will be caught using "sigwait" by the
|
|
|
734 -- corresponding Server_Task.
|
|
|
735
|
|
|
736 IMOP.Thread_Block_Interrupt (IMNG.Interrupt_ID (Interrupt));
|
|
|
737
|
|
|
738 -- We have installed a Handler or an Entry before we called
|
|
|
739 -- this procedure. If the Handler Task is waiting to be awakened,
|
|
|
740 -- do it here. Otherwise, the interrupt will be discarded.
|
|
|
741
|
|
|
742 POP.Wakeup (Server_ID (Interrupt), Interrupt_Server_Idle_Sleep);
|
|
|
743 end if;
|
|
|
744 end Bind_Handler;
|
|
|
745
|
|
|
746 --------------------
|
|
|
747 -- Unbind_Handler --
|
|
|
748 --------------------
|
|
|
749
|
|
|
750 procedure Unbind_Handler (Interrupt : Interrupt_ID) is
|
|
|
751 Server : System.Tasking.Task_Id;
|
|
|
752
|
|
|
753 begin
|
|
|
754 if not Blocked (Interrupt) then
|
|
|
755
|
|
|
756 -- Currently, there is a Handler or an Entry attached and
|
|
|
757 -- corresponding Server_Task is waiting on "sigwait." We have to
|
|
|
758 -- wake up the Server_Task and make it wait on condition variable
|
|
|
759 -- by sending an Abort_Task_Interrupt
|
|
|
760
|
|
|
761 Server := Server_ID (Interrupt);
|
|
|
762
|
|
|
763 case Server.Common.State is
|
|
|
764 when Interrupt_Server_Blocked_Interrupt_Sleep
|
|
|
765 | Interrupt_Server_Idle_Sleep
|
|
|
766 =>
|
|
|
767 POP.Wakeup (Server, Server.Common.State);
|
|
|
768
|
|
|
769 when Interrupt_Server_Blocked_On_Event_Flag =>
|
|
|
770 POP.Abort_Task (Server);
|
|
|
771
|
|
|
772 -- Make sure corresponding Server_Task is out of its
|
|
|
773 -- own sigwait state.
|
|
|
774
|
|
|
775 Ret_Interrupt :=
|
|
|
776 Interrupt_ID (IMOP.Interrupt_Wait (Intwait_Mask'Access));
|
|
|
777 pragma Assert
|
|
|
778 (Ret_Interrupt = Interrupt_ID (IMNG.Abort_Task_Interrupt));
|
|
|
779
|
|
|
780 when Runnable =>
|
|
|
781 null;
|
|
|
782
|
|
|
783 when others =>
|
|
|
784 pragma Assert (False);
|
|
|
785 null;
|
|
|
786 end case;
|
|
|
787
|
|
|
788 IMOP.Install_Default_Action (IMNG.Interrupt_ID (Interrupt));
|
|
|
789
|
|
|
790 -- Unmake the Interrupt for this task in order to allow default
|
|
|
791 -- action again.
|
|
|
792
|
|
|
793 IMOP.Thread_Unblock_Interrupt (IMNG.Interrupt_ID (Interrupt));
|
|
|
794
|
|
|
795 else
|
|
|
796 IMOP.Install_Default_Action (IMNG.Interrupt_ID (Interrupt));
|
|
|
797 end if;
|
|
|
798 end Unbind_Handler;
|
|
|
799
|
|
|
800 --------------------------------
|
|
|
801 -- Unprotected_Detach_Handler --
|
|
|
802 --------------------------------
|
|
|
803
|
|
|
804 procedure Unprotected_Detach_Handler
|
|
|
805 (Interrupt : Interrupt_ID;
|
|
|
806 Static : Boolean)
|
|
|
807 is
|
|
|
808 Old_Handler : Parameterless_Handler;
|
|
|
809
|
|
|
810 begin
|
|
|
811 if User_Entry (Interrupt).T /= Null_Task then
|
|
|
812
|
|
|
813 -- In case we have an Interrupt Entry installed, raise a program
|
|
|
814 -- error, (propagate it to the caller).
|
|
|
815
|
|
|
816 raise Program_Error with
|
|
|
817 "an interrupt entry is already installed";
|
|
|
818 end if;
|
|
|
819
|
|
|
820 -- Note : Static = True will pass the following check. That is the
|
|
|
821 -- case when we want to detach a handler regardless of the static
|
|
|
822 -- status of the current_Handler.
|
|
|
823
|
|
|
824 if not Static and then User_Handler (Interrupt).Static then
|
|
|
825
|
|
|
826 -- Tries to detach a static Interrupt Handler.
|
|
|
827 -- raise a program error.
|
|
|
828
|
|
|
829 raise Program_Error with
|
|
|
830 "trying to detach a static interrupt handler";
|
|
|
831 end if;
|
|
|
832
|
|
|
833 -- The interrupt should no longer be ignored if
|
|
|
834 -- it was ever ignored.
|
|
|
835
|
|
|
836 Ignored (Interrupt) := False;
|
|
|
837
|
|
|
838 Old_Handler := User_Handler (Interrupt).H;
|
|
|
839
|
|
|
840 -- The new handler
|
|
|
841
|
|
|
842 User_Handler (Interrupt).H := null;
|
|
|
843 User_Handler (Interrupt).Static := False;
|
|
|
844
|
|
|
845 if Old_Handler /= null then
|
|
|
846 Unbind_Handler (Interrupt);
|
|
|
847 end if;
|
|
|
848 end Unprotected_Detach_Handler;
|
|
|
849
|
|
|
850 ----------------------------------
|
|
|
851 -- Unprotected_Exchange_Handler --
|
|
|
852 ----------------------------------
|
|
|
853
|
|
|
854 procedure Unprotected_Exchange_Handler
|
|
|
855 (Old_Handler : out Parameterless_Handler;
|
|
|
856 New_Handler : Parameterless_Handler;
|
|
|
857 Interrupt : Interrupt_ID;
|
|
|
858 Static : Boolean;
|
|
|
859 Restoration : Boolean := False)
|
|
|
860 is
|
|
|
861 begin
|
|
|
862 if User_Entry (Interrupt).T /= Null_Task then
|
|
|
863
|
|
|
864 -- In case we have an Interrupt Entry already installed, raise a
|
|
|
865 -- program error, (propagate it to the caller).
|
|
|
866
|
|
|
867 raise Program_Error with
|
|
|
868 "an interrupt is already installed";
|
|
|
869 end if;
|
|
|
870
|
|
|
871 -- Note : A null handler with Static = True will pass the following
|
|
|
872 -- check. That is the case when we want to Detach a handler
|
|
|
873 -- regardless of the Static status of the current_Handler.
|
|
|
874
|
|
|
875 -- We don't check anything if Restoration is True, since we may be
|
|
|
876 -- detaching a static handler to restore a dynamic one.
|
|
|
877
|
|
|
878 if not Restoration and then not Static
|
|
|
879
|
|
|
880 -- Tries to overwrite a static Interrupt Handler with a dynamic
|
|
|
881 -- Handler
|
|
|
882
|
|
|
883 and then (User_Handler (Interrupt).Static
|
|
|
884
|
|
|
885 -- The new handler is not specified as an
|
|
|
886 -- Interrupt Handler by a pragma.
|
|
|
887
|
|
|
888 or else not Is_Registered (New_Handler))
|
|
|
889 then
|
|
|
890 raise Program_Error with
|
|
|
891 "trying to overwrite a static Interrupt Handler with a " &
|
|
|
892 "dynamic handler";
|
|
|
893 end if;
|
|
|
894
|
|
|
895 -- The interrupt should no longer be ignored if
|
|
|
896 -- it was ever ignored.
|
|
|
897
|
|
|
898 Ignored (Interrupt) := False;
|
|
|
899
|
|
|
900 -- Save the old handler
|
|
|
901
|
|
|
902 Old_Handler := User_Handler (Interrupt).H;
|
|
|
903
|
|
|
904 -- The new handler
|
|
|
905
|
|
|
906 User_Handler (Interrupt).H := New_Handler;
|
|
|
907
|
|
|
908 if New_Handler = null then
|
|
|
909
|
|
|
910 -- The null handler means we are detaching the handler
|
|
|
911
|
|
|
912 User_Handler (Interrupt).Static := False;
|
|
|
913
|
|
|
914 else
|
|
|
915 User_Handler (Interrupt).Static := Static;
|
|
|
916 end if;
|
|
|
917
|
|
|
918 -- Invoke a corresponding Server_Task if not yet created.
|
|
|
919 -- Place Task_Id info in Server_ID array.
|
|
|
920
|
|
|
921 if Server_ID (Interrupt) = Null_Task then
|
|
|
922
|
|
|
923 -- When a new Server_Task is created, it should have its
|
|
|
924 -- signal mask set to the All_Tasks_Mask.
|
|
|
925
|
|
|
926 IMOP.Set_Interrupt_Mask
|
|
|
927 (IMOP.All_Tasks_Mask'Access, Old_Mask'Access);
|
|
|
928 Access_Hold := new Server_Task (Interrupt);
|
|
|
929 IMOP.Set_Interrupt_Mask (Old_Mask'Access);
|
|
|
930
|
|
|
931 Server_ID (Interrupt) := To_System (Access_Hold.all'Identity);
|
|
|
932 end if;
|
|
|
933
|
|
|
934 if New_Handler = null then
|
|
|
935 if Old_Handler /= null then
|
|
|
936 Unbind_Handler (Interrupt);
|
|
|
937 end if;
|
|
|
938
|
|
|
939 return;
|
|
|
940 end if;
|
|
|
941
|
|
|
942 if Old_Handler = null then
|
|
|
943 Bind_Handler (Interrupt);
|
|
|
944 end if;
|
|
|
945 end Unprotected_Exchange_Handler;
|
|
|
946
|
|
|
947 -- Start of processing for Interrupt_Manager
|
|
|
948
|
|
|
949 begin
|
|
|
950 -- Environment task gets its own interrupt mask, saves it, and then
|
|
|
951 -- masks all interrupts except the Keep_Unmasked set.
|
|
|
952
|
|
|
953 -- During rendezvous, the Interrupt_Manager receives the old interrupt
|
|
|
954 -- mask of the environment task, and sets its own interrupt mask to that
|
|
|
955 -- value.
|
|
|
956
|
|
|
957 -- The environment task will call the entry of Interrupt_Manager some
|
|
|
958 -- during elaboration of the body of this package.
|
|
|
959
|
|
|
960 accept Initialize (Mask : IMNG.Interrupt_Mask) do
|
|
|
961 declare
|
|
|
962 The_Mask : aliased IMNG.Interrupt_Mask;
|
|
|
963 begin
|
|
|
964 IMOP.Copy_Interrupt_Mask (The_Mask, Mask);
|
|
|
965 IMOP.Set_Interrupt_Mask (The_Mask'Access);
|
|
|
966 end;
|
|
|
967 end Initialize;
|
|
|
968
|
|
|
969 -- Note: All tasks in RTS will have all the Reserve Interrupts being
|
|
|
970 -- masked (except the Interrupt_Manager) and Keep_Unmasked unmasked
|
|
|
971 -- when created.
|
|
|
972
|
|
|
973 -- Abort_Task_Interrupt is one of the Interrupt unmasked in all tasks.
|
|
|
974 -- We mask the Interrupt in this particular task so that "sigwait" is
|
|
|
975 -- possible to catch an explicitly sent Abort_Task_Interrupt from the
|
|
|
976 -- Server_Tasks.
|
|
|
977
|
|
|
978 -- This sigwaiting is needed so that we make sure a Server_Task is out
|
|
|
979 -- of its own sigwait state. This extra synchronization is necessary to
|
|
|
980 -- prevent following scenarios.
|
|
|
981
|
|
|
982 -- 1) Interrupt_Manager sends an Abort_Task_Interrupt to the
|
|
|
983 -- Server_Task then changes its own interrupt mask (OS level).
|
|
|
984 -- If an interrupt (corresponding to the Server_Task) arrives
|
|
|
985 -- in the mean time we have the Interrupt_Manager unmasked and
|
|
|
986 -- the Server_Task waiting on sigwait.
|
|
|
987
|
|
|
988 -- 2) For unbinding handler, we install a default action in the
|
|
|
989 -- Interrupt_Manager. POSIX.1c states that the result of using
|
|
|
990 -- "sigwait" and "sigaction" simultaneously on the same interrupt
|
|
|
991 -- is undefined. Therefore, we need to be informed from the
|
|
|
992 -- Server_Task of the fact that the Server_Task is out of its
|
|
|
993 -- sigwait stage.
|
|
|
994
|
|
|
995 IMOP.Empty_Interrupt_Mask (Intwait_Mask'Access);
|
|
|
996 IMOP.Add_To_Interrupt_Mask
|
|
|
997 (Intwait_Mask'Access, IMNG.Abort_Task_Interrupt);
|
|
|
998 IMOP.Thread_Block_Interrupt
|
|
|
999 (IMNG.Abort_Task_Interrupt);
|
|
|
1000
|
|
|
1001 loop
|
|
|
1002 -- A block is needed to absorb Program_Error exception
|
|
|
1003
|
|
|
1004 begin
|
|
|
1005 select
|
|
|
1006 accept Attach_Handler
|
|
|
1007 (New_Handler : Parameterless_Handler;
|
|
|
1008 Interrupt : Interrupt_ID;
|
|
|
1009 Static : Boolean;
|
|
|
1010 Restoration : Boolean := False)
|
|
|
1011 do
|
|
|
1012 Unprotected_Exchange_Handler
|
|
|
1013 (Old_Handler, New_Handler, Interrupt, Static, Restoration);
|
|
|
1014 end Attach_Handler;
|
|
|
1015
|
|
|
1016 or
|
|
|
1017 accept Exchange_Handler
|
|
|
1018 (Old_Handler : out Parameterless_Handler;
|
|
|
1019 New_Handler : Parameterless_Handler;
|
|
|
1020 Interrupt : Interrupt_ID;
|
|
|
1021 Static : Boolean)
|
|
|
1022 do
|
|
|
1023 Unprotected_Exchange_Handler
|
|
|
1024 (Old_Handler, New_Handler, Interrupt, Static);
|
|
|
1025 end Exchange_Handler;
|
|
|
1026
|
|
|
1027 or
|
|
|
1028 accept Detach_Handler
|
|
|
1029 (Interrupt : Interrupt_ID;
|
|
|
1030 Static : Boolean)
|
|
|
1031 do
|
|
|
1032 Unprotected_Detach_Handler (Interrupt, Static);
|
|
|
1033 end Detach_Handler;
|
|
|
1034
|
|
|
1035 or
|
|
|
1036 accept Bind_Interrupt_To_Entry
|
|
|
1037 (T : Task_Id;
|
|
|
1038 E : Task_Entry_Index;
|
|
|
1039 Interrupt : Interrupt_ID)
|
|
|
1040 do
|
|
|
1041 -- If there is a binding already (either a procedure or an
|
|
|
1042 -- entry), raise Program_Error (propagate it to the caller).
|
|
|
1043
|
|
|
1044 if User_Handler (Interrupt).H /= null
|
|
|
1045 or else User_Entry (Interrupt).T /= Null_Task
|
|
|
1046 then
|
|
|
1047 raise Program_Error with
|
|
|
1048 "a binding for this interrupt is already present";
|
|
|
1049 end if;
|
|
|
1050
|
|
|
1051 -- The interrupt should no longer be ignored if
|
|
|
1052 -- it was ever ignored.
|
|
|
1053
|
|
|
1054 Ignored (Interrupt) := False;
|
|
|
1055 User_Entry (Interrupt) := Entry_Assoc'(T => T, E => E);
|
|
|
1056
|
|
|
1057 -- Indicate the attachment of Interrupt Entry in ATCB.
|
|
|
1058 -- This is need so that when an Interrupt Entry task
|
|
|
1059 -- terminates the binding can be cleaned. The call to
|
|
|
1060 -- unbinding must be made by the task before it terminates.
|
|
|
1061
|
|
|
1062 T.Interrupt_Entry := True;
|
|
|
1063
|
|
|
1064 -- Invoke a corresponding Server_Task if not yet created.
|
|
|
1065 -- Place Task_Id info in Server_ID array.
|
|
|
1066
|
|
|
1067 if Server_ID (Interrupt) = Null_Task then
|
|
|
1068
|
|
|
1069 -- When a new Server_Task is created, it should have its
|
|
|
1070 -- signal mask set to the All_Tasks_Mask.
|
|
|
1071
|
|
|
1072 IMOP.Set_Interrupt_Mask
|
|
|
1073 (IMOP.All_Tasks_Mask'Access, Old_Mask'Access);
|
|
|
1074 Access_Hold := new Server_Task (Interrupt);
|
|
|
1075 IMOP.Set_Interrupt_Mask (Old_Mask'Access);
|
|
|
1076 Server_ID (Interrupt) :=
|
|
|
1077 To_System (Access_Hold.all'Identity);
|
|
|
1078 end if;
|
|
|
1079
|
|
|
1080 Bind_Handler (Interrupt);
|
|
|
1081 end Bind_Interrupt_To_Entry;
|
|
|
1082
|
|
|
1083 or
|
|
|
1084 accept Detach_Interrupt_Entries (T : Task_Id) do
|
|
|
1085 for J in Interrupt_ID'Range loop
|
|
|
1086 if not Is_Reserved (J) then
|
|
|
1087 if User_Entry (J).T = T then
|
|
|
1088
|
|
|
1089 -- The interrupt should no longer be ignored if
|
|
|
1090 -- it was ever ignored.
|
|
|
1091
|
|
|
1092 Ignored (J) := False;
|
|
|
1093 User_Entry (J) := Entry_Assoc'
|
|
|
1094 (T => Null_Task, E => Null_Task_Entry);
|
|
|
1095 Unbind_Handler (J);
|
|
|
1096 end if;
|
|
|
1097 end if;
|
|
|
1098 end loop;
|
|
|
1099
|
|
|
1100 -- Indicate in ATCB that no Interrupt Entries are attached
|
|
|
1101
|
|
|
1102 T.Interrupt_Entry := False;
|
|
|
1103 end Detach_Interrupt_Entries;
|
|
|
1104
|
|
|
1105 or
|
|
|
1106 accept Block_Interrupt (Interrupt : Interrupt_ID) do
|
|
|
1107 if Blocked (Interrupt) then
|
|
|
1108 return;
|
|
|
1109 end if;
|
|
|
1110
|
|
|
1111 Blocked (Interrupt) := True;
|
|
|
1112 Last_Unblocker (Interrupt) := Null_Task;
|
|
|
1113
|
|
|
1114 -- Mask this task for the given Interrupt so that all tasks
|
|
|
1115 -- are masked for the Interrupt.
|
|
|
1116
|
|
|
1117 IMOP.Thread_Block_Interrupt (IMNG.Interrupt_ID (Interrupt));
|
|
|
1118
|
|
|
1119 if User_Handler (Interrupt).H /= null
|
|
|
1120 or else User_Entry (Interrupt).T /= Null_Task
|
|
|
1121 then
|
|
|
1122 -- This is the case where the Server_Task
|
|
|
1123 -- is waiting on"sigwait." Wake it up by sending an
|
|
|
1124 -- Abort_Task_Interrupt so that the Server_Task waits
|
|
|
1125 -- on Cond.
|
|
|
1126
|
|
|
1127 POP.Abort_Task (Server_ID (Interrupt));
|
|
|
1128
|
|
|
1129 -- Make sure corresponding Server_Task is out of its own
|
|
|
1130 -- sigwait state.
|
|
|
1131
|
|
|
1132 Ret_Interrupt := Interrupt_ID
|
|
|
1133 (IMOP.Interrupt_Wait (Intwait_Mask'Access));
|
|
|
1134 pragma Assert
|
|
|
1135 (Ret_Interrupt =
|
|
|
1136 Interrupt_ID (IMNG.Abort_Task_Interrupt));
|
|
|
1137 end if;
|
|
|
1138 end Block_Interrupt;
|
|
|
1139
|
|
|
1140 or
|
|
|
1141 accept Unblock_Interrupt (Interrupt : Interrupt_ID) do
|
|
|
1142 if not Blocked (Interrupt) then
|
|
|
1143 return;
|
|
|
1144 end if;
|
|
|
1145
|
|
|
1146 Blocked (Interrupt) := False;
|
|
|
1147 Last_Unblocker (Interrupt) :=
|
|
|
1148 To_System (Unblock_Interrupt'Caller);
|
|
|
1149
|
|
|
1150 if User_Handler (Interrupt).H = null
|
|
|
1151 and then User_Entry (Interrupt).T = Null_Task
|
|
|
1152 then
|
|
|
1153 -- No handler is attached. Unmask the Interrupt so that
|
|
|
1154 -- the default action can be carried out.
|
|
|
1155
|
|
|
1156 IMOP.Thread_Unblock_Interrupt
|
|
|
1157 (IMNG.Interrupt_ID (Interrupt));
|
|
|
1158
|
|
|
1159 else
|
|
|
1160 -- The Server_Task must be waiting on the Cond variable
|
|
|
1161 -- since it was being blocked and an Interrupt Hander or
|
|
|
1162 -- an Entry was there. Wake it up and let it change it
|
|
|
1163 -- place of waiting according to its new state.
|
|
|
1164
|
|
|
1165 POP.Wakeup (Server_ID (Interrupt),
|
|
|
1166 Interrupt_Server_Blocked_Interrupt_Sleep);
|
|
|
1167 end if;
|
|
|
1168 end Unblock_Interrupt;
|
|
|
1169
|
|
|
1170 or
|
|
|
1171 accept Ignore_Interrupt (Interrupt : Interrupt_ID) do
|
|
|
1172 if Ignored (Interrupt) then
|
|
|
1173 return;
|
|
|
1174 end if;
|
|
|
1175
|
|
|
1176 Ignored (Interrupt) := True;
|
|
|
1177
|
|
|
1178 -- If there is a handler associated with the Interrupt,
|
|
|
1179 -- detach it first. In this way we make sure that the
|
|
|
1180 -- Server_Task is not on sigwait. This is legal since
|
|
|
1181 -- Unignore_Interrupt is to install the default action.
|
|
|
1182
|
|
|
1183 if User_Handler (Interrupt).H /= null then
|
|
|
1184 Unprotected_Detach_Handler
|
|
|
1185 (Interrupt => Interrupt, Static => True);
|
|
|
1186
|
|
|
1187 elsif User_Entry (Interrupt).T /= Null_Task then
|
|
|
1188 User_Entry (Interrupt) := Entry_Assoc'
|
|
|
1189 (T => Null_Task, E => Null_Task_Entry);
|
|
|
1190 Unbind_Handler (Interrupt);
|
|
|
1191 end if;
|
|
|
1192
|
|
|
1193 IMOP.Install_Ignore_Action (IMNG.Interrupt_ID (Interrupt));
|
|
|
1194 end Ignore_Interrupt;
|
|
|
1195
|
|
|
1196 or
|
|
|
1197 accept Unignore_Interrupt (Interrupt : Interrupt_ID) do
|
|
|
1198 Ignored (Interrupt) := False;
|
|
|
1199
|
|
|
1200 -- If there is a handler associated with the Interrupt,
|
|
|
1201 -- detach it first. In this way we make sure that the
|
|
|
1202 -- Server_Task is not on sigwait. This is legal since
|
|
|
1203 -- Unignore_Interrupt is to install the default action.
|
|
|
1204
|
|
|
1205 if User_Handler (Interrupt).H /= null then
|
|
|
1206 Unprotected_Detach_Handler
|
|
|
1207 (Interrupt => Interrupt, Static => True);
|
|
|
1208
|
|
|
1209 elsif User_Entry (Interrupt).T /= Null_Task then
|
|
|
1210 User_Entry (Interrupt) := Entry_Assoc'
|
|
|
1211 (T => Null_Task, E => Null_Task_Entry);
|
|
|
1212 Unbind_Handler (Interrupt);
|
|
|
1213 end if;
|
|
|
1214
|
|
|
1215 IMOP.Install_Default_Action (IMNG.Interrupt_ID (Interrupt));
|
|
|
1216 end Unignore_Interrupt;
|
|
|
1217 end select;
|
|
|
1218
|
|
|
1219 exception
|
|
|
1220 -- If there is a program error we just want to propagate it to
|
|
|
1221 -- the caller and do not want to stop this task.
|
|
|
1222
|
|
|
1223 when Program_Error =>
|
|
|
1224 null;
|
|
|
1225
|
|
|
1226 when X : others =>
|
|
|
1227 System.IO.Put_Line ("Exception in Interrupt_Manager");
|
|
|
1228 System.IO.Put_Line (Ada.Exceptions.Exception_Information (X));
|
|
|
1229 pragma Assert (False);
|
|
|
1230 end;
|
|
|
1231 end loop;
|
|
|
1232 end Interrupt_Manager;
|
|
|
1233
|
|
|
1234 -----------------
|
|
|
1235 -- Server_Task --
|
|
|
1236 -----------------
|
|
|
1237
|
|
|
1238 task body Server_Task is
|
|
|
1239 -- By making this task independent of master, when the process goes
|
|
|
1240 -- away, the Server_Task will terminate gracefully.
|
|
|
1241
|
|
|
1242 Ignore : constant Boolean := System.Tasking.Utilities.Make_Independent;
|
|
|
1243
|
|
|
1244 Intwait_Mask : aliased IMNG.Interrupt_Mask;
|
|
|
1245 Ret_Interrupt : Interrupt_ID;
|
|
|
1246 Self_ID : constant Task_Id := Self;
|
|
|
1247 Tmp_Handler : Parameterless_Handler;
|
|
|
1248 Tmp_ID : Task_Id;
|
|
|
1249 Tmp_Entry_Index : Task_Entry_Index;
|
|
|
1250
|
|
|
1251 begin
|
|
|
1252 -- Install default action in system level
|
|
|
1253
|
|
|
1254 IMOP.Install_Default_Action (IMNG.Interrupt_ID (Interrupt));
|
|
|
1255
|
|
|
1256 -- Note: All tasks in RTS will have all the Reserve Interrupts being
|
|
|
1257 -- masked (except the Interrupt_Manager) and Keep_Unmasked unmasked when
|
|
|
1258 -- created.
|
|
|
1259
|
|
|
1260 -- Abort_Task_Interrupt is one of the Interrupt unmasked in all tasks.
|
|
|
1261 -- We mask the Interrupt in this particular task so that "sigwait" is
|
|
|
1262 -- possible to catch an explicitly sent Abort_Task_Interrupt from the
|
|
|
1263 -- Interrupt_Manager.
|
|
|
1264
|
|
|
1265 -- There are two Interrupt interrupts that this task catch through
|
|
|
1266 -- "sigwait." One is the Interrupt this task is designated to catch
|
|
|
1267 -- in order to execute user handler or entry. The other one is
|
|
|
1268 -- the Abort_Task_Interrupt. This interrupt is being sent from the
|
|
|
1269 -- Interrupt_Manager to inform status changes (e.g: become Blocked,
|
|
|
1270 -- Handler or Entry is to be detached).
|
|
|
1271
|
|
|
1272 -- Prepare a mask to used for sigwait
|
|
|
1273
|
|
|
1274 IMOP.Empty_Interrupt_Mask (Intwait_Mask'Access);
|
|
|
1275
|
|
|
1276 IMOP.Add_To_Interrupt_Mask
|
|
|
1277 (Intwait_Mask'Access, IMNG.Interrupt_ID (Interrupt));
|
|
|
1278
|
|
|
1279 IMOP.Add_To_Interrupt_Mask
|
|
|
1280 (Intwait_Mask'Access, IMNG.Abort_Task_Interrupt);
|
|
|
1281
|
|
|
1282 IMOP.Thread_Block_Interrupt
|
|
|
1283 (IMNG.Abort_Task_Interrupt);
|
|
|
1284
|
|
|
1285 PIO.Set_Interrupt_ID (IMNG.Interrupt_ID (Interrupt), Self_ID);
|
|
|
1286
|
|
|
1287 loop
|
|
|
1288 System.Tasking.Initialization.Defer_Abort (Self_ID);
|
|
|
1289
|
|
|
1290 if Single_Lock then
|
|
|
1291 POP.Lock_RTS;
|
|
|
1292 end if;
|
|
|
1293
|
|
|
1294 POP.Write_Lock (Self_ID);
|
|
|
1295
|
|
|
1296 if User_Handler (Interrupt).H = null
|
|
|
1297 and then User_Entry (Interrupt).T = Null_Task
|
|
|
1298 then
|
|
|
1299 -- No Interrupt binding. If there is an interrupt,
|
|
|
1300 -- Interrupt_Manager will take default action.
|
|
|
1301
|
|
|
1302 Self_ID.Common.State := Interrupt_Server_Blocked_Interrupt_Sleep;
|
|
|
1303 POP.Sleep (Self_ID, Interrupt_Server_Idle_Sleep);
|
|
|
1304 Self_ID.Common.State := Runnable;
|
|
|
1305
|
|
|
1306 elsif Blocked (Interrupt) then
|
|
|
1307
|
|
|
1308 -- Interrupt is blocked, stay here, so we won't catch it
|
|
|
1309
|
|
|
1310 Self_ID.Common.State := Interrupt_Server_Blocked_Interrupt_Sleep;
|
|
|
1311 POP.Sleep (Self_ID, Interrupt_Server_Blocked_Interrupt_Sleep);
|
|
|
1312 Self_ID.Common.State := Runnable;
|
|
|
1313
|
|
|
1314 else
|
|
|
1315 -- A Handler or an Entry is installed. At this point all tasks
|
|
|
1316 -- mask for the Interrupt is masked. Catch the Interrupt using
|
|
|
1317 -- sigwait.
|
|
|
1318
|
|
|
1319 -- This task may wake up from sigwait by receiving an interrupt
|
|
|
1320 -- (Abort_Task_Interrupt) from the Interrupt_Manager for unbinding
|
|
|
1321 -- a Procedure Handler or an Entry. Or it could be a wake up
|
|
|
1322 -- from status change (Unblocked -> Blocked). If that is not
|
|
|
1323 -- the case, we should execute the attached Procedure or Entry.
|
|
|
1324
|
|
|
1325 Self_ID.Common.State := Interrupt_Server_Blocked_On_Event_Flag;
|
|
|
1326 POP.Unlock (Self_ID);
|
|
|
1327
|
|
|
1328 if Single_Lock then
|
|
|
1329 POP.Unlock_RTS;
|
|
|
1330 end if;
|
|
|
1331
|
|
|
1332 -- Avoid race condition when terminating application and
|
|
|
1333 -- System.Parameters.No_Abort is True.
|
|
|
1334
|
|
|
1335 if Parameters.No_Abort and then Self_ID.Pending_Action then
|
|
|
1336 Initialization.Do_Pending_Action (Self_ID);
|
|
|
1337 end if;
|
|
|
1338
|
|
|
1339 Ret_Interrupt :=
|
|
|
1340 Interrupt_ID (IMOP.Interrupt_Wait (Intwait_Mask'Access));
|
|
|
1341 Self_ID.Common.State := Runnable;
|
|
|
1342
|
|
|
1343 if Ret_Interrupt = Interrupt_ID (IMNG.Abort_Task_Interrupt) then
|
|
|
1344
|
|
|
1345 -- Inform the Interrupt_Manager of wakeup from above sigwait
|
|
|
1346
|
|
|
1347 POP.Abort_Task (Interrupt_Manager_ID);
|
|
|
1348
|
|
|
1349 if Single_Lock then
|
|
|
1350 POP.Lock_RTS;
|
|
|
1351 end if;
|
|
|
1352
|
|
|
1353 POP.Write_Lock (Self_ID);
|
|
|
1354
|
|
|
1355 else
|
|
|
1356 if Single_Lock then
|
|
|
1357 POP.Lock_RTS;
|
|
|
1358 end if;
|
|
|
1359
|
|
|
1360 POP.Write_Lock (Self_ID);
|
|
|
1361
|
|
|
1362 if Ret_Interrupt /= Interrupt then
|
|
|
1363
|
|
|
1364 -- On some systems (e.g. recent linux kernels), sigwait
|
|
|
1365 -- may return unexpectedly (with errno set to EINTR).
|
|
|
1366
|
|
|
1367 null;
|
|
|
1368
|
|
|
1369 else
|
|
|
1370 -- Even though we have received an Interrupt the status may
|
|
|
1371 -- have changed already before we got the Self_ID lock above
|
|
|
1372 -- Therefore we make sure a Handler or an Entry is still
|
|
|
1373 -- there and make appropriate call.
|
|
|
1374
|
|
|
1375 -- If there is no calls to make we need to regenerate the
|
|
|
1376 -- Interrupt in order not to lose it.
|
|
|
1377
|
|
|
1378 if User_Handler (Interrupt).H /= null then
|
|
|
1379 Tmp_Handler := User_Handler (Interrupt).H;
|
|
|
1380
|
|
|
1381 -- RTS calls should not be made with self being locked
|
|
|
1382
|
|
|
1383 POP.Unlock (Self_ID);
|
|
|
1384
|
|
|
1385 if Single_Lock then
|
|
|
1386 POP.Unlock_RTS;
|
|
|
1387 end if;
|
|
|
1388
|
|
|
1389 Tmp_Handler.all;
|
|
|
1390
|
|
|
1391 if Single_Lock then
|
|
|
1392 POP.Lock_RTS;
|
|
|
1393 end if;
|
|
|
1394
|
|
|
1395 POP.Write_Lock (Self_ID);
|
|
|
1396
|
|
|
1397 elsif User_Entry (Interrupt).T /= Null_Task then
|
|
|
1398 Tmp_ID := User_Entry (Interrupt).T;
|
|
|
1399 Tmp_Entry_Index := User_Entry (Interrupt).E;
|
|
|
1400
|
|
|
1401 -- RTS calls should not be made with self being locked
|
|
|
1402
|
|
|
1403 if Single_Lock then
|
|
|
1404 POP.Unlock_RTS;
|
|
|
1405 end if;
|
|
|
1406
|
|
|
1407 POP.Unlock (Self_ID);
|
|
|
1408
|
|
|
1409 System.Tasking.Rendezvous.Call_Simple
|
|
|
1410 (Tmp_ID, Tmp_Entry_Index, System.Null_Address);
|
|
|
1411
|
|
|
1412 POP.Write_Lock (Self_ID);
|
|
|
1413
|
|
|
1414 if Single_Lock then
|
|
|
1415 POP.Lock_RTS;
|
|
|
1416 end if;
|
|
|
1417
|
|
|
1418 else
|
|
|
1419 -- This is a situation that this task wakes up receiving
|
|
|
1420 -- an Interrupt and before it gets the lock the Interrupt
|
|
|
1421 -- is blocked. We do not want to lose the interrupt in
|
|
|
1422 -- this case so we regenerate the Interrupt to process
|
|
|
1423 -- level.
|
|
|
1424
|
|
|
1425 IMOP.Interrupt_Self_Process
|
|
|
1426 (IMNG.Interrupt_ID (Interrupt));
|
|
|
1427 end if;
|
|
|
1428 end if;
|
|
|
1429 end if;
|
|
|
1430 end if;
|
|
|
1431
|
|
|
1432 POP.Unlock (Self_ID);
|
|
|
1433
|
|
|
1434 if Single_Lock then
|
|
|
1435 POP.Unlock_RTS;
|
|
|
1436 end if;
|
|
|
1437
|
|
|
1438 System.Tasking.Initialization.Undefer_Abort (Self_ID);
|
|
|
1439
|
|
|
1440 if Self_ID.Pending_Action then
|
|
|
1441 Initialization.Do_Pending_Action (Self_ID);
|
|
|
1442 end if;
|
|
|
1443
|
|
|
1444 -- Undefer abort here to allow a window for this task to be aborted
|
|
|
1445 -- at the time of system shutdown. We also explicitly test for
|
|
|
1446 -- Pending_Action in case System.Parameters.No_Abort is True.
|
|
|
1447
|
|
|
1448 end loop;
|
|
|
1449 end Server_Task;
|
|
|
1450
|
|
|
1451 -- Elaboration code for package System.Interrupts
|
|
|
1452
|
|
|
1453 begin
|
|
|
1454 -- Get Interrupt_Manager's ID so that Abort_Interrupt can be sent
|
|
|
1455
|
|
|
1456 Interrupt_Manager_ID := To_System (Interrupt_Manager'Identity);
|
|
|
1457
|
|
|
1458 -- During the elaboration of this package body we want the RTS
|
|
|
1459 -- to inherit the interrupt mask from the Environment Task.
|
|
|
1460
|
|
|
1461 IMOP.Setup_Interrupt_Mask;
|
|
|
1462
|
|
|
1463 -- The environment task should have gotten its mask from the enclosing
|
|
|
1464 -- process during the RTS start up. (See processing in s-inmaop.adb). Pass
|
|
|
1465 -- the Interrupt_Mask of the environment task to the Interrupt_Manager.
|
|
|
1466
|
|
|
1467 -- Note: At this point we know that all tasks are masked for non-reserved
|
|
|
1468 -- signals. Only the Interrupt_Manager will have masks set up differently
|
|
|
1469 -- inheriting the original environment task's mask.
|
|
|
1470
|
|
|
1471 Interrupt_Manager.Initialize (IMOP.Environment_Mask);
|
|
|
1472 end System.Interrupts;
|
