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