|
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 -- --
|
|
145
|
9 -- Copyright (C) 1992-2019, 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
|
|
145
|
548 type Acc_Proc is access procedure;
|
|
|
549
|
|
111
|
550 type Fat_Ptr is record
|
|
|
551 Object_Addr : System.Address;
|
|
145
|
552 Handler_Addr : Acc_Proc;
|
|
111
|
553 end record;
|
|
|
554
|
|
|
555 function To_Fat_Ptr is new Ada.Unchecked_Conversion
|
|
|
556 (Parameterless_Handler, Fat_Ptr);
|
|
|
557
|
|
|
558 Ptr : R_Link;
|
|
|
559 Fat : Fat_Ptr;
|
|
|
560
|
|
|
561 begin
|
|
|
562 if Handler = null then
|
|
|
563 return True;
|
|
|
564 end if;
|
|
|
565
|
|
|
566 Fat := To_Fat_Ptr (Handler);
|
|
|
567
|
|
|
568 Ptr := Registered_Handler_Head;
|
|
|
569 while Ptr /= null loop
|
|
145
|
570 if Ptr.H = Fat.Handler_Addr.all'Address then
|
|
111
|
571 return True;
|
|
|
572 end if;
|
|
|
573
|
|
|
574 Ptr := Ptr.Next;
|
|
|
575 end loop;
|
|
|
576
|
|
|
577 return False;
|
|
|
578 end Is_Registered;
|
|
|
579
|
|
|
580 -----------------
|
|
|
581 -- Is_Reserved --
|
|
|
582 -----------------
|
|
|
583
|
|
|
584 function Is_Reserved (Interrupt : Interrupt_ID) return Boolean is
|
|
|
585 begin
|
|
|
586 return IMNG.Reserve (IMNG.Interrupt_ID (Interrupt));
|
|
|
587 end Is_Reserved;
|
|
|
588
|
|
|
589 ---------------
|
|
|
590 -- Reference --
|
|
|
591 ---------------
|
|
|
592
|
|
|
593 function Reference (Interrupt : Interrupt_ID) return System.Address is
|
|
|
594 begin
|
|
|
595 if Is_Reserved (Interrupt) then
|
|
|
596 raise Program_Error with
|
|
|
597 "interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
|
|
|
598 end if;
|
|
|
599
|
|
|
600 return Storage_Elements.To_Address
|
|
|
601 (Storage_Elements.Integer_Address (Interrupt));
|
|
|
602 end Reference;
|
|
|
603
|
|
|
604 ---------------------------------
|
|
|
605 -- Register_Interrupt_Handler --
|
|
|
606 ---------------------------------
|
|
|
607
|
|
|
608 procedure Register_Interrupt_Handler (Handler_Addr : System.Address) is
|
|
|
609 New_Node_Ptr : R_Link;
|
|
|
610
|
|
|
611 begin
|
|
|
612 -- This routine registers the Handler as usable for Dynamic Interrupt
|
|
|
613 -- Handler. Routines attaching and detaching Handler dynamically should
|
|
|
614 -- first consult if the Handler is registered. A Program Error should
|
|
|
615 -- be raised if it is not registered.
|
|
|
616
|
|
|
617 -- The pragma Interrupt_Handler can only appear in the library level PO
|
|
|
618 -- definition and instantiation. Therefore, we do not need to implement
|
|
|
619 -- Unregistering operation. Neither we need to protect the queue
|
|
|
620 -- structure using a Lock.
|
|
|
621
|
|
|
622 pragma Assert (Handler_Addr /= System.Null_Address);
|
|
|
623
|
|
|
624 New_Node_Ptr := new Registered_Handler;
|
|
|
625 New_Node_Ptr.H := Handler_Addr;
|
|
|
626
|
|
|
627 if Registered_Handler_Head = null then
|
|
|
628 Registered_Handler_Head := New_Node_Ptr;
|
|
|
629 Registered_Handler_Tail := New_Node_Ptr;
|
|
|
630
|
|
|
631 else
|
|
|
632 Registered_Handler_Tail.Next := New_Node_Ptr;
|
|
|
633 Registered_Handler_Tail := New_Node_Ptr;
|
|
|
634 end if;
|
|
|
635 end Register_Interrupt_Handler;
|
|
|
636
|
|
|
637 -----------------------
|
|
|
638 -- Unblock_Interrupt --
|
|
|
639 -----------------------
|
|
|
640
|
|
|
641 procedure Unblock_Interrupt (Interrupt : Interrupt_ID) is
|
|
|
642 begin
|
|
|
643 if Is_Reserved (Interrupt) then
|
|
|
644 raise Program_Error with
|
|
|
645 "interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
|
|
|
646 end if;
|
|
|
647
|
|
|
648 Interrupt_Manager.Unblock_Interrupt (Interrupt);
|
|
|
649 end Unblock_Interrupt;
|
|
|
650
|
|
|
651 ------------------
|
|
|
652 -- Unblocked_By --
|
|
|
653 ------------------
|
|
|
654
|
|
|
655 function Unblocked_By
|
|
|
656 (Interrupt : Interrupt_ID) return System.Tasking.Task_Id
|
|
|
657 is
|
|
|
658 begin
|
|
|
659 if Is_Reserved (Interrupt) then
|
|
|
660 raise Program_Error with
|
|
|
661 "interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
|
|
|
662 end if;
|
|
|
663
|
|
|
664 return Last_Unblocker (Interrupt);
|
|
|
665 end Unblocked_By;
|
|
|
666
|
|
|
667 ------------------------
|
|
|
668 -- Unignore_Interrupt --
|
|
|
669 ------------------------
|
|
|
670
|
|
|
671 procedure Unignore_Interrupt (Interrupt : Interrupt_ID) is
|
|
|
672 begin
|
|
|
673 if Is_Reserved (Interrupt) then
|
|
|
674 raise Program_Error with
|
|
|
675 "interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
|
|
|
676 end if;
|
|
|
677
|
|
|
678 Interrupt_Manager.Unignore_Interrupt (Interrupt);
|
|
|
679 end Unignore_Interrupt;
|
|
|
680
|
|
|
681 -----------------------
|
|
|
682 -- Interrupt_Manager --
|
|
|
683 -----------------------
|
|
|
684
|
|
|
685 task body Interrupt_Manager is
|
|
|
686 -- By making this task independent of master, when the process
|
|
|
687 -- goes away, the Interrupt_Manager will terminate gracefully.
|
|
|
688
|
|
|
689 Ignore : constant Boolean := System.Tasking.Utilities.Make_Independent;
|
|
|
690
|
|
|
691 ---------------------
|
|
|
692 -- Local Variables --
|
|
|
693 ---------------------
|
|
|
694
|
|
|
695 Intwait_Mask : aliased IMNG.Interrupt_Mask;
|
|
|
696 Ret_Interrupt : Interrupt_ID;
|
|
|
697 Old_Mask : aliased IMNG.Interrupt_Mask;
|
|
|
698 Old_Handler : Parameterless_Handler;
|
|
|
699
|
|
|
700 --------------------
|
|
|
701 -- Local Routines --
|
|
|
702 --------------------
|
|
|
703
|
|
|
704 procedure Bind_Handler (Interrupt : Interrupt_ID);
|
|
|
705 -- This procedure does not do anything if the Interrupt is blocked.
|
|
|
706 -- Otherwise, we have to interrupt Server_Task for status change through
|
|
|
707 -- Wakeup interrupt.
|
|
|
708
|
|
|
709 procedure Unbind_Handler (Interrupt : Interrupt_ID);
|
|
|
710 -- This procedure does not do anything if the Interrupt is blocked.
|
|
|
711 -- Otherwise, we have to interrupt Server_Task for status change
|
|
|
712 -- through abort interrupt.
|
|
|
713
|
|
|
714 procedure Unprotected_Exchange_Handler
|
|
|
715 (Old_Handler : out Parameterless_Handler;
|
|
|
716 New_Handler : Parameterless_Handler;
|
|
|
717 Interrupt : Interrupt_ID;
|
|
|
718 Static : Boolean;
|
|
|
719 Restoration : Boolean := False);
|
|
|
720
|
|
|
721 procedure Unprotected_Detach_Handler
|
|
|
722 (Interrupt : Interrupt_ID;
|
|
|
723 Static : Boolean);
|
|
|
724
|
|
|
725 ------------------
|
|
|
726 -- Bind_Handler --
|
|
|
727 ------------------
|
|
|
728
|
|
|
729 procedure Bind_Handler (Interrupt : Interrupt_ID) is
|
|
|
730 begin
|
|
|
731 if not Blocked (Interrupt) then
|
|
|
732
|
|
|
733 -- Mask this task for the given Interrupt so that all tasks
|
|
|
734 -- are masked for the Interrupt and the actual delivery of the
|
|
|
735 -- Interrupt will be caught using "sigwait" by the
|
|
|
736 -- corresponding Server_Task.
|
|
|
737
|
|
|
738 IMOP.Thread_Block_Interrupt (IMNG.Interrupt_ID (Interrupt));
|
|
|
739
|
|
|
740 -- We have installed a Handler or an Entry before we called
|
|
|
741 -- this procedure. If the Handler Task is waiting to be awakened,
|
|
|
742 -- do it here. Otherwise, the interrupt will be discarded.
|
|
|
743
|
|
|
744 POP.Wakeup (Server_ID (Interrupt), Interrupt_Server_Idle_Sleep);
|
|
|
745 end if;
|
|
|
746 end Bind_Handler;
|
|
|
747
|
|
|
748 --------------------
|
|
|
749 -- Unbind_Handler --
|
|
|
750 --------------------
|
|
|
751
|
|
|
752 procedure Unbind_Handler (Interrupt : Interrupt_ID) is
|
|
|
753 Server : System.Tasking.Task_Id;
|
|
|
754
|
|
|
755 begin
|
|
|
756 if not Blocked (Interrupt) then
|
|
|
757
|
|
|
758 -- Currently, there is a Handler or an Entry attached and
|
|
|
759 -- corresponding Server_Task is waiting on "sigwait." We have to
|
|
|
760 -- wake up the Server_Task and make it wait on condition variable
|
|
|
761 -- by sending an Abort_Task_Interrupt
|
|
|
762
|
|
|
763 Server := Server_ID (Interrupt);
|
|
|
764
|
|
|
765 case Server.Common.State is
|
|
|
766 when Interrupt_Server_Blocked_Interrupt_Sleep
|
|
|
767 | Interrupt_Server_Idle_Sleep
|
|
|
768 =>
|
|
|
769 POP.Wakeup (Server, Server.Common.State);
|
|
|
770
|
|
|
771 when Interrupt_Server_Blocked_On_Event_Flag =>
|
|
|
772 POP.Abort_Task (Server);
|
|
|
773
|
|
|
774 -- Make sure corresponding Server_Task is out of its
|
|
|
775 -- own sigwait state.
|
|
|
776
|
|
|
777 Ret_Interrupt :=
|
|
|
778 Interrupt_ID (IMOP.Interrupt_Wait (Intwait_Mask'Access));
|
|
|
779 pragma Assert
|
|
|
780 (Ret_Interrupt = Interrupt_ID (IMNG.Abort_Task_Interrupt));
|
|
|
781
|
|
|
782 when Runnable =>
|
|
|
783 null;
|
|
|
784
|
|
|
785 when others =>
|
|
|
786 pragma Assert (False);
|
|
|
787 null;
|
|
|
788 end case;
|
|
|
789
|
|
|
790 IMOP.Install_Default_Action (IMNG.Interrupt_ID (Interrupt));
|
|
|
791
|
|
|
792 -- Unmake the Interrupt for this task in order to allow default
|
|
|
793 -- action again.
|
|
|
794
|
|
|
795 IMOP.Thread_Unblock_Interrupt (IMNG.Interrupt_ID (Interrupt));
|
|
|
796
|
|
|
797 else
|
|
|
798 IMOP.Install_Default_Action (IMNG.Interrupt_ID (Interrupt));
|
|
|
799 end if;
|
|
|
800 end Unbind_Handler;
|
|
|
801
|
|
|
802 --------------------------------
|
|
|
803 -- Unprotected_Detach_Handler --
|
|
|
804 --------------------------------
|
|
|
805
|
|
|
806 procedure Unprotected_Detach_Handler
|
|
|
807 (Interrupt : Interrupt_ID;
|
|
|
808 Static : Boolean)
|
|
|
809 is
|
|
|
810 Old_Handler : Parameterless_Handler;
|
|
|
811
|
|
|
812 begin
|
|
|
813 if User_Entry (Interrupt).T /= Null_Task then
|
|
|
814
|
|
|
815 -- In case we have an Interrupt Entry installed, raise a program
|
|
|
816 -- error, (propagate it to the caller).
|
|
|
817
|
|
|
818 raise Program_Error with
|
|
|
819 "an interrupt entry is already installed";
|
|
|
820 end if;
|
|
|
821
|
|
|
822 -- Note : Static = True will pass the following check. That is the
|
|
|
823 -- case when we want to detach a handler regardless of the static
|
|
|
824 -- status of the current_Handler.
|
|
|
825
|
|
|
826 if not Static and then User_Handler (Interrupt).Static then
|
|
|
827
|
|
|
828 -- Tries to detach a static Interrupt Handler.
|
|
|
829 -- raise a program error.
|
|
|
830
|
|
|
831 raise Program_Error with
|
|
|
832 "trying to detach a static interrupt handler";
|
|
|
833 end if;
|
|
|
834
|
|
|
835 -- The interrupt should no longer be ignored if
|
|
|
836 -- it was ever ignored.
|
|
|
837
|
|
|
838 Ignored (Interrupt) := False;
|
|
|
839
|
|
|
840 Old_Handler := User_Handler (Interrupt).H;
|
|
|
841
|
|
|
842 -- The new handler
|
|
|
843
|
|
|
844 User_Handler (Interrupt).H := null;
|
|
|
845 User_Handler (Interrupt).Static := False;
|
|
|
846
|
|
|
847 if Old_Handler /= null then
|
|
|
848 Unbind_Handler (Interrupt);
|
|
|
849 end if;
|
|
|
850 end Unprotected_Detach_Handler;
|
|
|
851
|
|
|
852 ----------------------------------
|
|
|
853 -- Unprotected_Exchange_Handler --
|
|
|
854 ----------------------------------
|
|
|
855
|
|
|
856 procedure Unprotected_Exchange_Handler
|
|
|
857 (Old_Handler : out Parameterless_Handler;
|
|
|
858 New_Handler : Parameterless_Handler;
|
|
|
859 Interrupt : Interrupt_ID;
|
|
|
860 Static : Boolean;
|
|
|
861 Restoration : Boolean := False)
|
|
|
862 is
|
|
|
863 begin
|
|
|
864 if User_Entry (Interrupt).T /= Null_Task then
|
|
|
865
|
|
|
866 -- In case we have an Interrupt Entry already installed, raise a
|
|
|
867 -- program error, (propagate it to the caller).
|
|
|
868
|
|
|
869 raise Program_Error with
|
|
|
870 "an interrupt is already installed";
|
|
|
871 end if;
|
|
|
872
|
|
|
873 -- Note : A null handler with Static = True will pass the following
|
|
|
874 -- check. That is the case when we want to Detach a handler
|
|
|
875 -- regardless of the Static status of the current_Handler.
|
|
|
876
|
|
|
877 -- We don't check anything if Restoration is True, since we may be
|
|
|
878 -- detaching a static handler to restore a dynamic one.
|
|
|
879
|
|
|
880 if not Restoration and then not Static
|
|
|
881
|
|
|
882 -- Tries to overwrite a static Interrupt Handler with a dynamic
|
|
|
883 -- Handler
|
|
|
884
|
|
|
885 and then (User_Handler (Interrupt).Static
|
|
|
886
|
|
|
887 -- The new handler is not specified as an
|
|
|
888 -- Interrupt Handler by a pragma.
|
|
|
889
|
|
|
890 or else not Is_Registered (New_Handler))
|
|
|
891 then
|
|
|
892 raise Program_Error with
|
|
|
893 "trying to overwrite a static Interrupt Handler with a " &
|
|
|
894 "dynamic handler";
|
|
|
895 end if;
|
|
|
896
|
|
|
897 -- The interrupt should no longer be ignored if
|
|
|
898 -- it was ever ignored.
|
|
|
899
|
|
|
900 Ignored (Interrupt) := False;
|
|
|
901
|
|
|
902 -- Save the old handler
|
|
|
903
|
|
|
904 Old_Handler := User_Handler (Interrupt).H;
|
|
|
905
|
|
|
906 -- The new handler
|
|
|
907
|
|
|
908 User_Handler (Interrupt).H := New_Handler;
|
|
|
909
|
|
|
910 if New_Handler = null then
|
|
|
911
|
|
|
912 -- The null handler means we are detaching the handler
|
|
|
913
|
|
|
914 User_Handler (Interrupt).Static := False;
|
|
|
915
|
|
|
916 else
|
|
|
917 User_Handler (Interrupt).Static := Static;
|
|
|
918 end if;
|
|
|
919
|
|
|
920 -- Invoke a corresponding Server_Task if not yet created.
|
|
|
921 -- Place Task_Id info in Server_ID array.
|
|
|
922
|
|
|
923 if Server_ID (Interrupt) = Null_Task then
|
|
|
924
|
|
|
925 -- When a new Server_Task is created, it should have its
|
|
|
926 -- signal mask set to the All_Tasks_Mask.
|
|
|
927
|
|
|
928 IMOP.Set_Interrupt_Mask
|
|
|
929 (IMOP.All_Tasks_Mask'Access, Old_Mask'Access);
|
|
|
930 Access_Hold := new Server_Task (Interrupt);
|
|
|
931 IMOP.Set_Interrupt_Mask (Old_Mask'Access);
|
|
|
932
|
|
|
933 Server_ID (Interrupt) := To_System (Access_Hold.all'Identity);
|
|
|
934 end if;
|
|
|
935
|
|
|
936 if New_Handler = null then
|
|
|
937 if Old_Handler /= null then
|
|
|
938 Unbind_Handler (Interrupt);
|
|
|
939 end if;
|
|
|
940
|
|
|
941 return;
|
|
|
942 end if;
|
|
|
943
|
|
|
944 if Old_Handler = null then
|
|
|
945 Bind_Handler (Interrupt);
|
|
|
946 end if;
|
|
|
947 end Unprotected_Exchange_Handler;
|
|
|
948
|
|
|
949 -- Start of processing for Interrupt_Manager
|
|
|
950
|
|
|
951 begin
|
|
|
952 -- Environment task gets its own interrupt mask, saves it, and then
|
|
|
953 -- masks all interrupts except the Keep_Unmasked set.
|
|
|
954
|
|
|
955 -- During rendezvous, the Interrupt_Manager receives the old interrupt
|
|
|
956 -- mask of the environment task, and sets its own interrupt mask to that
|
|
|
957 -- value.
|
|
|
958
|
|
|
959 -- The environment task will call the entry of Interrupt_Manager some
|
|
|
960 -- during elaboration of the body of this package.
|
|
|
961
|
|
|
962 accept Initialize (Mask : IMNG.Interrupt_Mask) do
|
|
|
963 declare
|
|
|
964 The_Mask : aliased IMNG.Interrupt_Mask;
|
|
|
965 begin
|
|
|
966 IMOP.Copy_Interrupt_Mask (The_Mask, Mask);
|
|
|
967 IMOP.Set_Interrupt_Mask (The_Mask'Access);
|
|
|
968 end;
|
|
|
969 end Initialize;
|
|
|
970
|
|
|
971 -- Note: All tasks in RTS will have all the Reserve Interrupts being
|
|
|
972 -- masked (except the Interrupt_Manager) and Keep_Unmasked unmasked
|
|
|
973 -- when created.
|
|
|
974
|
|
|
975 -- Abort_Task_Interrupt is one of the Interrupt unmasked in all tasks.
|
|
|
976 -- We mask the Interrupt in this particular task so that "sigwait" is
|
|
|
977 -- possible to catch an explicitly sent Abort_Task_Interrupt from the
|
|
|
978 -- Server_Tasks.
|
|
|
979
|
|
|
980 -- This sigwaiting is needed so that we make sure a Server_Task is out
|
|
|
981 -- of its own sigwait state. This extra synchronization is necessary to
|
|
|
982 -- prevent following scenarios.
|
|
|
983
|
|
|
984 -- 1) Interrupt_Manager sends an Abort_Task_Interrupt to the
|
|
|
985 -- Server_Task then changes its own interrupt mask (OS level).
|
|
|
986 -- If an interrupt (corresponding to the Server_Task) arrives
|
|
|
987 -- in the mean time we have the Interrupt_Manager unmasked and
|
|
|
988 -- the Server_Task waiting on sigwait.
|
|
|
989
|
|
|
990 -- 2) For unbinding handler, we install a default action in the
|
|
|
991 -- Interrupt_Manager. POSIX.1c states that the result of using
|
|
|
992 -- "sigwait" and "sigaction" simultaneously on the same interrupt
|
|
|
993 -- is undefined. Therefore, we need to be informed from the
|
|
|
994 -- Server_Task of the fact that the Server_Task is out of its
|
|
|
995 -- sigwait stage.
|
|
|
996
|
|
|
997 IMOP.Empty_Interrupt_Mask (Intwait_Mask'Access);
|
|
|
998 IMOP.Add_To_Interrupt_Mask
|
|
|
999 (Intwait_Mask'Access, IMNG.Abort_Task_Interrupt);
|
|
|
1000 IMOP.Thread_Block_Interrupt
|
|
|
1001 (IMNG.Abort_Task_Interrupt);
|
|
|
1002
|
|
|
1003 loop
|
|
|
1004 -- A block is needed to absorb Program_Error exception
|
|
|
1005
|
|
|
1006 begin
|
|
|
1007 select
|
|
|
1008 accept Attach_Handler
|
|
|
1009 (New_Handler : Parameterless_Handler;
|
|
|
1010 Interrupt : Interrupt_ID;
|
|
|
1011 Static : Boolean;
|
|
|
1012 Restoration : Boolean := False)
|
|
|
1013 do
|
|
|
1014 Unprotected_Exchange_Handler
|
|
|
1015 (Old_Handler, New_Handler, Interrupt, Static, Restoration);
|
|
|
1016 end Attach_Handler;
|
|
|
1017
|
|
|
1018 or
|
|
|
1019 accept Exchange_Handler
|
|
|
1020 (Old_Handler : out Parameterless_Handler;
|
|
|
1021 New_Handler : Parameterless_Handler;
|
|
|
1022 Interrupt : Interrupt_ID;
|
|
|
1023 Static : Boolean)
|
|
|
1024 do
|
|
|
1025 Unprotected_Exchange_Handler
|
|
|
1026 (Old_Handler, New_Handler, Interrupt, Static);
|
|
|
1027 end Exchange_Handler;
|
|
|
1028
|
|
|
1029 or
|
|
|
1030 accept Detach_Handler
|
|
|
1031 (Interrupt : Interrupt_ID;
|
|
|
1032 Static : Boolean)
|
|
|
1033 do
|
|
|
1034 Unprotected_Detach_Handler (Interrupt, Static);
|
|
|
1035 end Detach_Handler;
|
|
|
1036
|
|
|
1037 or
|
|
|
1038 accept Bind_Interrupt_To_Entry
|
|
|
1039 (T : Task_Id;
|
|
|
1040 E : Task_Entry_Index;
|
|
|
1041 Interrupt : Interrupt_ID)
|
|
|
1042 do
|
|
|
1043 -- If there is a binding already (either a procedure or an
|
|
|
1044 -- entry), raise Program_Error (propagate it to the caller).
|
|
|
1045
|
|
|
1046 if User_Handler (Interrupt).H /= null
|
|
|
1047 or else User_Entry (Interrupt).T /= Null_Task
|
|
|
1048 then
|
|
|
1049 raise Program_Error with
|
|
|
1050 "a binding for this interrupt is already present";
|
|
|
1051 end if;
|
|
|
1052
|
|
|
1053 -- The interrupt should no longer be ignored if
|
|
|
1054 -- it was ever ignored.
|
|
|
1055
|
|
|
1056 Ignored (Interrupt) := False;
|
|
|
1057 User_Entry (Interrupt) := Entry_Assoc'(T => T, E => E);
|
|
|
1058
|
|
|
1059 -- Indicate the attachment of Interrupt Entry in ATCB.
|
|
|
1060 -- This is need so that when an Interrupt Entry task
|
|
|
1061 -- terminates the binding can be cleaned. The call to
|
|
|
1062 -- unbinding must be made by the task before it terminates.
|
|
|
1063
|
|
|
1064 T.Interrupt_Entry := True;
|
|
|
1065
|
|
|
1066 -- Invoke a corresponding Server_Task if not yet created.
|
|
|
1067 -- Place Task_Id info in Server_ID array.
|
|
|
1068
|
|
|
1069 if Server_ID (Interrupt) = Null_Task then
|
|
|
1070
|
|
|
1071 -- When a new Server_Task is created, it should have its
|
|
|
1072 -- signal mask set to the All_Tasks_Mask.
|
|
|
1073
|
|
|
1074 IMOP.Set_Interrupt_Mask
|
|
|
1075 (IMOP.All_Tasks_Mask'Access, Old_Mask'Access);
|
|
|
1076 Access_Hold := new Server_Task (Interrupt);
|
|
|
1077 IMOP.Set_Interrupt_Mask (Old_Mask'Access);
|
|
|
1078 Server_ID (Interrupt) :=
|
|
|
1079 To_System (Access_Hold.all'Identity);
|
|
|
1080 end if;
|
|
|
1081
|
|
|
1082 Bind_Handler (Interrupt);
|
|
|
1083 end Bind_Interrupt_To_Entry;
|
|
|
1084
|
|
|
1085 or
|
|
|
1086 accept Detach_Interrupt_Entries (T : Task_Id) do
|
|
|
1087 for J in Interrupt_ID'Range loop
|
|
|
1088 if not Is_Reserved (J) then
|
|
|
1089 if User_Entry (J).T = T then
|
|
|
1090
|
|
|
1091 -- The interrupt should no longer be ignored if
|
|
|
1092 -- it was ever ignored.
|
|
|
1093
|
|
|
1094 Ignored (J) := False;
|
|
|
1095 User_Entry (J) := Entry_Assoc'
|
|
|
1096 (T => Null_Task, E => Null_Task_Entry);
|
|
|
1097 Unbind_Handler (J);
|
|
|
1098 end if;
|
|
|
1099 end if;
|
|
|
1100 end loop;
|
|
|
1101
|
|
|
1102 -- Indicate in ATCB that no Interrupt Entries are attached
|
|
|
1103
|
|
|
1104 T.Interrupt_Entry := False;
|
|
|
1105 end Detach_Interrupt_Entries;
|
|
|
1106
|
|
|
1107 or
|
|
|
1108 accept Block_Interrupt (Interrupt : Interrupt_ID) do
|
|
|
1109 if Blocked (Interrupt) then
|
|
|
1110 return;
|
|
|
1111 end if;
|
|
|
1112
|
|
|
1113 Blocked (Interrupt) := True;
|
|
|
1114 Last_Unblocker (Interrupt) := Null_Task;
|
|
|
1115
|
|
|
1116 -- Mask this task for the given Interrupt so that all tasks
|
|
|
1117 -- are masked for the Interrupt.
|
|
|
1118
|
|
|
1119 IMOP.Thread_Block_Interrupt (IMNG.Interrupt_ID (Interrupt));
|
|
|
1120
|
|
|
1121 if User_Handler (Interrupt).H /= null
|
|
|
1122 or else User_Entry (Interrupt).T /= Null_Task
|
|
|
1123 then
|
|
|
1124 -- This is the case where the Server_Task
|
|
|
1125 -- is waiting on"sigwait." Wake it up by sending an
|
|
|
1126 -- Abort_Task_Interrupt so that the Server_Task waits
|
|
|
1127 -- on Cond.
|
|
|
1128
|
|
|
1129 POP.Abort_Task (Server_ID (Interrupt));
|
|
|
1130
|
|
|
1131 -- Make sure corresponding Server_Task is out of its own
|
|
|
1132 -- sigwait state.
|
|
|
1133
|
|
|
1134 Ret_Interrupt := Interrupt_ID
|
|
|
1135 (IMOP.Interrupt_Wait (Intwait_Mask'Access));
|
|
|
1136 pragma Assert
|
|
|
1137 (Ret_Interrupt =
|
|
|
1138 Interrupt_ID (IMNG.Abort_Task_Interrupt));
|
|
|
1139 end if;
|
|
|
1140 end Block_Interrupt;
|
|
|
1141
|
|
|
1142 or
|
|
|
1143 accept Unblock_Interrupt (Interrupt : Interrupt_ID) do
|
|
|
1144 if not Blocked (Interrupt) then
|
|
|
1145 return;
|
|
|
1146 end if;
|
|
|
1147
|
|
|
1148 Blocked (Interrupt) := False;
|
|
|
1149 Last_Unblocker (Interrupt) :=
|
|
|
1150 To_System (Unblock_Interrupt'Caller);
|
|
|
1151
|
|
|
1152 if User_Handler (Interrupt).H = null
|
|
|
1153 and then User_Entry (Interrupt).T = Null_Task
|
|
|
1154 then
|
|
|
1155 -- No handler is attached. Unmask the Interrupt so that
|
|
|
1156 -- the default action can be carried out.
|
|
|
1157
|
|
|
1158 IMOP.Thread_Unblock_Interrupt
|
|
|
1159 (IMNG.Interrupt_ID (Interrupt));
|
|
|
1160
|
|
|
1161 else
|
|
|
1162 -- The Server_Task must be waiting on the Cond variable
|
|
|
1163 -- since it was being blocked and an Interrupt Hander or
|
|
|
1164 -- an Entry was there. Wake it up and let it change it
|
|
|
1165 -- place of waiting according to its new state.
|
|
|
1166
|
|
|
1167 POP.Wakeup (Server_ID (Interrupt),
|
|
|
1168 Interrupt_Server_Blocked_Interrupt_Sleep);
|
|
|
1169 end if;
|
|
|
1170 end Unblock_Interrupt;
|
|
|
1171
|
|
|
1172 or
|
|
|
1173 accept Ignore_Interrupt (Interrupt : Interrupt_ID) do
|
|
|
1174 if Ignored (Interrupt) then
|
|
|
1175 return;
|
|
|
1176 end if;
|
|
|
1177
|
|
|
1178 Ignored (Interrupt) := True;
|
|
|
1179
|
|
|
1180 -- If there is a handler associated with the Interrupt,
|
|
|
1181 -- detach it first. In this way we make sure that the
|
|
|
1182 -- Server_Task is not on sigwait. This is legal since
|
|
|
1183 -- Unignore_Interrupt is to install the default action.
|
|
|
1184
|
|
|
1185 if User_Handler (Interrupt).H /= null then
|
|
|
1186 Unprotected_Detach_Handler
|
|
|
1187 (Interrupt => Interrupt, Static => True);
|
|
|
1188
|
|
|
1189 elsif User_Entry (Interrupt).T /= Null_Task then
|
|
|
1190 User_Entry (Interrupt) := Entry_Assoc'
|
|
|
1191 (T => Null_Task, E => Null_Task_Entry);
|
|
|
1192 Unbind_Handler (Interrupt);
|
|
|
1193 end if;
|
|
|
1194
|
|
|
1195 IMOP.Install_Ignore_Action (IMNG.Interrupt_ID (Interrupt));
|
|
|
1196 end Ignore_Interrupt;
|
|
|
1197
|
|
|
1198 or
|
|
|
1199 accept Unignore_Interrupt (Interrupt : Interrupt_ID) do
|
|
|
1200 Ignored (Interrupt) := False;
|
|
|
1201
|
|
|
1202 -- If there is a handler associated with the Interrupt,
|
|
|
1203 -- detach it first. In this way we make sure that the
|
|
|
1204 -- Server_Task is not on sigwait. This is legal since
|
|
|
1205 -- Unignore_Interrupt is to install the default action.
|
|
|
1206
|
|
|
1207 if User_Handler (Interrupt).H /= null then
|
|
|
1208 Unprotected_Detach_Handler
|
|
|
1209 (Interrupt => Interrupt, Static => True);
|
|
|
1210
|
|
|
1211 elsif User_Entry (Interrupt).T /= Null_Task then
|
|
|
1212 User_Entry (Interrupt) := Entry_Assoc'
|
|
|
1213 (T => Null_Task, E => Null_Task_Entry);
|
|
|
1214 Unbind_Handler (Interrupt);
|
|
|
1215 end if;
|
|
|
1216
|
|
|
1217 IMOP.Install_Default_Action (IMNG.Interrupt_ID (Interrupt));
|
|
|
1218 end Unignore_Interrupt;
|
|
|
1219 end select;
|
|
|
1220
|
|
|
1221 exception
|
|
|
1222 -- If there is a program error we just want to propagate it to
|
|
|
1223 -- the caller and do not want to stop this task.
|
|
|
1224
|
|
|
1225 when Program_Error =>
|
|
|
1226 null;
|
|
|
1227
|
|
|
1228 when X : others =>
|
|
|
1229 System.IO.Put_Line ("Exception in Interrupt_Manager");
|
|
|
1230 System.IO.Put_Line (Ada.Exceptions.Exception_Information (X));
|
|
|
1231 pragma Assert (False);
|
|
|
1232 end;
|
|
|
1233 end loop;
|
|
|
1234 end Interrupt_Manager;
|
|
|
1235
|
|
|
1236 -----------------
|
|
|
1237 -- Server_Task --
|
|
|
1238 -----------------
|
|
|
1239
|
|
|
1240 task body Server_Task is
|
|
|
1241 -- By making this task independent of master, when the process goes
|
|
|
1242 -- away, the Server_Task will terminate gracefully.
|
|
|
1243
|
|
|
1244 Ignore : constant Boolean := System.Tasking.Utilities.Make_Independent;
|
|
|
1245
|
|
|
1246 Intwait_Mask : aliased IMNG.Interrupt_Mask;
|
|
|
1247 Ret_Interrupt : Interrupt_ID;
|
|
|
1248 Self_ID : constant Task_Id := Self;
|
|
|
1249 Tmp_Handler : Parameterless_Handler;
|
|
|
1250 Tmp_ID : Task_Id;
|
|
|
1251 Tmp_Entry_Index : Task_Entry_Index;
|
|
|
1252
|
|
|
1253 begin
|
|
|
1254 -- Install default action in system level
|
|
|
1255
|
|
|
1256 IMOP.Install_Default_Action (IMNG.Interrupt_ID (Interrupt));
|
|
|
1257
|
|
|
1258 -- Note: All tasks in RTS will have all the Reserve Interrupts being
|
|
|
1259 -- masked (except the Interrupt_Manager) and Keep_Unmasked unmasked when
|
|
|
1260 -- created.
|
|
|
1261
|
|
|
1262 -- Abort_Task_Interrupt is one of the Interrupt unmasked in all tasks.
|
|
|
1263 -- We mask the Interrupt in this particular task so that "sigwait" is
|
|
|
1264 -- possible to catch an explicitly sent Abort_Task_Interrupt from the
|
|
|
1265 -- Interrupt_Manager.
|
|
|
1266
|
|
|
1267 -- There are two Interrupt interrupts that this task catch through
|
|
|
1268 -- "sigwait." One is the Interrupt this task is designated to catch
|
|
|
1269 -- in order to execute user handler or entry. The other one is
|
|
|
1270 -- the Abort_Task_Interrupt. This interrupt is being sent from the
|
|
|
1271 -- Interrupt_Manager to inform status changes (e.g: become Blocked,
|
|
|
1272 -- Handler or Entry is to be detached).
|
|
|
1273
|
|
|
1274 -- Prepare a mask to used for sigwait
|
|
|
1275
|
|
|
1276 IMOP.Empty_Interrupt_Mask (Intwait_Mask'Access);
|
|
|
1277
|
|
|
1278 IMOP.Add_To_Interrupt_Mask
|
|
|
1279 (Intwait_Mask'Access, IMNG.Interrupt_ID (Interrupt));
|
|
|
1280
|
|
|
1281 IMOP.Add_To_Interrupt_Mask
|
|
|
1282 (Intwait_Mask'Access, IMNG.Abort_Task_Interrupt);
|
|
|
1283
|
|
|
1284 IMOP.Thread_Block_Interrupt
|
|
|
1285 (IMNG.Abort_Task_Interrupt);
|
|
|
1286
|
|
|
1287 PIO.Set_Interrupt_ID (IMNG.Interrupt_ID (Interrupt), Self_ID);
|
|
|
1288
|
|
|
1289 loop
|
|
|
1290 System.Tasking.Initialization.Defer_Abort (Self_ID);
|
|
|
1291
|
|
|
1292 if Single_Lock then
|
|
|
1293 POP.Lock_RTS;
|
|
|
1294 end if;
|
|
|
1295
|
|
|
1296 POP.Write_Lock (Self_ID);
|
|
|
1297
|
|
|
1298 if User_Handler (Interrupt).H = null
|
|
|
1299 and then User_Entry (Interrupt).T = Null_Task
|
|
|
1300 then
|
|
|
1301 -- No Interrupt binding. If there is an interrupt,
|
|
|
1302 -- Interrupt_Manager will take default action.
|
|
|
1303
|
|
|
1304 Self_ID.Common.State := Interrupt_Server_Blocked_Interrupt_Sleep;
|
|
|
1305 POP.Sleep (Self_ID, Interrupt_Server_Idle_Sleep);
|
|
|
1306 Self_ID.Common.State := Runnable;
|
|
|
1307
|
|
|
1308 elsif Blocked (Interrupt) then
|
|
|
1309
|
|
|
1310 -- Interrupt is blocked, stay here, so we won't catch it
|
|
|
1311
|
|
|
1312 Self_ID.Common.State := Interrupt_Server_Blocked_Interrupt_Sleep;
|
|
|
1313 POP.Sleep (Self_ID, Interrupt_Server_Blocked_Interrupt_Sleep);
|
|
|
1314 Self_ID.Common.State := Runnable;
|
|
|
1315
|
|
|
1316 else
|
|
|
1317 -- A Handler or an Entry is installed. At this point all tasks
|
|
|
1318 -- mask for the Interrupt is masked. Catch the Interrupt using
|
|
|
1319 -- sigwait.
|
|
|
1320
|
|
|
1321 -- This task may wake up from sigwait by receiving an interrupt
|
|
|
1322 -- (Abort_Task_Interrupt) from the Interrupt_Manager for unbinding
|
|
|
1323 -- a Procedure Handler or an Entry. Or it could be a wake up
|
|
|
1324 -- from status change (Unblocked -> Blocked). If that is not
|
|
|
1325 -- the case, we should execute the attached Procedure or Entry.
|
|
|
1326
|
|
|
1327 Self_ID.Common.State := Interrupt_Server_Blocked_On_Event_Flag;
|
|
|
1328 POP.Unlock (Self_ID);
|
|
|
1329
|
|
|
1330 if Single_Lock then
|
|
|
1331 POP.Unlock_RTS;
|
|
|
1332 end if;
|
|
|
1333
|
|
|
1334 -- Avoid race condition when terminating application and
|
|
|
1335 -- System.Parameters.No_Abort is True.
|
|
|
1336
|
|
|
1337 if Parameters.No_Abort and then Self_ID.Pending_Action then
|
|
|
1338 Initialization.Do_Pending_Action (Self_ID);
|
|
|
1339 end if;
|
|
|
1340
|
|
|
1341 Ret_Interrupt :=
|
|
|
1342 Interrupt_ID (IMOP.Interrupt_Wait (Intwait_Mask'Access));
|
|
|
1343 Self_ID.Common.State := Runnable;
|
|
|
1344
|
|
|
1345 if Ret_Interrupt = Interrupt_ID (IMNG.Abort_Task_Interrupt) then
|
|
|
1346
|
|
|
1347 -- Inform the Interrupt_Manager of wakeup from above sigwait
|
|
|
1348
|
|
|
1349 POP.Abort_Task (Interrupt_Manager_ID);
|
|
|
1350
|
|
|
1351 if Single_Lock then
|
|
|
1352 POP.Lock_RTS;
|
|
|
1353 end if;
|
|
|
1354
|
|
|
1355 POP.Write_Lock (Self_ID);
|
|
|
1356
|
|
|
1357 else
|
|
|
1358 if Single_Lock then
|
|
|
1359 POP.Lock_RTS;
|
|
|
1360 end if;
|
|
|
1361
|
|
|
1362 POP.Write_Lock (Self_ID);
|
|
|
1363
|
|
|
1364 if Ret_Interrupt /= Interrupt then
|
|
|
1365
|
|
|
1366 -- On some systems (e.g. recent linux kernels), sigwait
|
|
|
1367 -- may return unexpectedly (with errno set to EINTR).
|
|
|
1368
|
|
|
1369 null;
|
|
|
1370
|
|
|
1371 else
|
|
|
1372 -- Even though we have received an Interrupt the status may
|
|
|
1373 -- have changed already before we got the Self_ID lock above
|
|
|
1374 -- Therefore we make sure a Handler or an Entry is still
|
|
|
1375 -- there and make appropriate call.
|
|
|
1376
|
|
|
1377 -- If there is no calls to make we need to regenerate the
|
|
|
1378 -- Interrupt in order not to lose it.
|
|
|
1379
|
|
|
1380 if User_Handler (Interrupt).H /= null then
|
|
|
1381 Tmp_Handler := User_Handler (Interrupt).H;
|
|
|
1382
|
|
|
1383 -- RTS calls should not be made with self being locked
|
|
|
1384
|
|
|
1385 POP.Unlock (Self_ID);
|
|
|
1386
|
|
|
1387 if Single_Lock then
|
|
|
1388 POP.Unlock_RTS;
|
|
|
1389 end if;
|
|
|
1390
|
|
|
1391 Tmp_Handler.all;
|
|
|
1392
|
|
|
1393 if Single_Lock then
|
|
|
1394 POP.Lock_RTS;
|
|
|
1395 end if;
|
|
|
1396
|
|
|
1397 POP.Write_Lock (Self_ID);
|
|
|
1398
|
|
|
1399 elsif User_Entry (Interrupt).T /= Null_Task then
|
|
|
1400 Tmp_ID := User_Entry (Interrupt).T;
|
|
|
1401 Tmp_Entry_Index := User_Entry (Interrupt).E;
|
|
|
1402
|
|
|
1403 -- RTS calls should not be made with self being locked
|
|
|
1404
|
|
|
1405 if Single_Lock then
|
|
|
1406 POP.Unlock_RTS;
|
|
|
1407 end if;
|
|
|
1408
|
|
|
1409 POP.Unlock (Self_ID);
|
|
|
1410
|
|
|
1411 System.Tasking.Rendezvous.Call_Simple
|
|
|
1412 (Tmp_ID, Tmp_Entry_Index, System.Null_Address);
|
|
|
1413
|
|
|
1414 POP.Write_Lock (Self_ID);
|
|
|
1415
|
|
|
1416 if Single_Lock then
|
|
|
1417 POP.Lock_RTS;
|
|
|
1418 end if;
|
|
|
1419
|
|
|
1420 else
|
|
|
1421 -- This is a situation that this task wakes up receiving
|
|
|
1422 -- an Interrupt and before it gets the lock the Interrupt
|
|
|
1423 -- is blocked. We do not want to lose the interrupt in
|
|
|
1424 -- this case so we regenerate the Interrupt to process
|
|
|
1425 -- level.
|
|
|
1426
|
|
|
1427 IMOP.Interrupt_Self_Process
|
|
|
1428 (IMNG.Interrupt_ID (Interrupt));
|
|
|
1429 end if;
|
|
|
1430 end if;
|
|
|
1431 end if;
|
|
|
1432 end if;
|
|
|
1433
|
|
|
1434 POP.Unlock (Self_ID);
|
|
|
1435
|
|
|
1436 if Single_Lock then
|
|
|
1437 POP.Unlock_RTS;
|
|
|
1438 end if;
|
|
|
1439
|
|
|
1440 System.Tasking.Initialization.Undefer_Abort (Self_ID);
|
|
|
1441
|
|
|
1442 if Self_ID.Pending_Action then
|
|
|
1443 Initialization.Do_Pending_Action (Self_ID);
|
|
|
1444 end if;
|
|
|
1445
|
|
|
1446 -- Undefer abort here to allow a window for this task to be aborted
|
|
|
1447 -- at the time of system shutdown. We also explicitly test for
|
|
|
1448 -- Pending_Action in case System.Parameters.No_Abort is True.
|
|
|
1449
|
|
|
1450 end loop;
|
|
|
1451 end Server_Task;
|
|
|
1452
|
|
|
1453 -- Elaboration code for package System.Interrupts
|
|
|
1454
|
|
|
1455 begin
|
|
|
1456 -- Get Interrupt_Manager's ID so that Abort_Interrupt can be sent
|
|
|
1457
|
|
|
1458 Interrupt_Manager_ID := To_System (Interrupt_Manager'Identity);
|
|
|
1459
|
|
|
1460 -- During the elaboration of this package body we want the RTS
|
|
|
1461 -- to inherit the interrupt mask from the Environment Task.
|
|
|
1462
|
|
|
1463 IMOP.Setup_Interrupt_Mask;
|
|
|
1464
|
|
|
1465 -- The environment task should have gotten its mask from the enclosing
|
|
|
1466 -- process during the RTS start up. (See processing in s-inmaop.adb). Pass
|
|
|
1467 -- the Interrupt_Mask of the environment task to the Interrupt_Manager.
|
|
|
1468
|
|
|
1469 -- Note: At this point we know that all tasks are masked for non-reserved
|
|
|
1470 -- signals. Only the Interrupt_Manager will have masks set up differently
|
|
|
1471 -- inheriting the original environment task's mask.
|
|
|
1472
|
|
|
1473 Interrupt_Manager.Initialize (IMOP.Environment_Mask);
|
|
|
1474 end System.Interrupts;
|
