summaryrefslogtreecommitdiff
path: root/gcc/ada/s-interr-vxworks.adb
diff options
context:
space:
mode:
authorArnaud Charlet <charlet@act-europe.fr>2004-05-14 12:02:00 +0200
committerArnaud Charlet <charlet@gcc.gnu.org>2004-05-14 12:02:00 +0200
commit084c663c9911a6649407b9956d9d2d59499cd03c (patch)
treead67eadab2c2032169ff2f33eb289b29a4e7e3a9 /gcc/ada/s-interr-vxworks.adb
parent02ea8d06bf236a38614eb0c88944e87df3b373f3 (diff)
downloadgcc-084c663c9911a6649407b9956d9d2d59499cd03c.tar.gz
Renaming of target specific files for clarity
* Makefile.in: Rename GNAT target specific files. * 31soccon.ads, 31soliop.ads 35soccon.ads, 3asoccon.ads, 3bsoccon.ads, 3gsoccon.ads, 3hsoccon.ads, 3psoccon.ads, 3ssoccon.ads, 3ssoliop.ads, 3veacodu.adb, 3vexpect.adb, 3vsoccon.ads, 3vsocthi.adb, 3vsocthi.ads, 3vtrasym.adb, 3wsoccon.ads, 3wsocthi.adb, 3wsocthi.ads, 3wsoliop.ads, 3zsoccon.ads, 3zsocthi.adb, 3zsocthi.ads, 41intnam.ads, 42intnam.ads, 45intnam.ads, 4aintnam.ads, 4cintnam.ads, 4gintnam.ads, 4hexcpol.adb, 4hintnam.ads, 4lintnam.ads, 4nintnam.ads, 4ointnam.ads, 4onumaux.ads, 4pintnam.ads, 4sintnam.ads, 4vcaldel.adb, 4vcalend.adb, 4vcalend.ads, 4vintnam.ads, 4wcalend.adb, 4wexcpol.adb, 4wintnam.ads, 4zintnam.ads, 4znumaux.ads, 4zsytaco.adb, 4zsytaco.ads, 51osinte.adb, 51osinte.ads, 51system.ads, 52osinte.adb, 52osinte.ads, 53osinte.ads, 54osinte.ads, 55osinte.adb, 55osinte.ads, 55system.ads, 56osinte.adb, 56osinte.ads, 56system.ads, 56taprop.adb, 56taspri.ads, 56tpopsp.adb, 57system.ads, 58system.ads, 5amastop.adb, 5aml-tgt.adb, 5aosinte.adb, 5aosinte.ads, 5asystem.ads, 5ataprop.adb, 5atasinf.ads, 5ataspri.ads, 5atpopsp.adb, 5avxwork.ads, 5bml-tgt.adb, 5bosinte.adb, 5bosinte.ads, 5bsystem.ads, 5cosinte.ads, 5csystem.ads, 5dsystem.ads, 5esystem.ads, 5fintman.adb, 5fosinte.adb, 5fosinte.ads, 5fsystem.ads, 5ftaprop.adb, 5ftasinf.ads, 5ginterr.adb, 5gintman.adb, 5gmastop.adb, 5gml-tgt.adb, 5gosinte.ads, 5gproinf.adb, 5gproinf.ads, 5gsystem.ads, 5gtaprop.adb, 5gtasinf.adb, 5gtasinf.ads, 5gtpgetc.adb, 5hml-tgt.adb, 5hosinte.adb, 5hosinte.ads, 5hparame.ads, 5hsystem.ads, 5htaprop.adb, 5htaspri.ads, 5htraceb.adb, 5iosinte.adb, 5iosinte.ads, 5itaprop.adb, 5itaspri.ads, 5ksystem.ads, 5kvxwork.ads, 5lml-tgt.adb, 5losinte.ads, 5lparame.adb, 5lsystem.ads, 5msystem.ads, 5mvxwork.ads, 5ninmaop.adb, 5nintman.adb, 5nosinte.ads, 5nsystem.ads, 5ntaprop.adb, 5ntaspri.ads, 5ointerr.adb, 5omastop.adb, 5oosinte.adb, 5oosinte.ads, 5oosprim.adb, 5oparame.adb, 5osystem.ads, 5otaprop.adb, 5otaspri.ads, 5posinte.ads, 5posprim.adb, 5psystem.ads, 5pvxwork.ads, 5sintman.adb, 5sml-tgt.adb, 5sosinte.adb, 5sosinte.ads, 5sosprim.adb, 5sparame.adb, 5ssystem.ads, 5staprop.adb, 5stasinf.adb, 5stasinf.ads, 5staspri.ads, 5stpopsp.adb, 5svxwork.ads, 5tosinte.ads, 5usystem.ads, 5vasthan.adb, 5vdirval.adb, 5vinmaop.adb, 5vinterr.adb, 5vintman.adb, 5vintman.ads, 5vmastop.adb, 5vml-tgt.adb, 5vosinte.adb, 5vosinte.ads, 5vosprim.adb, 5vosprim.ads, 5vparame.ads, 5vsymbol.adb, 5vsystem.ads, 5vtaprop.adb, 5vtaspri.ads, 5vtpopde.adb, 5vtpopde.ads, 5vtraent.adb, 5vtraent.ads, 5vvaflop.adb, 5wdirval.adb, 5wgloloc.adb, 5wintman.adb, 5wmemory.adb, 5wml-tgt.adb, 5wosinte.ads, 5wosprim.adb, 5wsystem.ads, 5wtaprop.adb, 5wtaspri.ads, 5xparame.ads, 5xsystem.ads, 5xvxwork.ads, 5yparame.ads, 5ysystem.ads, 5zinterr.adb, 5zintman.adb, 5zintman.ads, 5zml-tgt.adb, 5zosinte.adb, 5zosinte.ads, 5zosprim.adb, 5zparame.ads, 5zstchop.adb, 5zsystem.ads, 5ztaprop.adb, 5ztaspri.ads, 5ztfsetr.adb, 5ztpopsp.adb, 6vcpp.adb, 6vcstrea.adb, 6vinterf.ads, 7sinmaop.adb, 7sintman.adb, 7sosinte.adb, 7sosprim.adb, 7staprop.adb, 7staspri.ads, 7stfsetr.adb, 7stpopsp.adb, 7straceb.adb, 7straces.adb, 7strafor.adb, 7strafor.ads, 7stratas.adb, 86numaux.adb, 86numaux.ads: Replaced by files below. * a-caldel-vms.adb, a-calend-mingw.adb, a-calend-vms.adb, a-calend-vms.ads, a-dirval-mingw.adb, a-dirval-vms.adb, a-excpol-abort.adb, a-excpol-interix.adb, a-intnam-aix.ads, a-intnam-dummy.ads, a-intnam-freebsd.ads, a-intnam-hpux.ads, a-intnam-interix.ads, a-intnam-irix.ads, a-intnam-linux.ads, a-intnam-lynxos.ads, a-intnam-mingw.ads, a-intnam-os2.ads, a-intnam-solaris.ads, a-intnam-tru64.ads, a-intnam-unixware.ads, a-intnam-vms.ads, a-intnam-vxworks.ads, a-numaux-libc-x86.ads, a-numaux-vxworks.ads, a-numaux-x86.adb, a-numaux-x86.ads, a-sytaco-vxworks.adb, a-sytaco-vxworks.ads, g-eacodu-vms.adb, g-expect-vms.adb, g-soccon-aix.ads, g-soccon-freebsd.ads, g-soccon-hpux.ads, g-soccon-interix.ads, g-soccon-irix.ads, g-soccon-mingw.ads, g-soccon-solaris.ads, g-soccon-tru64.ads, g-soccon-unixware.ads, g-soccon-vms.adb, g-soccon-vxworks.ads, g-socthi-mingw.adb, g-socthi-mingw.ads, g-socthi-vms.adb, g-socthi-vms.ads, g-socthi-vxworks.adb, g-socthi-vxworks.ads, g-soliop-mingw.ads, g-soliop-solaris.ads, g-soliop-unixware.ads, g-trasym-vms.adb, i-cpp-vms.adb, i-cstrea-vms.adb, interfac-vms.ads, mlib-tgt-aix.adb, mlib-tgt-hpux.adb, mlib-tgt-irix.adb, mlib-tgt-linux.adb, mlib-tgt-mingw.adb, mlib-tgt-solaris.adb, mlib-tgt-tru64.adb, mlib-tgt-vms.adb, mlib-tgt-vxworks.adb, s-asthan-vms.adb, s-gloloc-mingw.adb, s-inmaop-dummy.adb, s-inmaop-posix.adb, s-inmaop-vms.adb, s-interr-dummy.adb, s-interr-sigaction.adb, s-interr-vms.adb, s-interr-vxworks.adb, s-intman-dummy.adb, s-intman-irix.adb, s-intman-irix-athread.adb, s-intman-mingw.adb, s-intman-posix.adb, s-intman-solaris.adb, s-intman-vms.adb, s-intman-vms.ads, s-intman-vxworks.adb, s-intman-vxworks.ads, s-mastop-irix.adb, s-mastop-tru64.adb, s-mastop-vms.adb, s-mastop-x86.adb, s-memory-mingw.adb, s-osinte-aix.adb, s-osinte-aix.ads, s-osinte-aix-fsu.ads, s-osinte-dummy.ads, s-osinte-freebsd.adb, s-osinte-freebsd.ads, s-osinte-fsu.adb, s-osinte-hpux.ads, s-osinte-hpux-dce.adb, s-osinte-hpux-dce.ads, s-osinte-interix.ads, s-osinte-irix.adb, s-osinte-irix.ads, s-osinte-irix-athread.ads, s-osinte-linux.ads, s-osinte-linux-fsu.ads, s-osinte-linux-ia64.ads, s-osinte-lynxos-3.adb, s-osinte-lynxos-3.ads, s-osinte-lynxos.adb, s-osinte-lynxos.ads, s-osinte-mingw.ads, s-osinte-os2.adb, s-osinte-os2.ads, s-osinte-posix.adb, s-osinte-solaris.adb, s-osinte-solaris.ads, s-osinte-solaris-fsu.ads, s-osinte-solaris-posix.ads, s-osinte-tru64.adb, s-osinte-tru64.ads, s-osinte-unixware.adb, s-osinte-unixware.ads, s-osinte-vms.adb, s-osinte-vms.ads, s-osinte-vxworks.adb, s-osinte-vxworks.ads, s-osprim-mingw.adb, s-osprim-os2.adb, s-osprim-posix.adb, s-osprim-solaris.adb, s-osprim-unix.adb, s-osprim-vms.adb, s-osprim-vms.ads, s-osprim-vxworks.adb, s-parame-ae653.ads, s-parame-hpux.ads, s-parame-linux.adb, s-parame-os2.adb, s-parame-solaris.adb, s-parame-vms.ads, s-parame-vms-restrict.ads, s-parame-vxworks.ads, s-proinf-irix-athread.adb, s-proinf-irix-athread.ads, s-stchop-vxworks.adb, s-taprop-dummy.adb, s-taprop-hpux-dce.adb, s-taprop-irix.adb, s-taprop-irix-athread.adb, s-taprop-linux.adb, s-taprop-lynxos.adb, s-taprop-mingw.adb, s-taprop-os2.adb, s-taprop-posix.adb, s-taprop-solaris.adb, s-taprop-tru64.adb, s-taprop-vms.adb, s-taprop-vxworks.adb, s-tasinf-irix.ads, s-tasinf-irix-athread.adb, s-tasinf-irix-athread.ads, s-tasinf-solaris.adb, s-tasinf-solaris.ads, s-tasinf-tru64.ads, s-taspri-dummy.ads, s-taspri-hpux-dce.ads, s-taspri-linux.ads, s-taspri-lynxos.ads, s-taspri-mingw.ads, s-taspri-os2.ads, s-taspri-posix.ads, s-taspri-solaris.ads, s-taspri-tru64.ads, s-taspri-vms.ads, s-taspri-vxworks.ads, s-tfsetr-default.adb, s-tfsetr-vxworks.adb, s-tpopde-vms.adb, s-tpopde-vms.ads, s-tpopsp-lynxos.adb, s-tpopsp-posix.adb, s-tpopsp-posix-foreign.adb, s-tpopsp-solaris.adb, s-tpopsp-vxworks.adb, s-traceb-hpux.adb, s-traceb-mastop.adb, s-traces-default.adb, s-traent-vms.adb, s-traent-vms.ads, s-trafor-default.adb, s-trafor-default.ads, s-tratas-default.adb, s-vaflop-vms.adb, s-vxwork-alpha.ads, s-vxwork-m68k.ads, s-vxwork-mips.ads, s-vxwork-ppc.ads, s-vxwork-sparcv9.ads, s-vxwork-xscale.ads, symbols-vms.adb, system-aix.ads, system-freebsd-x86.ads, system-hpux.ads, system-interix.ads, system-irix-n32.ads, system-irix-o32.ads, system-linux-x86_64.ads, system-linux-x86.ads, system-lynxos-ppc.ads, system-lynxos-x86.ads, system-mingw.ads, system-os2.ads, system-solaris-sparc.ads, system-solaris-sparcv9.ads, system-solaris-x86.ads, system-tru64.ads, system-unixware.ads, system-vms.ads, system-vms-zcx.ads, system-vxworks-alpha.ads, system-vxworks-m68k.ads, system-vxworks-mips.ads, system-vxworks-ppc.ads, system-vxworks-sparcv9.ads, system-vxworks-xscale.ads: Replace files above. From-SVN: r81834
Diffstat (limited to 'gcc/ada/s-interr-vxworks.adb')
-rw-r--r--gcc/ada/s-interr-vxworks.adb1146
1 files changed, 1146 insertions, 0 deletions
diff --git a/gcc/ada/s-interr-vxworks.adb b/gcc/ada/s-interr-vxworks.adb
new file mode 100644
index 00000000000..5898e6d7e26
--- /dev/null
+++ b/gcc/ada/s-interr-vxworks.adb
@@ -0,0 +1,1146 @@
+------------------------------------------------------------------------------
+-- --
+-- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS --
+-- --
+-- S Y S T E M . I N T E R R U P T S --
+-- --
+-- B o d y --
+-- --
+-- Copyright (C) 1992-2004, Free Software Foundation, Inc. --
+-- --
+-- GNARL is free software; you can redistribute it and/or modify it under --
+-- terms of the GNU General Public License as published by the Free Soft- --
+-- ware Foundation; either version 2, or (at your option) any later ver- --
+-- sion. GNARL is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
+-- for more details. You should have received a copy of the GNU General --
+-- Public License distributed with GNARL; see file COPYING. If not, write --
+-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
+-- MA 02111-1307, USA. --
+-- --
+-- As a special exception, if other files instantiate generics from this --
+-- unit, or you link this unit with other files to produce an executable, --
+-- this unit does not by itself cause the resulting executable to be --
+-- covered by the GNU General Public License. This exception does not --
+-- however invalidate any other reasons why the executable file might be --
+-- covered by the GNU Public License. --
+-- --
+-- GNARL was developed by the GNARL team at Florida State University. --
+-- Extensive contributions were provided by Ada Core Technologies, Inc. --
+-- --
+------------------------------------------------------------------------------
+
+-- Invariants:
+
+-- All user-handleable signals are masked at all times in all
+-- tasks/threads except possibly for the Interrupt_Manager task.
+
+-- When a user task wants to have the effect of masking/unmasking an
+-- signal, it must call Block_Interrupt/Unblock_Interrupt, which
+-- will have the effect of unmasking/masking the signal in the
+-- Interrupt_Manager task. These comments do not apply to vectored
+-- hardware interrupts, which may be masked or unmasked using routined
+-- interfaced to the relevant VxWorks system calls.
+
+-- Once we associate a Signal_Server_Task with an signal, the task never
+-- goes away, and we never remove the association. On the other hand, it
+-- is more convenient to terminate an associated Interrupt_Server_Task
+-- for a vectored hardware interrupt (since we use a binary semaphore
+-- for synchronization with the umbrella handler).
+
+-- There is no more than one signal per Signal_Server_Task and no more than
+-- one Signal_Server_Task per signal. The same relation holds for hardware
+-- interrupts and Interrupt_Server_Task's at any given time. That is,
+-- only one non-terminated Interrupt_Server_Task exists for a give
+-- interrupt at any time.
+
+-- Within this package, the lock L is used to protect the various status
+-- tables. If there is a Server_Task associated with a signal or interrupt,
+-- we use the per-task lock of the Server_Task instead so that we protect the
+-- status between Interrupt_Manager and Server_Task. Protection among
+-- service requests are ensured via user calls to the Interrupt_Manager
+-- entries.
+
+-- This is the VxWorks version of this package, supporting vectored hardware
+-- interrupts.
+
+with Unchecked_Conversion;
+
+with System.OS_Interface; use System.OS_Interface;
+
+with Interfaces.VxWorks;
+
+with Ada.Task_Identification;
+-- used for Task_ID type
+
+with Ada.Exceptions;
+-- used for Raise_Exception
+
+with System.Interrupt_Management;
+-- used for Reserve
+
+with System.Task_Primitives.Operations;
+-- used for Write_Lock
+-- Unlock
+-- Abort
+-- Wakeup_Task
+-- Sleep
+-- Initialize_Lock
+
+with System.Storage_Elements;
+-- used for To_Address
+-- To_Integer
+-- Integer_Address
+
+with System.Tasking;
+-- used for Task_ID
+-- Task_Entry_Index
+-- Null_Task
+-- Self
+-- Interrupt_Manager_ID
+
+with System.Tasking.Utilities;
+-- used for Make_Independent
+
+with System.Tasking.Rendezvous;
+-- used for Call_Simple
+pragma Elaborate_All (System.Tasking.Rendezvous);
+
+package body System.Interrupts is
+
+ use Tasking;
+ use Ada.Exceptions;
+
+ package POP renames System.Task_Primitives.Operations;
+
+ function To_Ada is new Unchecked_Conversion
+ (System.Tasking.Task_ID, Ada.Task_Identification.Task_Id);
+
+ function To_System is new Unchecked_Conversion
+ (Ada.Task_Identification.Task_Id, Task_ID);
+
+ -----------------
+ -- Local Tasks --
+ -----------------
+
+ -- WARNING: System.Tasking.Stages performs calls to this task
+ -- with low-level constructs. Do not change this spec without synchro-
+ -- nizing it.
+
+ task Interrupt_Manager is
+ entry Detach_Interrupt_Entries (T : Task_ID);
+
+ entry Attach_Handler
+ (New_Handler : Parameterless_Handler;
+ Interrupt : Interrupt_ID;
+ Static : Boolean;
+ Restoration : Boolean := False);
+
+ entry Exchange_Handler
+ (Old_Handler : out Parameterless_Handler;
+ New_Handler : Parameterless_Handler;
+ Interrupt : Interrupt_ID;
+ Static : Boolean);
+
+ entry Detach_Handler
+ (Interrupt : Interrupt_ID;
+ Static : Boolean);
+
+ entry Bind_Interrupt_To_Entry
+ (T : Task_ID;
+ E : Task_Entry_Index;
+ Interrupt : Interrupt_ID);
+
+ pragma Interrupt_Priority (System.Interrupt_Priority'First);
+ end Interrupt_Manager;
+
+ task type Interrupt_Server_Task
+ (Interrupt : Interrupt_ID; Int_Sema : SEM_ID) is
+ -- Server task for vectored hardware interrupt handling
+ pragma Interrupt_Priority (System.Interrupt_Priority'First + 2);
+ end Interrupt_Server_Task;
+
+ type Interrupt_Task_Access is access Interrupt_Server_Task;
+
+ -------------------------------
+ -- Local Types and Variables --
+ -------------------------------
+
+ type Entry_Assoc is record
+ T : Task_ID;
+ E : Task_Entry_Index;
+ end record;
+
+ type Handler_Assoc is record
+ H : Parameterless_Handler;
+ Static : Boolean; -- Indicates static binding;
+ end record;
+
+ User_Handler : array (Interrupt_ID) of Handler_Assoc :=
+ (others => (null, Static => False));
+ pragma Volatile_Components (User_Handler);
+ -- Holds the protected procedure handler (if any) and its Static
+ -- information for each interrupt or signal. A handler is static
+ -- iff it is specified through the pragma Attach_Handler.
+
+ User_Entry : array (Interrupt_ID) of Entry_Assoc :=
+ (others => (T => Null_Task, E => Null_Task_Entry));
+ pragma Volatile_Components (User_Entry);
+ -- Holds the task and entry index (if any) for each interrupt / signal
+
+ -- Type and Head, Tail of the list containing Registered Interrupt
+ -- Handlers. These definitions are used to register the handlers
+ -- specified by the pragma Interrupt_Handler.
+
+ type Registered_Handler;
+ type R_Link is access all Registered_Handler;
+
+ type Registered_Handler is record
+ H : System.Address := System.Null_Address;
+ Next : R_Link := null;
+ end record;
+
+ Registered_Handler_Head : R_Link := null;
+ Registered_Handler_Tail : R_Link := null;
+
+ Server_ID : array (Interrupt_ID) of System.Tasking.Task_ID :=
+ (others => System.Tasking.Null_Task);
+ pragma Atomic_Components (Server_ID);
+ -- Holds the Task_ID of the Server_Task for each interrupt / signal.
+ -- Task_ID is needed to accomplish locking per interrupt base. Also
+ -- is needed to determine whether to create a new Server_Task.
+
+ Semaphore_ID_Map : array
+ (Interrupt_ID range 0 .. System.OS_Interface.Max_HW_Interrupt)
+ of SEM_ID := (others => 0);
+ -- Array of binary semaphores associated with vectored interrupts
+ -- Note that the last bound should be Max_HW_Interrupt, but this will raise
+ -- Storage_Error if Num_HW_Interrupts is null, so use an extra 4 bytes
+ -- instead.
+
+ Interrupt_Access_Hold : Interrupt_Task_Access;
+ -- Variable for allocating an Interrupt_Server_Task
+
+ Default_Handler : array (HW_Interrupt) of Interfaces.VxWorks.VOIDFUNCPTR;
+ -- Vectored interrupt handlers installed prior to program startup.
+ -- These are saved only when the umbrella handler is installed for
+ -- a given interrupt number.
+
+ -----------------------
+ -- Local Subprograms --
+ -----------------------
+
+ procedure Check_Reserved_Interrupt (Interrupt : Interrupt_ID);
+ -- Check if Id is a reserved interrupt, and if so raise Program_Error
+ -- with an appropriate message, otherwise return.
+
+ procedure Finalize_Interrupt_Servers;
+ -- Unbind the handlers for hardware interrupt server tasks at program
+ -- termination.
+
+ function Is_Registered (Handler : Parameterless_Handler) return Boolean;
+ -- See if Handler has been "pragma"ed using Interrupt_Handler.
+ -- Always consider a null handler as registered.
+
+ procedure Notify_Interrupt (Param : System.Address);
+ -- Umbrella handler for vectored interrupts (not signals)
+
+ procedure Install_Default_Action (Interrupt : HW_Interrupt);
+ -- Restore a handler that was in place prior to program execution
+
+ procedure Install_Umbrella_Handler
+ (Interrupt : HW_Interrupt;
+ Handler : Interfaces.VxWorks.VOIDFUNCPTR);
+ -- Install the runtime umbrella handler for a vectored hardware
+ -- interrupt
+
+ procedure Unimplemented (Feature : String);
+ pragma No_Return (Unimplemented);
+ -- Used to mark a call to an unimplemented function. Raises Program_Error
+ -- with an appropriate message noting that Feature is unimplemented.
+
+ --------------------
+ -- Attach_Handler --
+ --------------------
+
+ -- Calling this procedure with New_Handler = null and Static = True
+ -- means we want to detach the current handler regardless of the
+ -- previous handler's binding status (ie. do not care if it is a
+ -- dynamic or static handler).
+
+ -- This option is needed so that during the finalization of a PO, we
+ -- can detach handlers attached through pragma Attach_Handler.
+
+ procedure Attach_Handler
+ (New_Handler : Parameterless_Handler;
+ Interrupt : Interrupt_ID;
+ Static : Boolean := False) is
+ begin
+ Check_Reserved_Interrupt (Interrupt);
+ Interrupt_Manager.Attach_Handler (New_Handler, Interrupt, Static);
+ end Attach_Handler;
+
+ -----------------------------
+ -- Bind_Interrupt_To_Entry --
+ -----------------------------
+
+ -- This procedure raises a Program_Error if it tries to
+ -- bind an interrupt to which an Entry or a Procedure is
+ -- already bound.
+
+ procedure Bind_Interrupt_To_Entry
+ (T : Task_ID;
+ E : Task_Entry_Index;
+ Int_Ref : System.Address)
+ is
+ Interrupt : constant Interrupt_ID :=
+ Interrupt_ID (Storage_Elements.To_Integer (Int_Ref));
+
+ begin
+ Check_Reserved_Interrupt (Interrupt);
+ Interrupt_Manager.Bind_Interrupt_To_Entry (T, E, Interrupt);
+ end Bind_Interrupt_To_Entry;
+
+ ---------------------
+ -- Block_Interrupt --
+ ---------------------
+
+ procedure Block_Interrupt (Interrupt : Interrupt_ID) is
+ begin
+ Unimplemented ("Block_Interrupt");
+ end Block_Interrupt;
+
+ ------------------------------
+ -- Check_Reserved_Interrupt --
+ ------------------------------
+
+ procedure Check_Reserved_Interrupt (Interrupt : Interrupt_ID) is
+ begin
+ if Is_Reserved (Interrupt) then
+ Raise_Exception
+ (Program_Error'Identity,
+ "Interrupt" & Interrupt_ID'Image (Interrupt) & " is reserved");
+ else
+ return;
+ end if;
+ end Check_Reserved_Interrupt;
+
+ ---------------------
+ -- Current_Handler --
+ ---------------------
+
+ function Current_Handler
+ (Interrupt : Interrupt_ID) return Parameterless_Handler is
+ begin
+ Check_Reserved_Interrupt (Interrupt);
+
+ -- ??? Since Parameterless_Handler is not Atomic, the
+ -- current implementation is wrong. We need a new service in
+ -- Interrupt_Manager to ensure atomicity.
+
+ return User_Handler (Interrupt).H;
+ end Current_Handler;
+
+ --------------------
+ -- Detach_Handler --
+ --------------------
+
+ -- Calling this procedure with Static = True means we want to Detach the
+ -- current handler regardless of the previous handler's binding status
+ -- (i.e. do not care if it is a dynamic or static handler).
+
+ -- This option is needed so that during the finalization of a PO, we can
+ -- detach handlers attached through pragma Attach_Handler.
+
+ procedure Detach_Handler
+ (Interrupt : Interrupt_ID;
+ Static : Boolean := False) is
+ begin
+ Check_Reserved_Interrupt (Interrupt);
+ Interrupt_Manager.Detach_Handler (Interrupt, Static);
+ end Detach_Handler;
+
+ ------------------------------
+ -- Detach_Interrupt_Entries --
+ ------------------------------
+
+ procedure Detach_Interrupt_Entries (T : Task_ID) is
+ begin
+ Interrupt_Manager.Detach_Interrupt_Entries (T);
+ end Detach_Interrupt_Entries;
+
+ ----------------------
+ -- Exchange_Handler --
+ ----------------------
+
+ -- Calling this procedure with New_Handler = null and Static = True
+ -- means we want to detach the current handler regardless of the
+ -- previous handler's binding status (ie. do not care if it is a
+ -- dynamic or static handler).
+
+ -- This option is needed so that during the finalization of a PO, we
+ -- can detach handlers attached through pragma Attach_Handler.
+
+ procedure Exchange_Handler
+ (Old_Handler : out Parameterless_Handler;
+ New_Handler : Parameterless_Handler;
+ Interrupt : Interrupt_ID;
+ Static : Boolean := False) is
+ begin
+ Check_Reserved_Interrupt (Interrupt);
+ Interrupt_Manager.Exchange_Handler
+ (Old_Handler, New_Handler, Interrupt, Static);
+ end Exchange_Handler;
+
+ --------------
+ -- Finalize --
+ --------------
+
+ procedure Finalize (Object : in out Static_Interrupt_Protection) is
+ begin
+ -- ??? loop to be executed only when we're not doing library level
+ -- finalization, since in this case all interrupt / signal tasks are
+ -- gone.
+
+ if not Interrupt_Manager'Terminated then
+ for N in reverse Object.Previous_Handlers'Range loop
+ Interrupt_Manager.Attach_Handler
+ (New_Handler => Object.Previous_Handlers (N).Handler,
+ Interrupt => Object.Previous_Handlers (N).Interrupt,
+ Static => Object.Previous_Handlers (N).Static,
+ Restoration => True);
+ end loop;
+ end if;
+
+ Tasking.Protected_Objects.Entries.Finalize
+ (Tasking.Protected_Objects.Entries.Protection_Entries (Object));
+ end Finalize;
+
+ --------------------------------
+ -- Finalize_Interrupt_Servers --
+ --------------------------------
+
+ -- Restore default handlers for interrupt servers.
+
+ -- This is called by the Interrupt_Manager task when it receives the abort
+ -- signal during program finalization.
+
+ procedure Finalize_Interrupt_Servers is
+ HW_Interrupts : constant Boolean := HW_Interrupt'Last >= 0;
+
+ begin
+ if HW_Interrupts then
+ for Int in HW_Interrupt loop
+ if Server_ID (Interrupt_ID (Int)) /= null
+ and then
+ not Ada.Task_Identification.Is_Terminated
+ (To_Ada (Server_ID (Interrupt_ID (Int))))
+ then
+ Interrupt_Manager.Attach_Handler
+ (New_Handler => null,
+ Interrupt => Interrupt_ID (Int),
+ Static => True,
+ Restoration => True);
+ end if;
+ end loop;
+ end if;
+ end Finalize_Interrupt_Servers;
+
+ -------------------------------------
+ -- Has_Interrupt_Or_Attach_Handler --
+ -------------------------------------
+
+ function Has_Interrupt_Or_Attach_Handler
+ (Object : access Dynamic_Interrupt_Protection)
+ return Boolean
+ is
+ pragma Unreferenced (Object);
+
+ begin
+ return True;
+ end Has_Interrupt_Or_Attach_Handler;
+
+ function Has_Interrupt_Or_Attach_Handler
+ (Object : access Static_Interrupt_Protection)
+ return Boolean
+ is
+ pragma Unreferenced (Object);
+
+ begin
+ return True;
+ end Has_Interrupt_Or_Attach_Handler;
+
+ ----------------------
+ -- Ignore_Interrupt --
+ ----------------------
+
+ procedure Ignore_Interrupt (Interrupt : Interrupt_ID) is
+ begin
+ Unimplemented ("Ignore_Interrupt");
+ end Ignore_Interrupt;
+
+ ----------------------------
+ -- Install_Default_Action --
+ ----------------------------
+
+ procedure Install_Default_Action (Interrupt : HW_Interrupt) is
+ begin
+ -- Restore original interrupt handler
+
+ Interfaces.VxWorks.intVecSet
+ (Interfaces.VxWorks.INUM_TO_IVEC (Integer (Interrupt)),
+ Default_Handler (Interrupt));
+ Default_Handler (Interrupt) := null;
+ end Install_Default_Action;
+
+ ----------------------
+ -- Install_Handlers --
+ ----------------------
+
+ procedure Install_Handlers
+ (Object : access Static_Interrupt_Protection;
+ New_Handlers : New_Handler_Array) is
+ begin
+ for N in New_Handlers'Range loop
+ -- We need a lock around this ???
+
+ Object.Previous_Handlers (N).Interrupt := New_Handlers (N).Interrupt;
+ Object.Previous_Handlers (N).Static := User_Handler
+ (New_Handlers (N).Interrupt).Static;
+
+ -- We call Exchange_Handler and not directly Interrupt_Manager.
+ -- Exchange_Handler so we get the Is_Reserved check.
+
+ Exchange_Handler
+ (Old_Handler => Object.Previous_Handlers (N).Handler,
+ New_Handler => New_Handlers (N).Handler,
+ Interrupt => New_Handlers (N).Interrupt,
+ Static => True);
+ end loop;
+ end Install_Handlers;
+
+ ------------------------------
+ -- Install_Umbrella_Handler --
+ ------------------------------
+
+ procedure Install_Umbrella_Handler
+ (Interrupt : HW_Interrupt;
+ Handler : Interfaces.VxWorks.VOIDFUNCPTR)
+ is
+ use Interfaces.VxWorks;
+
+ Vec : constant Interrupt_Vector :=
+ INUM_TO_IVEC (Interfaces.VxWorks.int (Interrupt));
+
+ Old_Handler : constant VOIDFUNCPTR :=
+ intVecGet
+ (INUM_TO_IVEC (Interfaces.VxWorks.int (Interrupt)));
+
+ Stat : Interfaces.VxWorks.STATUS;
+ pragma Unreferenced (Stat);
+ -- ??? shouldn't we test Stat at least in a pragma Assert?
+
+ begin
+ -- Only install umbrella handler when no Ada handler has already been
+ -- installed. Note that the interrupt number is passed as a parameter
+ -- when an interrupt occurs, so the umbrella handler has a different
+ -- wrapper generated by intConnect for each interrupt number.
+
+ if Default_Handler (Interrupt) = null then
+ Stat :=
+ intConnect (Vec, Handler, System.Address (Interrupt));
+ Default_Handler (Interrupt) := Old_Handler;
+ end if;
+ end Install_Umbrella_Handler;
+
+ ----------------
+ -- Is_Blocked --
+ ----------------
+
+ function Is_Blocked (Interrupt : Interrupt_ID) return Boolean is
+ begin
+ Unimplemented ("Is_Blocked");
+ return False;
+ end Is_Blocked;
+
+ -----------------------
+ -- Is_Entry_Attached --
+ -----------------------
+
+ function Is_Entry_Attached (Interrupt : Interrupt_ID) return Boolean is
+ begin
+ Check_Reserved_Interrupt (Interrupt);
+ return User_Entry (Interrupt).T /= Null_Task;
+ end Is_Entry_Attached;
+
+ -------------------------
+ -- Is_Handler_Attached --
+ -------------------------
+
+ function Is_Handler_Attached (Interrupt : Interrupt_ID) return Boolean is
+ begin
+ Check_Reserved_Interrupt (Interrupt);
+ return User_Handler (Interrupt).H /= null;
+ end Is_Handler_Attached;
+
+ ----------------
+ -- Is_Ignored --
+ ----------------
+
+ function Is_Ignored (Interrupt : Interrupt_ID) return Boolean is
+ begin
+ Unimplemented ("Is_Ignored");
+ return False;
+ end Is_Ignored;
+
+ -------------------
+ -- Is_Registered --
+ -------------------
+
+ function Is_Registered (Handler : Parameterless_Handler) return Boolean is
+ type Fat_Ptr is record
+ Object_Addr : System.Address;
+ Handler_Addr : System.Address;
+ end record;
+
+ function To_Fat_Ptr is new Unchecked_Conversion
+ (Parameterless_Handler, Fat_Ptr);
+
+ Ptr : R_Link;
+ Fat : Fat_Ptr;
+
+ begin
+ if Handler = null then
+ return True;
+ end if;
+
+ Fat := To_Fat_Ptr (Handler);
+
+ Ptr := Registered_Handler_Head;
+
+ while Ptr /= null loop
+ if Ptr.H = Fat.Handler_Addr then
+ return True;
+ end if;
+
+ Ptr := Ptr.Next;
+ end loop;
+
+ return False;
+ end Is_Registered;
+
+ -----------------
+ -- Is_Reserved --
+ -----------------
+
+ function Is_Reserved (Interrupt : Interrupt_ID) return Boolean is
+ use System.Interrupt_Management;
+ begin
+ return Reserve (System.Interrupt_Management.Interrupt_ID (Interrupt));
+ end Is_Reserved;
+
+ ----------------------
+ -- Notify_Interrupt --
+ ----------------------
+
+ -- Umbrella handler for vectored hardware interrupts (as opposed to
+ -- signals and exceptions). As opposed to the signal implementation,
+ -- this handler is only installed in the vector table while there is
+ -- an active association of an Ada handler to the interrupt.
+
+ -- Otherwise, the handler that existed prior to program startup is
+ -- in the vector table. This ensures that handlers installed by
+ -- the BSP are active unless explicitly replaced in the program text.
+
+ -- Each Interrupt_Server_Task has an associated binary semaphore
+ -- on which it pends once it's been started. This routine determines
+ -- The appropriate semaphore and and issues a semGive call, waking
+ -- the server task. When a handler is unbound,
+ -- System.Interrupts.Unbind_Handler issues a semFlush, and the
+ -- server task deletes its semaphore and terminates.
+
+ procedure Notify_Interrupt (Param : System.Address) is
+ Interrupt : constant Interrupt_ID := Interrupt_ID (Param);
+
+ Discard_Result : STATUS;
+ pragma Unreferenced (Discard_Result);
+
+ begin
+ Discard_Result := semGive (Semaphore_ID_Map (Interrupt));
+ end Notify_Interrupt;
+
+ ---------------
+ -- Reference --
+ ---------------
+
+ function Reference (Interrupt : Interrupt_ID) return System.Address is
+ begin
+ Check_Reserved_Interrupt (Interrupt);
+ return Storage_Elements.To_Address
+ (Storage_Elements.Integer_Address (Interrupt));
+ end Reference;
+
+ --------------------------------
+ -- Register_Interrupt_Handler --
+ --------------------------------
+
+ procedure Register_Interrupt_Handler (Handler_Addr : System.Address) is
+ New_Node_Ptr : R_Link;
+ begin
+ -- This routine registers a handler as usable for dynamic
+ -- interrupt handler association. Routines attaching and detaching
+ -- handlers dynamically should determine whether the handler is
+ -- registered. Program_Error should be raised if it is not registered.
+
+ -- Pragma Interrupt_Handler can only appear in a library
+ -- level PO definition and instantiation. Therefore, we do not need
+ -- to implement an unregister operation. Nor do we need to
+ -- protect the queue structure with a lock.
+
+ pragma Assert (Handler_Addr /= System.Null_Address);
+
+ New_Node_Ptr := new Registered_Handler;
+ New_Node_Ptr.H := Handler_Addr;
+
+ if Registered_Handler_Head = null then
+ Registered_Handler_Head := New_Node_Ptr;
+ Registered_Handler_Tail := New_Node_Ptr;
+
+ else
+ Registered_Handler_Tail.Next := New_Node_Ptr;
+ Registered_Handler_Tail := New_Node_Ptr;
+ end if;
+ end Register_Interrupt_Handler;
+
+ -----------------------
+ -- Unblock_Interrupt --
+ -----------------------
+
+ procedure Unblock_Interrupt (Interrupt : Interrupt_ID) is
+ begin
+ Unimplemented ("Unblock_Interrupt");
+ end Unblock_Interrupt;
+
+ ------------------
+ -- Unblocked_By --
+ ------------------
+
+ function Unblocked_By
+ (Interrupt : Interrupt_ID) return System.Tasking.Task_ID is
+ begin
+ Unimplemented ("Unblocked_By");
+ return Null_Task;
+ end Unblocked_By;
+
+ ------------------------
+ -- Unignore_Interrupt --
+ ------------------------
+
+ procedure Unignore_Interrupt (Interrupt : Interrupt_ID) is
+ begin
+ Unimplemented ("Unignore_Interrupt");
+ end Unignore_Interrupt;
+
+ -------------------
+ -- Unimplemented --
+ -------------------
+
+ procedure Unimplemented (Feature : String) is
+ begin
+ Raise_Exception
+ (Program_Error'Identity,
+ Feature & " not implemented on VxWorks");
+ end Unimplemented;
+
+ -----------------------
+ -- Interrupt_Manager --
+ -----------------------
+
+ task body Interrupt_Manager is
+
+ --------------------
+ -- Local Routines --
+ --------------------
+
+ procedure Bind_Handler (Interrupt : Interrupt_ID);
+ -- This procedure does not do anything if a signal is blocked.
+ -- Otherwise, we have to interrupt Server_Task for status change through
+ -- a wakeup signal.
+
+ procedure Unbind_Handler (Interrupt : Interrupt_ID);
+ -- This procedure does not do anything if a signal is blocked.
+ -- Otherwise, we have to interrupt Server_Task for status change
+ -- through an abort signal.
+
+ procedure Unprotected_Exchange_Handler
+ (Old_Handler : out Parameterless_Handler;
+ New_Handler : Parameterless_Handler;
+ Interrupt : Interrupt_ID;
+ Static : Boolean;
+ Restoration : Boolean := False);
+
+ procedure Unprotected_Detach_Handler
+ (Interrupt : Interrupt_ID;
+ Static : Boolean);
+
+ ------------------
+ -- Bind_Handler --
+ ------------------
+
+ procedure Bind_Handler (Interrupt : Interrupt_ID) is
+ begin
+ Install_Umbrella_Handler
+ (HW_Interrupt (Interrupt), Notify_Interrupt'Access);
+ end Bind_Handler;
+
+ --------------------
+ -- Unbind_Handler --
+ --------------------
+
+ procedure Unbind_Handler (Interrupt : Interrupt_ID) is
+ S : STATUS;
+ use type STATUS;
+
+ begin
+ -- Hardware interrupt
+
+ Install_Default_Action (HW_Interrupt (Interrupt));
+
+ -- Flush server task off semaphore, allowing it to terminate
+
+ S := semFlush (Semaphore_ID_Map (Interrupt));
+ pragma Assert (S = 0);
+ end Unbind_Handler;
+
+ --------------------------------
+ -- Unprotected_Detach_Handler --
+ --------------------------------
+
+ procedure Unprotected_Detach_Handler
+ (Interrupt : Interrupt_ID;
+ Static : Boolean)
+ is
+ Old_Handler : Parameterless_Handler;
+ begin
+ if User_Entry (Interrupt).T /= Null_Task then
+ -- If an interrupt entry is installed raise
+ -- Program_Error. (propagate it to the caller).
+
+ Raise_Exception (Program_Error'Identity,
+ "An interrupt entry is already installed");
+ end if;
+
+ -- Note : Static = True will pass the following check. This is the
+ -- case when we want to detach a handler regardless of the static
+ -- status of the Current_Handler.
+
+ if not Static and then User_Handler (Interrupt).Static then
+ -- Trying to detach a static Interrupt Handler.
+ -- raise Program_Error.
+
+ Raise_Exception (Program_Error'Identity,
+ "Trying to detach a static Interrupt Handler");
+ end if;
+
+ Old_Handler := User_Handler (Interrupt).H;
+
+ -- The new handler
+
+ User_Handler (Interrupt).H := null;
+ User_Handler (Interrupt).Static := False;
+
+ if Old_Handler /= null then
+ Unbind_Handler (Interrupt);
+ end if;
+ end Unprotected_Detach_Handler;
+
+ ----------------------------------
+ -- Unprotected_Exchange_Handler --
+ ----------------------------------
+
+ procedure Unprotected_Exchange_Handler
+ (Old_Handler : out Parameterless_Handler;
+ New_Handler : Parameterless_Handler;
+ Interrupt : Interrupt_ID;
+ Static : Boolean;
+ Restoration : Boolean := False) is
+ begin
+ if User_Entry (Interrupt).T /= Null_Task then
+ -- If an interrupt entry is already installed, raise
+ -- Program_Error. (propagate it to the caller).
+
+ Raise_Exception
+ (Program_Error'Identity,
+ "An interrupt is already installed");
+ end if;
+
+ -- Note : A null handler with Static = True will
+ -- pass the following check. This is the case when we want to
+ -- detach a handler regardless of the Static status
+ -- of Current_Handler.
+ -- We don't check anything if Restoration is True, since we
+ -- may be detaching a static handler to restore a dynamic one.
+
+ if not Restoration and then not Static
+ and then (User_Handler (Interrupt).Static
+
+ -- Trying to overwrite a static Interrupt Handler with a
+ -- dynamic Handler
+
+ -- The new handler is not specified as an
+ -- Interrupt Handler by a pragma.
+
+ or else not Is_Registered (New_Handler))
+ then
+ Raise_Exception
+ (Program_Error'Identity,
+ "Trying to overwrite a static Interrupt Handler with a " &
+ "dynamic Handler");
+ end if;
+
+ -- Save the old handler
+
+ Old_Handler := User_Handler (Interrupt).H;
+
+ -- The new handler
+
+ User_Handler (Interrupt).H := New_Handler;
+
+ if New_Handler = null then
+
+ -- The null handler means we are detaching the handler.
+
+ User_Handler (Interrupt).Static := False;
+
+ else
+ User_Handler (Interrupt).Static := Static;
+ end if;
+
+ -- Invoke a corresponding Server_Task if not yet created.
+ -- Place Task_ID info in Server_ID array.
+
+ if New_Handler /= null
+ and then
+ (Server_ID (Interrupt) = Null_Task
+ or else
+ Ada.Task_Identification.Is_Terminated
+ (To_Ada (Server_ID (Interrupt))))
+ then
+ Interrupt_Access_Hold :=
+ new Interrupt_Server_Task
+ (Interrupt, semBCreate (SEM_Q_FIFO, SEM_EMPTY));
+ Server_ID (Interrupt) :=
+ To_System (Interrupt_Access_Hold.all'Identity);
+ end if;
+
+ if (New_Handler = null) and then Old_Handler /= null then
+ -- Restore default handler
+
+ Unbind_Handler (Interrupt);
+
+ elsif Old_Handler = null then
+ -- Save default handler
+
+ Bind_Handler (Interrupt);
+ end if;
+ end Unprotected_Exchange_Handler;
+
+ -- Start of processing for Interrupt_Manager
+
+ begin
+ -- By making this task independent of any master, when the process
+ -- goes away, the Interrupt_Manager will terminate gracefully.
+
+ System.Tasking.Utilities.Make_Independent;
+
+ loop
+ -- A block is needed to absorb Program_Error exception
+
+ declare
+ Old_Handler : Parameterless_Handler;
+
+ begin
+ select
+ accept Attach_Handler
+ (New_Handler : Parameterless_Handler;
+ Interrupt : Interrupt_ID;
+ Static : Boolean;
+ Restoration : Boolean := False)
+ do
+ Unprotected_Exchange_Handler
+ (Old_Handler, New_Handler, Interrupt, Static, Restoration);
+ end Attach_Handler;
+
+ or
+ accept Exchange_Handler
+ (Old_Handler : out Parameterless_Handler;
+ New_Handler : Parameterless_Handler;
+ Interrupt : Interrupt_ID;
+ Static : Boolean)
+ do
+ Unprotected_Exchange_Handler
+ (Old_Handler, New_Handler, Interrupt, Static);
+ end Exchange_Handler;
+
+ or
+ accept Detach_Handler
+ (Interrupt : Interrupt_ID;
+ Static : Boolean)
+ do
+ Unprotected_Detach_Handler (Interrupt, Static);
+ end Detach_Handler;
+ or
+ accept Bind_Interrupt_To_Entry
+ (T : Task_ID;
+ E : Task_Entry_Index;
+ Interrupt : Interrupt_ID)
+ do
+ -- If there is a binding already (either a procedure or an
+ -- entry), raise Program_Error (propagate it to the caller).
+
+ if User_Handler (Interrupt).H /= null
+ or else User_Entry (Interrupt).T /= Null_Task
+ then
+ Raise_Exception
+ (Program_Error'Identity,
+ "A binding for this interrupt is already present");
+ end if;
+
+ User_Entry (Interrupt) := Entry_Assoc'(T => T, E => E);
+
+ -- Indicate the attachment of interrupt entry in the ATCB.
+ -- This is needed so when an interrupt entry task terminates
+ -- the binding can be cleaned. The call to unbinding must be
+ -- make by the task before it terminates.
+
+ T.Interrupt_Entry := True;
+
+ -- Invoke a corresponding Server_Task if not yet created.
+ -- Place Task_ID info in Server_ID array.
+
+ if Server_ID (Interrupt) = Null_Task
+ or else
+ Ada.Task_Identification.Is_Terminated
+ (To_Ada (Server_ID (Interrupt)))
+ then
+ Interrupt_Access_Hold := new Interrupt_Server_Task
+ (Interrupt, semBCreate (SEM_Q_FIFO, SEM_EMPTY));
+ Server_ID (Interrupt) :=
+ To_System (Interrupt_Access_Hold.all'Identity);
+ end if;
+
+ Bind_Handler (Interrupt);
+ end Bind_Interrupt_To_Entry;
+
+ or
+ accept Detach_Interrupt_Entries (T : Task_ID) do
+ for Int in Interrupt_ID'Range loop
+ if not Is_Reserved (Int) then
+ if User_Entry (Int).T = T then
+ User_Entry (Int) :=
+ Entry_Assoc'
+ (T => Null_Task, E => Null_Task_Entry);
+ Unbind_Handler (Int);
+ end if;
+ end if;
+ end loop;
+
+ -- Indicate in ATCB that no interrupt entries are attached.
+
+ T.Interrupt_Entry := False;
+ end Detach_Interrupt_Entries;
+ end select;
+
+ exception
+ -- If there is a Program_Error we just want to propagate it to
+ -- the caller and do not want to stop this task.
+
+ when Program_Error =>
+ null;
+
+ when others =>
+ pragma Assert (False);
+ null;
+ end;
+ end loop;
+
+ exception
+ when Standard'Abort_Signal =>
+ -- Flush interrupt server semaphores, so they can terminate
+ Finalize_Interrupt_Servers;
+ raise;
+ end Interrupt_Manager;
+
+ ---------------------------
+ -- Interrupt_Server_Task --
+ ---------------------------
+
+ -- Server task for vectored hardware interrupt handling
+
+ task body Interrupt_Server_Task is
+ Self_Id : constant Task_ID := Self;
+ Tmp_Handler : Parameterless_Handler;
+ Tmp_ID : Task_ID;
+ Tmp_Entry_Index : Task_Entry_Index;
+ S : STATUS;
+
+ use type STATUS;
+
+ begin
+ System.Tasking.Utilities.Make_Independent;
+ Semaphore_ID_Map (Interrupt) := Int_Sema;
+
+ loop
+ -- Pend on semaphore that will be triggered by the
+ -- umbrella handler when the associated interrupt comes in
+
+ S := semTake (Int_Sema, WAIT_FOREVER);
+ pragma Assert (S = 0);
+
+ if User_Handler (Interrupt).H /= null then
+
+ -- Protected procedure handler
+
+ Tmp_Handler := User_Handler (Interrupt).H;
+ Tmp_Handler.all;
+
+ elsif User_Entry (Interrupt).T /= Null_Task then
+
+ -- Interrupt entry handler
+
+ Tmp_ID := User_Entry (Interrupt).T;
+ Tmp_Entry_Index := User_Entry (Interrupt).E;
+ System.Tasking.Rendezvous.Call_Simple
+ (Tmp_ID, Tmp_Entry_Index, System.Null_Address);
+
+ else
+ -- Semaphore has been flushed by an unbind operation in
+ -- the Interrupt_Manager. Terminate the server task.
+
+ -- Wait for the Interrupt_Manager to complete its work
+
+ POP.Write_Lock (Self_Id);
+
+ -- Delete the associated semaphore
+
+ S := semDelete (Int_Sema);
+
+ pragma Assert (S = 0);
+
+ -- Set status for the Interrupt_Manager
+
+ Semaphore_ID_Map (Interrupt) := 0;
+ Server_ID (Interrupt) := Null_Task;
+ POP.Unlock (Self_Id);
+
+ exit;
+ end if;
+ end loop;
+ end Interrupt_Server_Task;
+
+begin
+ -- Get Interrupt_Manager's ID so that Abort_Interrupt can be sent.
+
+ Interrupt_Manager_ID := To_System (Interrupt_Manager'Identity);
+end System.Interrupts;