re PR ada/35143 (Serious regression on ACATS results since 4.2.3)

2008-02-11  Joel Sherrill <joel.sherrill@oarcorp.com>

	PR ada/35143
	* env.c: Add __rtems__ to if defined.
	* s-osinte-rtems.adb: Add To_Target_Priority.  Fix formatting.
	* s-osinte-rtems.ads: Add To_Target_Priority prototype and
	PTHREAD_SCOPE_PROCESS/PTHREAD_SCOPE_SYSTEM constants.  Add
	pragma Convention as required.
	* gsocket.h: Make compile in and out of RTS.
	* Makefile.in: Add system-rtems.ads.  Build DEC extensions.
	Use g-soccon-rtems.ads.
	* g-soccon-rtems.ads, system-rtems.ads: New files.

From-SVN: r132294

8 files changed, 423 insertions, 12 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index c8914b2..404c262 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,16 @@
+2008-02-11  Joel Sherrill <joel.sherrill@oarcorp.com>
+
+	PR ada/35143
+	* env.c: Add __rtems__ to if defined.
+	* s-osinte-rtems.adb: Add To_Target_Priority.  Fix formatting.
+	* s-osinte-rtems.ads: Add To_Target_Priority prototype and
+	PTHREAD_SCOPE_PROCESS/PTHREAD_SCOPE_SYSTEM constants.  Add
+	pragma Convention as required.
+	* gsocket.h: Make compile in and out of RTS.
+	* Makefile.in: Add system-rtems.ads.  Build DEC extensions.
+	Use g-soccon-rtems.ads.
+	* g-soccon-rtems.ads, system-rtems.ads: New files.
+
 2008-02-06  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
 
 	PR other/35107
diff --git a/gcc/ada/Makefile.in b/gcc/ada/Makefile.in
index 3dd5298..2869926 100644
--- a/gcc/ada/Makefile.in
+++ b/gcc/ada/Makefile.in
@@ -1,5 +1,5 @@
 # Makefile for GNU Ada Compiler (GNAT).
-#   Copyright (C) 1994-2007 Free Software Foundation, Inc.
+#   Copyright (C) 1994-2008 Free Software Foundation, Inc.
 
 #This file is part of GCC.
 
@@ -1136,6 +1136,7 @@ endif
 
 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 \
@@ -1145,9 +1146,9 @@ ifeq ($(strip $(filter-out rtems%,$(osys))),)
   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
 endif
 
 ifeq ($(strip $(filter-out alpha% dec osf%,$(targ))),)
diff --git a/gcc/ada/env.c b/gcc/ada/env.c
index 46bfe1b0c..01c25d6 100644
--- a/gcc/ada/env.c
+++ b/gcc/ada/env.c
@@ -6,7 +6,7 @@
  *                                                                          *
  *                          C Implementation File                           *
  *                                                                          *
- *            Copyright (C) 2005-2007, Free Software Foundation, Inc.       *
+ *            Copyright (C) 2005-2008, 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- *
@@ -290,7 +290,7 @@ void __gnat_clearenv (void) {
   }
 #elif defined (__MINGW32__) || defined (__FreeBSD__) || defined (__APPLE__) \
    || (defined (__vxworks) && defined (__RTP__)) || defined (__CYGWIN__) \
-   || defined (__NetBSD__) || defined (__OpenBSD__)
+   || defined (__NetBSD__) || defined (__OpenBSD__) || 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 --git a/gcc/ada/g-soccon-rtems.ads b/gcc/ada/g-soccon-rtems.ads
new file mode 100644
index 0000000..cc7e56d
--- /dev/null
+++ b/gcc/ada/g-soccon-rtems.ads
@@ -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;
diff --git a/gcc/ada/gsocket.h b/gcc/ada/gsocket.h
index 7df7ea0..bfdf123 100644
--- a/gcc/ada/gsocket.h
+++ b/gcc/ada/gsocket.h
@@ -6,7 +6,7 @@
  *                                                                          *
  *                              C Header File                               *
  *                                                                          *
- *         Copyright (C) 2004-2006, Free Software Foundation, Inc.          *
+ *         Copyright (C) 2004-2008, 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 --git a/gcc/ada/s-osinte-rtems.adb b/gcc/ada/s-osinte-rtems.adb
index 0a8e681..494947c 100644
--- a/gcc/ada/s-osinte-rtems.adb
+++ b/gcc/ada/s-osinte-rtems.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  B o d y                                 --
 --                                                                          --
---            Copyright (C) 1991-2002 Florida State University              --
+--            Copyright (C) 1991-2008 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 @@ package body System.OS_Interface is
       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 @@ package body System.OS_Interface is
 
       --  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 @@ package body System.OS_Interface is
 
       --  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 --git a/gcc/ada/s-osinte-rtems.ads b/gcc/ada/s-osinte-rtems.ads
index 561e897..268eb43 100644
--- a/gcc/ada/s-osinte-rtems.ads
+++ b/gcc/ada/s-osinte-rtems.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                   S p e c                                --
 --                                                                          --
---          Copyright (C) 1997-2003 Free Software Foundation, Inc.          --
+--          Copyright (C) 1997-2008 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- --
@@ -194,6 +194,10 @@ package System.OS_Interface is
    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 --
    -------------
@@ -222,6 +226,7 @@ package System.OS_Interface is
 
    type Thread_Body is access
      function (arg : System.Address) return System.Address;
+   pragma Convention (C, Thread_Body);
 
    type pthread_t           is private;
    subtype Thread_Id        is pthread_t;
@@ -237,6 +242,9 @@ package System.OS_Interface is
 
    PTHREAD_CREATE_DETACHED : constant := 0;
 
+   PTHREAD_SCOPE_PROCESS : constant := 0;
+   PTHREAD_SCOPE_SYSTEM  : constant := 1;
+
    -----------
    -- Stack --
    -----------
@@ -460,6 +468,7 @@ package System.OS_Interface is
    pragma Import (C, pthread_getspecific, "pthread_getspecific");
 
    type destructor_pointer is access procedure (arg : System.Address);
+   pragma Convention (C, destructor_pointer);
 
    function pthread_key_create
      (key        : access pthread_key_t;
diff --git a/gcc/ada/system-rtems.ads b/gcc/ada/system-rtems.ads
new file mode 100644
index 0000000..95338f5
--- /dev/null
+++ b/gcc/ada/system-rtems.ads
@@ -0,0 +1,168 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                        GNAT RUN-TIME COMPONENTS                          --
+--                                                                          --
+--                               S Y S T E M                                --
+--                                                                          --
+--                                 S p e c                                  --
+--                            (Compiler Version)                            --
+--                                                                          --
+--          Copyright (C) 1992-2008 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;