This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

GNAT/RTEMS Update


Hi,

Attached is a patch against 4.2.2 and the SVN
trunk which updates the RTEMS target.  Overall,
it does the following:

+ Adds stack checking for RTEMS
+ Adds GNAT socket support for RTEMS
+ Adds a shared hardware interrupt implementation
 based upon the VxWorks code.  Both VxWorks and
 RTEMS were updated to share this code.

ACATS ran very well on 4.2.2 targeting the PowerPC
with only 3 failures which were not RTEMS related.
On the SVN trunk, there were lots of failures but
they all appeared to be overflow, range checking, etc.
I did not see any which appeared to hint at an
RTEMS specific tasking issue.

The gnat1 huge compile time is obvious which running
ACATS.  It was about 80 minutes for 4.2.2 and about 911
minutes (yes 15 hours!!) for the SVN trunk.

I verified the RTEMS hardware interrupt support on a
SPARC target but did not run the full ACATS on that
target. I did earlier and it did good as well.  I can
NOT compile or test the VxWorks modifications but did
them per Arnaud's earlier request.

FWIW I didn't want to include 0 in the valid priority
range for RTEMS but it is used in the initialization
of Current_Priority.  I know it isn't a big deal but why
the hard-coded number which might be out of range?

--joel
diff -uNr gcc-4.2.2-orig/gcc/ada/env.c gcc-4.2.2/gcc/ada/env.c
--- gcc-4.2.2-orig/gcc/ada/env.c	2007-08-22 12:54:43.000000000 -0500
+++ gcc-4.2.2/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.2-orig/gcc/ada/gen-soccon.c gcc-4.2.2/gcc/ada/gen-soccon.c
--- gcc-4.2.2-orig/gcc/ada/gen-soccon.c	2005-11-15 07:50:37.000000000 -0600
+++ gcc-4.2.2/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.2-orig/gcc/ada/g-soccon-rtems.ads gcc-4.2.2/gcc/ada/g-soccon-rtems.ads
--- gcc-4.2.2-orig/gcc/ada/g-soccon-rtems.ads	1969-12-31 18:00:00.000000000 -0600
+++ gcc-4.2.2/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.2-orig/gcc/ada/gsocket.h gcc-4.2.2/gcc/ada/gsocket.h
--- gcc-4.2.2-orig/gcc/ada/gsocket.h	2005-11-15 07:50:37.000000000 -0600
+++ gcc-4.2.2/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.2-orig/gcc/ada/Makefile.in gcc-4.2.2/gcc/ada/Makefile.in
--- gcc-4.2.2-orig/gcc/ada/Makefile.in	2007-09-03 08:11:02.000000000 -0500
+++ gcc-4.2.2/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.2-orig/gcc/ada/s-interr-hwint.adb gcc-4.2.2/gcc/ada/s-interr-hwint.adb
--- gcc-4.2.2-orig/gcc/ada/s-interr-hwint.adb	1969-12-31 18:00:00.000000000 -0600
+++ gcc-4.2.2/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.2-orig/gcc/ada/s-interr-vxworks.adb gcc-4.2.2/gcc/ada/s-interr-vxworks.adb
--- gcc-4.2.2-orig/gcc/ada/s-interr-vxworks.adb	2006-02-15 03:29:17.000000000 -0600
+++ gcc-4.2.2/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.2-orig/gcc/ada/s-osinte-rtems.adb gcc-4.2.2/gcc/ada/s-osinte-rtems.adb
--- gcc-4.2.2-orig/gcc/ada/s-osinte-rtems.adb	2005-06-30 20:29:17.000000000 -0500
+++ gcc-4.2.2/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.2-orig/gcc/ada/s-osinte-rtems.ads gcc-4.2.2/gcc/ada/s-osinte-rtems.ads
--- gcc-4.2.2-orig/gcc/ada/s-osinte-rtems.ads	2007-07-08 09:18:34.000000000 -0500
+++ gcc-4.2.2/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.2-orig/gcc/ada/s-osinte-vxworks.adb gcc-4.2.2/gcc/ada/s-osinte-vxworks.adb
--- gcc-4.2.2-orig/gcc/ada/s-osinte-vxworks.adb	2005-09-05 02:49:24.000000000 -0500
+++ gcc-4.2.2/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.2-orig/gcc/ada/s-osinte-vxworks.ads gcc-4.2.2/gcc/ada/s-osinte-vxworks.ads
--- gcc-4.2.2-orig/gcc/ada/s-osinte-vxworks.ads	2006-02-15 03:29:34.000000000 -0600
+++ gcc-4.2.2/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.2-orig/gcc/ada/s-stchop-rtems.adb gcc-4.2.2/gcc/ada/s-stchop-rtems.adb
--- gcc-4.2.2-orig/gcc/ada/s-stchop-rtems.adb	1969-12-31 18:00:00.000000000 -0600
+++ gcc-4.2.2/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.2-orig/gcc/ada/system-rtems.ads gcc-4.2.2/gcc/ada/system-rtems.ads
--- gcc-4.2.2-orig/gcc/ada/system-rtems.ads	1969-12-31 18:00:00.000000000 -0600
+++ gcc-4.2.2/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.2-orig/gcc/ada/.system-vxworks-alpha.ads.swp and gcc-4.2.2/gcc/ada/.system-vxworks-alpha.ads.swp differ
Index: gcc/ada/s-interr-hwint.adb
===================================================================
--- gcc/ada/s-interr-hwint.adb	(revision 0)
+++ gcc/ada/s-interr-hwint.adb	(revision 0)
@@ -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;
Index: gcc/ada/s-interr-vxworks.adb
===================================================================
--- gcc/ada/s-interr-vxworks.adb	(revision 130603)
+++ gcc/ada/s-interr-vxworks.adb	(working copy)
@@ -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-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 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 Ada.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 Ada.Unchecked_Conversion
-     (System.Tasking.Task_Id, Ada.Task_Identification.Task_Id);
-
-   function To_System is new Ada.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 Ada.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;
Index: gcc/ada/env.c
===================================================================
--- gcc/ada/env.c	(revision 130603)
+++ gcc/ada/env.c	(working copy)
@@ -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 */
Index: gcc/ada/s-osinte-rtems.adb
===================================================================
--- gcc/ada/s-osinte-rtems.adb	(revision 130603)
+++ gcc/ada/s-osinte-rtems.adb	(working copy)
@@ -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,
Index: gcc/ada/s-osinte-rtems.ads
===================================================================
--- gcc/ada/s-osinte-rtems.ads	(revision 130603)
+++ gcc/ada/s-osinte-rtems.ads	(working copy)
@@ -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
+--  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.
 
