diff -uNr gcc-4.2.3-orig/gcc/ada/env.c gcc-4.2.3/gcc/ada/env.c
--- gcc-4.2.3-orig/gcc/ada/env.c	2007-08-22 12:54:43.000000000 -0500
+++ gcc-4.2.3/gcc/ada/env.c	2007-10-16 10:51:05.000000000 -0500
@@ -289,7 +289,7 @@
   }
 #elif defined (__MINGW32__) || defined (__FreeBSD__) || defined (__APPLE__) \
    || (defined (__vxworks) && defined (__RTP__)) || defined (__CYGWIN__) \
-   || defined (__NetBSD__)
+   || defined (__NetBSD__) || defined (__rtems__)
   /* On Windows, FreeBSD and MacOS there is no function to clean all the
      environment but there is a "clean" way to unset a variable. So go
      through the environ table and call __gnat_unsetenv on all entries */
diff -uNr gcc-4.2.3-orig/gcc/ada/gen-soccon.c gcc-4.2.3/gcc/ada/gen-soccon.c
--- gcc-4.2.3-orig/gcc/ada/gen-soccon.c	2005-11-15 07:50:37.000000000 -0600
+++ gcc-4.2.3/gcc/ada/gen-soccon.c	2007-10-15 13:44:20.000000000 -0500
@@ -4,7 +4,7 @@
  *                                                                          *
  *                           G E N - S O C C O N                            *
  *                                                                          *
- *          Copyright (C) 2004-2005, Free Software Foundation, Inc.         *
+ *          Copyright (C) 2004-2007, Free Software Foundation, Inc.         *
  *                                                                          *
  * GNAT 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- *
@@ -98,7 +98,7 @@
 TXT("--                                                                          --")
 TXT("--                                 S p e c                                  --")
 TXT("--                                                                          --")
-TXT("--          Copyright (C) 2000-2005, Free Software Foundation, Inc.         --")
+TXT("--          Copyright (C) 2000-2007, Free Software Foundation, Inc.         --")
 TXT("--                                                                          --")
 TXT("-- GNAT is free software;  you can  redistribute it  and/or modify it under --")
 TXT("-- terms of the  GNU General Public License as published  by the Free Soft- --")
