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