---  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 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;
Index: gcc/ada/s-osinte-vxworks.adb
===================================================================
--- gcc/ada/s-osinte-vxworks.adb	(revision 130603)
+++ gcc/ada/s-osinte-vxworks.adb	(working copy)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                   B o d y                                --
 --                                                                          --
---         Copyright (C) 1997-2007, Free Software Foundation, Inc.          --
+--             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- --
@@ -239,4 +239,92 @@
       return int (Ticks);
    end To_Clock_Ticks;
 
+   -----------------------------
+   -- 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;
Index: gcc/ada/s-osinte-vxworks.ads
===================================================================
--- gcc/ada/s-osinte-vxworks.ads	(revision 130603)
+++ gcc/ada/s-osinte-vxworks.ads	(working copy)
@@ -7,7 +7,7 @@
 --                                   S p e c                                --
 --                                                                          --
 --             Copyright (C) 1991-1994, Florida State University            --
---          Copyright (C) 1995-2007, 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- --
@@ -392,6 +392,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;
 
Index: gcc/ada/gsocket.h
===================================================================
--- gcc/ada/gsocket.h	(revision 130603)
+++ gcc/ada/gsocket.h	(working copy)
@@ -6,7 +6,7 @@
  *                                                                          *
  *                              C Header File                               *
  *                                                                          *