diff -uNr gcc-4.2.3-orig/gcc/ada/g-soccon-rtems.ads gcc-4.2.3/gcc/ada/g-soccon-rtems.ads
--- gcc-4.2.3-orig/gcc/ada/g-soccon-rtems.ads	1969-12-31 18:00:00.000000000 -0600
+++ gcc-4.2.3/gcc/ada/g-soccon-rtems.ads	2007-10-15 13:44:20.000000000 -0500
@@ -0,0 +1,181 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--               G N A T . S O C K E T S . C O N S T A N T S                --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--          Copyright (C) 2000-2007, Free Software Foundation, Inc.         --
+--                                                                          --
+-- GNAT 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.  GNAT 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 GNAT;  see file COPYING.  If not, write --
+-- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
+-- Boston, MA 02110-1301, 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.                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  This package provides target dependent definitions of constant for use
+--  by the GNAT.Sockets package (g-socket.ads). This package should not be
+--  directly with'ed by an applications program.
+
+--  This is the version for RTEMS
+--  This file is generated automatically, do not modify it by hand! Instead,
+--  make changes to gen-soccon.c and re-run it on each target.
+
+package GNAT.Sockets.Constants is
+
+   --------------
+   -- Families --
+   --------------
+
+   AF_INET            : constant :=           2; --  IPv4 address family
+   AF_INET6           : constant :=          28; --  IPv6 address family
+
+   -----------
+   -- Modes --
+   -----------
+
+   SOCK_STREAM        : constant :=           1; --  Stream socket
+   SOCK_DGRAM         : constant :=           2; --  Datagram socket
+
+   -------------------
+   -- Socket errors --
+   -------------------
+
+   EACCES             : constant :=          13; --  Permission denied
+   EADDRINUSE         : constant :=         112; --  Address already in use
+   EADDRNOTAVAIL      : constant :=         125; --  Cannot assign address
+   EAFNOSUPPORT       : constant :=         106; --  Addr family not supported
+   EALREADY           : constant :=         120; --  Operation in progress
+   EBADF              : constant :=           9; --  Bad file descriptor
+   ECONNABORTED       : constant :=         113; --  Connection aborted
+   ECONNREFUSED       : constant :=         111; --  Connection refused
+   ECONNRESET         : constant :=         104; --  Connection reset by peer
+   EDESTADDRREQ       : constant :=         121; --  Destination addr required
+   EFAULT             : constant :=          14; --  Bad address
+   EHOSTDOWN          : constant :=         117; --  Host is down
+   EHOSTUNREACH       : constant :=         118; --  No route to host
+   EINPROGRESS        : constant :=         119; --  Operation now in progress
+   EINTR              : constant :=           4; --  Interrupted system call
+   EINVAL             : constant :=          22; --  Invalid argument
+   EIO                : constant :=           5; --  Input output error
+   EISCONN            : constant :=         127; --  Socket already connected
+   ELOOP              : constant :=          92; --  Too many symbolic lynks
+   EMFILE             : constant :=          24; --  Too many open files
+   EMSGSIZE           : constant :=         122; --  Message too long
+   ENAMETOOLONG       : constant :=          91; --  Name too long
+   ENETDOWN           : constant :=         115; --  Network is down
+   ENETRESET          : constant :=         126; --  Disconn. on network reset
+   ENETUNREACH        : constant :=         114; --  Network is unreachable
+   ENOBUFS            : constant :=         105; --  No buffer space available
+   ENOPROTOOPT        : constant :=         109; --  Protocol not available
+   ENOTCONN           : constant :=         128; --  Socket not connected
+   ENOTSOCK           : constant :=         108; --  Operation on non socket
+   EOPNOTSUPP         : constant :=          95; --  Operation not supported
+   EPFNOSUPPORT       : constant :=          96; --  Unknown protocol family
+   EPROTONOSUPPORT    : constant :=         123; --  Unknown protocol
+   EPROTOTYPE         : constant :=         107; --  Unknown protocol type
+   ESHUTDOWN          : constant :=         110; --  Cannot send once shutdown
+   ESOCKTNOSUPPORT    : constant :=         124; --  Socket type not supported
+   ETIMEDOUT          : constant :=         116; --  Connection timed out
+   ETOOMANYREFS       : constant :=         129; --  Too many references
+   EWOULDBLOCK        : constant :=          11; --  Operation would block
+
+   -----------------
+   -- Host errors --
+   -----------------
+
+   HOST_NOT_FOUND     : constant :=           1; --  Unknown host
+   TRY_AGAIN          : constant :=           2; --  Host name lookup failure
+   NO_DATA            : constant :=           4; --  No data record for name
+   NO_RECOVERY        : constant :=           3; --  Non recoverable errors
+
+   -------------------
+   -- Control flags --
+   -------------------
+
+   FIONBIO            : constant := -2147195266; --  Set/clear non-blocking io
+   FIONREAD           : constant :=  1074030207; --  How many bytes to read
+
+   --------------------
+   -- Shutdown modes --
+   --------------------
+
+   SHUT_RD            : constant :=           0; --  No more recv
+   SHUT_WR            : constant :=           1; --  No more send
+   SHUT_RDWR          : constant :=           2; --  No more recv/send
+
+   ---------------------
+   -- Protocol levels --
+   ---------------------
+
+   SOL_SOCKET         : constant :=       65535; --  Options for socket level
+   IPPROTO_IP         : constant :=           0; --  Dummy protocol for IP
+   IPPROTO_UDP        : constant :=          17; --  UDP
+   IPPROTO_TCP        : constant :=           6; --  TCP
+
+   -------------------
+   -- Request flags --
+   -------------------
+
+   MSG_OOB            : constant :=           1; --  Process out-of-band data
+   MSG_PEEK           : constant :=           2; --  Peek at incoming data
+   MSG_EOR            : constant :=           8; --  Send end of record
+   MSG_WAITALL        : constant :=          64; --  Wait for full reception
+   MSG_NOSIGNAL       : constant :=          -1; --  No SIGPIPE on send
+   MSG_Forced_Flags   : constant :=           0;
+   --  Flags set on all send(2) calls
+
+   --------------------
+   -- Socket options --
+   --------------------
+
+   TCP_NODELAY        : constant :=           1; --  Do not coalesce packets
+   SO_REUSEADDR       : constant :=           4; --  Bind reuse local address
+   SO_KEEPALIVE       : constant :=           8; --  Enable keep-alive msgs
+   SO_LINGER          : constant :=         128; --  Defer close to flush data
+   SO_BROADCAST       : constant :=          32; --  Can send broadcast msgs
+   SO_SNDBUF          : constant :=        4097; --  Set/get send buffer size
+   SO_RCVBUF          : constant :=        4098; --  Set/get recv buffer size
+   SO_SNDTIMEO        : constant :=        4101; --  Emission timeout
+   SO_RCVTIMEO        : constant :=        4102; --  Reception timeout
+   SO_ERROR           : constant :=        4103; --  Get/clear error status
+   IP_MULTICAST_IF    : constant :=           9; --  Set/get mcast interface
+   IP_MULTICAST_TTL   : constant :=          10; --  Set/get multicast TTL
+   IP_MULTICAST_LOOP  : constant :=          11; --  Set/get mcast loopback
+   IP_ADD_MEMBERSHIP  : constant :=          12; --  Join a multicast group
+   IP_DROP_MEMBERSHIP : constant :=          13; --  Leave a multicast group
+
+   -------------------
+   -- System limits --
+   -------------------
+
+   IOV_MAX            : constant :=        1024; --  Maximum writev iovcnt
+
+   ----------------------
+   -- Type definitions --
+   ----------------------
+
+   --  Sizes (in bytes) of the components of struct timeval
+
+   SIZEOF_tv_sec      : constant :=           4; --  tv_sec
+   SIZEOF_tv_usec     : constant :=           4; --  tv_usec
+
+end GNAT.Sockets.Constants;
diff -uNr gcc-4.2.3-orig/gcc/ada/gsocket.h gcc-4.2.3/gcc/ada/gsocket.h
--- gcc-4.2.3-orig/gcc/ada/gsocket.h	2005-11-15 07:50:37.000000000 -0600
+++ gcc-4.2.3/gcc/ada/gsocket.h	2007-10-19 08:32:07.000000000 -0500
@@ -6,7 +6,7 @@
  *                                                                          *
  *                              C Header File                               *
  *                                                                          *
- *         Copyright (C) 2004-2005, Free Software Foundation, Inc.          *
+ *         Copyright (C) 2004-2007, Free Software Foundation, Inc.          *
  *                                                                          *
  * GNAT 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- *
@@ -139,7 +139,15 @@
 #include <sys/time.h>
 #endif
 
