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.


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@81834 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 682 insertions, 0 deletions

diff --git a/gcc/ada/s-interr-sigaction.adb b/gcc/ada/s-interr-sigaction.adb
new file mode 100644
index 00000000000..4ee53e00b09
--- /dev/null
+++ b/gcc/ada/s-interr-sigaction.adb
@@ -0,0 +1,682 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                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) 1998-2004 Free Software Fundation             --
+--                                                                          --
+-- 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.     --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  This is the IRIX & NT version of this package.
+
+with Ada.Task_Identification;
+--  used for Task_Id
+
+with Ada.Exceptions;
+--  used for Raise_Exception
+
+with System.OS_Interface;
+--  used for intr_attach
+
+with System.Storage_Elements;
+--  used for To_Address
+--           To_Integer
+
+with System.Task_Primitives.Operations;
+--  used for Self
+--           Sleep
+--           Wakeup
+--           Write_Lock
+--           Unlock
+
+with System.Tasking.Utilities;
+--  used for Make_Independent
+
+with System.Tasking.Rendezvous;
+--  used for Call_Simple
+
+with System.Tasking.Initialization;
+--  used for Defer_Abort
+--           Undefer_Abort
+
+with System.Interrupt_Management;
+
+with System.Parameters;
+--  used for Single_Lock
+
+with Interfaces.C;
+--  used for int
+
+with Unchecked_Conversion;
+
+package body System.Interrupts is
+
+   use Parameters;
+   use Tasking;
+   use Ada.Exceptions;
+   use System.OS_Interface;
+   use Interfaces.C;
+
+   package STPO renames System.Task_Primitives.Operations;
+   package IMNG renames System.Interrupt_Management;
+
+   subtype int is Interfaces.C.int;
+
+   function To_System is new Unchecked_Conversion
+     (Ada.Task_Identification.Task_Id, Task_ID);
+
+   type Handler_Kind is (Unknown, Task_Entry, Protected_Procedure);
+
+   type Handler_Desc is record
+      Kind   : Handler_Kind := Unknown;
+      T      : Task_ID;
+      E      : Task_Entry_Index;
+      H      : Parameterless_Handler;
+      Static : Boolean := False;
+   end record;
+
+   task type Server_Task (Interrupt : Interrupt_ID) is
+      pragma Interrupt_Priority (System.Interrupt_Priority'Last);
+   end Server_Task;
+
+   type Server_Task_Access is access Server_Task;
+
+   Attached_Interrupts : array (Interrupt_ID) of Boolean;
+   Handlers            : array (Interrupt_ID) of Task_ID;
+   Descriptors         : array (Interrupt_ID) of Handler_Desc;
+   Interrupt_Count     : array (Interrupt_ID) of Integer := (others => 0);
+
+   pragma Volatile_Components (Interrupt_Count);
+
+   procedure Attach_Handler
+     (New_Handler : Parameterless_Handler;
+      Interrupt   : Interrupt_ID;
+      Static      : Boolean;
+      Restoration : Boolean);
+   --  This internal procedure is needed to finalize protected objects
+   --  that contain interrupt handlers.
+
+   procedure Signal_Handler (Sig : Interrupt_ID);
+   --  This procedure is used to handle all the signals.
+
+   --  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.
+
+   --
+   --  Handler Registration:
+   --
+
+   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_Handlers : R_Link := null;
+
+   function Is_Registered (Handler : Parameterless_Handler) return Boolean;
+   --  See if the Handler has been "pragma"ed using Interrupt_Handler.
+   --  Always consider a null handler as registered.
+
+   type Handler_Ptr is access procedure (Sig : Interrupt_ID);
+
+   function TISR is new Unchecked_Conversion (Handler_Ptr, isr_address);
+
+   procedure Signal_Handler (Sig : Interrupt_ID) is
+      Handler : Task_ID renames Handlers (Sig);
+   begin
+      if Intr_Attach_Reset and then
+        intr_attach (int (Sig), TISR (Signal_Handler'Access)) = FUNC_ERR
+      then
+         raise Program_Error;
+      end if;
+
+      if Handler /= null then
+         Interrupt_Count (Sig) := Interrupt_Count (Sig) + 1;
+         STPO.Wakeup (Handler, Interrupt_Server_Idle_Sleep);
+      end if;
+   end Signal_Handler;
+
+   -----------------
+   -- Is_Reserved --
+   -----------------
+
+   function Is_Reserved (Interrupt : Interrupt_ID) return Boolean is
+   begin
+      return IMNG.Reserve (IMNG.Interrupt_ID (Interrupt));
+   end Is_Reserved;
+
+   -----------------------
+   -- Is_Entry_Attached --
+   -----------------------
+
+   function Is_Entry_Attached (Interrupt : Interrupt_ID) return Boolean is
+   begin
+      if Is_Reserved (Interrupt) then
+         Raise_Exception (Program_Error'Identity, "Interrupt" &
+           Interrupt_ID'Image (Interrupt) & " is reserved");
+      end if;
+
+      return Descriptors (Interrupt).T /= Null_Task;
+   end Is_Entry_Attached;
+
+   -------------------------
+   -- Is_Handler_Attached --
+   -------------------------
+
+   function Is_Handler_Attached (Interrupt : Interrupt_ID) return Boolean is
+   begin
+      if Is_Reserved (Interrupt) then
+         Raise_Exception (Program_Error'Identity, "Interrupt" &
+           Interrupt_ID'Image (Interrupt) & " is reserved");
+      end if;
+
+      return Descriptors (Interrupt).Kind /= Unknown;
+   end Is_Handler_Attached;
+
+   ----------------
+   -- Is_Ignored --
+   ----------------
+
+   function Is_Ignored (Interrupt : Interrupt_ID) return Boolean is
+   begin
+      raise Program_Error;
+      return False;
+   end Is_Ignored;
+
+   ------------------
+   -- Unblocked_By --
+   ------------------
+
+   function Unblocked_By (Interrupt : Interrupt_ID) return Task_ID is
+   begin
+      raise Program_Error;
+      return Null_Task;
+   end Unblocked_By;
+
+   ----------------------
+   -- Ignore_Interrupt --
+   ----------------------
+
+   procedure Ignore_Interrupt (Interrupt : Interrupt_ID) is
+   begin
+      raise Program_Error;
+   end Ignore_Interrupt;
+
+   ------------------------
+   -- Unignore_Interrupt --
+   ------------------------
+
+   procedure Unignore_Interrupt (Interrupt : Interrupt_ID) is
+   begin
+      raise Program_Error;
+   end Unignore_Interrupt;
+
+   -------------------------------------
+   -- 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;
+
+   ----------------
+   --  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 tasks are gone.
+
+      for N in reverse Object.Previous_Handlers'Range loop
+         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;
+
+      Tasking.Protected_Objects.Entries.Finalize
+        (Tasking.Protected_Objects.Entries.Protection_Entries (Object));
+   end Finalize;
+
+   -------------------------------------
+   -- 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;
+
+   ----------------------
+   -- 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    := Descriptors
+           (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;
+
+   ---------------------
+   -- Current_Handler --
+   ---------------------
+
+   function Current_Handler
+     (Interrupt : Interrupt_ID) return Parameterless_Handler
+   is
+   begin
+      if Is_Reserved (Interrupt) then
+         raise Program_Error;
+      end if;
+
+      if Descriptors (Interrupt).Kind = Protected_Procedure then
+         return Descriptors (Interrupt).H;
+      else
+         return null;
+      end if;
+   end Current_Handler;
+
+   --------------------
+   -- Attach_Handler --
+   --------------------
+
+   procedure Attach_Handler
+     (New_Handler : Parameterless_Handler;
+      Interrupt   : Interrupt_ID;
+      Static      : Boolean := False) is
+   begin
+      Attach_Handler (New_Handler, Interrupt, Static, False);
+   end Attach_Handler;
+
+   procedure Attach_Handler
+     (New_Handler : Parameterless_Handler;
+      Interrupt   : Interrupt_ID;
+      Static      : Boolean;
+      Restoration : Boolean)
+   is
+      New_Task : Server_Task_Access;
+
+   begin
+      if Is_Reserved (Interrupt) then
+         raise Program_Error;
+      end if;
+
+      if not Restoration and then not Static
+
+         --  Tries to overwrite a static Interrupt Handler with a
+         --  dynamic Handler
+
+        and then (Descriptors (Interrupt).Static
+
+                     --  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;
+
+      if Handlers (Interrupt) = null then
+         New_Task := new Server_Task (Interrupt);
+         Handlers (Interrupt) := To_System (New_Task.all'Identity);
+      end if;
+
+      if intr_attach (int (Interrupt),
+        TISR (Signal_Handler'Access)) = FUNC_ERR
+      then
+         raise Program_Error;
+      end if;
+
+      if New_Handler = null then
+
+         --  The null handler means we are detaching the handler.
+
+         Attached_Interrupts (Interrupt) := False;
+         Descriptors (Interrupt) :=
+           (Kind => Unknown, T => null, E => 0, H => null, Static => False);
+
+      else
+         Descriptors (Interrupt).Kind := Protected_Procedure;
+         Descriptors (Interrupt).H := New_Handler;
+         Descriptors (Interrupt).Static := Static;
+         Attached_Interrupts (Interrupt) := True;
+      end if;
+   end Attach_Handler;
+
+   ----------------------
+   -- Exchange_Handler --
+   ----------------------
+
+   procedure Exchange_Handler
+     (Old_Handler : out Parameterless_Handler;
+      New_Handler : Parameterless_Handler;
+      Interrupt   : Interrupt_ID;
+      Static      : Boolean := False) is
+   begin
+      if Is_Reserved (Interrupt) then
+         raise Program_Error;
+      end if;
+
+      if Descriptors (Interrupt).Kind = Task_Entry then
+
+         --  In case we have an Interrupt Entry already installed.
+         --  raise a program error. (propagate it to the caller).
+
+         Raise_Exception (Program_Error'Identity,
+           "An interrupt is already installed");
+      end if;
+
+      Old_Handler := Current_Handler (Interrupt);
+      Attach_Handler (New_Handler, Interrupt, Static);
+   end Exchange_Handler;
+
+   --------------------
+   -- Detach_Handler --
+   --------------------
+
+   procedure Detach_Handler
+     (Interrupt : Interrupt_ID;
+      Static    : Boolean := False) is
+   begin
+      if Is_Reserved (Interrupt) then
+         raise Program_Error;
+      end if;
+
+      if Descriptors (Interrupt).Kind = Task_Entry then
+         Raise_Exception (Program_Error'Identity,
+           "Trying to detach an Interrupt Entry");
+      end if;
+
+      if not Static and then Descriptors (Interrupt).Static then
+         Raise_Exception (Program_Error'Identity,
+           "Trying to detach a static Interrupt Handler");
+      end if;
+
+      Attached_Interrupts (Interrupt) := False;
+      Descriptors (Interrupt) :=
+        (Kind => Unknown, T => null, E => 0, H => null, Static => False);
+
+      if intr_attach (int (Interrupt), null) = FUNC_ERR then
+         raise Program_Error;
+      end if;
+   end Detach_Handler;
+
+   ---------------
+   -- Reference --
+   ---------------
+
+   function Reference (Interrupt : Interrupt_ID) return System.Address is
+      Signal : constant System.Address :=
+                 System.Storage_Elements.To_Address
+                   (System.Storage_Elements.Integer_Address (Interrupt));
+
+   begin
+      if Is_Reserved (Interrupt) then
+
+         --  Only usable Interrupts can be used for binding it to an Entry
+
+         raise Program_Error;
+      end if;
+
+      return Signal;
+   end Reference;
+
+   --------------------------------
+   -- Register_Interrupt_Handler --
+   --------------------------------
+
+   procedure Register_Interrupt_Handler (Handler_Addr : System.Address) is
+   begin
+      Registered_Handlers :=
+       new Registered_Handler'(H => Handler_Addr, Next => Registered_Handlers);
+   end Register_Interrupt_Handler;
+
+   -------------------
+   -- Is_Registered --
+   -------------------
+
+   --  See if the Handler has been "pragma"ed using Interrupt_Handler.
+   --  Always consider a null handler as registered.
+
+   function Is_Registered (Handler : Parameterless_Handler) return Boolean is
+      Ptr : R_Link := Registered_Handlers;
+
+      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);
+
+      Fat : Fat_Ptr;
+
+   begin
+      if Handler = null then
+         return True;
+      end if;
+
+      Fat := To_Fat_Ptr (Handler);
+
+      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;
+
+   -----------------------------
+   -- Bind_Interrupt_To_Entry --
+   -----------------------------
+
+   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));
+
+      New_Task : Server_Task_Access;
+
+   begin
+      if Is_Reserved (Interrupt) then
+         raise Program_Error;
+      end if;
+
+      if Descriptors (Interrupt).Kind /= Unknown then
+         Raise_Exception (Program_Error'Identity,
+           "A binding for this interrupt is already present");
+      end if;
+
+      if Handlers (Interrupt) = null then
+         New_Task := new Server_Task (Interrupt);
+         Handlers (Interrupt) := To_System (New_Task.all'Identity);
+      end if;
+
+      if intr_attach (int (Interrupt),
+        TISR (Signal_Handler'Access)) = FUNC_ERR
+      then
+         raise Program_Error;
+      end if;
+
+      Descriptors (Interrupt).Kind := Task_Entry;
+      Descriptors (Interrupt).T := T;
+      Descriptors (Interrupt).E := E;
+
+      --  Indicate the attachment of Interrupt Entry in ATCB.
+      --  This is need so that 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;
+
+      Attached_Interrupts (Interrupt) := True;
+   end Bind_Interrupt_To_Entry;
+
+   ------------------------------
+   -- Detach_Interrupt_Entries --
+   ------------------------------
+
+   procedure Detach_Interrupt_Entries (T : Task_ID) is
+   begin
+      for I in Interrupt_ID loop
+         if not Is_Reserved (I) then
+            if Descriptors (I).Kind = Task_Entry and then
+              Descriptors (I).T = T then
+               Attached_Interrupts (I) := False;
+               Descriptors (I).Kind := Unknown;
+
+               if intr_attach (int (I), null) = FUNC_ERR then
+                  raise Program_Error;
+               end if;
+            end if;
+         end if;
+      end loop;
+
+      --  Indicate in ATCB that no Interrupt Entries are attached.
+
+      T.Interrupt_Entry := True;
+   end Detach_Interrupt_Entries;
+
+   ---------------------
+   -- Block_Interrupt --
+   ---------------------
+
+   procedure Block_Interrupt (Interrupt : Interrupt_ID) is
+   begin
+      raise Program_Error;
+   end Block_Interrupt;
+
+   -----------------------
+   -- Unblock_Interrupt --
+   -----------------------
+
+   procedure Unblock_Interrupt (Interrupt : Interrupt_ID) is
+   begin
+      raise Program_Error;
+   end Unblock_Interrupt;
+
+   ----------------
+   -- Is_Blocked --
+   ----------------
+
+   function Is_Blocked (Interrupt : Interrupt_ID) return Boolean is
+   begin
+      raise Program_Error;
+      return False;
+   end Is_Blocked;
+
+   task body Server_Task is
+      Desc    : Handler_Desc renames Descriptors (Interrupt);
+      Self_Id : constant Task_ID := STPO.Self;
+      Temp    : Parameterless_Handler;
+
+   begin
+      Utilities.Make_Independent;
+
+      loop
+         while Interrupt_Count (Interrupt) > 0 loop
+            Interrupt_Count (Interrupt) := Interrupt_Count (Interrupt) - 1;
+            begin
+               case Desc.Kind is
+                  when Unknown =>
+                     null;
+                  when Task_Entry =>
+                     Rendezvous.Call_Simple (Desc.T, Desc.E, Null_Address);
+                  when Protected_Procedure =>
+                     Temp := Desc.H;
+                     Temp.all;
+               end case;
+            exception
+               when others => null;
+            end;
+         end loop;
+
+         Initialization.Defer_Abort (Self_Id);
+
+         if Single_Lock then
+            STPO.Lock_RTS;
+         end if;
+
+         STPO.Write_Lock (Self_Id);
+         Self_Id.Common.State := Interrupt_Server_Idle_Sleep;
+         STPO.Sleep (Self_Id, Interrupt_Server_Idle_Sleep);
+         Self_Id.Common.State := Runnable;
+         STPO.Unlock (Self_Id);
+
+         if Single_Lock then
+            STPO.Unlock_RTS;
+         end if;
+
+         Initialization.Undefer_Abort (Self_Id);
+
+         --  Undefer abort here to allow a window for this task
+         --  to be aborted  at the time of system shutdown.
+
+      end loop;
+   end Server_Task;
+
+end System.Interrupts;