<div dir="auto">What happened to this code?<div dir="auto"><br></div><div dir="auto">Is the BSP install handlers method still being invoked for exceptions?</div></div><div class="gmail_extra"><br><div class="gmail_quote">On Jun 12, 2017 6:22 AM, "Sebastian Huber" <<a href="mailto:sebastian.huber@embedded-brains.de">sebastian.huber@embedded-brains.de</a>> wrote:<br type="attribution"><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex">From: ebotcazou <ebotcazou@138bc75d-0d04-0410-<wbr>961f-82ee72b054a4><br>
<br>
git-svn-id: svn+ssh://<a href="http://gcc.gnu.org/svn/gcc/branches/gcc-7-branch@249116" rel="noreferrer" target="_blank">gcc.gnu.org/svn/gcc/<wbr>branches/gcc-7-branch@249116</a> 138bc75d-0d04-0410-961f-<wbr>82ee72b054a4<br>
---<br>
gcc/ada/ChangeLog | 6 +<br>
gcc/ada/gcc-interface/<wbr>Makefile.in | 2 +-<br>
gcc/ada/s-interr-hwint.adb | 1110 ++++++++++++++++++++++++++++++<wbr>+++++++<br>
3 files changed, 1117 insertions(+), 1 deletion(-)<br>
create mode 100644 gcc/ada/s-interr-hwint.adb<br>
<br>
diff --git a/gcc/ada/gcc-interface/<wbr>Makefile.in b/gcc/ada/gcc-interface/<wbr>Makefile.in<br>
index 2dff5ab36e6..95221cdbe73 100644<br>
--- a/gcc/ada/gcc-interface/<wbr>Makefile.in<br>
+++ b/gcc/ada/gcc-interface/<wbr>Makefile.in<br>
@@ -1736,7 +1736,7 @@ ifeq ($(strip $(filter-out rtems%,$(target_os))),)<br>
s-taspri.ads<s-taspri-posix.<wbr>ads \<br>
s-tpopsp.adb<s-tpopsp-tls.adb \<br>
s-stchop.adb<s-stchop-rtems.<wbr>adb \<br>
- s-interr.adb<s-interr-vxworks.<wbr>adb<br>
+ s-interr.adb<s-interr-hwint.<wbr>adb<br>
endif<br>
<br>
# PikeOS<br>
diff --git a/gcc/ada/s-interr-hwint.adb b/gcc/ada/s-interr-hwint.adb<br>
new file mode 100644<br>
index 00000000000..8e2950f30fb<br>
--- /dev/null<br>
+++ b/gcc/ada/s-interr-hwint.adb<br>
@@ -0,0 +1,1110 @@<br>
+-----------------------------<wbr>------------------------------<wbr>-------------------<br>
+-- --<br>
+-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --<br>
+-- --<br>
+-- S Y S T E M . I N T E R R U P T S --<br>
+-- --<br>
+-- B o d y --<br>
+-- --<br>
+-- Copyright (C) 1992-2014, Free Software Foundation, Inc. --<br>
+-- --<br>
+-- GNARL is free software; you can redistribute it and/or modify it under --<br>
+-- terms of the GNU General Public License as published by the Free Soft- --<br>
+-- ware Foundation; either version 3, or (at your option) any later ver- --<br>
+-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --<br>
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --<br>
+-- or FITNESS FOR A PARTICULAR PURPOSE. --<br>
+-- --<br>
+-- As a special exception under Section 7 of GPL version 3, you are granted --<br>
+-- additional permissions described in the GCC Runtime Library Exception, --<br>
+-- version 3.1, as published by the Free Software Foundation. --<br>
+-- --<br>
+-- You should have received a copy of the GNU General Public License and --<br>
+-- a copy of the GCC Runtime Library Exception along with this program; --<br>
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --<br>
+-- <<a href="http://www.gnu.org/licenses/" rel="noreferrer" target="_blank">http://www.gnu.org/licenses/</a>><wbr>. --<br>
+-- --<br>
+-- GNARL was developed by the GNARL team at Florida State University. --<br>
+-- Extensive contributions were provided by Ada Core Technologies, Inc. --<br>
+-- --<br>
+-----------------------------<wbr>------------------------------<wbr>-------------------<br>
+<br>
+-- Invariants:<br>
+<br>
+-- All user-handlable signals are masked at all times in all tasks/threads<br>
+-- except possibly for the Interrupt_Manager task.<br>
+<br>
+-- When a user task wants to have the effect of masking/unmasking an signal,<br>
+-- it must call Block_Interrupt/Unblock_<wbr>Interrupt, which will have the effect<br>
+-- of unmasking/masking the signal in the Interrupt_Manager task. These<br>
+-- comments do not apply to vectored hardware interrupts, which may be masked<br>
+-- or unmasked using routined interfaced to the relevant embedded RTOS system<br>
+-- calls.<br>
+<br>
+-- Once we associate a Signal_Server_Task with an signal, the task never goes<br>
+-- away, and we never remove the association. On the other hand, it is more<br>
+-- convenient to terminate an associated Interrupt_Server_Task for a vectored<br>
+-- hardware interrupt (since we use a binary semaphore for synchronization<br>
+-- with the umbrella handler).<br>
+<br>
+-- There is no more than one signal per Signal_Server_Task and no more than<br>
+-- one Signal_Server_Task per signal. The same relation holds for hardware<br>
+-- interrupts and Interrupt_Server_Task's at any given time. That is, only<br>
+-- one non-terminated Interrupt_Server_Task exists for a give interrupt at<br>
+-- any time.<br>
+<br>
+-- Within this package, the lock L is used to protect the various status<br>
+-- tables. If there is a Server_Task associated with a signal or interrupt,<br>
+-- we use the per-task lock of the Server_Task instead so that we protect the<br>
+-- status between Interrupt_Manager and Server_Task. Protection among service<br>
+-- requests are ensured via user calls to the Interrupt_Manager entries.<br>
+<br>
+-- This is reasonably generic version of this package, supporting vectored<br>
+-- hardware interrupts using non-RTOS specific adapter routines which should<br>
+-- easily implemented on any RTOS capable of supporting GNAT.<br>
+<br>
+with Ada.Unchecked_Conversion;<br>
+with Ada.Task_Identification;<br>
+<br>
+with Interfaces.C; use Interfaces.C;<br>
+with System.OS_Interface; use System.OS_Interface;<br>
+with System.Interrupt_Management;<br>
+with System.Task_Primitives.<wbr>Operations;<br>
+with System.Storage_Elements;<br>
+with System.Tasking.Utilities;<br>
+<br>
+with System.Tasking.Rendezvous;<br>
+pragma Elaborate_All (System.Tasking.Rendezvous);<br>
+<br>
+package body System.Interrupts is<br>
+<br>
+ use Tasking;<br>
+<br>
+ package POP renames System.Task_Primitives.<wbr>Operations;<br>
+<br>
+ function To_Ada is new Ada.Unchecked_Conversion<br>
+ (System.Tasking.Task_Id, Ada.Task_Identification.Task_<wbr>Id);<br>
+<br>
+ function To_System is new Ada.Unchecked_Conversion<br>
+ (Ada.Task_Identification.Task_<wbr>Id, Task_Id);<br>
+<br>
+ -----------------<br>
+ -- Local Tasks --<br>
+ -----------------<br>
+<br>
+ -- WARNING: System.Tasking.Stages performs calls to this task with low-<br>
+ -- level constructs. Do not change this spec without synchronizing it.<br>
+<br>
+ task Interrupt_Manager is<br>
+ entry Detach_Interrupt_Entries (T : Task_Id);<br>
+<br>
+ entry Attach_Handler<br>
+ (New_Handler : Parameterless_Handler;<br>
+ Interrupt : Interrupt_ID;<br>
+ Static : Boolean;<br>
+ Restoration : Boolean := False);<br>
+<br>
+ entry Exchange_Handler<br>
+ (Old_Handler : out Parameterless_Handler;<br>
+ New_Handler : Parameterless_Handler;<br>
+ Interrupt : Interrupt_ID;<br>
+ Static : Boolean);<br>
+<br>
+ entry Detach_Handler<br>
+ (Interrupt : Interrupt_ID;<br>
+ Static : Boolean);<br>
+<br>
+ entry Bind_Interrupt_To_Entry<br>
+ (T : Task_Id;<br>
+ E : Task_Entry_Index;<br>
+ Interrupt : Interrupt_ID);<br>
+<br>
+ pragma Interrupt_Priority (System.Interrupt_Priority'<wbr>First);<br>
+ end Interrupt_Manager;<br>
+<br>
+ task type Interrupt_Server_Task<br>
+ (Interrupt : Interrupt_ID;<br>
+ Int_Sema : Binary_Semaphore_Id)<br>
+ is<br>
+ -- Server task for vectored hardware interrupt handling<br>
+<br>
+ pragma Interrupt_Priority (System.Interrupt_Priority'<wbr>First + 2);<br>
+ end Interrupt_Server_Task;<br>
+<br>
+ type Interrupt_Task_Access is access Interrupt_Server_Task;<br>
+<br>
+ ------------------------------<wbr>-<br>
+ -- Local Types and Variables --<br>
+ ------------------------------<wbr>-<br>
+<br>
+ type Entry_Assoc is record<br>
+ T : Task_Id;<br>
+ E : Task_Entry_Index;<br>
+ end record;<br>
+<br>
+ type Handler_Assoc is record<br>
+ H : Parameterless_Handler;<br>
+ Static : Boolean; -- Indicates static binding;<br>
+ end record;<br>
+<br>
+ User_Handler : array (Interrupt_ID) of Handler_Assoc :=<br>
+ (others => (null, Static => False));<br>
+ pragma Volatile_Components (User_Handler);<br>
+ -- Holds the protected procedure handler (if any) and its Static<br>
+ -- information for each interrupt or signal. A handler is static iff it<br>
+ -- is specified through the pragma Attach_Handler.<br>
+<br>
+ User_Entry : array (Interrupt_ID) of Entry_Assoc :=<br>
+ (others => (T => Null_Task, E => Null_Task_Entry));<br>
+ pragma Volatile_Components (User_Entry);<br>
+ -- Holds the task and entry index (if any) for each interrupt / signal<br>
+<br>
+ -- Type and Head, Tail of the list containing Registered Interrupt<br>
+ -- Handlers. These definitions are used to register the handlers<br>
+ -- specified by the pragma Interrupt_Handler.<br>
+<br>
+ type Registered_Handler;<br>
+ type R_Link is access all Registered_Handler;<br>
+<br>
+ type Registered_Handler is record<br>
+ H : System.Address := System.Null_Address;<br>
+ Next : R_Link := null;<br>
+ end record;<br>
+<br>
+ Registered_Handler_Head : R_Link := null;<br>
+ Registered_Handler_Tail : R_Link := null;<br>
+<br>
+ Server_ID : array (Interrupt_ID) of System.Tasking.Task_Id :=<br>
+ (others => System.Tasking.Null_Task);<br>
+ pragma Atomic_Components (Server_ID);<br>
+ -- Holds the Task_Id of the Server_Task for each interrupt / signal.<br>
+ -- Task_Id is needed to accomplish locking per interrupt base. Also<br>
+ -- is needed to determine whether to create a new Server_Task.<br>
+<br>
+ Semaphore_ID_Map : array<br>
+ (Interrupt_ID range 0 .. System.OS_Interface.Max_HW_<wbr>Interrupt) of<br>
+ Binary_Semaphore_Id := (others => 0);<br>
+ -- Array of binary semaphores associated with vectored interrupts. Note<br>
+ -- that the last bound should be Max_HW_Interrupt, but this will raise<br>
+ -- Storage_Error if Num_HW_Interrupts is null so use extra 4 bytes instead.<br>
+<br>
+ Interrupt_Access_Hold : Interrupt_Task_Access;<br>
+ -- Variable for allocating an Interrupt_Server_Task<br>
+<br>
+ Handler_Installed : array (HW_Interrupt) of Boolean := (others => False);<br>
+ -- True if Notify_Interrupt was connected to the interrupt. Handlers can<br>
+ -- be connected but disconnection is not possible on VxWorks. Therefore<br>
+ -- we ensure Notify_Installed is connected at most once.<br>
+<br>
+ -----------------------<br>
+ -- Local Subprograms --<br>
+ -----------------------<br>
+<br>
+ procedure Check_Reserved_Interrupt (Interrupt : Interrupt_ID);<br>
+ -- Check if Id is a reserved interrupt, and if so raise Program_Error<br>
+ -- with an appropriate message, otherwise return.<br>
+<br>
+ procedure Finalize_Interrupt_Servers;<br>
+ -- Unbind the handlers for hardware interrupt server tasks at program<br>
+ -- termination.<br>
+<br>
+ function Is_Registered (Handler : Parameterless_Handler) return Boolean;<br>
+ -- See if Handler has been "pragma"ed using Interrupt_Handler.<br>
+ -- Always consider a null handler as registered.<br>
+<br>
+ procedure Notify_Interrupt (Param : System.Address);<br>
+ pragma Convention (C, Notify_Interrupt);<br>
+ -- Umbrella handler for vectored interrupts (not signals)<br>
+<br>
+ procedure Install_Umbrella_Handler<br>
+ (Interrupt : HW_Interrupt;<br>
+ Handler : System.OS_Interface.Interrupt_<wbr>Handler);<br>
+ -- Install the runtime umbrella handler for a vectored hardware<br>
+ -- interrupt<br>
+<br>
+ procedure Unimplemented (Feature : String);<br>
+ pragma No_Return (Unimplemented);<br>
+ -- Used to mark a call to an unimplemented function. Raises Program_Error<br>
+ -- with an appropriate message noting that Feature is unimplemented.<br>
+<br>
+ --------------------<br>
+ -- Attach_Handler --<br>
+ --------------------<br>
+<br>
+ -- Calling this procedure with New_Handler = null and Static = True<br>
+ -- means we want to detach the current handler regardless of the previous<br>
+ -- handler's binding status (i.e. do not care if it is a dynamic or static<br>
+ -- handler).<br>
+<br>
+ -- This option is needed so that during the finalization of a PO, we can<br>
+ -- detach handlers attached through pragma Attach_Handler.<br>
+<br>
+ procedure Attach_Handler<br>
+ (New_Handler : Parameterless_Handler;<br>
+ Interrupt : Interrupt_ID;<br>
+ Static : Boolean := False) is<br>
+ begin<br>
+ Check_Reserved_Interrupt (Interrupt);<br>
+ Interrupt_Manager.Attach_<wbr>Handler (New_Handler, Interrupt, Static);<br>
+ end Attach_Handler;<br>
+<br>
+ -----------------------------<br>
+ -- Bind_Interrupt_To_Entry --<br>
+ -----------------------------<br>
+<br>
+ -- This procedure raises a Program_Error if it tries to<br>
+ -- bind an interrupt to which an Entry or a Procedure is<br>
+ -- already bound.<br>
+<br>
+ procedure Bind_Interrupt_To_Entry<br>
+ (T : Task_Id;<br>
+ E : Task_Entry_Index;<br>
+ Int_Ref : System.Address)<br>
+ is<br>
+ Interrupt : constant Interrupt_ID :=<br>
+ Interrupt_ID (Storage_Elements.To_Integer (Int_Ref));<br>
+ begin<br>
+ Check_Reserved_Interrupt (Interrupt);<br>
+ Interrupt_Manager.Bind_<wbr>Interrupt_To_Entry (T, E, Interrupt);<br>
+ end Bind_Interrupt_To_Entry;<br>
+<br>
+ ---------------------<br>
+ -- Block_Interrupt --<br>
+ ---------------------<br>
+<br>
+ procedure Block_Interrupt (Interrupt : Interrupt_ID) is<br>
+ begin<br>
+ Unimplemented ("Block_Interrupt");<br>
+ end Block_Interrupt;<br>
+<br>
+ ------------------------------<br>
+ -- Check_Reserved_Interrupt --<br>
+ ------------------------------<br>
+<br>
+ procedure Check_Reserved_Interrupt (Interrupt : Interrupt_ID) is<br>
+ begin<br>
+ if Is_Reserved (Interrupt) then<br>
+ raise Program_Error with<br>
+ "interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved";<br>
+ else<br>
+ return;<br>
+ end if;<br>
+ end Check_Reserved_Interrupt;<br>
+<br>
+ ---------------------<br>
+ -- Current_Handler --<br>
+ ---------------------<br>
+<br>
+ function Current_Handler<br>
+ (Interrupt : Interrupt_ID) return Parameterless_Handler<br>
+ is<br>
+ begin<br>
+ Check_Reserved_Interrupt (Interrupt);<br>
+<br>
+ -- ??? Since Parameterless_Handler is not Atomic, the current<br>
+ -- implementation is wrong. We need a new service in Interrupt_Manager<br>
+ -- to ensure atomicity.<br>
+<br>
+ return User_Handler (Interrupt).H;<br>
+ end Current_Handler;<br>
+<br>
+ --------------------<br>
+ -- Detach_Handler --<br>
+ --------------------<br>
+<br>
+ -- Calling this procedure with Static = True means we want to Detach the<br>
+ -- current handler regardless of the previous handler's binding status<br>
+ -- (i.e. do not care if it is a dynamic or static handler).<br>
+<br>
+ -- This option is needed so that during the finalization of a PO, we can<br>
+ -- detach handlers attached through pragma Attach_Handler.<br>
+<br>
+ procedure Detach_Handler<br>
+ (Interrupt : Interrupt_ID;<br>
+ Static : Boolean := False)<br>
+ is<br>
+ begin<br>
+ Check_Reserved_Interrupt (Interrupt);<br>
+ Interrupt_Manager.Detach_<wbr>Handler (Interrupt, Static);<br>
+ end Detach_Handler;<br>
+<br>
+ ------------------------------<br>
+ -- Detach_Interrupt_Entries --<br>
+ ------------------------------<br>
+<br>
+ procedure Detach_Interrupt_Entries (T : Task_Id) is<br>
+ begin<br>
+ Interrupt_Manager.Detach_<wbr>Interrupt_Entries (T);<br>
+ end Detach_Interrupt_Entries;<br>
+<br>
+ ----------------------<br>
+ -- Exchange_Handler --<br>
+ ----------------------<br>
+<br>
+ -- Calling this procedure with New_Handler = null and Static = True<br>
+ -- means we want to detach the current handler regardless of the previous<br>
+ -- handler's binding status (i.e. we do not care if it is a dynamic or<br>
+ -- static handler).<br>
+<br>
+ -- This option is needed so that during the finalization of a PO, we can<br>
+ -- detach handlers attached through pragma Attach_Handler.<br>
+<br>
+ procedure Exchange_Handler<br>
+ (Old_Handler : out Parameterless_Handler;<br>
+ New_Handler : Parameterless_Handler;<br>
+ Interrupt : Interrupt_ID;<br>
+ Static : Boolean := False)<br>
+ is<br>
+ begin<br>
+ Check_Reserved_Interrupt (Interrupt);<br>
+ Interrupt_Manager.Exchange_<wbr>Handler<br>
+ (Old_Handler, New_Handler, Interrupt, Static);<br>
+ end Exchange_Handler;<br>
+<br>
+ --------------<br>
+ -- Finalize --<br>
+ --------------<br>
+<br>
+ procedure Finalize (Object : in out Static_Interrupt_Protection) is<br>
+ begin<br>
+ -- ??? loop to be executed only when we're not doing library level<br>
+ -- finalization, since in this case all interrupt / signal tasks are<br>
+ -- gone.<br>
+<br>
+ if not Interrupt_Manager'Terminated then<br>
+ for N in reverse Object.Previous_Handlers'Range loop<br>
+ Interrupt_Manager.Attach_<wbr>Handler<br>
+ (New_Handler => Object.Previous_Handlers (N).Handler,<br>
+ Interrupt => Object.Previous_Handlers (N).Interrupt,<br>
+ Static => Object.Previous_Handlers (N).Static,<br>
+ Restoration => True);<br>
+ end loop;<br>
+ end if;<br>
+<br>
+ Tasking.Protected_Objects.<wbr>Entries.Finalize<br>
+ (Tasking.Protected_Objects.<wbr>Entries.Protection_Entries (Object));<br>
+ end Finalize;<br>
+<br>
+ ------------------------------<wbr>--<br>
+ -- Finalize_Interrupt_Servers --<br>
+ ------------------------------<wbr>--<br>
+<br>
+ -- Restore default handlers for interrupt servers<br>
+<br>
+ -- This is called by the Interrupt_Manager task when it receives the abort<br>
+ -- signal during program finalization.<br>
+<br>
+ procedure Finalize_Interrupt_Servers is<br>
+ HW_Interrupts : constant Boolean := HW_Interrupt'Last >= 0;<br>
+ begin<br>
+ if HW_Interrupts then<br>
+ for Int in HW_Interrupt loop<br>
+ if Server_ID (Interrupt_ID (Int)) /= null<br>
+ and then<br>
+ not Ada.Task_Identification.Is_<wbr>Terminated<br>
+ (To_Ada (Server_ID (Interrupt_ID (Int))))<br>
+ then<br>
+ Interrupt_Manager.Attach_<wbr>Handler<br>
+ (New_Handler => null,<br>
+ Interrupt => Interrupt_ID (Int),<br>
+ Static => True,<br>
+ Restoration => True);<br>
+ end if;<br>
+ end loop;<br>
+ end if;<br>
+ end Finalize_Interrupt_Servers;<br>
+<br>
+ ------------------------------<wbr>-------<br>
+ -- Has_Interrupt_Or_Attach_<wbr>Handler --<br>
+ ------------------------------<wbr>-------<br>
+<br>
+ function Has_Interrupt_Or_Attach_<wbr>Handler<br>
+ (Object : access Dynamic_Interrupt_Protection)<br>
+ return Boolean<br>
+ is<br>
+ pragma Unreferenced (Object);<br>
+ begin<br>
+ return True;<br>
+ end Has_Interrupt_Or_Attach_<wbr>Handler;<br>
+<br>
+ function Has_Interrupt_Or_Attach_<wbr>Handler<br>
+ (Object : access Static_Interrupt_Protection)<br>
+ return Boolean<br>
+ is<br>
+ pragma Unreferenced (Object);<br>
+ begin<br>
+ return True;<br>
+ end Has_Interrupt_Or_Attach_<wbr>Handler;<br>
+<br>
+ ----------------------<br>
+ -- Ignore_Interrupt --<br>
+ ----------------------<br>
+<br>
+ procedure Ignore_Interrupt (Interrupt : Interrupt_ID) is<br>
+ begin<br>
+ Unimplemented ("Ignore_Interrupt");<br>
+ end Ignore_Interrupt;<br>
+<br>
+ ----------------------<br>
+ -- Install_Handlers --<br>
+ ----------------------<br>
+<br>
+ procedure Install_Handlers<br>
+ (Object : access Static_Interrupt_Protection;<br>
+ New_Handlers : New_Handler_Array)<br>
+ is<br>
+ begin<br>
+ for N in New_Handlers'Range loop<br>
+<br>
+ -- We need a lock around this ???<br>
+<br>
+ Object.Previous_Handlers (N).Interrupt := New_Handlers (N).Interrupt;<br>
+ Object.Previous_Handlers (N).Static := User_Handler<br>
+ (New_Handlers (N).Interrupt).Static;<br>
+<br>
+ -- We call Exchange_Handler and not directly Interrupt_Manager.<br>
+ -- Exchange_Handler so we get the Is_Reserved check.<br>
+<br>
+ Exchange_Handler<br>
+ (Old_Handler => Object.Previous_Handlers (N).Handler,<br>
+ New_Handler => New_Handlers (N).Handler,<br>
+ Interrupt => New_Handlers (N).Interrupt,<br>
+ Static => True);<br>
+ end loop;<br>
+ end Install_Handlers;<br>
+<br>
+ ------------------------------<wbr>---<br>
+ -- Install_Restricted_Handlers --<br>
+ ------------------------------<wbr>---<br>
+<br>
+ procedure Install_Restricted_Handlers<br>
+ (Prio : Any_Priority;<br>
+ Handlers : New_Handler_Array)<br>
+ is<br>
+ pragma Unreferenced (Prio);<br>
+ begin<br>
+ for N in Handlers'Range loop<br>
+ Attach_Handler (Handlers (N).Handler, Handlers (N).Interrupt, True);<br>
+ end loop;<br>
+ end Install_Restricted_Handlers;<br>
+<br>
+ ------------------------------<br>
+ -- Install_Umbrella_Handler --<br>
+ ------------------------------<br>
+<br>
+ procedure Install_Umbrella_Handler<br>
+ (Interrupt : HW_Interrupt;<br>
+ Handler : System.OS_Interface.Interrupt_<wbr>Handler)<br>
+ is<br>
+ Vec : constant Interrupt_Vector :=<br>
+ Interrupt_Number_To_Vector (int (Interrupt));<br>
+<br>
+ Status : int;<br>
+<br>
+ begin<br>
+ -- Only install umbrella handler when no Ada handler has already been<br>
+ -- installed. Note that the interrupt number is passed as a parameter<br>
+ -- when an interrupt occurs, so the umbrella handler has a different<br>
+ -- wrapper generated by intConnect for each interrupt number.<br>
+<br>
+ if not Handler_Installed (Interrupt) then<br>
+ Status :=<br>
+ Interrupt_Connect (Vec, Handler, System.Address (Interrupt));<br>
+ pragma Assert (Status = 0);<br>
+<br>
+ Handler_Installed (Interrupt) := True;<br>
+ end if;<br>
+ end Install_Umbrella_Handler;<br>
+<br>
+ ----------------<br>
+ -- Is_Blocked --<br>
+ ----------------<br>
+<br>
+ function Is_Blocked (Interrupt : Interrupt_ID) return Boolean is<br>
+ begin<br>
+ Unimplemented ("Is_Blocked");<br>
+ return False;<br>
+ end Is_Blocked;<br>
+<br>
+ -----------------------<br>
+ -- Is_Entry_Attached --<br>
+ -----------------------<br>
+<br>
+ function Is_Entry_Attached (Interrupt : Interrupt_ID) return Boolean is<br>
+ begin<br>
+ Check_Reserved_Interrupt (Interrupt);<br>
+ return User_Entry (Interrupt).T /= Null_Task;<br>
+ end Is_Entry_Attached;<br>
+<br>
+ -------------------------<br>
+ -- Is_Handler_Attached --<br>
+ -------------------------<br>
+<br>
+ function Is_Handler_Attached (Interrupt : Interrupt_ID) return Boolean is<br>
+ begin<br>
+ Check_Reserved_Interrupt (Interrupt);<br>
+ return User_Handler (Interrupt).H /= null;<br>
+ end Is_Handler_Attached;<br>
+<br>
+ ----------------<br>
+ -- Is_Ignored --<br>
+ ----------------<br>
+<br>
+ function Is_Ignored (Interrupt : Interrupt_ID) return Boolean is<br>
+ begin<br>
+ Unimplemented ("Is_Ignored");<br>
+ return False;<br>
+ end Is_Ignored;<br>
+<br>
+ -------------------<br>
+ -- Is_Registered --<br>
+ -------------------<br>
+<br>
+ function Is_Registered (Handler : Parameterless_Handler) return Boolean is<br>
+ type Fat_Ptr is record<br>
+ Object_Addr : System.Address;<br>
+ Handler_Addr : System.Address;<br>
+ end record;<br>
+<br>
+ function To_Fat_Ptr is new Ada.Unchecked_Conversion<br>
+ (Parameterless_Handler, Fat_Ptr);<br>
+<br>
+ Ptr : R_Link;<br>
+ Fat : Fat_Ptr;<br>
+<br>
+ begin<br>
+ if Handler = null then<br>
+ return True;<br>
+ end if;<br>
+<br>
+ Fat := To_Fat_Ptr (Handler);<br>
+<br>
+ Ptr := Registered_Handler_Head;<br>
+ while Ptr /= null loop<br>
+ if Ptr.H = Fat.Handler_Addr then<br>
+ return True;<br>
+ end if;<br>
+<br>
+ Ptr := Ptr.Next;<br>
+ end loop;<br>
+<br>
+ return False;<br>
+ end Is_Registered;<br>
+<br>
+ -----------------<br>
+ -- Is_Reserved --<br>
+ -----------------<br>
+<br>
+ function Is_Reserved (Interrupt : Interrupt_ID) return Boolean is<br>
+ use System.Interrupt_Management;<br>
+ begin<br>
+ return Reserve (System.Interrupt_Management.<wbr>Interrupt_ID (Interrupt));<br>
+ end Is_Reserved;<br>
+<br>
+ ----------------------<br>
+ -- Notify_Interrupt --<br>
+ ----------------------<br>
+<br>
+ -- Umbrella handler for vectored hardware interrupts (as opposed to signals<br>
+ -- and exceptions). As opposed to the signal implementation, this handler<br>
+ -- is installed in the vector table when the first Ada handler is attached<br>
+ -- to the interrupt. However because VxWorks don't support disconnecting<br>
+ -- handlers, this subprogram always test whether or not an Ada handler is<br>
+ -- effectively attached.<br>
+<br>
+ -- Otherwise, the handler that existed prior to program startup is in the<br>
+ -- vector table. This ensures that handlers installed by the BSP are active<br>
+ -- unless explicitly replaced in the program text.<br>
+<br>
+ -- Each Interrupt_Server_Task has an associated binary semaphore on which<br>
+ -- it pends once it's been started. This routine determines The appropriate<br>
+ -- semaphore and issues a semGive call, waking the server task. When<br>
+ -- a handler is unbound, System.Interrupts.Unbind_<wbr>Handler issues a<br>
+ -- Binary_Semaphore_Flush, and the server task deletes its semaphore<br>
+ -- and terminates.<br>
+<br>
+ procedure Notify_Interrupt (Param : System.Address) is<br>
+ Interrupt : constant Interrupt_ID := Interrupt_ID (Param);<br>
+ Id : constant Binary_Semaphore_Id := Semaphore_ID_Map (Interrupt);<br>
+ Status : int;<br>
+ begin<br>
+ if Id /= 0 then<br>
+ Status := Binary_Semaphore_Release (Id);<br>
+ pragma Assert (Status = 0);<br>
+ end if;<br>
+ end Notify_Interrupt;<br>
+<br>
+ ---------------<br>
+ -- Reference --<br>
+ ---------------<br>
+<br>
+ function Reference (Interrupt : Interrupt_ID) return System.Address is<br>
+ begin<br>
+ Check_Reserved_Interrupt (Interrupt);<br>
+ return Storage_Elements.To_Address<br>
+ (Storage_Elements.Integer_<wbr>Address (Interrupt));<br>
+ end Reference;<br>
+<br>
+ ------------------------------<wbr>--<br>
+ -- Register_Interrupt_Handler --<br>
+ ------------------------------<wbr>--<br>
+<br>
+ procedure Register_Interrupt_Handler (Handler_Addr : System.Address) is<br>
+ New_Node_Ptr : R_Link;<br>
+<br>
+ begin<br>
+ -- This routine registers a handler as usable for dynamic interrupt<br>
+ -- handler association. Routines attaching and detaching handlers<br>
+ -- dynamically should determine whether the handler is registered.<br>
+ -- Program_Error should be raised if it is not registered.<br>
+<br>
+ -- Pragma Interrupt_Handler can only appear in a library level PO<br>
+ -- definition and instantiation. Therefore, we do not need to implement<br>
+ -- an unregister operation. Nor do we need to protect the queue<br>
+ -- structure with a lock.<br>
+<br>
+ pragma Assert (Handler_Addr /= System.Null_Address);<br>
+<br>
+ New_Node_Ptr := new Registered_Handler;<br>
+ New_Node_Ptr.H := Handler_Addr;<br>
+<br>
+ if Registered_Handler_Head = null then<br>
+ Registered_Handler_Head := New_Node_Ptr;<br>
+ Registered_Handler_Tail := New_Node_Ptr;<br>
+ else<br>
+ Registered_Handler_Tail.Next := New_Node_Ptr;<br>
+ Registered_Handler_Tail := New_Node_Ptr;<br>
+ end if;<br>
+ end Register_Interrupt_Handler;<br>
+<br>
+ -----------------------<br>
+ -- Unblock_Interrupt --<br>
+ -----------------------<br>
+<br>
+ procedure Unblock_Interrupt (Interrupt : Interrupt_ID) is<br>
+ begin<br>
+ Unimplemented ("Unblock_Interrupt");<br>
+ end Unblock_Interrupt;<br>
+<br>
+ ------------------<br>
+ -- Unblocked_By --<br>
+ ------------------<br>
+<br>
+ function Unblocked_By<br>
+ (Interrupt : Interrupt_ID) return System.Tasking.Task_Id<br>
+ is<br>
+ begin<br>
+ Unimplemented ("Unblocked_By");<br>
+ return Null_Task;<br>
+ end Unblocked_By;<br>
+<br>
+ ------------------------<br>
+ -- Unignore_Interrupt --<br>
+ ------------------------<br>
+<br>
+ procedure Unignore_Interrupt (Interrupt : Interrupt_ID) is<br>
+ begin<br>
+ Unimplemented ("Unignore_Interrupt");<br>
+ end Unignore_Interrupt;<br>
+<br>
+ -------------------<br>
+ -- Unimplemented --<br>
+ -------------------<br>
+<br>
+ procedure Unimplemented (Feature : String) is<br>
+ begin<br>
+ raise Program_Error with Feature & " not implemented on VxWorks";<br>
+ end Unimplemented;<br>
+<br>
+ -----------------------<br>
+ -- Interrupt_Manager --<br>
+ -----------------------<br>
+<br>
+ task body Interrupt_Manager is<br>
+ -- By making this task independent of any master, when the process goes<br>
+ -- away, the Interrupt_Manager will terminate gracefully.<br>
+<br>
+ Ignore : constant Boolean := System.Tasking.Utilities.Make_<wbr>Independent;<br>
+ pragma Unreferenced (Ignore);<br>
+<br>
+ --------------------<br>
+ -- Local Routines --<br>
+ --------------------<br>
+<br>
+ procedure Bind_Handler (Interrupt : Interrupt_ID);<br>
+ -- This procedure does not do anything if a signal is blocked.<br>
+ -- Otherwise, we have to interrupt Server_Task for status change<br>
+ -- through a wakeup signal.<br>
+<br>
+ procedure Unbind_Handler (Interrupt : Interrupt_ID);<br>
+ -- This procedure does not do anything if a signal is blocked.<br>
+ -- Otherwise, we have to interrupt Server_Task for status change<br>
+ -- through an abort signal.<br>
+<br>
+ procedure Unprotected_Exchange_Handler<br>
+ (Old_Handler : out Parameterless_Handler;<br>
+ New_Handler : Parameterless_Handler;<br>
+ Interrupt : Interrupt_ID;<br>
+ Static : Boolean;<br>
+ Restoration : Boolean := False);<br>
+<br>
+ procedure Unprotected_Detach_Handler<br>
+ (Interrupt : Interrupt_ID;<br>
+ Static : Boolean);<br>
+<br>
+ ------------------<br>
+ -- Bind_Handler --<br>
+ ------------------<br>
+<br>
+ procedure Bind_Handler (Interrupt : Interrupt_ID) is<br>
+ begin<br>
+ Install_Umbrella_Handler<br>
+ (HW_Interrupt (Interrupt), Notify_Interrupt'Access);<br>
+ end Bind_Handler;<br>
+<br>
+ --------------------<br>
+ -- Unbind_Handler --<br>
+ --------------------<br>
+<br>
+ procedure Unbind_Handler (Interrupt : Interrupt_ID) is<br>
+ Status : int;<br>
+<br>
+ begin<br>
+ -- Flush server task off semaphore, allowing it to terminate<br>
+<br>
+ Status := Binary_Semaphore_Flush (Semaphore_ID_Map (Interrupt));<br>
+ pragma Assert (Status = 0);<br>
+ end Unbind_Handler;<br>
+<br>
+ ------------------------------<wbr>--<br>
+ -- Unprotected_Detach_Handler --<br>
+ ------------------------------<wbr>--<br>
+<br>
+ procedure Unprotected_Detach_Handler<br>
+ (Interrupt : Interrupt_ID;<br>
+ Static : Boolean)<br>
+ is<br>
+ Old_Handler : Parameterless_Handler;<br>
+ begin<br>
+ if User_Entry (Interrupt).T /= Null_Task then<br>
+<br>
+ -- If an interrupt entry is installed raise Program_Error<br>
+ -- (propagate it to the caller).<br>
+<br>
+ raise Program_Error with<br>
+ "an interrupt entry is already installed";<br>
+ end if;<br>
+<br>
+ -- Note : Static = True will pass the following check. This is the<br>
+ -- case when we want to detach a handler regardless of the static<br>
+ -- status of the Current_Handler.<br>
+<br>
+ if not Static and then User_Handler (Interrupt).Static then<br>
+<br>
+ -- Trying to detach a static Interrupt Handler, raise<br>
+ -- Program_Error.<br>
+<br>
+ raise Program_Error with<br>
+ "trying to detach a static Interrupt Handler";<br>
+ end if;<br>
+<br>
+ Old_Handler := User_Handler (Interrupt).H;<br>
+<br>
+ -- The new handler<br>
+<br>
+ User_Handler (Interrupt).H := null;<br>
+ User_Handler (Interrupt).Static := False;<br>
+<br>
+ if Old_Handler /= null then<br>
+ Unbind_Handler (Interrupt);<br>
+ end if;<br>
+ end Unprotected_Detach_Handler;<br>
+<br>
+ ------------------------------<wbr>----<br>
+ -- Unprotected_Exchange_Handler --<br>
+ ------------------------------<wbr>----<br>
+<br>
+ procedure Unprotected_Exchange_Handler<br>
+ (Old_Handler : out Parameterless_Handler;<br>
+ New_Handler : Parameterless_Handler;<br>
+ Interrupt : Interrupt_ID;<br>
+ Static : Boolean;<br>
+ Restoration : Boolean := False)<br>
+ is<br>
+ begin<br>
+ if User_Entry (Interrupt).T /= Null_Task then<br>
+<br>
+ -- If an interrupt entry is already installed, raise<br>
+ -- Program_Error (propagate it to the caller).<br>
+<br>
+ raise Program_Error with "an interrupt is already installed";<br>
+ end if;<br>
+<br>
+ -- Note : A null handler with Static = True will pass the following<br>
+ -- check. This is the case when we want to detach a handler<br>
+ -- regardless of the Static status of Current_Handler.<br>
+<br>
+ -- We don't check anything if Restoration is True, since we may be<br>
+ -- detaching a static handler to restore a dynamic one.<br>
+<br>
+ if not Restoration and then not Static<br>
+ and then (User_Handler (Interrupt).Static<br>
+<br>
+ -- Trying to overwrite a static Interrupt Handler with a dynamic<br>
+ -- Handler<br>
+<br>
+ -- The new handler is not specified as an Interrupt Handler by a<br>
+ -- pragma.<br>
+<br>
+ or else not Is_Registered (New_Handler))<br>
+ then<br>
+ raise Program_Error with<br>
+ "trying to overwrite a static interrupt handler with a "<br>
+ & "dynamic handler";<br>
+ end if;<br>
+<br>
+ -- Save the old handler<br>
+<br>
+ Old_Handler := User_Handler (Interrupt).H;<br>
+<br>
+ -- The new handler<br>
+<br>
+ User_Handler (Interrupt).H := New_Handler;<br>
+<br>
+ if New_Handler = null then<br>
+<br>
+ -- The null handler means we are detaching the handler<br>
+<br>
+ User_Handler (Interrupt).Static := False;<br>
+<br>
+ else<br>
+ User_Handler (Interrupt).Static := Static;<br>
+ end if;<br>
+<br>
+ -- Invoke a corresponding Server_Task if not yet created. Place<br>
+ -- Task_Id info in Server_ID array.<br>
+<br>
+ if New_Handler /= null<br>
+ and then<br>
+ (Server_ID (Interrupt) = Null_Task<br>
+ or else<br>
+ Ada.Task_Identification.Is_<wbr>Terminated<br>
+ (To_Ada (Server_ID (Interrupt))))<br>
+ then<br>
+ Interrupt_Access_Hold :=<br>
+ new Interrupt_Server_Task (Interrupt, Binary_Semaphore_Create);<br>
+ Server_ID (Interrupt) :=<br>
+ To_System (Interrupt_Access_Hold.all'<wbr>Identity);<br>
+ end if;<br>
+<br>
+ if (New_Handler = null) and then Old_Handler /= null then<br>
+<br>
+ -- Restore default handler<br>
+<br>
+ Unbind_Handler (Interrupt);<br>
+<br>
+ elsif Old_Handler = null then<br>
+<br>
+ -- Save default handler<br>
+<br>
+ Bind_Handler (Interrupt);<br>
+ end if;<br>
+ end Unprotected_Exchange_Handler;<br>
+<br>
+ -- Start of processing for Interrupt_Manager<br>
+<br>
+ begin<br>
+ loop<br>
+ -- A block is needed to absorb Program_Error exception<br>
+<br>
+ declare<br>
+ Old_Handler : Parameterless_Handler;<br>
+<br>
+ begin<br>
+ select<br>
+ accept Attach_Handler<br>
+ (New_Handler : Parameterless_Handler;<br>
+ Interrupt : Interrupt_ID;<br>
+ Static : Boolean;<br>
+ Restoration : Boolean := False)<br>
+ do<br>
+ Unprotected_Exchange_Handler<br>
+ (Old_Handler, New_Handler, Interrupt, Static, Restoration);<br>
+ end Attach_Handler;<br>
+<br>
+ or<br>
+ accept Exchange_Handler<br>
+ (Old_Handler : out Parameterless_Handler;<br>
+ New_Handler : Parameterless_Handler;<br>
+ Interrupt : Interrupt_ID;<br>
+ Static : Boolean)<br>
+ do<br>
+ Unprotected_Exchange_Handler<br>
+ (Old_Handler, New_Handler, Interrupt, Static);<br>
+ end Exchange_Handler;<br>
+<br>
+ or<br>
+ accept Detach_Handler<br>
+ (Interrupt : Interrupt_ID;<br>
+ Static : Boolean)<br>
+ do<br>
+ Unprotected_Detach_Handler (Interrupt, Static);<br>
+ end Detach_Handler;<br>
+<br>
+ or<br>
+ accept Bind_Interrupt_To_Entry<br>
+ (T : Task_Id;<br>
+ E : Task_Entry_Index;<br>
+ Interrupt : Interrupt_ID)<br>
+ do<br>
+ -- If there is a binding already (either a procedure or an<br>
+ -- entry), raise Program_Error (propagate it to the caller).<br>
+<br>
+ if User_Handler (Interrupt).H /= null<br>
+ or else User_Entry (Interrupt).T /= Null_Task<br>
+ then<br>
+ raise Program_Error with<br>
+ "a binding for this interrupt is already present";<br>
+ end if;<br>
+<br>
+ User_Entry (Interrupt) := Entry_Assoc'(T => T, E => E);<br>
+<br>
+ -- Indicate the attachment of interrupt entry in the ATCB.<br>
+ -- This is needed so when an interrupt entry task terminates<br>
+ -- the binding can be cleaned. The call to unbinding must be<br>
+ -- make by the task before it terminates.<br>
+<br>
+ T.Interrupt_Entry := True;<br>
+<br>
+ -- Invoke a corresponding Server_Task if not yet created.<br>
+ -- Place Task_Id info in Server_ID array.<br>
+<br>
+ if Server_ID (Interrupt) = Null_Task<br>
+ or else<br>
+ Ada.Task_Identification.Is_<wbr>Terminated<br>
+ (To_Ada (Server_ID (Interrupt)))<br>
+ then<br>
+ Interrupt_Access_Hold := new Interrupt_Server_Task<br>
+ (Interrupt, Binary_Semaphore_Create);<br>
+ Server_ID (Interrupt) :=<br>
+ To_System (Interrupt_Access_Hold.all'<wbr>Identity);<br>
+ end if;<br>
+<br>
+ Bind_Handler (Interrupt);<br>
+ end Bind_Interrupt_To_Entry;<br>
+<br>
+ or<br>
+ accept Detach_Interrupt_Entries (T : Task_Id) do<br>
+ for Int in Interrupt_ID'Range loop<br>
+ if not Is_Reserved (Int) then<br>
+ if User_Entry (Int).T = T then<br>
+ User_Entry (Int) :=<br>
+ Entry_Assoc'<br>
+ (T => Null_Task, E => Null_Task_Entry);<br>
+ Unbind_Handler (Int);<br>
+ end if;<br>
+ end if;<br>
+ end loop;<br>
+<br>
+ -- Indicate in ATCB that no interrupt entries are attached<br>
+<br>
+ T.Interrupt_Entry := False;<br>
+ end Detach_Interrupt_Entries;<br>
+ end select;<br>
+<br>
+ exception<br>
+ -- If there is a Program_Error we just want to propagate it to<br>
+ -- the caller and do not want to stop this task.<br>
+<br>
+ when Program_Error =><br>
+ null;<br>
+<br>
+ when others =><br>
+ pragma Assert (False);<br>
+ null;<br>
+ end;<br>
+ end loop;<br>
+<br>
+ exception<br>
+ when Standard'Abort_Signal =><br>
+<br>
+ -- Flush interrupt server semaphores, so they can terminate<br>
+<br>
+ Finalize_Interrupt_Servers;<br>
+ raise;<br>
+ end Interrupt_Manager;<br>
+<br>
+ ---------------------------<br>
+ -- Interrupt_Server_Task --<br>
+ ---------------------------<br>
+<br>
+ -- Server task for vectored hardware interrupt handling<br>
+<br>
+ task body Interrupt_Server_Task is<br>
+ Ignore : constant Boolean := System.Tasking.Utilities.Make_<wbr>Independent;<br>
+<br>
+ Self_Id : constant Task_Id := Self;<br>
+ Tmp_Handler : Parameterless_Handler;<br>
+ Tmp_ID : Task_Id;<br>
+ Tmp_Entry_Index : Task_Entry_Index;<br>
+ Status : int;<br>
+<br>
+ begin<br>
+ Semaphore_ID_Map (Interrupt) := Int_Sema;<br>
+<br>
+ loop<br>
+ -- Pend on semaphore that will be triggered by the umbrella handler<br>
+ -- when the associated interrupt comes in.<br>
+<br>
+ Status := Binary_Semaphore_Obtain (Int_Sema);<br>
+ pragma Assert (Status = 0);<br>
+<br>
+ if User_Handler (Interrupt).H /= null then<br>
+<br>
+ -- Protected procedure handler<br>
+<br>
+ Tmp_Handler := User_Handler (Interrupt).H;<br>
+ Tmp_Handler.all;<br>
+<br>
+ elsif User_Entry (Interrupt).T /= Null_Task then<br>
+<br>
+ -- Interrupt entry handler<br>
+<br>
+ Tmp_ID := User_Entry (Interrupt).T;<br>
+ Tmp_Entry_Index := User_Entry (Interrupt).E;<br>
+ System.Tasking.Rendezvous.<wbr>Call_Simple<br>
+ (Tmp_ID, Tmp_Entry_Index, System.Null_Address);<br>
+<br>
+ else<br>
+ -- Semaphore has been flushed by an unbind operation in the<br>
+ -- Interrupt_Manager. Terminate the server task.<br>
+<br>
+ -- Wait for the Interrupt_Manager to complete its work<br>
+<br>
+ POP.Write_Lock (Self_Id);<br>
+<br>
+ -- Unassociate the interrupt handler<br>
+<br>
+ Semaphore_ID_Map (Interrupt) := 0;<br>
+<br>
+ -- Delete the associated semaphore<br>
+<br>
+ Status := Binary_Semaphore_Delete (Int_Sema);<br>
+<br>
+ pragma Assert (Status = 0);<br>
+<br>
+ -- Set status for the Interrupt_Manager<br>
+<br>
+ Server_ID (Interrupt) := Null_Task;<br>
+ POP.Unlock (Self_Id);<br>
+<br>
+ exit;<br>
+ end if;<br>
+ end loop;<br>
+ end Interrupt_Server_Task;<br>
+<br>
+begin<br>
+ -- Get Interrupt_Manager's ID so that Abort_Interrupt can be sent<br>
+<br>
+ Interrupt_Manager_ID := To_System (Interrupt_Manager'Identity);<br>
+end System.Interrupts;<br>
--<br>
2.12.3<br>
<br>
<br>
<br>
______________________________<wbr>_________________<br>
devel mailing list<br>
<a href="mailto:devel@rtems.org">devel@rtems.org</a><br>
<a href="http://lists.rtems.org/mailman/listinfo/devel" rel="noreferrer" target="_blank">http://lists.rtems.org/<wbr>mailman/listinfo/devel</a><br>
</blockquote></div></div>