-#if !(defined (VMS) || defined (__MINGW32__) || defined(__rtems__))
+/*
+ * RTEMS has these .h files but not until you have built RTEMS.  When
+ * IN_RTS, you only have the .h files in the newlib C library.
+ * Because this file is also included from gen-soccon.c which is built
+ * to run on RTEMS (not IN_RTS), we must distinguish between IN_RTS
+ * and using this file to compile gen-soccon.
+ */
+#if !(defined (VMS) || defined (__MINGW32__) || \
+      (defined(__rtems__) && defined(IN_RTS)))
 #include <sys/socket.h>
 #include <netinet/in.h>
 #include <netinet/tcp.h>
diff -uNr gcc-4.2.3-orig/gcc/ada/Makefile.in gcc-4.2.3/gcc/ada/Makefile.in
--- gcc-4.2.3-orig/gcc/ada/Makefile.in	2007-09-03 08:11:02.000000000 -0500
+++ gcc-4.2.3/gcc/ada/Makefile.in	2007-11-29 16:08:17.000000000 -0600
@@ -392,7 +392,7 @@
   a-intnam.ads<a-intnam-vxworks.ads \
   a-numaux.ads<a-numaux-vxworks.ads \
   s-inmaop.adb<s-inmaop-posix.adb \
-  s-interr.adb<s-interr-vxworks.adb \
+  s-interr.adb<s-interr-hwint.adb \
   s-intman.ads<s-intman-vxworks.ads \
   s-intman.adb<s-intman-vxworks.adb \
   s-osinte.adb<s-osinte-vxworks.adb \
@@ -430,7 +430,7 @@
   a-intnam.ads<a-intnam-vxworks.ads \
   a-numaux.ads<a-numaux-vxworks.ads \
   s-inmaop.adb<s-inmaop-posix.adb \
-  s-interr.adb<s-interr-vxworks.adb \
+  s-interr.adb<s-interr-hwint.adb \
   s-intman.ads<s-intman-vxworks.ads \
   s-intman.adb<s-intman-vxworks.adb \
   s-osinte.ads<s-osinte-vxworks.ads \
@@ -485,7 +485,7 @@
   g-io.adb<g-io-vxworks-ppc-cert.adb \
   g-io.ads<g-io-vxworks-ppc-cert.ads \
   s-inmaop.adb<s-inmaop-posix.adb \
-  s-interr.adb<s-interr-vxworks.adb \
+  s-interr.adb<s-interr-hwint.adb \
   s-intman.ads<s-intman-vxworks.ads \
   s-intman.adb<s-intman-vxworks.adb \
   s-osinte.adb<s-osinte-vxworks.adb \
@@ -529,7 +529,7 @@
   a-intnam.ads<a-intnam-vxworks.ads \
   a-numaux.ads<a-numaux-vxworks.ads \
   s-inmaop.adb<s-inmaop-posix.adb \
-  s-interr.adb<s-interr-vxworks.adb \
+  s-interr.adb<s-interr-hwint.adb \
   s-intman.ads<s-intman-vxworks.ads \
   s-intman.adb<s-intman-vxworks.adb \
   s-osinte.adb<s-osinte-vxworks.adb \
@@ -558,7 +558,7 @@
   a-intnam.ads<a-intnam-vxworks.ads \
   i-vxwork.ads<i-vxwork-x86.ads \
   s-inmaop.adb<s-inmaop-posix.adb \
-  s-interr.adb<s-interr-vxworks.adb \
+  s-interr.adb<s-interr-hwint.adb \
   s-intman.ads<s-intman-vxworks.ads \
   s-intman.adb<s-intman-vxworks.adb \
   a-numaux.adb<a-numaux-x86.adb \
@@ -610,7 +610,7 @@
   a-intnam.ads<a-intnam-vxworks.ads \
   a-numaux.ads<a-numaux-vxworks.ads \
   s-inmaop.adb<s-inmaop-posix.adb \
-  s-interr.adb<s-interr-vxworks.adb \
+  s-interr.adb<s-interr-hwint.adb \
   s-intman.ads<s-intman-vxworks.ads \
   s-intman.adb<s-intman-vxworks.adb \
   s-osinte.adb<s-osinte-vxworks.adb \
@@ -639,7 +639,7 @@
   a-intnam.ads<a-intnam-vxworks.ads \
   a-numaux.ads<a-numaux-vxworks.ads \
   s-inmaop.adb<s-inmaop-posix.adb \
-  s-interr.adb<s-interr-vxworks.adb \
+  s-interr.adb<s-interr-hwint.adb \
   s-intman.ads<s-intman-vxworks.ads \
   s-intman.adb<s-intman-vxworks.adb \
   s-osinte.adb<s-osinte-vxworks.adb \
@@ -1037,6 +1037,7 @@
 
 ifeq ($(strip $(filter-out rtems%,$(osys))),)
   LIBGNAT_TARGET_PAIRS = \
+  system.ads<system-rtems.ads \
   a-intnam.ads<a-intnam-rtems.ads \
   s-inmaop.adb<s-inmaop-posix.adb \
   s-intman.adb<s-intman-posix.adb \
@@ -1046,9 +1047,10 @@
   s-parame.adb<s-parame-rtems.adb \
   s-taprop.adb<s-taprop-posix.adb \
   s-taspri.ads<s-taspri-posix.ads \
-  s-auxdec.ads<s-auxdec-empty.ads \
-  s-auxdec.adb<s-auxdec-empty.adb \
-  s-tpopsp.adb<s-tpopsp-rtems.adb
+  s-tpopsp.adb<s-tpopsp-rtems.adb \
+  g-soccon.ads<g-soccon-rtems.ads \
+  s-stchop.adb<s-stchop-rtems.adb \
+  s-interr.adb<s-interr-hwint.adb
 endif
 
 ifeq ($(strip $(filter-out alpha% dec osf%,$(targ))),)
