1 ------------------------------------------------------------------------------
3 -- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
5 -- S Y S T E M . I N T E R R U P T S --
9 -- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
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, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, USA. --
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. --
29 -- GNARL was developed by the GNARL team at Florida State University. --
30 -- Extensive contributions were provided by Ada Core Technologies, Inc. --
32 ------------------------------------------------------------------------------
36 -- All user-handleable signals are masked at all times in all tasks/threads
37 -- except possibly for the Interrupt_Manager task.
39 -- When a user task wants to have the effect of masking/unmasking an signal,
40 -- it must call Block_Interrupt/Unblock_Interrupt, which will have the effect
41 -- of unmasking/masking the signal in the Interrupt_Manager task. These
42 -- comments do not apply to vectored hardware interrupts, which may be masked
43 -- or unmasked using routined interfaced to the relevant VxWorks system
46 -- Once we associate a Signal_Server_Task with an signal, the task never goes
47 -- away, and we never remove the association. On the other hand, it is more
48 -- convenient to terminate an associated Interrupt_Server_Task for a vectored
49 -- hardware interrupt (since we use a binary semaphore for synchronization
50 -- with the umbrella handler).
52 -- There is no more than one signal per Signal_Server_Task and no more than
53 -- one Signal_Server_Task per signal. The same relation holds for hardware
54 -- interrupts and Interrupt_Server_Task's at any given time. That is, only
55 -- one non-terminated Interrupt_Server_Task exists for a give interrupt at
58 -- Within this package, the lock L is used to protect the various status
59 -- tables. If there is a Server_Task associated with a signal or interrupt, we
60 -- use the per-task lock of the Server_Task instead so that we protect the
61 -- status between Interrupt_Manager and Server_Task. Protection among service
62 -- requests are ensured via user calls to the Interrupt_Manager entries.
64 -- This is the VxWorks version of this package, supporting vectored hardware
67 with Ada.Unchecked_Conversion;
68 with Ada.Task_Identification;
70 with Interfaces.VxWorks;
72 with System.OS_Interface; use System.OS_Interface;
73 with System.Interrupt_Management;
74 with System.Task_Primitives.Operations;
75 with System.Storage_Elements;
76 with System.Tasking.Utilities;
78 with System.Tasking.Rendezvous;
79 pragma Elaborate_All (System.Tasking.Rendezvous);
81 package body System.Interrupts is
85 package POP renames System.Task_Primitives.Operations;
87 function To_Ada is new Ada.Unchecked_Conversion
88 (System.Tasking.Task_Id, Ada.Task_Identification.Task_Id);
90 function To_System is new Ada.Unchecked_Conversion
91 (Ada.Task_Identification.Task_Id, Task_Id);
97 -- WARNING: System.Tasking.Stages performs calls to this task with
98 -- low-level constructs. Do not change this spec without synchronizing it.
100 task Interrupt_Manager is
101 entry Detach_Interrupt_Entries (T : Task_Id);
104 (New_Handler : Parameterless_Handler;
105 Interrupt : Interrupt_ID;
107 Restoration : Boolean := False);
109 entry Exchange_Handler
110 (Old_Handler : out Parameterless_Handler;
111 New_Handler : Parameterless_Handler;
112 Interrupt : Interrupt_ID;
116 (Interrupt : Interrupt_ID;
119 entry Bind_Interrupt_To_Entry
121 E : Task_Entry_Index;
122 Interrupt : Interrupt_ID);
124 pragma Interrupt_Priority (System.Interrupt_Priority'First);
125 end Interrupt_Manager;
127 task type Interrupt_Server_Task
128 (Interrupt : Interrupt_ID; Int_Sema : SEM_ID) is
129 -- Server task for vectored hardware interrupt handling
130 pragma Interrupt_Priority (System.Interrupt_Priority'First + 2);
131 end Interrupt_Server_Task;
133 type Interrupt_Task_Access is access Interrupt_Server_Task;
135 -------------------------------
136 -- Local Types and Variables --
137 -------------------------------
139 type Entry_Assoc is record
141 E : Task_Entry_Index;
144 type Handler_Assoc is record
145 H : Parameterless_Handler;
146 Static : Boolean; -- Indicates static binding;
149 User_Handler : array (Interrupt_ID) of Handler_Assoc :=
150 (others => (null, Static => False));
151 pragma Volatile_Components (User_Handler);
152 -- Holds the protected procedure handler (if any) and its Static
153 -- information for each interrupt or signal. A handler is static
154 -- iff it is specified through the pragma Attach_Handler.
156 User_Entry : array (Interrupt_ID) of Entry_Assoc :=
157 (others => (T => Null_Task, E => Null_Task_Entry));
158 pragma Volatile_Components (User_Entry);
159 -- Holds the task and entry index (if any) for each interrupt / signal
161 -- Type and Head, Tail of the list containing Registered Interrupt
162 -- Handlers. These definitions are used to register the handlers
163 -- specified by the pragma Interrupt_Handler.
165 type Registered_Handler;
166 type R_Link is access all Registered_Handler;
168 type Registered_Handler is record
169 H : System.Address := System.Null_Address;
170 Next : R_Link := null;
173 Registered_Handler_Head : R_Link := null;
174 Registered_Handler_Tail : R_Link := null;
176 Server_ID : array (Interrupt_ID) of System.Tasking.Task_Id :=
177 (others => System.Tasking.Null_Task);
178 pragma Atomic_Components (Server_ID);
179 -- Holds the Task_Id of the Server_Task for each interrupt / signal.
180 -- Task_Id is needed to accomplish locking per interrupt base. Also
181 -- is needed to determine whether to create a new Server_Task.
183 Semaphore_ID_Map : array
184 (Interrupt_ID range 0 .. System.OS_Interface.Max_HW_Interrupt)
185 of SEM_ID := (others => 0);
186 -- Array of binary semaphores associated with vectored interrupts
187 -- Note that the last bound should be Max_HW_Interrupt, but this will raise
188 -- Storage_Error if Num_HW_Interrupts is null, so use an extra 4 bytes
191 Interrupt_Access_Hold : Interrupt_Task_Access;
192 -- Variable for allocating an Interrupt_Server_Task
194 Handler_Installed : array (HW_Interrupt) of Boolean := (others => False);
195 -- True if Notify_Interrupt was connected to the interrupt. Handlers
196 -- can be connected but disconnection is not possible on VxWorks.
197 -- Therefore we ensure Notify_Installed is connected at most once.
199 -----------------------
200 -- Local Subprograms --
201 -----------------------
203 procedure Check_Reserved_Interrupt (Interrupt : Interrupt_ID);
204 -- Check if Id is a reserved interrupt, and if so raise Program_Error
205 -- with an appropriate message, otherwise return.
207 procedure Finalize_Interrupt_Servers;
208 -- Unbind the handlers for hardware interrupt server tasks at program
211 function Is_Registered (Handler : Parameterless_Handler) return Boolean;
212 -- See if Handler has been "pragma"ed using Interrupt_Handler.
213 -- Always consider a null handler as registered.
215 procedure Notify_Interrupt (Param : System.Address);
216 -- Umbrella handler for vectored interrupts (not signals)
218 procedure Install_Umbrella_Handler
219 (Interrupt : HW_Interrupt;
220 Handler : Interfaces.VxWorks.VOIDFUNCPTR);
221 -- Install the runtime umbrella handler for a vectored hardware
224 procedure Unimplemented (Feature : String);
225 pragma No_Return (Unimplemented);
226 -- Used to mark a call to an unimplemented function. Raises Program_Error
227 -- with an appropriate message noting that Feature is unimplemented.
233 -- Calling this procedure with New_Handler = null and Static = True
234 -- means we want to detach the current handler regardless of the
235 -- previous handler's binding status (ie. do not care if it is a
236 -- dynamic or static handler).
238 -- This option is needed so that during the finalization of a PO, we
239 -- can detach handlers attached through pragma Attach_Handler.
241 procedure Attach_Handler
242 (New_Handler : Parameterless_Handler;
243 Interrupt : Interrupt_ID;
244 Static : Boolean := False) is
246 Check_Reserved_Interrupt (Interrupt);
247 Interrupt_Manager.Attach_Handler (New_Handler, Interrupt, Static);
250 -----------------------------
251 -- Bind_Interrupt_To_Entry --
252 -----------------------------
254 -- This procedure raises a Program_Error if it tries to
255 -- bind an interrupt to which an Entry or a Procedure is
258 procedure Bind_Interrupt_To_Entry
260 E : Task_Entry_Index;
261 Int_Ref : System.Address)
263 Interrupt : constant Interrupt_ID :=
264 Interrupt_ID (Storage_Elements.To_Integer (Int_Ref));
267 Check_Reserved_Interrupt (Interrupt);
268 Interrupt_Manager.Bind_Interrupt_To_Entry (T, E, Interrupt);
269 end Bind_Interrupt_To_Entry;
271 ---------------------
272 -- Block_Interrupt --
273 ---------------------
275 procedure Block_Interrupt (Interrupt : Interrupt_ID) is
277 Unimplemented ("Block_Interrupt");
280 ------------------------------
281 -- Check_Reserved_Interrupt --
282 ------------------------------
284 procedure Check_Reserved_Interrupt (Interrupt : Interrupt_ID) is
286 if Is_Reserved (Interrupt) then
287 raise Program_Error with
288 "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";
292 end Check_Reserved_Interrupt;
294 ---------------------
295 -- Current_Handler --
296 ---------------------
298 function Current_Handler
299 (Interrupt : Interrupt_ID) return Parameterless_Handler
302 Check_Reserved_Interrupt (Interrupt);
304 -- ??? Since Parameterless_Handler is not Atomic, the
305 -- current implementation is wrong. We need a new service in
306 -- Interrupt_Manager to ensure atomicity.
308 return User_Handler (Interrupt).H;
315 -- Calling this procedure with Static = True means we want to Detach the
316 -- current handler regardless of the previous handler's binding status
317 -- (i.e. do not care if it is a dynamic or static handler).
319 -- This option is needed so that during the finalization of a PO, we can
320 -- detach handlers attached through pragma Attach_Handler.
322 procedure Detach_Handler
323 (Interrupt : Interrupt_ID;
324 Static : Boolean := False) is
326 Check_Reserved_Interrupt (Interrupt);
327 Interrupt_Manager.Detach_Handler (Interrupt, Static);
330 ------------------------------
331 -- Detach_Interrupt_Entries --
332 ------------------------------
334 procedure Detach_Interrupt_Entries (T : Task_Id) is
336 Interrupt_Manager.Detach_Interrupt_Entries (T);
337 end Detach_Interrupt_Entries;
339 ----------------------
340 -- Exchange_Handler --
341 ----------------------
343 -- Calling this procedure with New_Handler = null and Static = True
344 -- means we want to detach the current handler regardless of the
345 -- previous handler's binding status (ie. do not care if it is a
346 -- dynamic or static handler).
348 -- This option is needed so that during the finalization of a PO, we
349 -- can detach handlers attached through pragma Attach_Handler.
351 procedure Exchange_Handler
352 (Old_Handler : out Parameterless_Handler;
353 New_Handler : Parameterless_Handler;
354 Interrupt : Interrupt_ID;
355 Static : Boolean := False)
358 Check_Reserved_Interrupt (Interrupt);
359 Interrupt_Manager.Exchange_Handler
360 (Old_Handler, New_Handler, Interrupt, Static);
361 end Exchange_Handler;
367 procedure Finalize (Object : in out Static_Interrupt_Protection) is
369 -- ??? loop to be executed only when we're not doing library level
370 -- finalization, since in this case all interrupt / signal tasks are
373 if not Interrupt_Manager'Terminated then
374 for N in reverse Object.Previous_Handlers'Range loop
375 Interrupt_Manager.Attach_Handler
376 (New_Handler => Object.Previous_Handlers (N).Handler,
377 Interrupt => Object.Previous_Handlers (N).Interrupt,
378 Static => Object.Previous_Handlers (N).Static,
379 Restoration => True);
383 Tasking.Protected_Objects.Entries.Finalize
384 (Tasking.Protected_Objects.Entries.Protection_Entries (Object));
387 --------------------------------
388 -- Finalize_Interrupt_Servers --
389 --------------------------------
391 -- Restore default handlers for interrupt servers
393 -- This is called by the Interrupt_Manager task when it receives the abort
394 -- signal during program finalization.
396 procedure Finalize_Interrupt_Servers is
397 HW_Interrupts : constant Boolean := HW_Interrupt'Last >= 0;
400 if HW_Interrupts then
401 for Int in HW_Interrupt loop
402 if Server_ID (Interrupt_ID (Int)) /= null
404 not Ada.Task_Identification.Is_Terminated
405 (To_Ada (Server_ID (Interrupt_ID (Int))))
407 Interrupt_Manager.Attach_Handler
408 (New_Handler => null,
409 Interrupt => Interrupt_ID (Int),
411 Restoration => True);
415 end Finalize_Interrupt_Servers;
417 -------------------------------------
418 -- Has_Interrupt_Or_Attach_Handler --
419 -------------------------------------
421 function Has_Interrupt_Or_Attach_Handler
422 (Object : access Dynamic_Interrupt_Protection)
425 pragma Unreferenced (Object);
428 end Has_Interrupt_Or_Attach_Handler;
430 function Has_Interrupt_Or_Attach_Handler
431 (Object : access Static_Interrupt_Protection)
434 pragma Unreferenced (Object);
437 end Has_Interrupt_Or_Attach_Handler;
439 ----------------------
440 -- Ignore_Interrupt --
441 ----------------------
443 procedure Ignore_Interrupt (Interrupt : Interrupt_ID) is
445 Unimplemented ("Ignore_Interrupt");
446 end Ignore_Interrupt;
448 ----------------------
449 -- Install_Handlers --
450 ----------------------
452 procedure Install_Handlers
453 (Object : access Static_Interrupt_Protection;
454 New_Handlers : New_Handler_Array)
457 for N in New_Handlers'Range loop
459 -- We need a lock around this ???
461 Object.Previous_Handlers (N).Interrupt := New_Handlers (N).Interrupt;
462 Object.Previous_Handlers (N).Static := User_Handler
463 (New_Handlers (N).Interrupt).Static;
465 -- We call Exchange_Handler and not directly Interrupt_Manager.
466 -- Exchange_Handler so we get the Is_Reserved check.
469 (Old_Handler => Object.Previous_Handlers (N).Handler,
470 New_Handler => New_Handlers (N).Handler,
471 Interrupt => New_Handlers (N).Interrupt,
474 end Install_Handlers;
476 ---------------------------------
477 -- Install_Restricted_Handlers --
478 ---------------------------------
480 procedure Install_Restricted_Handlers (Handlers : New_Handler_Array) is
482 for N in Handlers'Range loop
483 Attach_Handler (Handlers (N).Handler, Handlers (N).Interrupt, True);
485 end Install_Restricted_Handlers;
487 ------------------------------
488 -- Install_Umbrella_Handler --
489 ------------------------------
491 procedure Install_Umbrella_Handler
492 (Interrupt : HW_Interrupt;
493 Handler : Interfaces.VxWorks.VOIDFUNCPTR)
495 use Interfaces.VxWorks;
497 Vec : constant Interrupt_Vector :=
498 INUM_TO_IVEC (Interfaces.VxWorks.int (Interrupt));
500 Stat : Interfaces.VxWorks.STATUS;
501 pragma Unreferenced (Stat);
502 -- ??? shouldn't we test Stat at least in a pragma Assert?
505 -- Only install umbrella handler when no Ada handler has already been
506 -- installed. Note that the interrupt number is passed as a parameter
507 -- when an interrupt occurs, so the umbrella handler has a different
508 -- wrapper generated by intConnect for each interrupt number.
510 if not Handler_Installed (Interrupt) then
511 Stat := intConnect (Vec, Handler, System.Address (Interrupt));
512 Handler_Installed (Interrupt) := True;
514 end Install_Umbrella_Handler;
520 function Is_Blocked (Interrupt : Interrupt_ID) return Boolean is
522 Unimplemented ("Is_Blocked");
526 -----------------------
527 -- Is_Entry_Attached --
528 -----------------------
530 function Is_Entry_Attached (Interrupt : Interrupt_ID) return Boolean is
532 Check_Reserved_Interrupt (Interrupt);
533 return User_Entry (Interrupt).T /= Null_Task;
534 end Is_Entry_Attached;
536 -------------------------
537 -- Is_Handler_Attached --
538 -------------------------
540 function Is_Handler_Attached (Interrupt : Interrupt_ID) return Boolean is
542 Check_Reserved_Interrupt (Interrupt);
543 return User_Handler (Interrupt).H /= null;
544 end Is_Handler_Attached;
550 function Is_Ignored (Interrupt : Interrupt_ID) return Boolean is
552 Unimplemented ("Is_Ignored");
560 function Is_Registered (Handler : Parameterless_Handler) return Boolean is
561 type Fat_Ptr is record
562 Object_Addr : System.Address;
563 Handler_Addr : System.Address;
566 function To_Fat_Ptr is new Ada.Unchecked_Conversion
567 (Parameterless_Handler, Fat_Ptr);
573 if Handler = null then
577 Fat := To_Fat_Ptr (Handler);
579 Ptr := Registered_Handler_Head;
581 while Ptr /= null loop
582 if Ptr.H = Fat.Handler_Addr then
596 function Is_Reserved (Interrupt : Interrupt_ID) return Boolean is
597 use System.Interrupt_Management;
599 return Reserve (System.Interrupt_Management.Interrupt_ID (Interrupt));
602 ----------------------
603 -- Notify_Interrupt --
604 ----------------------
606 -- Umbrella handler for vectored hardware interrupts (as opposed to
607 -- signals and exceptions). As opposed to the signal implementation,
608 -- this handler is installed in the vector table when the first Ada
609 -- handler is attached to the interrupt. However because VxWorks don't
610 -- support disconnecting handlers, this subprogram always test wether
611 -- or not an Ada handler is effectively attached.
613 -- Otherwise, the handler that existed prior to program startup is
614 -- in the vector table. This ensures that handlers installed by
615 -- the BSP are active unless explicitly replaced in the program text.
617 -- Each Interrupt_Server_Task has an associated binary semaphore
618 -- on which it pends once it's been started. This routine determines
619 -- The appropriate semaphore and and issues a semGive call, waking
620 -- the server task. When a handler is unbound,
621 -- System.Interrupts.Unbind_Handler issues a semFlush, and the
622 -- server task deletes its semaphore and terminates.
624 procedure Notify_Interrupt (Param : System.Address) is
625 Interrupt : constant Interrupt_ID := Interrupt_ID (Param);
627 Id : constant SEM_ID := Semaphore_ID_Map (Interrupt);
629 Discard_Result : STATUS;
630 pragma Unreferenced (Discard_Result);
634 Discard_Result := semGive (Id);
636 end Notify_Interrupt;
642 function Reference (Interrupt : Interrupt_ID) return System.Address is
644 Check_Reserved_Interrupt (Interrupt);
645 return Storage_Elements.To_Address
646 (Storage_Elements.Integer_Address (Interrupt));
649 --------------------------------
650 -- Register_Interrupt_Handler --
651 --------------------------------
653 procedure Register_Interrupt_Handler (Handler_Addr : System.Address) is
654 New_Node_Ptr : R_Link;
657 -- This routine registers a handler as usable for dynamic
658 -- interrupt handler association. Routines attaching and detaching
659 -- handlers dynamically should determine whether the handler is
660 -- registered. Program_Error should be raised if it is not registered.
662 -- Pragma Interrupt_Handler can only appear in a library
663 -- level PO definition and instantiation. Therefore, we do not need
664 -- to implement an unregister operation. Nor do we need to
665 -- protect the queue structure with a lock.
667 pragma Assert (Handler_Addr /= System.Null_Address);
669 New_Node_Ptr := new Registered_Handler;
670 New_Node_Ptr.H := Handler_Addr;
672 if Registered_Handler_Head = null then
673 Registered_Handler_Head := New_Node_Ptr;
674 Registered_Handler_Tail := New_Node_Ptr;
677 Registered_Handler_Tail.Next := New_Node_Ptr;
678 Registered_Handler_Tail := New_Node_Ptr;
680 end Register_Interrupt_Handler;
682 -----------------------
683 -- Unblock_Interrupt --
684 -----------------------
686 procedure Unblock_Interrupt (Interrupt : Interrupt_ID) is
688 Unimplemented ("Unblock_Interrupt");
689 end Unblock_Interrupt;
695 function Unblocked_By
696 (Interrupt : Interrupt_ID) return System.Tasking.Task_Id
699 Unimplemented ("Unblocked_By");
703 ------------------------
704 -- Unignore_Interrupt --
705 ------------------------
707 procedure Unignore_Interrupt (Interrupt : Interrupt_ID) is
709 Unimplemented ("Unignore_Interrupt");
710 end Unignore_Interrupt;
716 procedure Unimplemented (Feature : String) is
718 raise Program_Error with Feature & " not implemented on VxWorks";
721 -----------------------
722 -- Interrupt_Manager --
723 -----------------------
725 task body Interrupt_Manager is
731 procedure Bind_Handler (Interrupt : Interrupt_ID);
732 -- This procedure does not do anything if a signal is blocked.
733 -- Otherwise, we have to interrupt Server_Task for status change through
736 procedure Unbind_Handler (Interrupt : Interrupt_ID);
737 -- This procedure does not do anything if a signal is blocked.
738 -- Otherwise, we have to interrupt Server_Task for status change
739 -- through an abort signal.
741 procedure Unprotected_Exchange_Handler
742 (Old_Handler : out Parameterless_Handler;
743 New_Handler : Parameterless_Handler;
744 Interrupt : Interrupt_ID;
746 Restoration : Boolean := False);
748 procedure Unprotected_Detach_Handler
749 (Interrupt : Interrupt_ID;
756 procedure Bind_Handler (Interrupt : Interrupt_ID) is
758 Install_Umbrella_Handler
759 (HW_Interrupt (Interrupt), Notify_Interrupt'Access);
766 procedure Unbind_Handler (Interrupt : Interrupt_ID) is
772 -- Flush server task off semaphore, allowing it to terminate
774 S := semFlush (Semaphore_ID_Map (Interrupt));
775 pragma Assert (S = 0);
778 --------------------------------
779 -- Unprotected_Detach_Handler --
780 --------------------------------
782 procedure Unprotected_Detach_Handler
783 (Interrupt : Interrupt_ID;
786 Old_Handler : Parameterless_Handler;
788 if User_Entry (Interrupt).T /= Null_Task then
789 -- If an interrupt entry is installed raise
790 -- Program_Error. (propagate it to the caller).
792 raise Program_Error with
793 "An interrupt entry is already installed";
796 -- Note : Static = True will pass the following check. This is the
797 -- case when we want to detach a handler regardless of the static
798 -- status of the Current_Handler.
800 if not Static and then User_Handler (Interrupt).Static then
802 -- Trying to detach a static Interrupt Handler. raise
805 raise Program_Error with
806 "Trying to detach a static Interrupt Handler";
809 Old_Handler := User_Handler (Interrupt).H;
813 User_Handler (Interrupt).H := null;
814 User_Handler (Interrupt).Static := False;
816 if Old_Handler /= null then
817 Unbind_Handler (Interrupt);
819 end Unprotected_Detach_Handler;
821 ----------------------------------
822 -- Unprotected_Exchange_Handler --
823 ----------------------------------
825 procedure Unprotected_Exchange_Handler
826 (Old_Handler : out Parameterless_Handler;
827 New_Handler : Parameterless_Handler;
828 Interrupt : Interrupt_ID;
830 Restoration : Boolean := False)
833 if User_Entry (Interrupt).T /= Null_Task then
835 -- If an interrupt entry is already installed, raise
836 -- Program_Error. (propagate it to the caller).
838 raise Program_Error with "An interrupt is already installed";
841 -- Note : A null handler with Static = True will
842 -- pass the following check. This is the case when we want to
843 -- detach a handler regardless of the Static status
844 -- of Current_Handler.
845 -- We don't check anything if Restoration is True, since we
846 -- may be detaching a static handler to restore a dynamic one.
848 if not Restoration and then not Static
849 and then (User_Handler (Interrupt).Static
851 -- Trying to overwrite a static Interrupt Handler with a
854 -- The new handler is not specified as an
855 -- Interrupt Handler by a pragma.
857 or else not Is_Registered (New_Handler))
859 raise Program_Error with
860 "Trying to overwrite a static Interrupt Handler with a " &
864 -- Save the old handler
866 Old_Handler := User_Handler (Interrupt).H;
870 User_Handler (Interrupt).H := New_Handler;
872 if New_Handler = null then
874 -- The null handler means we are detaching the handler
876 User_Handler (Interrupt).Static := False;
879 User_Handler (Interrupt).Static := Static;
882 -- Invoke a corresponding Server_Task if not yet created.
883 -- Place Task_Id info in Server_ID array.
885 if New_Handler /= null
887 (Server_ID (Interrupt) = Null_Task
889 Ada.Task_Identification.Is_Terminated
890 (To_Ada (Server_ID (Interrupt))))
892 Interrupt_Access_Hold :=
893 new Interrupt_Server_Task
894 (Interrupt, semBCreate (SEM_Q_FIFO, SEM_EMPTY));
895 Server_ID (Interrupt) :=
896 To_System (Interrupt_Access_Hold.all'Identity);
899 if (New_Handler = null) and then Old_Handler /= null then
901 -- Restore default handler
903 Unbind_Handler (Interrupt);
905 elsif Old_Handler = null then
907 -- Save default handler
909 Bind_Handler (Interrupt);
911 end Unprotected_Exchange_Handler;
913 -- Start of processing for Interrupt_Manager
916 -- By making this task independent of any master, when the process
917 -- goes away, the Interrupt_Manager will terminate gracefully.
919 System.Tasking.Utilities.Make_Independent;
922 -- A block is needed to absorb Program_Error exception
925 Old_Handler : Parameterless_Handler;
929 accept Attach_Handler
930 (New_Handler : Parameterless_Handler;
931 Interrupt : Interrupt_ID;
933 Restoration : Boolean := False)
935 Unprotected_Exchange_Handler
936 (Old_Handler, New_Handler, Interrupt, Static, Restoration);
940 accept Exchange_Handler
941 (Old_Handler : out Parameterless_Handler;
942 New_Handler : Parameterless_Handler;
943 Interrupt : Interrupt_ID;
946 Unprotected_Exchange_Handler
947 (Old_Handler, New_Handler, Interrupt, Static);
948 end Exchange_Handler;
951 accept Detach_Handler
952 (Interrupt : Interrupt_ID;
955 Unprotected_Detach_Handler (Interrupt, Static);
958 accept Bind_Interrupt_To_Entry
960 E : Task_Entry_Index;
961 Interrupt : Interrupt_ID)
963 -- If there is a binding already (either a procedure or an
964 -- entry), raise Program_Error (propagate it to the caller).
966 if User_Handler (Interrupt).H /= null
967 or else User_Entry (Interrupt).T /= Null_Task
969 raise Program_Error with
970 "A binding for this interrupt is already present";
973 User_Entry (Interrupt) := Entry_Assoc'(T => T, E => E);
975 -- Indicate the attachment of interrupt entry in the ATCB.
976 -- This is needed so when an interrupt entry task terminates
977 -- the binding can be cleaned. The call to unbinding must be
978 -- make by the task before it terminates.
980 T.Interrupt_Entry := True;
982 -- Invoke a corresponding Server_Task if not yet created.
983 -- Place Task_Id info in Server_ID array.
985 if Server_ID (Interrupt) = Null_Task
987 Ada.Task_Identification.Is_Terminated
988 (To_Ada (Server_ID (Interrupt)))
990 Interrupt_Access_Hold := new Interrupt_Server_Task
991 (Interrupt, semBCreate (SEM_Q_FIFO, SEM_EMPTY));
992 Server_ID (Interrupt) :=
993 To_System (Interrupt_Access_Hold.all'Identity);
996 Bind_Handler (Interrupt);
997 end Bind_Interrupt_To_Entry;
1000 accept Detach_Interrupt_Entries (T : Task_Id) do
1001 for Int in Interrupt_ID'Range loop
1002 if not Is_Reserved (Int) then
1003 if User_Entry (Int).T = T then
1006 (T => Null_Task, E => Null_Task_Entry);
1007 Unbind_Handler (Int);
1012 -- Indicate in ATCB that no interrupt entries are attached
1014 T.Interrupt_Entry := False;
1015 end Detach_Interrupt_Entries;
1019 -- If there is a Program_Error we just want to propagate it to
1020 -- the caller and do not want to stop this task.
1022 when Program_Error =>
1026 pragma Assert (False);
1032 when Standard'Abort_Signal =>
1033 -- Flush interrupt server semaphores, so they can terminate
1034 Finalize_Interrupt_Servers;
1036 end Interrupt_Manager;
1038 ---------------------------
1039 -- Interrupt_Server_Task --
1040 ---------------------------
1042 -- Server task for vectored hardware interrupt handling
1044 task body Interrupt_Server_Task is
1045 Self_Id : constant Task_Id := Self;
1046 Tmp_Handler : Parameterless_Handler;
1048 Tmp_Entry_Index : Task_Entry_Index;
1054 System.Tasking.Utilities.Make_Independent;
1055 Semaphore_ID_Map (Interrupt) := Int_Sema;
1058 -- Pend on semaphore that will be triggered by the
1059 -- umbrella handler when the associated interrupt comes in
1061 S := semTake (Int_Sema, WAIT_FOREVER);
1062 pragma Assert (S = 0);
1064 if User_Handler (Interrupt).H /= null then
1066 -- Protected procedure handler
1068 Tmp_Handler := User_Handler (Interrupt).H;
1071 elsif User_Entry (Interrupt).T /= Null_Task then
1073 -- Interrupt entry handler
1075 Tmp_ID := User_Entry (Interrupt).T;
1076 Tmp_Entry_Index := User_Entry (Interrupt).E;
1077 System.Tasking.Rendezvous.Call_Simple
1078 (Tmp_ID, Tmp_Entry_Index, System.Null_Address);
1081 -- Semaphore has been flushed by an unbind operation in
1082 -- the Interrupt_Manager. Terminate the server task.
1084 -- Wait for the Interrupt_Manager to complete its work
1086 POP.Write_Lock (Self_Id);
1088 -- Unassociate the interrupt handler.
1090 Semaphore_ID_Map (Interrupt) := 0;
1092 -- Delete the associated semaphore
1094 S := semDelete (Int_Sema);
1096 pragma Assert (S = 0);
1098 -- Set status for the Interrupt_Manager
1100 Server_ID (Interrupt) := Null_Task;
1101 POP.Unlock (Self_Id);
1106 end Interrupt_Server_Task;
1109 -- Get Interrupt_Manager's ID so that Abort_Interrupt can be sent
1111 Interrupt_Manager_ID := To_System (Interrupt_Manager'Identity);
1112 end System.Interrupts;