1 ------------------------------------------------------------------------------
3 -- GNU ADA 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-2005, 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, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, 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,
60 -- we 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
62 -- service requests are ensured via user calls to the Interrupt_Manager
65 -- This is the VxWorks version of this package, supporting vectored hardware
68 with Unchecked_Conversion
;
70 with System
.OS_Interface
; use System
.OS_Interface
;
72 with Interfaces
.VxWorks
;
74 with Ada
.Task_Identification
;
75 -- used for Task_Id type
78 -- used for Raise_Exception
80 with System
.Interrupt_Management
;
83 with System
.Task_Primitives
.Operations
;
84 -- used for Write_Lock
91 with System
.Storage_Elements
;
92 -- used for To_Address
101 -- Interrupt_Manager_ID
103 with System
.Tasking
.Utilities
;
104 -- used for Make_Independent
106 with System
.Tasking
.Rendezvous
;
107 -- used for Call_Simple
108 pragma Elaborate_All
(System
.Tasking
.Rendezvous
);
110 package body System
.Interrupts
is
115 package POP
renames System
.Task_Primitives
.Operations
;
117 function To_Ada
is new Unchecked_Conversion
118 (System
.Tasking
.Task_Id
, Ada
.Task_Identification
.Task_Id
);
120 function To_System
is new Unchecked_Conversion
121 (Ada
.Task_Identification
.Task_Id
, Task_Id
);
127 -- WARNING: System.Tasking.Stages performs calls to this task with
128 -- low-level constructs. Do not change this spec without synchronizing it.
130 task Interrupt_Manager
is
131 entry Detach_Interrupt_Entries
(T
: Task_Id
);
134 (New_Handler
: Parameterless_Handler
;
135 Interrupt
: Interrupt_ID
;
137 Restoration
: Boolean := False);
139 entry Exchange_Handler
140 (Old_Handler
: out Parameterless_Handler
;
141 New_Handler
: Parameterless_Handler
;
142 Interrupt
: Interrupt_ID
;
146 (Interrupt
: Interrupt_ID
;
149 entry Bind_Interrupt_To_Entry
151 E
: Task_Entry_Index
;
152 Interrupt
: Interrupt_ID
);
154 pragma Interrupt_Priority
(System
.Interrupt_Priority
'First);
155 end Interrupt_Manager
;
157 task type Interrupt_Server_Task
158 (Interrupt
: Interrupt_ID
; Int_Sema
: SEM_ID
) is
159 -- Server task for vectored hardware interrupt handling
160 pragma Interrupt_Priority
(System
.Interrupt_Priority
'First + 2);
161 end Interrupt_Server_Task
;
163 type Interrupt_Task_Access
is access Interrupt_Server_Task
;
165 -------------------------------
166 -- Local Types and Variables --
167 -------------------------------
169 type Entry_Assoc
is record
171 E
: Task_Entry_Index
;
174 type Handler_Assoc
is record
175 H
: Parameterless_Handler
;
176 Static
: Boolean; -- Indicates static binding;
179 User_Handler
: array (Interrupt_ID
) of Handler_Assoc
:=
180 (others => (null, Static
=> False));
181 pragma Volatile_Components
(User_Handler
);
182 -- Holds the protected procedure handler (if any) and its Static
183 -- information for each interrupt or signal. A handler is static
184 -- iff it is specified through the pragma Attach_Handler.
186 User_Entry
: array (Interrupt_ID
) of Entry_Assoc
:=
187 (others => (T
=> Null_Task
, E
=> Null_Task_Entry
));
188 pragma Volatile_Components
(User_Entry
);
189 -- Holds the task and entry index (if any) for each interrupt / signal
191 -- Type and Head, Tail of the list containing Registered Interrupt
192 -- Handlers. These definitions are used to register the handlers
193 -- specified by the pragma Interrupt_Handler.
195 type Registered_Handler
;
196 type R_Link
is access all Registered_Handler
;
198 type Registered_Handler
is record
199 H
: System
.Address
:= System
.Null_Address
;
200 Next
: R_Link
:= null;
203 Registered_Handler_Head
: R_Link
:= null;
204 Registered_Handler_Tail
: R_Link
:= null;
206 Server_ID
: array (Interrupt_ID
) of System
.Tasking
.Task_Id
:=
207 (others => System
.Tasking
.Null_Task
);
208 pragma Atomic_Components
(Server_ID
);
209 -- Holds the Task_Id of the Server_Task for each interrupt / signal.
210 -- Task_Id is needed to accomplish locking per interrupt base. Also
211 -- is needed to determine whether to create a new Server_Task.
213 Semaphore_ID_Map
: array
214 (Interrupt_ID
range 0 .. System
.OS_Interface
.Max_HW_Interrupt
)
215 of SEM_ID
:= (others => 0);
216 -- Array of binary semaphores associated with vectored interrupts
217 -- Note that the last bound should be Max_HW_Interrupt, but this will raise
218 -- Storage_Error if Num_HW_Interrupts is null, so use an extra 4 bytes
221 Interrupt_Access_Hold
: Interrupt_Task_Access
;
222 -- Variable for allocating an Interrupt_Server_Task
224 Default_Handler
: array (HW_Interrupt
) of Interfaces
.VxWorks
.VOIDFUNCPTR
;
225 -- Vectored interrupt handlers installed prior to program startup.
226 -- These are saved only when the umbrella handler is installed for
227 -- a given interrupt number.
229 -----------------------
230 -- Local Subprograms --
231 -----------------------
233 procedure Check_Reserved_Interrupt
(Interrupt
: Interrupt_ID
);
234 -- Check if Id is a reserved interrupt, and if so raise Program_Error
235 -- with an appropriate message, otherwise return.
237 procedure Finalize_Interrupt_Servers
;
238 -- Unbind the handlers for hardware interrupt server tasks at program
241 function Is_Registered
(Handler
: Parameterless_Handler
) return Boolean;
242 -- See if Handler has been "pragma"ed using Interrupt_Handler.
243 -- Always consider a null handler as registered.
245 procedure Notify_Interrupt
(Param
: System
.Address
);
246 -- Umbrella handler for vectored interrupts (not signals)
248 procedure Install_Default_Action
(Interrupt
: HW_Interrupt
);
249 -- Restore a handler that was in place prior to program execution
251 procedure Install_Umbrella_Handler
252 (Interrupt
: HW_Interrupt
;
253 Handler
: Interfaces
.VxWorks
.VOIDFUNCPTR
);
254 -- Install the runtime umbrella handler for a vectored hardware
257 procedure Unimplemented
(Feature
: String);
258 pragma No_Return
(Unimplemented
);
259 -- Used to mark a call to an unimplemented function. Raises Program_Error
260 -- with an appropriate message noting that Feature is unimplemented.
266 -- Calling this procedure with New_Handler = null and Static = True
267 -- means we want to detach the current handler regardless of the
268 -- previous handler's binding status (ie. do not care if it is a
269 -- dynamic or static handler).
271 -- This option is needed so that during the finalization of a PO, we
272 -- can detach handlers attached through pragma Attach_Handler.
274 procedure Attach_Handler
275 (New_Handler
: Parameterless_Handler
;
276 Interrupt
: Interrupt_ID
;
277 Static
: Boolean := False) is
279 Check_Reserved_Interrupt
(Interrupt
);
280 Interrupt_Manager
.Attach_Handler
(New_Handler
, Interrupt
, Static
);
283 -----------------------------
284 -- Bind_Interrupt_To_Entry --
285 -----------------------------
287 -- This procedure raises a Program_Error if it tries to
288 -- bind an interrupt to which an Entry or a Procedure is
291 procedure Bind_Interrupt_To_Entry
293 E
: Task_Entry_Index
;
294 Int_Ref
: System
.Address
)
296 Interrupt
: constant Interrupt_ID
:=
297 Interrupt_ID
(Storage_Elements
.To_Integer
(Int_Ref
));
300 Check_Reserved_Interrupt
(Interrupt
);
301 Interrupt_Manager
.Bind_Interrupt_To_Entry
(T
, E
, Interrupt
);
302 end Bind_Interrupt_To_Entry
;
304 ---------------------
305 -- Block_Interrupt --
306 ---------------------
308 procedure Block_Interrupt
(Interrupt
: Interrupt_ID
) is
310 Unimplemented
("Block_Interrupt");
313 ------------------------------
314 -- Check_Reserved_Interrupt --
315 ------------------------------
317 procedure Check_Reserved_Interrupt
(Interrupt
: Interrupt_ID
) is
319 if Is_Reserved
(Interrupt
) then
321 (Program_Error
'Identity,
322 "Interrupt" & Interrupt_ID
'Image (Interrupt
) & " is reserved");
326 end Check_Reserved_Interrupt
;
328 ---------------------
329 -- Current_Handler --
330 ---------------------
332 function Current_Handler
333 (Interrupt
: Interrupt_ID
) return Parameterless_Handler
336 Check_Reserved_Interrupt
(Interrupt
);
338 -- ??? Since Parameterless_Handler is not Atomic, the
339 -- current implementation is wrong. We need a new service in
340 -- Interrupt_Manager to ensure atomicity.
342 return User_Handler
(Interrupt
).H
;
349 -- Calling this procedure with Static = True means we want to Detach the
350 -- current handler regardless of the previous handler's binding status
351 -- (i.e. do not care if it is a dynamic or static handler).
353 -- This option is needed so that during the finalization of a PO, we can
354 -- detach handlers attached through pragma Attach_Handler.
356 procedure Detach_Handler
357 (Interrupt
: Interrupt_ID
;
358 Static
: Boolean := False) is
360 Check_Reserved_Interrupt
(Interrupt
);
361 Interrupt_Manager
.Detach_Handler
(Interrupt
, Static
);
364 ------------------------------
365 -- Detach_Interrupt_Entries --
366 ------------------------------
368 procedure Detach_Interrupt_Entries
(T
: Task_Id
) is
370 Interrupt_Manager
.Detach_Interrupt_Entries
(T
);
371 end Detach_Interrupt_Entries
;
373 ----------------------
374 -- Exchange_Handler --
375 ----------------------
377 -- Calling this procedure with New_Handler = null and Static = True
378 -- means we want to detach the current handler regardless of the
379 -- previous handler's binding status (ie. do not care if it is a
380 -- dynamic or static handler).
382 -- This option is needed so that during the finalization of a PO, we
383 -- can detach handlers attached through pragma Attach_Handler.
385 procedure Exchange_Handler
386 (Old_Handler
: out Parameterless_Handler
;
387 New_Handler
: Parameterless_Handler
;
388 Interrupt
: Interrupt_ID
;
389 Static
: Boolean := False)
392 Check_Reserved_Interrupt
(Interrupt
);
393 Interrupt_Manager
.Exchange_Handler
394 (Old_Handler
, New_Handler
, Interrupt
, Static
);
395 end Exchange_Handler
;
401 procedure Finalize
(Object
: in out Static_Interrupt_Protection
) is
403 -- ??? loop to be executed only when we're not doing library level
404 -- finalization, since in this case all interrupt / signal tasks are
407 if not Interrupt_Manager
'Terminated then
408 for N
in reverse Object
.Previous_Handlers
'Range loop
409 Interrupt_Manager
.Attach_Handler
410 (New_Handler
=> Object
.Previous_Handlers
(N
).Handler
,
411 Interrupt
=> Object
.Previous_Handlers
(N
).Interrupt
,
412 Static
=> Object
.Previous_Handlers
(N
).Static
,
413 Restoration
=> True);
417 Tasking
.Protected_Objects
.Entries
.Finalize
418 (Tasking
.Protected_Objects
.Entries
.Protection_Entries
(Object
));
421 --------------------------------
422 -- Finalize_Interrupt_Servers --
423 --------------------------------
425 -- Restore default handlers for interrupt servers
427 -- This is called by the Interrupt_Manager task when it receives the abort
428 -- signal during program finalization.
430 procedure Finalize_Interrupt_Servers
is
431 HW_Interrupts
: constant Boolean := HW_Interrupt
'Last >= 0;
434 if HW_Interrupts
then
435 for Int
in HW_Interrupt
loop
436 if Server_ID
(Interrupt_ID
(Int
)) /= null
438 not Ada
.Task_Identification
.Is_Terminated
439 (To_Ada
(Server_ID
(Interrupt_ID
(Int
))))
441 Interrupt_Manager
.Attach_Handler
442 (New_Handler
=> null,
443 Interrupt
=> Interrupt_ID
(Int
),
445 Restoration
=> True);
449 end Finalize_Interrupt_Servers
;
451 -------------------------------------
452 -- Has_Interrupt_Or_Attach_Handler --
453 -------------------------------------
455 function Has_Interrupt_Or_Attach_Handler
456 (Object
: access Dynamic_Interrupt_Protection
)
459 pragma Unreferenced
(Object
);
462 end Has_Interrupt_Or_Attach_Handler
;
464 function Has_Interrupt_Or_Attach_Handler
465 (Object
: access Static_Interrupt_Protection
)
468 pragma Unreferenced
(Object
);
471 end Has_Interrupt_Or_Attach_Handler
;
473 ----------------------
474 -- Ignore_Interrupt --
475 ----------------------
477 procedure Ignore_Interrupt
(Interrupt
: Interrupt_ID
) is
479 Unimplemented
("Ignore_Interrupt");
480 end Ignore_Interrupt
;
482 ----------------------------
483 -- Install_Default_Action --
484 ----------------------------
486 procedure Install_Default_Action
(Interrupt
: HW_Interrupt
) is
488 -- Restore original interrupt handler
490 Interfaces
.VxWorks
.intVecSet
491 (Interfaces
.VxWorks
.INUM_TO_IVEC
(Integer (Interrupt
)),
492 Default_Handler
(Interrupt
));
493 Default_Handler
(Interrupt
) := null;
494 end Install_Default_Action
;
496 ----------------------
497 -- Install_Handlers --
498 ----------------------
500 procedure Install_Handlers
501 (Object
: access Static_Interrupt_Protection
;
502 New_Handlers
: New_Handler_Array
)
505 for N
in New_Handlers
'Range loop
507 -- We need a lock around this ???
509 Object
.Previous_Handlers
(N
).Interrupt
:= New_Handlers
(N
).Interrupt
;
510 Object
.Previous_Handlers
(N
).Static
:= User_Handler
511 (New_Handlers
(N
).Interrupt
).Static
;
513 -- We call Exchange_Handler and not directly Interrupt_Manager.
514 -- Exchange_Handler so we get the Is_Reserved check.
517 (Old_Handler
=> Object
.Previous_Handlers
(N
).Handler
,
518 New_Handler
=> New_Handlers
(N
).Handler
,
519 Interrupt
=> New_Handlers
(N
).Interrupt
,
522 end Install_Handlers
;
524 ------------------------------
525 -- Install_Umbrella_Handler --
526 ------------------------------
528 procedure Install_Umbrella_Handler
529 (Interrupt
: HW_Interrupt
;
530 Handler
: Interfaces
.VxWorks
.VOIDFUNCPTR
)
532 use Interfaces
.VxWorks
;
534 Vec
: constant Interrupt_Vector
:=
535 INUM_TO_IVEC
(Interfaces
.VxWorks
.int
(Interrupt
));
537 Old_Handler
: constant VOIDFUNCPTR
:=
539 (INUM_TO_IVEC
(Interfaces
.VxWorks
.int
(Interrupt
)));
541 Stat
: Interfaces
.VxWorks
.STATUS
;
542 pragma Unreferenced
(Stat
);
543 -- ??? shouldn't we test Stat at least in a pragma Assert?
546 -- Only install umbrella handler when no Ada handler has already been
547 -- installed. Note that the interrupt number is passed as a parameter
548 -- when an interrupt occurs, so the umbrella handler has a different
549 -- wrapper generated by intConnect for each interrupt number.
551 if Default_Handler
(Interrupt
) = null then
553 intConnect
(Vec
, Handler
, System
.Address
(Interrupt
));
554 Default_Handler
(Interrupt
) := Old_Handler
;
556 end Install_Umbrella_Handler
;
562 function Is_Blocked
(Interrupt
: Interrupt_ID
) return Boolean is
564 Unimplemented
("Is_Blocked");
568 -----------------------
569 -- Is_Entry_Attached --
570 -----------------------
572 function Is_Entry_Attached
(Interrupt
: Interrupt_ID
) return Boolean is
574 Check_Reserved_Interrupt
(Interrupt
);
575 return User_Entry
(Interrupt
).T
/= Null_Task
;
576 end Is_Entry_Attached
;
578 -------------------------
579 -- Is_Handler_Attached --
580 -------------------------
582 function Is_Handler_Attached
(Interrupt
: Interrupt_ID
) return Boolean is
584 Check_Reserved_Interrupt
(Interrupt
);
585 return User_Handler
(Interrupt
).H
/= null;
586 end Is_Handler_Attached
;
592 function Is_Ignored
(Interrupt
: Interrupt_ID
) return Boolean is
594 Unimplemented
("Is_Ignored");
602 function Is_Registered
(Handler
: Parameterless_Handler
) return Boolean is
603 type Fat_Ptr
is record
604 Object_Addr
: System
.Address
;
605 Handler_Addr
: System
.Address
;
608 function To_Fat_Ptr
is new Unchecked_Conversion
609 (Parameterless_Handler
, Fat_Ptr
);
615 if Handler
= null then
619 Fat
:= To_Fat_Ptr
(Handler
);
621 Ptr
:= Registered_Handler_Head
;
623 while Ptr
/= null loop
624 if Ptr
.H
= Fat
.Handler_Addr
then
638 function Is_Reserved
(Interrupt
: Interrupt_ID
) return Boolean is
639 use System
.Interrupt_Management
;
641 return Reserve
(System
.Interrupt_Management
.Interrupt_ID
(Interrupt
));
644 ----------------------
645 -- Notify_Interrupt --
646 ----------------------
648 -- Umbrella handler for vectored hardware interrupts (as opposed to
649 -- signals and exceptions). As opposed to the signal implementation,
650 -- this handler is only installed in the vector table while there is
651 -- an active association of an Ada handler to the interrupt.
653 -- Otherwise, the handler that existed prior to program startup is
654 -- in the vector table. This ensures that handlers installed by
655 -- the BSP are active unless explicitly replaced in the program text.
657 -- Each Interrupt_Server_Task has an associated binary semaphore
658 -- on which it pends once it's been started. This routine determines
659 -- The appropriate semaphore and and issues a semGive call, waking
660 -- the server task. When a handler is unbound,
661 -- System.Interrupts.Unbind_Handler issues a semFlush, and the
662 -- server task deletes its semaphore and terminates.
664 procedure Notify_Interrupt
(Param
: System
.Address
) is
665 Interrupt
: constant Interrupt_ID
:= Interrupt_ID
(Param
);
667 Discard_Result
: STATUS
;
668 pragma Unreferenced
(Discard_Result
);
671 Discard_Result
:= semGive
(Semaphore_ID_Map
(Interrupt
));
672 end Notify_Interrupt
;
678 function Reference
(Interrupt
: Interrupt_ID
) return System
.Address
is
680 Check_Reserved_Interrupt
(Interrupt
);
681 return Storage_Elements
.To_Address
682 (Storage_Elements
.Integer_Address
(Interrupt
));
685 --------------------------------
686 -- Register_Interrupt_Handler --
687 --------------------------------
689 procedure Register_Interrupt_Handler
(Handler_Addr
: System
.Address
) is
690 New_Node_Ptr
: R_Link
;
693 -- This routine registers a handler as usable for dynamic
694 -- interrupt handler association. Routines attaching and detaching
695 -- handlers dynamically should determine whether the handler is
696 -- registered. Program_Error should be raised if it is not registered.
698 -- Pragma Interrupt_Handler can only appear in a library
699 -- level PO definition and instantiation. Therefore, we do not need
700 -- to implement an unregister operation. Nor do we need to
701 -- protect the queue structure with a lock.
703 pragma Assert
(Handler_Addr
/= System
.Null_Address
);
705 New_Node_Ptr
:= new Registered_Handler
;
706 New_Node_Ptr
.H
:= Handler_Addr
;
708 if Registered_Handler_Head
= null then
709 Registered_Handler_Head
:= New_Node_Ptr
;
710 Registered_Handler_Tail
:= New_Node_Ptr
;
713 Registered_Handler_Tail
.Next
:= New_Node_Ptr
;
714 Registered_Handler_Tail
:= New_Node_Ptr
;
716 end Register_Interrupt_Handler
;
718 -----------------------
719 -- Unblock_Interrupt --
720 -----------------------
722 procedure Unblock_Interrupt
(Interrupt
: Interrupt_ID
) is
724 Unimplemented
("Unblock_Interrupt");
725 end Unblock_Interrupt
;
731 function Unblocked_By
732 (Interrupt
: Interrupt_ID
) return System
.Tasking
.Task_Id
735 Unimplemented
("Unblocked_By");
739 ------------------------
740 -- Unignore_Interrupt --
741 ------------------------
743 procedure Unignore_Interrupt
(Interrupt
: Interrupt_ID
) is
745 Unimplemented
("Unignore_Interrupt");
746 end Unignore_Interrupt
;
752 procedure Unimplemented
(Feature
: String) is
755 (Program_Error
'Identity,
756 Feature
& " not implemented on VxWorks");
759 -----------------------
760 -- Interrupt_Manager --
761 -----------------------
763 task body Interrupt_Manager
is
769 procedure Bind_Handler
(Interrupt
: Interrupt_ID
);
770 -- This procedure does not do anything if a signal is blocked.
771 -- Otherwise, we have to interrupt Server_Task for status change through
774 procedure Unbind_Handler
(Interrupt
: Interrupt_ID
);
775 -- This procedure does not do anything if a signal is blocked.
776 -- Otherwise, we have to interrupt Server_Task for status change
777 -- through an abort signal.
779 procedure Unprotected_Exchange_Handler
780 (Old_Handler
: out Parameterless_Handler
;
781 New_Handler
: Parameterless_Handler
;
782 Interrupt
: Interrupt_ID
;
784 Restoration
: Boolean := False);
786 procedure Unprotected_Detach_Handler
787 (Interrupt
: Interrupt_ID
;
794 procedure Bind_Handler
(Interrupt
: Interrupt_ID
) is
796 Install_Umbrella_Handler
797 (HW_Interrupt
(Interrupt
), Notify_Interrupt
'Access);
804 procedure Unbind_Handler
(Interrupt
: Interrupt_ID
) is
809 -- Hardware interrupt
811 Install_Default_Action
(HW_Interrupt
(Interrupt
));
813 -- Flush server task off semaphore, allowing it to terminate
815 S
:= semFlush
(Semaphore_ID_Map
(Interrupt
));
816 pragma Assert
(S
= 0);
819 --------------------------------
820 -- Unprotected_Detach_Handler --
821 --------------------------------
823 procedure Unprotected_Detach_Handler
824 (Interrupt
: Interrupt_ID
;
827 Old_Handler
: Parameterless_Handler
;
829 if User_Entry
(Interrupt
).T
/= Null_Task
then
830 -- If an interrupt entry is installed raise
831 -- Program_Error. (propagate it to the caller).
833 Raise_Exception
(Program_Error
'Identity,
834 "An interrupt entry is already installed");
837 -- Note : Static = True will pass the following check. This is the
838 -- case when we want to detach a handler regardless of the static
839 -- status of the Current_Handler.
841 if not Static
and then User_Handler
(Interrupt
).Static
then
843 -- Trying to detach a static Interrupt Handler. raise
846 Raise_Exception
(Program_Error
'Identity,
847 "Trying to detach a static Interrupt Handler");
850 Old_Handler
:= User_Handler
(Interrupt
).H
;
854 User_Handler
(Interrupt
).H
:= null;
855 User_Handler
(Interrupt
).Static
:= False;
857 if Old_Handler
/= null then
858 Unbind_Handler
(Interrupt
);
860 end Unprotected_Detach_Handler
;
862 ----------------------------------
863 -- Unprotected_Exchange_Handler --
864 ----------------------------------
866 procedure Unprotected_Exchange_Handler
867 (Old_Handler
: out Parameterless_Handler
;
868 New_Handler
: Parameterless_Handler
;
869 Interrupt
: Interrupt_ID
;
871 Restoration
: Boolean := False)
874 if User_Entry
(Interrupt
).T
/= Null_Task
then
876 -- If an interrupt entry is already installed, raise
877 -- Program_Error. (propagate it to the caller).
880 (Program_Error
'Identity,
881 "An interrupt is already installed");
884 -- Note : A null handler with Static = True will
885 -- pass the following check. This is the case when we want to
886 -- detach a handler regardless of the Static status
887 -- of Current_Handler.
888 -- We don't check anything if Restoration is True, since we
889 -- may be detaching a static handler to restore a dynamic one.
891 if not Restoration
and then not Static
892 and then (User_Handler
(Interrupt
).Static
894 -- Trying to overwrite a static Interrupt Handler with a
897 -- The new handler is not specified as an
898 -- Interrupt Handler by a pragma.
900 or else not Is_Registered
(New_Handler
))
903 (Program_Error
'Identity,
904 "Trying to overwrite a static Interrupt Handler with a " &
908 -- Save the old handler
910 Old_Handler
:= User_Handler
(Interrupt
).H
;
914 User_Handler
(Interrupt
).H
:= New_Handler
;
916 if New_Handler
= null then
918 -- The null handler means we are detaching the handler
920 User_Handler
(Interrupt
).Static
:= False;
923 User_Handler
(Interrupt
).Static
:= Static
;
926 -- Invoke a corresponding Server_Task if not yet created.
927 -- Place Task_Id info in Server_ID array.
929 if New_Handler
/= null
931 (Server_ID
(Interrupt
) = Null_Task
933 Ada
.Task_Identification
.Is_Terminated
934 (To_Ada
(Server_ID
(Interrupt
))))
936 Interrupt_Access_Hold
:=
937 new Interrupt_Server_Task
938 (Interrupt
, semBCreate
(SEM_Q_FIFO
, SEM_EMPTY
));
939 Server_ID
(Interrupt
) :=
940 To_System
(Interrupt_Access_Hold
.all'Identity);
943 if (New_Handler
= null) and then Old_Handler
/= null then
945 -- Restore default handler
947 Unbind_Handler
(Interrupt
);
949 elsif Old_Handler
= null then
951 -- Save default handler
953 Bind_Handler
(Interrupt
);
955 end Unprotected_Exchange_Handler
;
957 -- Start of processing for Interrupt_Manager
960 -- By making this task independent of any master, when the process
961 -- goes away, the Interrupt_Manager will terminate gracefully.
963 System
.Tasking
.Utilities
.Make_Independent
;
966 -- A block is needed to absorb Program_Error exception
969 Old_Handler
: Parameterless_Handler
;
973 accept Attach_Handler
974 (New_Handler
: Parameterless_Handler
;
975 Interrupt
: Interrupt_ID
;
977 Restoration
: Boolean := False)
979 Unprotected_Exchange_Handler
980 (Old_Handler
, New_Handler
, Interrupt
, Static
, Restoration
);
984 accept Exchange_Handler
985 (Old_Handler
: out Parameterless_Handler
;
986 New_Handler
: Parameterless_Handler
;
987 Interrupt
: Interrupt_ID
;
990 Unprotected_Exchange_Handler
991 (Old_Handler
, New_Handler
, Interrupt
, Static
);
992 end Exchange_Handler
;
995 accept Detach_Handler
996 (Interrupt
: Interrupt_ID
;
999 Unprotected_Detach_Handler
(Interrupt
, Static
);
1002 accept Bind_Interrupt_To_Entry
1004 E
: Task_Entry_Index
;
1005 Interrupt
: Interrupt_ID
)
1007 -- If there is a binding already (either a procedure or an
1008 -- entry), raise Program_Error (propagate it to the caller).
1010 if User_Handler
(Interrupt
).H
/= null
1011 or else User_Entry
(Interrupt
).T
/= Null_Task
1014 (Program_Error
'Identity,
1015 "A binding for this interrupt is already present");
1018 User_Entry
(Interrupt
) := Entry_Assoc
'(T => T, E => E);
1020 -- Indicate the attachment of interrupt entry in the ATCB.
1021 -- This is needed so when an interrupt entry task terminates
1022 -- the binding can be cleaned. The call to unbinding must be
1023 -- make by the task before it terminates.
1025 T.Interrupt_Entry := True;
1027 -- Invoke a corresponding Server_Task if not yet created.
1028 -- Place Task_Id info in Server_ID array.
1030 if Server_ID (Interrupt) = Null_Task
1032 Ada.Task_Identification.Is_Terminated
1033 (To_Ada (Server_ID (Interrupt)))
1035 Interrupt_Access_Hold := new Interrupt_Server_Task
1036 (Interrupt, semBCreate (SEM_Q_FIFO, SEM_EMPTY));
1037 Server_ID (Interrupt) :=
1038 To_System (Interrupt_Access_Hold.all'Identity);
1041 Bind_Handler (Interrupt);
1042 end Bind_Interrupt_To_Entry;
1045 accept Detach_Interrupt_Entries (T : Task_Id) do
1046 for Int in Interrupt_ID'Range loop
1047 if not Is_Reserved (Int) then
1048 if User_Entry (Int).T = T then
1051 (T
=> Null_Task
, E
=> Null_Task_Entry
);
1052 Unbind_Handler
(Int
);
1057 -- Indicate in ATCB that no interrupt entries are attached
1059 T
.Interrupt_Entry
:= False;
1060 end Detach_Interrupt_Entries
;
1064 -- If there is a Program_Error we just want to propagate it to
1065 -- the caller and do not want to stop this task.
1067 when Program_Error
=>
1071 pragma Assert
(False);
1077 when Standard
'Abort_Signal =>
1078 -- Flush interrupt server semaphores, so they can terminate
1079 Finalize_Interrupt_Servers
;
1081 end Interrupt_Manager
;
1083 ---------------------------
1084 -- Interrupt_Server_Task --
1085 ---------------------------
1087 -- Server task for vectored hardware interrupt handling
1089 task body Interrupt_Server_Task
is
1090 Self_Id
: constant Task_Id
:= Self
;
1091 Tmp_Handler
: Parameterless_Handler
;
1093 Tmp_Entry_Index
: Task_Entry_Index
;
1099 System
.Tasking
.Utilities
.Make_Independent
;
1100 Semaphore_ID_Map
(Interrupt
) := Int_Sema
;
1103 -- Pend on semaphore that will be triggered by the
1104 -- umbrella handler when the associated interrupt comes in
1106 S
:= semTake
(Int_Sema
, WAIT_FOREVER
);
1107 pragma Assert
(S
= 0);
1109 if User_Handler
(Interrupt
).H
/= null then
1111 -- Protected procedure handler
1113 Tmp_Handler
:= User_Handler
(Interrupt
).H
;
1116 elsif User_Entry
(Interrupt
).T
/= Null_Task
then
1118 -- Interrupt entry handler
1120 Tmp_ID
:= User_Entry
(Interrupt
).T
;
1121 Tmp_Entry_Index
:= User_Entry
(Interrupt
).E
;
1122 System
.Tasking
.Rendezvous
.Call_Simple
1123 (Tmp_ID
, Tmp_Entry_Index
, System
.Null_Address
);
1126 -- Semaphore has been flushed by an unbind operation in
1127 -- the Interrupt_Manager. Terminate the server task.
1129 -- Wait for the Interrupt_Manager to complete its work
1131 POP
.Write_Lock
(Self_Id
);
1133 -- Delete the associated semaphore
1135 S
:= semDelete
(Int_Sema
);
1137 pragma Assert
(S
= 0);
1139 -- Set status for the Interrupt_Manager
1141 Semaphore_ID_Map
(Interrupt
) := 0;
1142 Server_ID
(Interrupt
) := Null_Task
;
1143 POP
.Unlock
(Self_Id
);
1148 end Interrupt_Server_Task
;
1151 -- Get Interrupt_Manager's ID so that Abort_Interrupt can be sent
1153 Interrupt_Manager_ID
:= To_System
(Interrupt_Manager
'Identity);
1154 end System
.Interrupts
;