diff -uNr gcc-4.2.3-orig/gcc/ada/s-interr-hwint.adb gcc-4.2.3/gcc/ada/s-interr-hwint.adb
--- gcc-4.2.3-orig/gcc/ada/s-interr-hwint.adb	1969-12-31 18:00:00.000000000 -0600
+++ gcc-4.2.3/gcc/ada/s-interr-hwint.adb	2007-11-29 15:09:36.000000000 -0600
@@ -0,0 +1,1138 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                 GNAT 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-2007, 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,  51  Franklin  Street,  Fifth  Floor, --
+-- Boston, MA 02110-1301, 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 embedded RTOS 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 reasonably generic version of this package, supporting vectored
+--  hardware interrupts using non-RTOS specific adapter routines which
+--  should easily implemented on any RTOS capable of supporting GNAT.
+
+with Unchecked_Conversion;
+
+with System.OS_Interface; use System.OS_Interface;
+
+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.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 synchronizing 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 : Binary_Semaphore_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 Binary_Semaphore_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
+      System.OS_Interface.Interrupt_Handler;
+   --  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   : System.OS_Interface.Interrupt_Handler);
+   --  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
+
+      Interrupt_Vector_Set
+        (System.OS_Interface.Interrupt_Number_To_Vector (int (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   : System.OS_Interface.Interrupt_Handler)
+   is
+      Vec : constant Interrupt_Vector :=
+              Interrupt_Number_To_Vector (int (Interrupt));
+
+      Old_Handler : constant System.OS_Interface.Interrupt_Handler :=
+         Interrupt_Vector_Get (Interrupt_Number_To_Vector (int (Interrupt)));
+
+      Status : int;
+      pragma Unreferenced (Status);
+      --  ??? 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
+         Status := Interrupt_Connect
+            (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 Binary_Semaphore_Release
+   --  call, waking the server task.  When a handler is unbound,
+   --  System.Interrupts.Unbind_Handler issues a Binary_Semaphore_Flush,
+   --  and the server task deletes its semaphore and terminates.
+
+   procedure Notify_Interrupt (Param : System.Address) is
+      Interrupt : constant Interrupt_ID := Interrupt_ID (Param);
+
+      Status : int;
+      pragma Unreferenced (Status);
+      --  ??? shouldn't we test Stat at least in a pragma Assert?
+   begin
+      Status := Binary_Semaphore_Release (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 for hardware interrupts");
+   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
+         Status : int;
+         pragma Unreferenced (Status);
+         --  ??? shouldn't we test Stat at least in a pragma Assert?
+      begin
+         --  Hardware interrupt
+
+         Install_Default_Action (HW_Interrupt (Interrupt));
+
+         --  Flush server task off semaphore, allowing it to terminate
+
+         Status := Binary_Semaphore_Flush (Semaphore_ID_Map (Interrupt));
+      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, Binary_Semaphore_Create);
+            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, Binary_Semaphore_Create);
+                     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;
+
+      Status : int;
+      pragma Unreferenced (Status);
+      --  ??? shouldn't we test Stat at least in a pragma Assert?
+   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
+
+         Status := Binary_Semaphore_Obtain (Int_Sema);
+
+         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
+
+            Status := Binary_Semaphore_Delete (Int_Sema);
+
+            --  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;
diff -uNr gcc-4.2.3-orig/gcc/ada/s-interr-vxworks.adb gcc-4.2.3/gcc/ada/s-interr-vxworks.adb
--- gcc-4.2.3-orig/gcc/ada/s-interr-vxworks.adb	2006-02-15 03:29:17.000000000 -0600
+++ gcc-4.2.3/gcc/ada/s-interr-vxworks.adb	1969-12-31 18:00:00.000000000 -0600
@@ -1,1147 +0,0 @@
-------------------------------------------------------------------------------
---                                                                          --
---                 GNAT 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-2006, 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,  51  Franklin  Street,  Fifth  Floor, --
--- Boston, MA 02110-1301, 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.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 synchronizing 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;
diff -uNr gcc-4.2.3-orig/gcc/ada/s-osinte-rtems.adb gcc-4.2.3/gcc/ada/s-osinte-rtems.adb
--- gcc-4.2.3-orig/gcc/ada/s-osinte-rtems.adb	2005-06-30 20:29:17.000000000 -0500
+++ gcc-4.2.3/gcc/ada/s-osinte-rtems.adb	2007-11-29 15:11:45.000000000 -0600
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  B o d y                                 --
 --                                                                          --
---            Copyright (C) 1991-2002 Florida State University              --
+--            Copyright (C) 1991-2007 Florida State University              --
 --                                                                          --
 -- 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- --
@@ -57,6 +57,17 @@
       return Duration (TS.tv_sec) + Duration (TS.tv_nsec) / 10#1#E9;
    end To_Duration;
 
+   ------------------------
+   -- To_Target_Priority --
+   ------------------------
+
+   function To_Target_Priority
+     (Prio : System.Any_Priority) return Interfaces.C.int
+   is
+   begin
+      return Interfaces.C.int (Prio);
+   end To_Target_Priority;
+
    -----------------
    -- To_Timespec --
    -----------------
@@ -70,7 +81,10 @@
 
       --  If F has negative value due to round-up, adjust for positive F value
 
-      if F < 0.0 then S := S - 1; F := F + 1.0; end if;
+      if F < 0.0 then
+         S := S - 1;
+         F := F + 1.0;
+      end if;
       return timespec'(tv_sec => S,
                        tv_nsec => long (Long_Long_Integer (F * 10#1#E9)));
    end To_Timespec;
@@ -89,7 +103,10 @@
 
       --  If F has negative value due to a round-up, adjust for positive F
       --  value.
-      if F < 0.0 then S := S - 1; F := F + 1.0; end if;
+      if F < 0.0 then
+         S := S - 1;
+         F := F + 1.0;
+      end if;
       return
         struct_timeval'
           (tv_sec  => S,
diff -uNr gcc-4.2.3-orig/gcc/ada/s-osinte-rtems.ads gcc-4.2.3/gcc/ada/s-osinte-rtems.ads
--- gcc-4.2.3-orig/gcc/ada/s-osinte-rtems.ads	2007-07-08 09:18:34.000000000 -0500
+++ gcc-4.2.3/gcc/ada/s-osinte-rtems.ads	2007-11-29 16:27:29.000000000 -0600
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                   S p e c                                --
 --                                                                          --
---          Copyright (C) 1997-2003 Free Software Foundation, Inc.          --
+--          Copyright (C) 1997-2007 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- --
@@ -35,17 +35,21 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
---  This is the RTEMS version of this package
-
---  These are guesses based on what I think the GNARL team will want to
---  call the rtems configurations.  We use CPU-rtems for the rtems
---  configurations.
+--  This is the RTEMS version of this package.
+--
+--  RTEMS target names are of the form CPU-rtems.
+--  This implementation is designed to work on ALL RTEMS targets.
+--  The RTEMS implementation is primarily based upon the POSIX threads
+--  API but there are also bindings to GNAT/RTEMS support routines
+--  to insulate this code from C API specific details and, in some
+--  cases, obtain target architecture and BSP specific information
+--  that is unavailable at the time this package is built.
 
 --  This package encapsulates all direct interfaces to OS services
 --  that are needed by children of System.
 
 --  PLEASE DO NOT add any with-clauses to this package
---  or remove the pragma Elaborate_Body.
+--  or remove the pragma Preelaborate.
 --  It is designed to be a bottom-level (leaf) package.
 
 with Interfaces.C;
@@ -84,7 +88,13 @@
    -- Signals --
    -------------
 
-   Max_Interrupt : constant := 31;
+   Num_HW_Interrupts : constant := 256;
+
+   Max_HW_Interrupt : constant := Num_HW_Interrupts - 1;
+   type HW_Interrupt is new int range 0 .. Max_HW_Interrupt;
+
+   Max_Interrupt : constant := Max_HW_Interrupt;
+
    type Signal is new int range 0 .. Max_Interrupt;
 
    SIGXCPU     : constant := 0; --  XCPU
@@ -194,6 +204,10 @@
    SCHED_RR    : constant := 2;
    SCHED_OTHER : constant := 0;
 
+   function To_Target_Priority
+     (Prio : System.Any_Priority) return Interfaces.C.int;
+   --  Maps System.Any_Priority to a POSIX priority
+
    -------------
    -- Process --
    -------------
@@ -237,6 +251,9 @@
 
    PTHREAD_CREATE_DETACHED : constant := 0;
 
+   PTHREAD_SCOPE_PROCESS : constant := 0;
+   PTHREAD_SCOPE_SYSTEM  : constant := 1;
+
    -----------
    -- Stack --
    -----------
@@ -466,6 +483,78 @@
       destructor : destructor_pointer) return int;
    pragma Import (C, pthread_key_create, "pthread_key_create");
 
+   ------------------------------------------------------------
+   --   Binary Semaphore Wrapper to Support Interrupt Tasks  --
+   ------------------------------------------------------------
+
+   type Binary_Semaphore_Id is new rtems_id;
+
+   function Binary_Semaphore_Create return Binary_Semaphore_Id;
+   pragma Import (
+      C,
+      Binary_Semaphore_Create,
+      "__gnat_binary_semaphore_create");
+
+   function Binary_Semaphore_Delete (ID : Binary_Semaphore_Id) return int;
+   pragma Import (
+      C,
+      Binary_Semaphore_Delete,
+      "__gnat_binary_semaphore_delete");
+
+   function Binary_Semaphore_Obtain (ID : Binary_Semaphore_Id) return int;
+   pragma Import (
+      C,
+      Binary_Semaphore_Obtain,
+      "__gnat_binary_semaphore_obtain");
+
+   function Binary_Semaphore_Release (ID : Binary_Semaphore_Id) return int;
+   pragma Import (
+      C,
+      Binary_Semaphore_Release,
+      "__gnat_binary_semaphore_release");
+
+   function Binary_Semaphore_Flush (ID : Binary_Semaphore_Id) return int;
+   pragma Import (
+      C,
+      Binary_Semaphore_Flush,
+      "__gnat_binary_semaphore_flush");
+
+   ------------------------------------------------------------
+   -- Hardware Interrupt Wrappers to Support Interrupt Tasks --
+   ------------------------------------------------------------
+
+   type Interrupt_Handler is access procedure (parameter : System.Address);
+   type Interrupt_Vector is new System.Address;
+
+   function Interrupt_Connect
+     (Vector    : Interrupt_Vector;
+      Handler   : Interrupt_Handler;
+      Parameter : System.Address := System.Null_Address) return int;
+   pragma Import (C, Interrupt_Connect, "__gnat_interrupt_connect");
+   --  Use this to set up an user handler. The routine installs a
+   --  a user handler which is invoked after RTEMS has saved enough
+   --  context for a high-level language routine to be safely invoked.
+
+   function Interrupt_Vector_Get
+     (Vector : Interrupt_Vector) return Interrupt_Handler;
+   pragma Import (C, Interrupt_Vector_Get, "__gnat_interrupt_get");
+   --  Use this to get the existing handler for later restoral.
+
+   procedure Interrupt_Vector_Set
+     (Vector  : Interrupt_Vector;
+      Handler : Interrupt_Handler);
+   pragma Import (C, Interrupt_Vector_Set, "__gnat_interrupt_set");
+   --  Use this to restore a handler obtained using Interrupt_Vector_Get.
+
+   function Interrupt_Number_To_Vector (intNum : int) return Interrupt_Vector;
+   --  Convert a logical interrupt number to the hardware interrupt vector
+   --  number used to connect the interrupt.
+   pragma Import (
+      C,
+      Interrupt_Number_To_Vector,
+      "__gnat_interrupt_number_to_vector"
+   );
+
 private
 
    type sigset_t is new int;
diff -uNr gcc-4.2.3-orig/gcc/ada/s-osinte-vxworks.adb gcc-4.2.3/gcc/ada/s-osinte-vxworks.adb
--- gcc-4.2.3-orig/gcc/ada/s-osinte-vxworks.adb	2005-09-05 02:49:24.000000000 -0500
+++ gcc-4.2.3/gcc/ada/s-osinte-vxworks.adb	2007-12-06 08:56:01.000000000 -0600
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                   B o d y                                --
 --                                                                          --
---             Copyright (C) 1997-2005 Free Software Foundation             --
+--             Copyright (C) 1997-2007 Free Software Foundation             --
 --                                                                          --
 -- 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- --
@@ -192,4 +192,92 @@
       return 16#0008#;
    end VX_FP_TASK;
 
+   -----------------------------
+   -- Binary_Semaphore_Create --
+   -----------------------------
+
+   function Binary_Semaphore_Create return Binary_Semaphore_Id is
+   begin
+      return semBCreate (SEM_Q_FIFO, SEM_EMPTY);
+   end Binary_Semaphore_Create;
+
+   -----------------------------
+   -- Binary_Semaphore_Delete --
+   -----------------------------
+
+   function Binary_Semaphore_Delete (ID : Binary_Semaphore_Id) return int is
+   begin
+      return semDelete (ID);
+   end Binary_Semaphore_Obtain;
+
+   -----------------------------
+   -- Binary_Semaphore_Obtain --
+   -----------------------------
+
+   function Binary_Semaphore_Obtain (ID : Binary_Semaphore_Id) return int is
+   begin
+      return semTake (ID, WAIT_FOREVER);
+   end Binary_Semaphore_Obtain;
+
+   ------------------------------
+   -- Binary_Semaphore_Release --
+   ------------------------------
+
+   function Binary_Semaphore_Release (ID : Binary_Semaphore_Id) return int is
+   begin
+      return semGive (ID);
+   end Binary_Semaphore_Release;
+
+   ----------------------------
+   -- Binary_Semaphore_Flush --
+   ----------------------------
+
+   function Binary_Semaphore_Flush (ID : Binary_Semaphore_Id) return int is
+   begin
+      return semFlush (ID);
+   end Binary_Semaphore_Flush;
+
+
+   ----------------------------
+   -- Interrupt_Connect --
+   ----------------------------
+
+   function Interrupt_Connect
+     (Vector    : Interrupt_Vector;
+      Handler   : Interrupt_Handler;
+      Parameter : System.Address := System.Null_Address) return int is
+   begin
+     return intConnect (Vector, Handler, Parameter);
+   end Interrupt_Connect;
+
+   ----------------------------
+   -- Interrupt_Vector_Get --
+   ----------------------------
+
+   function Interrupt_Vector_Get
+     (Vector : Interrupt_Vector) return Interrupt_Handler is
+   begin
+     return intVecGet (Vector);
+   end Interrupt_Get;
+
+   ----------------------------
+   -- Interrupt_Vector_Set --
+   ----------------------------
+
+   procedure Interrupt_Vector_Set
+     (Vector  : Interrupt_Vector;
+      Handler : Interrupt_Handler) is
+   begin
+      intVecSet (Interfaces.VxWorks.INUM_TO_IVEC (Vector), Handler);
+   end Interrupt_Vector_Set;
+
+   ----------------------------r --
+   -- Interrupt_Number_To_Vector --
+   ----------------------------r --
+
+   function Interrupt_Number_To_Vector (intNum : int) return Interrupt_Vector is
+   begin
+      return INUM_TO_IVEC (Interfaces.VxWorks.int (Interrupt));
+   end Interrupt_Number_To_Vector;
+
 end System.OS_Interface;
diff -uNr gcc-4.2.3-orig/gcc/ada/s-osinte-vxworks.ads gcc-4.2.3/gcc/ada/s-osinte-vxworks.ads
--- gcc-4.2.3-orig/gcc/ada/s-osinte-vxworks.ads	2006-02-15 03:29:34.000000000 -0600
+++ gcc-4.2.3/gcc/ada/s-osinte-vxworks.ads	2007-12-06 08:56:07.000000000 -0600
@@ -7,7 +7,7 @@
 --                                   S p e c                                --
 --                                                                          --
 --             Copyright (C) 1991-1994, Florida State University            --
---             Copyright (C) 1995-2006, Free Software Foundation, Inc.      --
+--             Copyright (C) 1995-2007, 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- --
@@ -366,6 +366,50 @@
    pragma Import (C, semFlush, "semFlush");
    --  Release all threads blocked on the semaphore
 
+   ------------------------------------------------------------
+   --   Binary Semaphore Wrapper to Support Interrupt Tasks  --
+   ------------------------------------------------------------
+
+   type Binary_Semaphore_Id is new SEM_ID;
+
+   function Binary_Semaphore_Create return Binary_Semaphore_Id;
+
+   function Binary_Semaphore_Delete (ID : Binary_Semaphore_Id) return int;
+
+   function Binary_Semaphore_Obtain (ID : Binary_Semaphore_Id) return int;
+
+   function Binary_Semaphore_Release (ID : Binary_Semaphore_Id) return int;
+
+   function Binary_Semaphore_Flush (ID : Binary_Semaphore_Id) return int;
+
+   ------------------------------------------------------------
+   -- Hardware Interrupt Wrappers to Support Interrupt Tasks --
+   ------------------------------------------------------------
+
+   type Interrupt_Handler is access procedure (parameter : System.Address);
+   type Interrupt_Vector is new System.Address;
+
+   function Interrupt_Connect
+     (Vector    : Interrupt_Vector;
+      Handler   : Interrupt_Handler;
+      Parameter : System.Address := System.Null_Address) return int;
+   --  Use this to set up an user handler. The routine installs a
+   --  a user handler which is invoked after RTEMS has saved enough
+   --  context for a high-level language routine to be safely invoked.
+
+   function Interrupt_Vector_Get
+     (Vector : Interrupt_Vector) return Interrupt_Handler;
+   --  Use this to get the existing handler for later restoral.
+
+   procedure Interrupt_Vector_Set
+     (Vector  : Interrupt_Vector;
+      Handler : Interrupt_Handler);
+   --  Use this to restore a handler obtained using Interrupt_Vector_Get.
+
+   function Interrupt_Number_To_Vector (intNum : int) return Interrupt_Vector;
+   --  Convert a logical interrupt number to the hardware interrupt vector
+   --  number used to connect the interrupt.
+
 private
    type sigset_t is new long;
 
diff -uNr gcc-4.2.3-orig/gcc/ada/s-stchop-rtems.adb gcc-4.2.3/gcc/ada/s-stchop-rtems.adb
--- gcc-4.2.3-orig/gcc/ada/s-stchop-rtems.adb	1969-12-31 18:00:00.000000000 -0600
+++ gcc-4.2.3/gcc/ada/s-stchop-rtems.adb	2007-10-15 13:44:20.000000000 -0500
@@ -0,0 +1,96 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                 GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                 --
+--                                                                          --
+--     S Y S T E M . S T A C K _ C H E C K I N G . O P E R A T I O N S      --
+--                                                                          --
+--                                  B o d y                                 --
+--                                                                          --
+--          Copyright (C) 1999-2007, 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,  51  Franklin  Street,  Fifth  Floor, --
+-- Boston, MA 02110-1301, 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 RTEMS version of this package.
+--  This file should be kept synchronized with the general implementation
+--  provided by s-stchop.adb.
+
+pragma Restrictions (No_Elaboration_Code);
+--  We want to guarantee the absence of elaboration code because the
+--  binder does not handle references to this package.
+
+with Ada.Exceptions;
+
+with Interfaces.C; use Interfaces.C;
+
+package body System.Stack_Checking.Operations is
+
+   ----------------------------
+   -- Invalidate_Stack_Cache --
+   ----------------------------
+
+   procedure Invalidate_Stack_Cache (Any_Stack : Stack_Access) is
+      pragma Warnings (Off, Any_Stack);
+   begin
+      Cache := Null_Stack;
+   end Invalidate_Stack_Cache;
+
+   -----------------
+   -- Stack_Check --
+   -----------------
+
+   function Stack_Check
+     (Stack_Address : System.Address) return Stack_Access
+   is
+      pragma Unreferenced (Stack_Address);
+
+      --  RTEMS has a routine to check this.  So use it.
+      function rtems_stack_checker_is_blown return Interfaces.C.int;
+      pragma Import (C,
+         rtems_stack_checker_is_blown, "rtems_stack_checker_is_blown");
+
+   begin
+      --  RTEMS has a routine to check this.  So use it.
+
+      if rtems_stack_checker_is_blown /= 0 then
+         Ada.Exceptions.Raise_Exception
+           (E       => Storage_Error'Identity,
+            Message => "stack overflow detected");
+      end if;
+
+      return null;
+
+   end Stack_Check;
+
+   ------------------------
+   -- Update_Stack_Cache --
+   ------------------------
+
+   procedure Update_Stack_Cache (Stack : Stack_Access) is
+   begin
+      if not Multi_Processor then
+         Cache := Stack;
+      end if;
+   end Update_Stack_Cache;
+
+end System.Stack_Checking.Operations;
diff -uNr gcc-4.2.3-orig/gcc/ada/system-rtems.ads gcc-4.2.3/gcc/ada/system-rtems.ads
--- gcc-4.2.3-orig/gcc/ada/system-rtems.ads	1969-12-31 18:00:00.000000000 -0600
+++ gcc-4.2.3/gcc/ada/system-rtems.ads	2007-12-05 12:26:38.000000000 -0600
@@ -0,0 +1,168 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                        GNAT RUN-TIME COMPONENTS                          --
+--                                                                          --
+--                               S Y S T E M                                --
+--                                                                          --
+--                                 S p e c                                  --
+--                            (Compiler Version)                            --
+--                                                                          --
+--          Copyright (C) 1992-2007 Free Software Foundation, Inc.          --
+--                                                                          --
+-- This specification is derived from the Ada Reference Manual for use with --
+-- GNAT. The copyright notice above, and the license provisions that follow --
+-- apply solely to the  contents of the part following the private keyword. --
+--                                                                          --
+-- GNAT 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.  GNAT 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 GNAT;  see file COPYING.  If not, write --
+-- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
+-- Boston, MA 02110-1301, 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.                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  This version of System is a RTEMS version that is used in building
+--  the compiler.  This is based as closely as possible on the generic
+--  version with the following exceptions:
+--      + priority definitions
+
+package System is
+   pragma Pure;
+   --  Note that we take advantage of the implementation permission to make
+   --  this unit Pure instead of Preelaborable; see RM 13.7.1(15). In Ada
+   --  2005, this is Pure in any case (AI-362).
+
+   type Name is (SYSTEM_NAME_GNAT);
+   System_Name : constant Name := SYSTEM_NAME_GNAT;
+
+   --  System-Dependent Named Numbers
+
+   Min_Int               : constant := Long_Long_Integer'First;
+   Max_Int               : constant := Long_Long_Integer'Last;
+
+   Max_Binary_Modulus    : constant := 2 ** Long_Long_Integer'Size;
+   Max_Nonbinary_Modulus : constant := Integer'Last;
+
+   Max_Base_Digits       : constant := Long_Long_Float'Digits;
+   Max_Digits            : constant := Long_Long_Float'Digits;
+
+   Max_Mantissa          : constant := 63;
+   Fine_Delta            : constant := 2.0 ** (-Max_Mantissa);
+
+   Tick                  : constant := 0.01;
+
+   --  Storage-related Declarations
+
+   type Address is private;
+   Null_Address : constant Address;
+
+   Storage_Unit : constant := Standard'Storage_Unit;
+   Word_Size    : constant := Standard'Word_Size;
+   Memory_Size  : constant := 2 ** Standard'Address_Size;
+
+   --  Address comparison
+
+   function "<"  (Left, Right : Address) return Boolean;
+   function "<=" (Left, Right : Address) return Boolean;
+   function ">"  (Left, Right : Address) return Boolean;
+   function ">=" (Left, Right : Address) return Boolean;
+   function "="  (Left, Right : Address) return Boolean;
+
+   pragma Import (Intrinsic, "<");
+   pragma Import (Intrinsic, "<=");
+   pragma Import (Intrinsic, ">");
+   pragma Import (Intrinsic, ">=");
+   pragma Import (Intrinsic, "=");
+
+   --  Other System-Dependent Declarations
+
+   type Bit_Order is (High_Order_First, Low_Order_First);
+   Default_Bit_Order : constant Bit_Order :=
+                         Bit_Order'Val (Standard'Default_Bit_Order);
+   pragma Warnings (Off, Default_Bit_Order); -- kill constant condition warning
+
+   --  Priority-related Declarations (RM D.1)
+
+   --  RTEMS POSIX threads support 256 priority levels with 255 being
+   --  logically the most important. Levels 0 and 255 are reserved.
+   --
+   --  255        is reserved for RTEMS system tasks
+   --  247 - 254  correspond to hardware interrupt levels 0 .. 7
+   --  246        is a catchall default "interrupt" priority for signals,
+   --             allowing higher priority than normal tasks, but lower than
+   --             hardware priority levels.  Protected Object ceilings can
+   --             override these values.
+   --  245        is used by the Interrupt_Manager task
+   --  0          is reserved for the RTEMS IDLE task and really should not
+   --             be accessible from Ada but GNAT initializes
+   --             Current_Priority to 0 so it must be valid
+
+   Max_Priority           : constant Positive := 244;
+   Max_Interrupt_Priority : constant Positive := 254;
+
+   subtype Any_Priority       is Integer      range   0 .. 254;
+   subtype Priority           is Any_Priority range   0 .. 244;
+   subtype Interrupt_Priority is Any_Priority range 245 .. 254;
+
+   Default_Priority : constant Priority := 122;
+
+private
+
+   type Address is mod Memory_Size;
+   Null_Address : constant Address := 0;
+
+   --------------------------------------
+   -- System Implementation Parameters --
+   --------------------------------------
+
+   --  These parameters provide information about the target that is used
+   --  by the compiler. They are in the private part of System, where they
+   --  can be accessed using the special circuitry in the Targparm unit
+   --  whose source should be consulted for more detailed descriptions
+   --  of the individual switch values.
+
+   Backend_Divide_Checks     : constant Boolean := False;
+   Backend_Overflow_Checks   : constant Boolean := False;
+   Command_Line_Args         : constant Boolean := True;
+   Configurable_Run_Time     : constant Boolean := False;
+   Denorm                    : constant Boolean := True;
+   Duration_32_Bits          : constant Boolean := False;
+   Exit_Status_Supported     : constant Boolean := True;
+   Fractional_Fixed_Ops      : constant Boolean := False;
+   Frontend_Layout           : constant Boolean := False;
+   Machine_Overflows         : constant Boolean := False;
+   Machine_Rounds            : constant Boolean := True;
+   Preallocated_Stacks       : constant Boolean := False;
+   Signed_Zeros              : constant Boolean := True;
+   Stack_Check_Default       : constant Boolean := False;
+   Stack_Check_Probes        : constant Boolean := False;
+   Support_64_Bit_Divides    : constant Boolean := True;
+   Support_Aggregates        : constant Boolean := True;
+   Support_Composite_Assign  : constant Boolean := True;
+   Support_Composite_Compare : constant Boolean := True;
+   Support_Long_Shifts       : constant Boolean := True;
+   Suppress_Standard_Library : constant Boolean := False;
+   Use_Ada_Main_Program_Name : constant Boolean := False;
+   ZCX_By_Default            : constant Boolean := False;
+   GCC_ZCX_Support           : constant Boolean := True;
+
+   --  One would think you did not have to define this but
+   --  it is used in the run-time.
+   OpenVMS                   : constant Boolean := False;
+
+end System;
Binary files gcc-4.2.3-orig/gcc/ada/.system-vxworks-alpha.ads.swp and gcc-4.2.3/gcc/ada/.system-vxworks-alpha.ads.swp differ
