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