- *         Copyright (C) 2004-2006, 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>
Index: gcc/ada/g-soccon-rtems.ads
===================================================================
--- gcc/ada/g-soccon-rtems.ads	(revision 0)
+++ gcc/ada/g-soccon-rtems.ads	(revision 0)
@@ -0,0 +1,195 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         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_REUSEPORT       : constant :=          -1; --  Bind reuse port number
+   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
+
+   ----------------------------------------
+   -- Properties of supported interfaces --
+   ----------------------------------------
+
+   Need_Netdb_Buffer  : constant :=           1; --  Need buffer for Netdb ops
+
+   ----------------------
+   -- Additional flags --
+   ----------------------
+
+   Thread_Blocking_IO : constant Boolean := True;
+   --  Set False for contexts where socket i/o are process blocking
+
+end GNAT.Sockets.Constants;
Index: gcc/ada/Makefile.in
===================================================================
--- gcc/ada/Makefile.in	(revision 130603)
+++ gcc/ada/Makefile.in	(working copy)
@@ -120,7 +120,7 @@
 SOME_ADAFLAGS =-gnata
 FORCE_DEBUG_ADAFLAGS = -g
 GNATLIBFLAGS = -gnatpg -nostdinc
-GNATLIBCFLAGS = -g -O2
+GNATLIBCFLAGS = -g -O0
 GNATLIBCFLAGS_FOR_C = $(GNATLIBCFLAGS) $(TARGET_LIBGCC2_CFLAGS) -fexceptions \
 	-DIN_RTS
 ALL_ADA_CFLAGS = $(X_ADA_CFLAGS) $(T_ADA_CFLAGS) $(ADA_CFLAGS)
@@ -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 \
@@ -470,7 +470,7 @@
     EXTRA_GNATRTL_NONTASKING_OBJS=s-vxwexc.o
   else
     LIBGNAT_TARGET_PAIRS += \
-    s-interr.adb<s-interr-vxworks.adb \
+    s-interr.adb<s-interr-hwint.adb \
     s-tpopsp.adb<s-tpopsp-vxworks.adb \
     system.ads<system-vxworks-ppc.ads
 
@@ -500,7 +500,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 \
@@ -547,7 +547,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 \
@@ -619,7 +619,7 @@
     EXTRA_GNATRTL_NONTASKING_OBJS=s-vxwexc.o
   else
     LIBGNAT_TARGET_PAIRS += \
-    s-interr.adb<s-interr-vxworks.adb \
+    s-interr.adb<s-interr-hwint.adb \
     s-tpopsp.adb<s-tpopsp-vxworks.adb \
     system.ads<system-vxworks-x86.ads
 
@@ -644,7 +644,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 \
@@ -676,7 +676,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 \
@@ -1112,6 +1112,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 \
@@ -1121,9 +1122,12 @@
   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
+
+  EH_MECHANISM=-gcc
 endif
 
 ifeq ($(strip $(filter-out alpha% dec osf%,$(targ))),)
Index: gcc/ada/system-rtems.ads
===================================================================
--- gcc/ada/system-rtems.ads	(revision 0)
+++ gcc/ada/system-rtems.ads	(revision 0)
@@ -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;
2007-12-06  Joel Sherrill <joel.sherrill@oarcorp.com>

	* Makefile.in: Switch RTEMS and VxWorks to s-interr-hwint.adb.
	For RTEMS, add stack checking, socket support and enable DEC
	extensions.
	* s-interr-hwint.adb: New file with portable implementation.
 	* s-interr-vxworks.adb: Removed.
	* env.c: Add __rtems__ conditional.
	* s-osinte-rtems.adb, s-osinte-rtems.ads, s-osinte-vxworks.adb,
	s-osinte-vxworks.ads: Add shared hardware interrupt adapter layer.
	* gsocket.h: Add __rtems__ conditional since .h files are not
	available when GCC is built.
	* g-soccon-rtems.ads: New file.
	* system-rtems.ads: New file.  Includes Ada interrupt priorities.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]