diff options
| author | Richard Kenner <kenner@gcc.gnu.org> | 2001-10-02 09:35:49 -0400 |
|---|---|---|
| committer | Richard Kenner <kenner@gcc.gnu.org> | 2001-10-02 09:35:49 -0400 |
| commit | 6cbd1b6f7ebf08244942dd1aaae5ae73ef79da48 (patch) | |
| tree | 8039778417b2122e974910f3074427072e0ef202 /gcc | |
| parent | 644eddaac53831b51967cea591f0bdf3b5e770a7 (diff) | |
| download | gcc-6cbd1b6f7ebf08244942dd1aaae5ae73ef79da48.zip gcc-6cbd1b6f7ebf08244942dd1aaae5ae73ef79da48.tar.gz gcc-6cbd1b6f7ebf08244942dd1aaae5ae73ef79da48.tar.bz2 | |
New Language: Ada
From-SVN: r45950
Diffstat (limited to 'gcc')
43 files changed, 5880 insertions, 0 deletions
diff --git a/gcc/ada/1aexcept.adb b/gcc/ada/1aexcept.adb new file mode 100644 index 0000000..2b122b6 --- /dev/null +++ b/gcc/ada/1aexcept.adb @@ -0,0 +1,51 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- A D A . E X C E P T I O N S -- +-- -- +-- B o d y -- +-- -- +-- $Revision: 1.1 $ +-- -- +-- Copyright (C) 1992-2001 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, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). -- +-- -- +------------------------------------------------------------------------------ + +package body Ada.Exceptions is + + procedure Last_Chance_Handler (Msg : System.Address; Line : Integer); + pragma Import (C, Last_Chance_Handler, "__gnat_last_chance_handler"); + pragma No_Return (Last_Chance_Handler); + + --------------------- + -- Raise_Exception -- + --------------------- + + procedure Raise_Exception (E : Exception_Id; Message : String := "") is + begin + Last_Chance_Handler (Message'Address, 0); + end Raise_Exception; + +end Ada.Exceptions; diff --git a/gcc/ada/1aexcept.ads b/gcc/ada/1aexcept.ads new file mode 100644 index 0000000..7281516 --- /dev/null +++ b/gcc/ada/1aexcept.ads @@ -0,0 +1,68 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- A D A . E X C E P T I O N S -- +-- (Version for No Exception Handlers) -- +-- -- +-- S p e c -- +-- -- +-- $Revision: 1.1 $ +-- -- +-- Copyright (C) 1992-2001 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, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). -- +-- -- +------------------------------------------------------------------------------ + +-- This version is for use when the restriction No_Exception_Handlers +-- is enabled. + +with System; + +package Ada.Exceptions is + + type Exception_Id is private; + + Null_Id : constant Exception_Id; + + procedure Raise_Exception (E : Exception_Id; Message : String := ""); + -- Unconditionally call __gnat_last_chance_handler. + -- Message should be a null terminated string. + pragma No_Return (Raise_Exception); + +private + + ------------------ + -- Exception_Id -- + ------------------ + + type Exception_Id is new System.Address; + Null_Id : constant Exception_Id := Exception_Id (System.Null_Address); + + pragma Inline_Always (Raise_Exception); + +end Ada.Exceptions; diff --git a/gcc/ada/1ic.ads b/gcc/ada/1ic.ads new file mode 100644 index 0000000..df8828a --- /dev/null +++ b/gcc/ada/1ic.ads @@ -0,0 +1,85 @@ +----------------------------------------------------------------------------- +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- I N T E R F A C E S . C -- +-- -- +-- S p e c -- +-- -- +-- $Revision: 1.1 $ +-- -- +-- This specification is adapted from the Ada Reference Manual for use with -- +-- GNAT Hi Integrity Edition. In accordance with the copyright of that -- +-- document, you can freely copy and modify this specification, provided -- +-- that if you redistribute a modified version, any changes that you have -- +-- made are clearly indicated. -- +-- -- +------------------------------------------------------------------------------ + +-- This version contains only the type definitions for standard interfacing +-- with C. All functions have been removed from the original spec. + +package Interfaces.C is +pragma Pure (C); + + -- Declaration's based on C's <limits.h> + + CHAR_BIT : constant := 8; + SCHAR_MIN : constant := -128; + SCHAR_MAX : constant := 127; + UCHAR_MAX : constant := 255; + + -- Signed and Unsigned Integers. Note that in GNAT, we have ensured that + -- the standard predefined Ada types correspond to the standard C types + + type int is new Integer; + type short is new Short_Integer; + type long is new Long_Integer; + + type signed_char is range SCHAR_MIN .. SCHAR_MAX; + for signed_char'Size use CHAR_BIT; + + type unsigned is mod 2 ** int'Size; + type unsigned_short is mod 2 ** short'Size; + type unsigned_long is mod 2 ** long'Size; + + type unsigned_char is mod (UCHAR_MAX + 1); + for unsigned_char'Size use CHAR_BIT; + + subtype plain_char is unsigned_char; + + type ptrdiff_t is + range -(2 ** (Standard'Address_Size - 1)) .. + +(2 ** (Standard'Address_Size - 1) - 1); + + type size_t is mod 2 ** Standard'Address_Size; + + -- Floating-Point + + type C_float is new Float; + type double is new Standard.Long_Float; + type long_double is new Standard.Long_Long_Float; + + ---------------------------- + -- Characters and Strings -- + ---------------------------- + + type char is new Character; + + nul : constant char := char'First; + + type char_array is array (size_t range <>) of aliased char; + for char_array'Component_Size use CHAR_BIT; + + ------------------------------------ + -- Wide Character and Wide String -- + ------------------------------------ + + type wchar_t is new Wide_Character; + for wchar_t'Size use Standard'Wchar_T_Size; + + wide_nul : constant wchar_t := wchar_t'First; + + type wchar_array is array (size_t range <>) of aliased wchar_t; + +end Interfaces.C; diff --git a/gcc/ada/31soccon.ads b/gcc/ada/31soccon.ads new file mode 100644 index 0000000..b0b4838 --- /dev/null +++ b/gcc/ada/31soccon.ads @@ -0,0 +1,115 @@ +------------------------------------------------------------------------------ +-- -- +-- 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 -- +-- -- +-- $Revision: 1.1 $ +-- -- +-- Copyright (C) 2001 Ada Core Technologies, 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, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNAT is maintained by Ada Core Technologies Inc (http://www.gnat.com). -- +-- -- +------------------------------------------------------------------------------ + +-- This is the version for UnixWare + +package GNAT.Sockets.Constants is + + -- Families + + AF_INET : constant := 2; + AF_INET6 : constant := 27; + + -- Modes + + SOCK_STREAM : constant := 2; + SOCK_DGRAM : constant := 1; + + -- Socket Errors + + EBADF : constant := 9; + ENOTSOCK : constant := 95; + ENOTCONN : constant := 134; + ENOBUFS : constant := 132; + EOPNOTSUPP : constant := 122; + EFAULT : constant := 14; + EWOULDBLOCK : constant := 11; + EADDRNOTAVAIL : constant := 126; + EMSGSIZE : constant := 97; + EADDRINUSE : constant := 125; + EINVAL : constant := 22; + EACCES : constant := 13; + EAFNOSUPPORT : constant := 124; + EISCONN : constant := 133; + ETIMEDOUT : constant := 145; + ECONNREFUSED : constant := 146; + ENETUNREACH : constant := 128; + EALREADY : constant := 149; + EINPROGRESS : constant := 150; + ENOPROTOOPT : constant := 99; + EPROTONOSUPPORT : constant := 120; + EINTR : constant := 4; + EIO : constant := 5; + ESOCKTNOSUPPORT : constant := 121; + + -- Host Errors + + HOST_NOT_FOUND : constant := 1; + TRY_AGAIN : constant := 2; + NO_ADDRESS : constant := 4; + NO_RECOVERY : constant := 3; + + -- Control Flags + + FIONBIO : constant := -2147195266; + FIONREAD : constant := 1074030207; + + -- Shutdown Modes + + SHUT_RD : constant := 0; + SHUT_WR : constant := 1; + SHUT_RDWR : constant := 2; + + -- Protocol Levels + + SOL_SOCKET : constant := 65535; + IPPROTO_IP : constant := 0; + IPPROTO_UDP : constant := 17; + IPPROTO_TCP : constant := 6; + + -- Socket Options + + TCP_NODELAY : constant := 1; + SO_SNDBUF : constant := 4097; + SO_RCVBUF : constant := 4098; + SO_REUSEADDR : constant := 4; + SO_KEEPALIVE : constant := 8; + SO_LINGER : constant := 128; + SO_ERROR : constant := 4103; + SO_BROADCAST : constant := 32; + IP_ADD_MEMBERSHIP : constant := 11; + IP_DROP_MEMBERSHIP : constant := 12; + IP_MULTICAST_TTL : constant := 16; + IP_MULTICAST_LOOP : constant := 10; +end GNAT.Sockets.Constants; diff --git a/gcc/ada/31soliop.ads b/gcc/ada/31soliop.ads new file mode 100644 index 0000000..3966ec3 --- /dev/null +++ b/gcc/ada/31soliop.ads @@ -0,0 +1,44 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- G N A T . S O C K E T S . L I N K E R _ O P T I O N S -- +-- -- +-- S p e c -- +-- -- +-- $Revision: 1.1 $ +-- -- +-- Copyright (C) 2001 Ada Core Technologies, 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, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNAT is maintained by Ada Core Technologies Inc (http://www.gnat.com). -- +-- -- +------------------------------------------------------------------------------ + +package GNAT.Sockets.Linker_Options is + + -- This is the UnixWare version of this package. + +private + + pragma Linker_Options ("-lnsl"); + pragma Linker_Options ("-lsocket"); + +end GNAT.Sockets.Linker_Options; diff --git a/gcc/ada/3asoccon.ads b/gcc/ada/3asoccon.ads new file mode 100644 index 0000000..3e4620b --- /dev/null +++ b/gcc/ada/3asoccon.ads @@ -0,0 +1,115 @@ +------------------------------------------------------------------------------ +-- -- +-- 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 -- +-- -- +-- $Revision: 1.5 $ +-- -- +-- Copyright (C) 2001 Ada Core Technologies, 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, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNAT is maintained by Ada Core Technologies Inc (http://www.gnat.com). -- +-- -- +------------------------------------------------------------------------------ + +-- This is the version for OSF + +package GNAT.Sockets.Constants is + + -- Families + + AF_INET : constant := 2; + AF_INET6 : constant := 26; + + -- Modes + + SOCK_STREAM : constant := 1; + SOCK_DGRAM : constant := 2; + + -- Socket Errors + + EBADF : constant := 9; + ENOTSOCK : constant := 38; + ENOTCONN : constant := 57; + ENOBUFS : constant := 55; + EOPNOTSUPP : constant := 45; + EFAULT : constant := 14; + EWOULDBLOCK : constant := 35; + EADDRNOTAVAIL : constant := 49; + EMSGSIZE : constant := 40; + EADDRINUSE : constant := 48; + EINVAL : constant := 22; + EACCES : constant := 13; + EAFNOSUPPORT : constant := 47; + EISCONN : constant := 56; + ETIMEDOUT : constant := 60; + ECONNREFUSED : constant := 61; + ENETUNREACH : constant := 51; + EALREADY : constant := 37; + EINPROGRESS : constant := 36; + ENOPROTOOPT : constant := 42; + EPROTONOSUPPORT : constant := 43; + EINTR : constant := 4; + EIO : constant := 5; + ESOCKTNOSUPPORT : constant := 44; + + -- Host Errors + + HOST_NOT_FOUND : constant := 1; + TRY_AGAIN : constant := 2; + NO_ADDRESS : constant := 4; + NO_RECOVERY : constant := 3; + + -- Control Flags + + FIONBIO : constant := -2147195266; + FIONREAD : constant := 1074030207; + + -- Shutdown Modes + + SHUT_RD : constant := 0; + SHUT_WR : constant := 1; + SHUT_RDWR : constant := 2; + + -- Protocol Levels + + SOL_SOCKET : constant := 65535; + IPPROTO_IP : constant := 0; + IPPROTO_UDP : constant := 17; + IPPROTO_TCP : constant := 6; + + -- Socket Options + + TCP_NODELAY : constant := 1; + SO_SNDBUF : constant := 4097; + SO_RCVBUF : constant := 4098; + SO_REUSEADDR : constant := 4; + SO_KEEPALIVE : constant := 8; + SO_LINGER : constant := 128; + SO_ERROR : constant := 4103; + SO_BROADCAST : constant := 32; + IP_ADD_MEMBERSHIP : constant := 12; + IP_DROP_MEMBERSHIP : constant := 13; + IP_MULTICAST_TTL : constant := 10; + IP_MULTICAST_LOOP : constant := 11; +end GNAT.Sockets.Constants; diff --git a/gcc/ada/3bsoccon.ads b/gcc/ada/3bsoccon.ads new file mode 100644 index 0000000..7ca4b8b --- /dev/null +++ b/gcc/ada/3bsoccon.ads @@ -0,0 +1,115 @@ +------------------------------------------------------------------------------ +-- -- +-- 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 -- +-- -- +-- $Revision: 1.5 $ +-- -- +-- Copyright (C) 2001 Ada Core Technologies, 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, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNAT is maintained by Ada Core Technologies Inc (http://www.gnat.com). -- +-- -- +------------------------------------------------------------------------------ + +-- This is the version for AIX + +package GNAT.Sockets.Constants is + + -- Families + + AF_INET : constant := 2; + AF_INET6 : constant := 24; + + -- Modes + + SOCK_STREAM : constant := 1; + SOCK_DGRAM : constant := 2; + + -- Socket Errors + + EBADF : constant := 9; + ENOTSOCK : constant := 57; + ENOTCONN : constant := 76; + ENOBUFS : constant := 74; + EOPNOTSUPP : constant := 64; + EFAULT : constant := 14; + EWOULDBLOCK : constant := 11; + EADDRNOTAVAIL : constant := 68; + EMSGSIZE : constant := 59; + EADDRINUSE : constant := 67; + EINVAL : constant := 22; + EACCES : constant := 13; + EAFNOSUPPORT : constant := 66; + EISCONN : constant := 75; + ETIMEDOUT : constant := 78; + ECONNREFUSED : constant := 79; + ENETUNREACH : constant := 70; + EALREADY : constant := 56; + EINPROGRESS : constant := 55; + ENOPROTOOPT : constant := 61; + EPROTONOSUPPORT : constant := 62; + EINTR : constant := 4; + EIO : constant := 5; + ESOCKTNOSUPPORT : constant := 63; + + -- Host Errors + + HOST_NOT_FOUND : constant := 1; + TRY_AGAIN : constant := 2; + NO_ADDRESS : constant := 4; + NO_RECOVERY : constant := 3; + + -- Control Flags + + FIONBIO : constant := -2147195266; + FIONREAD : constant := 1074030207; + + -- Shutdown Modes + + SHUT_RD : constant := 0; + SHUT_WR : constant := 1; + SHUT_RDWR : constant := 2; + + -- Protocol Levels + + SOL_SOCKET : constant := 65535; + IPPROTO_IP : constant := 0; + IPPROTO_UDP : constant := 17; + IPPROTO_TCP : constant := 6; + + -- Socket Options + + TCP_NODELAY : constant := 1; + SO_SNDBUF : constant := 4097; + SO_RCVBUF : constant := 4098; + SO_REUSEADDR : constant := 4; + SO_KEEPALIVE : constant := 8; + SO_LINGER : constant := 128; + SO_ERROR : constant := 4103; + SO_BROADCAST : constant := 32; + IP_ADD_MEMBERSHIP : constant := 12; + IP_DROP_MEMBERSHIP : constant := 13; + IP_MULTICAST_TTL : constant := 10; + IP_MULTICAST_LOOP : constant := 11; +end GNAT.Sockets.Constants; diff --git a/gcc/ada/3gsoccon.ads b/gcc/ada/3gsoccon.ads new file mode 100644 index 0000000..12c3f53 --- /dev/null +++ b/gcc/ada/3gsoccon.ads @@ -0,0 +1,115 @@ +------------------------------------------------------------------------------ +-- -- +-- 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 -- +-- -- +-- $Revision: 1.4 $ +-- -- +-- Copyright (C) 2001 Ada Core Technologies, 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, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNAT is maintained by Ada Core Technologies Inc (http://www.gnat.com). -- +-- -- +------------------------------------------------------------------------------ + +-- This is the version for SGI + +package GNAT.Sockets.Constants is + + -- Families + + AF_INET : constant := 2; + AF_INET6 : constant := 24; + + -- Modes + + SOCK_STREAM : constant := 2; + SOCK_DGRAM : constant := 1; + + -- Socket Errors + + EBADF : constant := 9; + ENOTSOCK : constant := 95; + ENOTCONN : constant := 134; + ENOBUFS : constant := 132; + EOPNOTSUPP : constant := 122; + EFAULT : constant := 14; + EWOULDBLOCK : constant := 11; + EADDRNOTAVAIL : constant := 126; + EMSGSIZE : constant := 97; + EADDRINUSE : constant := 125; + EINVAL : constant := 22; + EACCES : constant := 13; + EAFNOSUPPORT : constant := 124; + EISCONN : constant := 133; + ETIMEDOUT : constant := 145; + ECONNREFUSED : constant := 146; + ENETUNREACH : constant := 128; + EALREADY : constant := 149; + EINPROGRESS : constant := 150; + ENOPROTOOPT : constant := 99; + EPROTONOSUPPORT : constant := 120; + EINTR : constant := 4; + EIO : constant := 5; + ESOCKTNOSUPPORT : constant := 121; + + -- Host Errors + + HOST_NOT_FOUND : constant := 1; + TRY_AGAIN : constant := 2; + NO_ADDRESS : constant := 4; + NO_RECOVERY : constant := 3; + + -- Control Flags + + FIONBIO : constant := -2147195266; + FIONREAD : constant := 1074030207; + + -- Shutdown Modes + + SHUT_RD : constant := 0; + SHUT_WR : constant := 1; + SHUT_RDWR : constant := 2; + + -- Protocol Levels + + SOL_SOCKET : constant := 65535; + IPPROTO_IP : constant := 0; + IPPROTO_UDP : constant := 17; + IPPROTO_TCP : constant := 6; + + -- Socket Options + + TCP_NODELAY : constant := 1; + SO_SNDBUF : constant := 4097; + SO_RCVBUF : constant := 4098; + SO_REUSEADDR : constant := 4; + SO_KEEPALIVE : constant := 8; + SO_LINGER : constant := 128; + SO_ERROR : constant := 4103; + SO_BROADCAST : constant := 32; + IP_ADD_MEMBERSHIP : constant := 23; + IP_DROP_MEMBERSHIP : constant := 24; + IP_MULTICAST_TTL : constant := 21; + IP_MULTICAST_LOOP : constant := 22; +end GNAT.Sockets.Constants; diff --git a/gcc/ada/3hsoccon.ads b/gcc/ada/3hsoccon.ads new file mode 100644 index 0000000..889a26d --- /dev/null +++ b/gcc/ada/3hsoccon.ads @@ -0,0 +1,115 @@ +------------------------------------------------------------------------------ +-- -- +-- 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 -- +-- -- +-- $Revision: 1.5 $ +-- -- +-- Copyright (C) 2001 Ada Core Technologies, 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, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNAT is maintained by Ada Core Technologies Inc (http://www.gnat.com). -- +-- -- +------------------------------------------------------------------------------ + +-- This is the version for HP/UX + +package GNAT.Sockets.Constants is + + -- Families + + AF_INET : constant := 2; + AF_INET6 : constant := -1; + + -- Modes + + SOCK_STREAM : constant := 1; + SOCK_DGRAM : constant := 2; + + -- Socket Errors + + EBADF : constant := 9; + ENOTSOCK : constant := 216; + ENOTCONN : constant := 235; + ENOBUFS : constant := 233; + EOPNOTSUPP : constant := 223; + EFAULT : constant := 14; + EWOULDBLOCK : constant := 246; + EADDRNOTAVAIL : constant := 227; + EMSGSIZE : constant := 218; + EADDRINUSE : constant := 226; + EINVAL : constant := 22; + EACCES : constant := 13; + EAFNOSUPPORT : constant := 225; + EISCONN : constant := 234; + ETIMEDOUT : constant := 238; + ECONNREFUSED : constant := 239; + ENETUNREACH : constant := 229; + EALREADY : constant := 244; + EINPROGRESS : constant := 245; + ENOPROTOOPT : constant := 220; + EPROTONOSUPPORT : constant := 221; + EINTR : constant := 4; + EIO : constant := 5; + ESOCKTNOSUPPORT : constant := 222; + + -- Host Errors + + HOST_NOT_FOUND : constant := 1; + TRY_AGAIN : constant := 2; + NO_ADDRESS : constant := 4; + NO_RECOVERY : constant := 3; + + -- Control Flags + + FIONBIO : constant := -2147195266; + FIONREAD : constant := 1074030207; + + -- Shutdown Modes + + SHUT_RD : constant := 0; + SHUT_WR : constant := 1; + SHUT_RDWR : constant := 2; + + -- Protocol Levels + + SOL_SOCKET : constant := 65535; + IPPROTO_IP : constant := 0; + IPPROTO_UDP : constant := 17; + IPPROTO_TCP : constant := 6; + + -- Socket Options + + TCP_NODELAY : constant := 1; + SO_SNDBUF : constant := 4097; + SO_RCVBUF : constant := 4098; + SO_REUSEADDR : constant := 4; + SO_KEEPALIVE : constant := 8; + SO_LINGER : constant := 128; + SO_ERROR : constant := 4103; + SO_BROADCAST : constant := 32; + IP_ADD_MEMBERSHIP : constant := 5; + IP_DROP_MEMBERSHIP : constant := 6; + IP_MULTICAST_TTL : constant := 3; + IP_MULTICAST_LOOP : constant := 4; +end GNAT.Sockets.Constants; diff --git a/gcc/ada/3ssoccon.ads b/gcc/ada/3ssoccon.ads new file mode 100644 index 0000000..331d1fe --- /dev/null +++ b/gcc/ada/3ssoccon.ads @@ -0,0 +1,115 @@ +------------------------------------------------------------------------------ +-- -- +-- 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 -- +-- -- +-- $Revision: 1.7 $ +-- -- +-- Copyright (C) 2001 Ada Core Technologies, 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, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNAT is maintained by Ada Core Technologies Inc (http://www.gnat.com). -- +-- -- +------------------------------------------------------------------------------ + +-- This is the version for Solaris + +package GNAT.Sockets.Constants is + + -- Families + + AF_INET : constant := 2; + AF_INET6 : constant := 26; + + -- Modes + + SOCK_STREAM : constant := 2; + SOCK_DGRAM : constant := 1; + + -- Socket Errors + + EBADF : constant := 9; + ENOTSOCK : constant := 95; + ENOTCONN : constant := 134; + ENOBUFS : constant := 132; + EOPNOTSUPP : constant := 122; + EFAULT : constant := 14; + EWOULDBLOCK : constant := 11; + EADDRNOTAVAIL : constant := 126; + EMSGSIZE : constant := 97; + EADDRINUSE : constant := 125; + EINVAL : constant := 22; + EACCES : constant := 13; + EAFNOSUPPORT : constant := 124; + EISCONN : constant := 133; + ETIMEDOUT : constant := 145; + ECONNREFUSED : constant := 146; + ENETUNREACH : constant := 128; + EALREADY : constant := 149; + EINPROGRESS : constant := 150; + ENOPROTOOPT : constant := 99; + EPROTONOSUPPORT : constant := 120; + EINTR : constant := 4; + EIO : constant := 5; + ESOCKTNOSUPPORT : constant := 121; + + -- Host Errors + + HOST_NOT_FOUND : constant := 1; + TRY_AGAIN : constant := 2; + NO_ADDRESS : constant := 4; + NO_RECOVERY : constant := 3; + + -- Control Flags + + FIONBIO : constant := -2147195266; + FIONREAD : constant := 1074030207; + + -- Shutdown Modes + + SHUT_RD : constant := 0; + SHUT_WR : constant := 1; + SHUT_RDWR : constant := 2; + + -- Protocol Levels + + SOL_SOCKET : constant := 65535; + IPPROTO_IP : constant := 0; + IPPROTO_UDP : constant := 17; + IPPROTO_TCP : constant := 6; + + -- Socket Options + + TCP_NODELAY : constant := 1; + SO_SNDBUF : constant := 4097; + SO_RCVBUF : constant := 4098; + SO_REUSEADDR : constant := 4; + SO_KEEPALIVE : constant := 8; + SO_LINGER : constant := 128; + SO_ERROR : constant := 4103; + SO_BROADCAST : constant := 32; + IP_ADD_MEMBERSHIP : constant := 19; + IP_DROP_MEMBERSHIP : constant := 20; + IP_MULTICAST_TTL : constant := 17; + IP_MULTICAST_LOOP : constant := 18; +end GNAT.Sockets.Constants; diff --git a/gcc/ada/3ssoliop.ads b/gcc/ada/3ssoliop.ads new file mode 100644 index 0000000..e8c5026 --- /dev/null +++ b/gcc/ada/3ssoliop.ads @@ -0,0 +1,44 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- G N A T . S O C K E T S . L I N K E R _ O P T I O N S -- +-- -- +-- S p e c -- +-- -- +-- $Revision: 1.1 $ +-- -- +-- Copyright (C) 2001 Ada Core Technologies, 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, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNAT is maintained by Ada Core Technologies Inc (http://www.gnat.com). -- +-- -- +------------------------------------------------------------------------------ + +package GNAT.Sockets.Linker_Options is + + -- This is the Solaris version of this package. + +private + + pragma Linker_Options ("-lnsl"); + pragma Linker_Options ("-lsocket"); + +end GNAT.Sockets.Linker_Options; diff --git a/gcc/ada/3wsoccon.ads b/gcc/ada/3wsoccon.ads new file mode 100644 index 0000000..38bf70a --- /dev/null +++ b/gcc/ada/3wsoccon.ads @@ -0,0 +1,136 @@ +------------------------------------------------------------------------------ +-- -- +-- 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 -- +-- -- +-- $Revision: 1.11 $ +-- -- +-- Copyright (C) 2001 Ada Core Technologies, 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, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNAT is maintained by Ada Core Technologies Inc (http://www.gnat.com). -- +-- -- +------------------------------------------------------------------------------ + +-- This is the version for MINGW32 NT + +package GNAT.Sockets.Constants is + + -- Families + + AF_INET : constant := 2; + AF_INET6 : constant := 3; + + -- Modes + + SOCK_STREAM : constant := 1; + SOCK_DGRAM : constant := 2; + + -- Socket Errors + + EINTR : constant := 10004; + EBADF : constant := 10009; + EACCES : constant := 10013; + EFAULT : constant := 10014; + EINVAL : constant := 10022; + EMFILE : constant := 10024; + EWOULDBLOCK : constant := 10035; + EINPROGRESS : constant := 10036; + EALREADY : constant := 10037; + ENOTSOCK : constant := 10038; + EDESTADDRREQ : constant := 10039; + EMSGSIZE : constant := 10040; + EPROTOTYPE : constant := 10041; + ENOPROTOOPT : constant := 10042; + EPROTONOSUPPORT : constant := 10043; + ESOCKTNOSUPPORT : constant := 10044; + EOPNOTSUPP : constant := 10045; + EPFNOSUPPORT : constant := 10046; + EAFNOSUPPORT : constant := 10047; + EADDRINUSE : constant := 10048; + EADDRNOTAVAIL : constant := 10049; + ENETDOWN : constant := 10050; + ENETUNREACH : constant := 10051; + ENETRESET : constant := 10052; + ECONNABORTED : constant := 10053; + ECONNRESET : constant := 10054; + ENOBUFS : constant := 10055; + EISCONN : constant := 10056; + ENOTCONN : constant := 10057; + ESHUTDOWN : constant := 10058; + ETOOMANYREFS : constant := 10059; + ETIMEDOUT : constant := 10060; + ECONNREFUSED : constant := 10061; + ELOOP : constant := 10062; + ENAMETOOLONG : constant := 10063; + EHOSTDOWN : constant := 10064; + EHOSTUNREACH : constant := 10065; + SYSNOTREADY : constant := 10091; + VERNOTSUPPORTED : constant := 10092; + NOTINITIALISED : constant := 10093; + EDISCON : constant := 10101; + + -- Host Errors + + HOST_NOT_FOUND : constant := 11001; + TRY_AGAIN : constant := 11002; + NO_RECOVERY : constant := 11003; + NO_ADDRESS : constant := 11004; + NO_DATA : constant := 11004; + + EIO : constant := 10101; + + -- Control Flags + + FIONBIO : constant := -2147195266; + FIONREAD : constant := 1074030207; + + -- Shutdown Modes + + SHUT_RD : constant := 0; + SHUT_WR : constant := 1; + SHUT_RDWR : constant := 2; + + -- Protocol Levels + + SOL_SOCKET : constant := 65535; + IPPROTO_IP : constant := 0; + IPPROTO_UDP : constant := 17; + IPPROTO_TCP : constant := 6; + + -- Socket Options + + TCP_NODELAY : constant := 1; + SO_SNDBUF : constant := 4097; + SO_RCVBUF : constant := 4098; + SO_REUSEADDR : constant := 4; + SO_KEEPALIVE : constant := 8; + SO_LINGER : constant := 128; + SO_ERROR : constant := 4103; + SO_BROADCAST : constant := 32; + IP_ADD_MEMBERSHIP : constant := 5; + IP_DROP_MEMBERSHIP : constant := 6; + IP_MULTICAST_TTL : constant := 3; + IP_MULTICAST_LOOP : constant := 4; + +end GNAT.Sockets.Constants; diff --git a/gcc/ada/3wsocthi.adb b/gcc/ada/3wsocthi.adb new file mode 100644 index 0000000..ebbe841 --- /dev/null +++ b/gcc/ada/3wsocthi.adb @@ -0,0 +1,318 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- G N A T . S O C K E T S . T H I N -- +-- -- +-- B o d y -- +-- -- +-- $Revision: 1.5 $ +-- -- +-- Copyright (C) 2001 Ada Core Technologies, 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, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNAT is maintained by Ada Core Technologies Inc (http://www.gnat.com). -- +-- -- +------------------------------------------------------------------------------ + +-- This version is for NT. + +package body GNAT.Sockets.Thin is + + use type C.unsigned; + + WSAData_Dummy : array (1 .. 512) of C.int; + + WS_Version : constant := 16#0101#; + Initialized : Boolean := False; + + ----------- + -- Clear -- + ----------- + + procedure Clear + (Item : in out Fd_Set; + Socket : C.int) + is + begin + for J in 1 .. Item.fd_count loop + if Item.fd_array (J) = Socket then + Item.fd_array (J .. Item.fd_count - 1) := + Item.fd_array (J + 1 .. Item.fd_count); + Item.fd_count := Item.fd_count - 1; + exit; + end if; + end loop; + end Clear; + + ----------- + -- Empty -- + ----------- + + procedure Empty (Item : in out Fd_Set) is + begin + Item := Null_Fd_Set; + end Empty; + + -------------- + -- Finalize -- + -------------- + + procedure Finalize is + begin + if Initialized then + WSACleanup; + Initialized := False; + end if; + end Finalize; + + -------------- + -- Is_Empty -- + -------------- + + function Is_Empty (Item : Fd_Set) return Boolean is + begin + return Item.fd_count = 0; + end Is_Empty; + + ------------ + -- Is_Set -- + ------------ + + function Is_Set (Item : Fd_Set; Socket : C.int) return Boolean is + begin + for J in 1 .. Item.fd_count loop + if Item.fd_array (J) = Socket then + return True; + end if; + end loop; + + return False; + end Is_Set; + + ---------------- + -- Initialize -- + ---------------- + + procedure Initialize (Process_Blocking_IO : Boolean := False) is + Return_Value : Interfaces.C.int; + + begin + if not Initialized then + Return_Value := WSAStartup (WS_Version, WSAData_Dummy'Address); + pragma Assert (Interfaces.C."=" (Return_Value, 0)); + Initialized := True; + end if; + end Initialize; + + --------- + -- Max -- + --------- + + function Max (Item : Fd_Set) return C.int is + L : C.int := 0; + + begin + for J in 1 .. Item.fd_count loop + if Item.fd_array (J) > L then + L := Item.fd_array (J); + end if; + end loop; + + return L; + end Max; + + --------- + -- Set -- + --------- + + procedure Set (Item : in out Fd_Set; Socket : in C.int) is + begin + Item.fd_count := Item.fd_count + 1; + Item.fd_array (Item.fd_count) := Socket; + end Set; + + -------------------------- + -- Socket_Error_Message -- + -------------------------- + + function Socket_Error_Message (Errno : Integer) return String is + use GNAT.Sockets.Constants; + + begin + case Errno is + when EINTR => + return "Interrupted system call"; + + when EBADF => + return "Bad file number"; + + when EACCES => + return "Permission denied"; + + when EFAULT => + return "Bad address"; + + when EINVAL => + return "Invalid argument"; + + when EMFILE => + return "Too many open files"; + + when EWOULDBLOCK => + return "Operation would block"; + + when EINPROGRESS => + return "Operation now in progress. This error is " + & "returned if any Windows Sockets API " + & "function is called while a blocking " + & "function is in progress"; + + when EALREADY => + return "Operation already in progress"; + + when ENOTSOCK => + return "Socket operation on nonsocket"; + + when EDESTADDRREQ => + return "Destination address required"; + + when EMSGSIZE => + return "Message too long"; + + when EPROTOTYPE => + return "Protocol wrong type for socket"; + + when ENOPROTOOPT => + return "Protocol not available"; + + when EPROTONOSUPPORT => + return "Protocol not supported"; + + when ESOCKTNOSUPPORT => + return "Socket type not supported"; + + when EOPNOTSUPP => + return "Operation not supported on socket"; + + when EPFNOSUPPORT => + return "Protocol family not supported"; + + when EAFNOSUPPORT => + return "Address family not supported by protocol family"; + + when EADDRINUSE => + return "Address already in use"; + + when EADDRNOTAVAIL => + return "Cannot assign requested address"; + + when ENETDOWN => + return "Network is down. This error may be " + & "reported at any time if the Windows " + & "Sockets implementation detects an " + & "underlying failure"; + + when ENETUNREACH => + return "Network is unreachable"; + + when ENETRESET => + return "Network dropped connection on reset"; + + when ECONNABORTED => + return "Software caused connection abort"; + + when ECONNRESET => + return "Connection reset by peer"; + + when ENOBUFS => + return "No buffer space available"; + + when EISCONN => + return "Socket is already connected"; + + when ENOTCONN => + return "Socket is not connected"; + + when ESHUTDOWN => + return "Cannot send after socket shutdown"; + + when ETOOMANYREFS => + return "Too many references: cannot splice"; + + when ETIMEDOUT => + return "Connection timed out"; + + when ECONNREFUSED => + return "Connection refused"; + + when ELOOP => + return "Too many levels of symbolic links"; + + when ENAMETOOLONG => + return "File name too long"; + + when EHOSTDOWN => + return "Host is down"; + + when EHOSTUNREACH => + return "No route to host"; + + when SYSNOTREADY => + return "Returned by WSAStartup(), indicating that " + & "the network subsystem is unusable"; + + when VERNOTSUPPORTED => + return "Returned by WSAStartup(), indicating that " + & "the Windows Sockets DLL cannot support this application"; + + when NOTINITIALISED => + return "Winsock not initialized. This message is " + & "returned by any function except WSAStartup(), " + & "indicating that a successful WSAStartup() has " + & "not yet been performed"; + + when EDISCON => + return "Disconnect"; + + when HOST_NOT_FOUND => + return "Host not found. This message indicates " + & "that the key (name, address, and so on) was not found"; + + when TRY_AGAIN => + return "Nonauthoritative host not found. This error may " + & "suggest that the name service itself is not functioning"; + + when NO_RECOVERY => + return "Nonrecoverable error. This error may suggest that the " + & "name service itself is not functioning"; + + when NO_DATA => + return "Valid name, no data record of requested type. " + & "This error indicates that the key (name, address, " + & "and so on) was not found."; + + when others => + return "Unknown system error"; + + end case; + end Socket_Error_Message; + +end GNAT.Sockets.Thin; diff --git a/gcc/ada/3wsocthi.ads b/gcc/ada/3wsocthi.ads new file mode 100644 index 0000000..06fbce0 --- /dev/null +++ b/gcc/ada/3wsocthi.ads @@ -0,0 +1,363 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- G N A T . S O C K E T S . T H I N -- +-- -- +-- S p e c -- +-- -- +-- $Revision: 1.16 $ +-- -- +-- Copyright (C) 2001 Ada Core Technologies, 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, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNAT is maintained by Ada Core Technologies Inc (http://www.gnat.com). -- +-- -- +------------------------------------------------------------------------------ + +-- This version is for NT. + +with Interfaces.C.Pointers; +with Interfaces.C.Strings; + +with GNAT.Sockets.Constants; + +with System; + +package GNAT.Sockets.Thin is + + -- ??? far more comments required ??? + + package C renames Interfaces.C; + + use type C.int; + -- So that we can declare the Failure constant below. + + Success : constant C.int := 0; + Failure : constant C.int := -1; + + function Socket_Errno return Integer; + -- Returns last socket error number. + + function Socket_Error_Message (Errno : Integer) return String; + -- Returns the error message string for the error number Errno. If + -- Errno is not known it returns "Unknown system error". + + type Socket_Fd_Array is array (C.unsigned range 1 .. 64) of C.int; + pragma Convention (C, Socket_Fd_Array); + + type Fd_Set is record + fd_count : C.unsigned; + fd_array : Socket_Fd_Array; + end record; + pragma Convention (C, Fd_Set); + + Null_Fd_Set : constant Fd_Set := (0, (others => 0)); + + type Fd_Set_Access is access all Fd_Set; + pragma Convention (C, Fd_Set_Access); + + type Timeval_Unit is new C.long; + pragma Convention (C, Timeval_Unit); + + type Timeval is record + Tv_Sec : Timeval_Unit; + Tv_Usec : Timeval_Unit; + end record; + pragma Convention (C, Timeval); + + type Timeval_Access is access all Timeval; + pragma Convention (C, Timeval_Access); + + Immediat : constant Timeval := (0, 0); + + type Int_Access is access all C.int; + pragma Convention (C, Int_Access); + -- Access to C integers + + type Chars_Ptr_Array is array (C.size_t range <>) of + aliased C.Strings.chars_ptr; + + package Chars_Ptr_Pointers is + new C.Pointers (C.size_t, C.Strings.chars_ptr, Chars_Ptr_Array, + C.Strings.Null_Ptr); + -- Arrays of C (char *) + + type In_Addr is record + S_B1, S_B2, S_B3, S_B4 : C.unsigned_char; + end record; + pragma Convention (C, In_Addr); + -- Internet address + + type In_Addr_Access is access all In_Addr; + pragma Convention (C, In_Addr_Access); + -- Access to internet address + + Inaddr_Any : aliased constant In_Addr := (others => 0); + -- Any internet address (all the interfaces) + + type In_Addr_Access_Array is array (C.size_t range <>) + of aliased In_Addr_Access; + pragma Convention (C, In_Addr_Access_Array); + package In_Addr_Access_Pointers is + new C.Pointers (C.size_t, In_Addr_Access, In_Addr_Access_Array, null); + -- Array of internet addresses + + type Sockaddr is record + Sa_Family : C.unsigned_short; + Sa_Data : C.char_array (1 .. 14); + end record; + pragma Convention (C, Sockaddr); + -- Socket address + + type Sockaddr_Access is access all Sockaddr; + pragma Convention (C, Sockaddr_Access); + -- Access to socket address + + type Sockaddr_In is record + Sin_Family : C.unsigned_short := Constants.AF_INET; + Sin_Port : C.unsigned_short := 0; + Sin_Addr : In_Addr := Inaddr_Any; + Sin_Zero : C.char_array (1 .. 8) := (others => C.char'Val (0)); + end record; + pragma Convention (C, Sockaddr_In); + -- Internet socket address + + type Sockaddr_In_Access is access all Sockaddr_In; + pragma Convention (C, Sockaddr_In_Access); + -- Access to internet socket address + + type Hostent is record + H_Name : C.Strings.chars_ptr; + H_Aliases : Chars_Ptr_Pointers.Pointer; + H_Addrtype : C.short; + H_Length : C.short; + H_Addr_List : In_Addr_Access_Pointers.Pointer; + end record; + pragma Convention (C, Hostent); + -- Host entry + + type Hostent_Access is access all Hostent; + pragma Convention (C, Hostent_Access); + -- Access to host entry + + type Two_Int is array (0 .. 1) of C.int; + pragma Convention (C, Two_Int); + -- Used with pipe() + + function C_Accept + (S : C.int; + Addr : System.Address; + Addrlen : access C.int) + return C.int; + + function C_Bind + (S : C.int; + Name : System.Address; + Namelen : C.int) + return C.int; + + function C_Close + (Fd : C.int) + return C.int; + + function C_Connect + (S : C.int; + Name : System.Address; + Namelen : C.int) + return C.int; + + function C_Gethostbyaddr + (Addr : System.Address; + Length : C.int; + Typ : C.int) + return Hostent_Access; + + function C_Gethostbyname + (Name : C.char_array) + return Hostent_Access; + + function C_Gethostname + (Name : System.Address; + Namelen : C.int) + return C.int; + + function C_Getpeername + (S : C.int; + Name : System.Address; + Namelen : access C.int) + return C.int; + + function C_Getsockname + (S : C.int; + Name : System.Address; + Namelen : access C.int) + return C.int; + + function C_Getsockopt + (S : C.int; + Level : C.int; + Optname : C.int; + Optval : System.Address; + Optlen : access C.int) + return C.int; + + function C_Inet_Addr + (Cp : C.Strings.chars_ptr) + return C.int; + + function C_Ioctl + (S : C.int; + Req : C.int; + Arg : Int_Access) + return C.int; + + function C_Listen + (S, Backlog : C.int) + return C.int; + + function C_Read + (Fildes : C.int; + Buf : System.Address; + Nbyte : C.int) + return C.int; + + function C_Recv + (S : C.int; + Buf : System.Address; + Len : C.int; + Flags : C.int) + return C.int; + + function C_Recvfrom + (S : C.int; + Buf : System.Address; + Len : C.int; + Flags : C.int; + From : Sockaddr_In_Access; + Fromlen : access C.int) + return C.int; + + function C_Select + (Nfds : C.int; + Readfds : Fd_Set_Access; + Writefds : Fd_Set_Access; + Exceptfds : Fd_Set_Access; + Timeout : Timeval_Access) + return C.int; + + function C_Send + (S : C.int; + Buf : System.Address; + Len : C.int; + Flags : C.int) + return C.int; + + function C_Sendto + (S : C.int; + Msg : System.Address; + Len : C.int; + Flags : C.int; + To : Sockaddr_In_Access; + Tolen : C.int) + return C.int; + + function C_Setsockopt + (S : C.int; + Level : C.int; + Optname : C.int; + Optval : System.Address; + Optlen : C.int) + return C.int; + + function C_Shutdown + (S : C.int; + How : C.int) + return C.int; + + function C_Socket + (Domain : C.int; + Typ : C.int; + Protocol : C.int) + return C.int; + + function C_Strerror + (Errnum : C.int) + return C.Strings.chars_ptr; + + function C_System + (Command : System.Address) + return C.int; + + function C_Write + (Fildes : C.int; + Buf : System.Address; + Nbyte : C.int) + return C.int; + + function WSAStartup + (WS_Version : Interfaces.C.int; + WSADataAddress : System.Address) + return Interfaces.C.int; + + procedure WSACleanup; + + procedure Clear (Item : in out Fd_Set; Socket : in C.int); + procedure Empty (Item : in out Fd_Set); + function Is_Empty (Item : Fd_Set) return Boolean; + function Is_Set (Item : Fd_Set; Socket : C.int) return Boolean; + function Max (Item : Fd_Set) return C.int; + procedure Set (Item : in out Fd_Set; Socket : in C.int); + + procedure Finalize; + procedure Initialize (Process_Blocking_IO : Boolean := False); + +private + + pragma Import (Stdcall, C_Accept, "accept"); + pragma Import (Stdcall, C_Bind, "bind"); + pragma Import (Stdcall, C_Close, "closesocket"); + pragma Import (Stdcall, C_Connect, "connect"); + pragma Import (Stdcall, C_Gethostbyaddr, "gethostbyaddr"); + pragma Import (Stdcall, C_Gethostbyname, "gethostbyname"); + pragma Import (Stdcall, C_Gethostname, "gethostname"); + pragma Import (Stdcall, C_Getpeername, "getpeername"); + pragma Import (Stdcall, C_Getsockname, "getsockname"); + pragma Import (Stdcall, C_Getsockopt, "getsockopt"); + pragma Import (Stdcall, C_Inet_Addr, "inet_addr"); + pragma Import (Stdcall, C_Ioctl, "ioctlsocket"); + pragma Import (Stdcall, C_Listen, "listen"); + pragma Import (C, C_Read, "_read"); + pragma Import (Stdcall, C_Recv, "recv"); + pragma Import (Stdcall, C_Recvfrom, "recvfrom"); + pragma Import (Stdcall, C_Select, "select"); + pragma Import (Stdcall, C_Send, "send"); + pragma Import (Stdcall, C_Sendto, "sendto"); + pragma Import (Stdcall, C_Setsockopt, "setsockopt"); + pragma Import (Stdcall, C_Shutdown, "shutdown"); + pragma Import (Stdcall, C_Socket, "socket"); + pragma Import (C, C_Strerror, "strerror"); + pragma Import (C, C_System, "_system"); + pragma Import (C, C_Write, "_write"); + pragma Import (Stdcall, Socket_Errno, "WSAGetLastError"); + pragma Import (Stdcall, WSAStartup, "WSAStartup"); + pragma Import (Stdcall, WSACleanup, "WSACleanup"); + +end GNAT.Sockets.Thin; diff --git a/gcc/ada/3wsoliop.ads b/gcc/ada/3wsoliop.ads new file mode 100644 index 0000000..fc3e103 --- /dev/null +++ b/gcc/ada/3wsoliop.ads @@ -0,0 +1,43 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- G N A T . S O C K E T S . L I N K E R _ O P T I O N S -- +-- -- +-- S p e c -- +-- -- +-- $Revision: 1.1 $ +-- -- +-- Copyright (C) 2001 Ada Core Technologies, 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, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNAT is maintained by Ada Core Technologies Inc (http://www.gnat.com). -- +-- -- +------------------------------------------------------------------------------ + +package GNAT.Sockets.Linker_Options is + + -- Windows NT version of this package + +private + + pragma Linker_Options ("-lwsock32"); + +end GNAT.Sockets.Linker_Options; diff --git a/gcc/ada/41intnam.ads b/gcc/ada/41intnam.ads new file mode 100644 index 0000000..8442cc8 --- /dev/null +++ b/gcc/ada/41intnam.ads @@ -0,0 +1,168 @@ +------------------------------------------------------------------------------ +-- -- +-- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS -- +-- -- +-- A D A . I N T E R R U P T S . N A M E S -- +-- -- +-- S p e c -- +-- -- +-- $Revision: 1.2 $ +-- -- +-- Copyright (C) 1991-2001 Free Software Foundation, Inc. -- +-- -- +-- GNARL is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 2, or (at your option) any later ver- -- +-- sion. GNARL is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNARL; see file COPYING. If not, write -- +-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNARL was developed by the GNARL team at Florida State University. It is -- +-- now maintained by Ada Core Technologies Inc. in cooperation with Florida -- +-- State University (http://www.gnat.com). -- +-- -- +------------------------------------------------------------------------------ + +-- This is a SCO UnixWare version of this package. +-- +-- The following signals are reserved by the run time: +-- +-- SIGFPE, SIGILL, SIGSEGV, SIGBUS, SIGTRAP, SIGABRT, SIGINT, +-- SIGWAITING, SIGLWP, SIGTTIN, SIGTTOU, SIGTSTP, SIGPROF, SIGSTOP, SIGKILL +-- +-- The pragma Unreserve_All_Interrupts affects the following signal(s): +-- +-- SIGINT: made available for Ada handler +-- SIGILL, SIGBUS, SIGSEGV: disconnected from runtime exception mapping + +with System.OS_Interface; +-- used for names of interrupts + +package Ada.Interrupts.Names is + + -- Beware that the mapping of names to signals may be + -- many-to-one. There may be aliases. + + SIGHUP : constant Interrupt_ID := + System.OS_Interface.SIGHUP; -- hangup + + SIGINT : constant Interrupt_ID := + System.OS_Interface.SIGINT; -- interrupt (rubout) + + SIGQUIT : constant Interrupt_ID := + System.OS_Interface.SIGQUIT; -- quit (ASCD FS) + + SIGILL : constant Interrupt_ID := + System.OS_Interface.SIGILL; -- illegal instruction (not reset) + + SIGTRAP : constant Interrupt_ID := + System.OS_Interface.SIGTRAP; -- trace trap (not reset) + + SIGIOT : constant Interrupt_ID := + System.OS_Interface.SIGIOT; -- IOT instruction + + SIGABRT : constant Interrupt_ID := -- used by abort, + System.OS_Interface.SIGABRT; -- replace SIGIOT in the future + + SIGEMT : constant Interrupt_ID := + System.OS_Interface.SIGEMT; -- EMT instruction + + SIGFPE : constant Interrupt_ID := + System.OS_Interface.SIGFPE; -- floating point exception + + SIGKILL : constant Interrupt_ID := + System.OS_Interface.SIGKILL; -- kill (cannot be caught or ignored) + + SIGBUS : constant Interrupt_ID := + System.OS_Interface.SIGBUS; -- bus error + + SIGSEGV : constant Interrupt_ID := + System.OS_Interface.SIGSEGV; -- segmentation violation + + SIGSYS : constant Interrupt_ID := + System.OS_Interface.SIGSYS; -- bad argument to system call + + SIGPIPE : constant Interrupt_ID := -- write on a pipe with + System.OS_Interface.SIGPIPE; -- no one to read it + + SIGALRM : constant Interrupt_ID := + System.OS_Interface.SIGALRM; -- alarm clock + + SIGTERM : constant Interrupt_ID := + System.OS_Interface.SIGTERM; -- software termination signal from kill + + SIGUSR1 : constant Interrupt_ID := + System.OS_Interface.SIGUSR1; -- user defined signal 1 + + SIGUSR2 : constant Interrupt_ID := + System.OS_Interface.SIGUSR2; -- user defined signal 2 + + SIGCLD : constant Interrupt_ID := + System.OS_Interface.SIGCLD; -- child status change + + SIGCHLD : constant Interrupt_ID := + System.OS_Interface.SIGCHLD; -- 4.3BSD's/POSIX name for SIGCLD + + SIGPWR : constant Interrupt_ID := + System.OS_Interface.SIGPWR; -- power-fail restart + + SIGWINCH : constant Interrupt_ID := + System.OS_Interface.SIGWINCH; -- window size change + + SIGURG : constant Interrupt_ID := + System.OS_Interface.SIGURG; -- urgent condition on IO channel + + SIGPOLL : constant Interrupt_ID := + System.OS_Interface.SIGPOLL; -- pollable event occurred + + SIGIO : constant Interrupt_ID := -- input/output possible, + System.OS_Interface.SIGIO; -- SIGPOLL alias (Solaris) + + SIGSTOP : constant Interrupt_ID := + System.OS_Interface.SIGSTOP; -- stop (cannot be caught or ignored) + + SIGTSTP : constant Interrupt_ID := + System.OS_Interface.SIGTSTP; -- user stop requested from tty + + SIGCONT : constant Interrupt_ID := + System.OS_Interface.SIGCONT; -- stopped process has been continued + + SIGTTIN : constant Interrupt_ID := + System.OS_Interface.SIGTTIN; -- background tty read attempted + + SIGTTOU : constant Interrupt_ID := + System.OS_Interface.SIGTTOU; -- background tty write attempted + + SIGVTALRM : constant Interrupt_ID := + System.OS_Interface.SIGVTALRM; -- virtual timer expired + + SIGPROF : constant Interrupt_ID := + System.OS_Interface.SIGPROF; -- profiling timer expired + + SIGXCPU : constant Interrupt_ID := + System.OS_Interface.SIGXCPU; -- CPU time limit exceeded + + SIGXFSZ : constant Interrupt_ID := + System.OS_Interface.SIGXFSZ; -- filesize limit exceeded + + SIGWAITING : constant Interrupt_ID := + System.OS_Interface.SIGWAITING; -- process's lwps blocked (Solaris) + + SIGLWP : constant Interrupt_ID := + System.OS_Interface.SIGLWP; -- used by thread library (Solaris) + + SIGAIO : constant Interrupt_ID := + System.OS_Interface.SIGAIO; -- Asynchronous I/O signal + +end Ada.Interrupts.Names; diff --git a/gcc/ada/42intnam.ads b/gcc/ada/42intnam.ads new file mode 100644 index 0000000..6e35c55 --- /dev/null +++ b/gcc/ada/42intnam.ads @@ -0,0 +1,169 @@ +------------------------------------------------------------------------------ +-- -- +-- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS -- +-- -- +-- A D A . I N T E R R U P T S . N A M E S -- +-- -- +-- S p e c -- +-- -- +-- $Revision: 1.2 $ +-- -- +-- Copyright (C) 1991-2001 Free Software Foundation, Inc. -- +-- -- +-- GNARL is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 2, or (at your option) any later ver- -- +-- sion. GNARL is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNARL; see file COPYING. If not, write -- +-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNARL was developed by the GNARL team at Florida State University. It is -- +-- now maintained by Ada Core Technologies Inc. in cooperation with Florida -- +-- State University (http://www.gnat.com). -- +-- -- +------------------------------------------------------------------------------ + +-- This is a LynxOS version of this package. +-- +-- The following signals are reserved by the run time: +-- +-- SIGFPE, SIGILL, SIGSEGV, SIGBUS, SIGTRAP, SIGABRT, SIGINT, +-- SIGWAITING, SIGLWP, SIGTTIN, SIGTTOU, SIGTSTP, SIGPROF, SIGSTOP, SIGKILL +-- +-- The pragma Unreserve_All_Interrupts affects the following signal(s): +-- +-- SIGINT: made available for Ada handler +-- SIGILL, SIGBUS, SIGSEGV: disconnected from runtime exception mapping + +with System.OS_Interface; +-- used for names of interrupts + +package Ada.Interrupts.Names is + + -- Beware that the mapping of names to signals may be + -- many-to-one. There may be aliases. + + SIGHUP : constant Interrupt_ID := + System.OS_Interface.SIGHUP; -- hangup + + SIGINT : constant Interrupt_ID := + System.OS_Interface.SIGINT; -- interrupt (rubout) + + SIGQUIT : constant Interrupt_ID := + System.OS_Interface.SIGQUIT; -- quit (ASCD FS) + + SIGILL : constant Interrupt_ID := + System.OS_Interface.SIGILL; -- illegal instruction (not reset) + + SIGTRAP : constant Interrupt_ID := + System.OS_Interface.SIGTRAP; -- trace trap (not reset) + + SIGBRK : constant Interrupt_ID := + System.OS_Interface.SIGBRK; -- break + + SIGIOT : constant Interrupt_ID := + System.OS_Interface.SIGIOT; -- IOT instruction + + SIGABRT : constant Interrupt_ID := -- used by abort, + System.OS_Interface.SIGABRT; -- replace SIGIOT in the future + + SIGCORE : constant Interrupt_ID := + System.OS_Interface.SIGCORE; -- kill with core dump + + SIGEMT : constant Interrupt_ID := + System.OS_Interface.SIGEMT; -- EMT instruction + + SIGFPE : constant Interrupt_ID := + System.OS_Interface.SIGFPE; -- floating point exception + + SIGKILL : constant Interrupt_ID := + System.OS_Interface.SIGKILL; -- kill (cannot be caught or ignored) + + SIGBUS : constant Interrupt_ID := + System.OS_Interface.SIGBUS; -- bus error + + SIGSEGV : constant Interrupt_ID := + System.OS_Interface.SIGSEGV; -- segmentation violation + + SIGSYS : constant Interrupt_ID := + System.OS_Interface.SIGSYS; -- bad argument to system call + + SIGPIPE : constant Interrupt_ID := -- write on a pipe with + System.OS_Interface.SIGPIPE; -- no one to read it + + SIGALRM : constant Interrupt_ID := + System.OS_Interface.SIGALRM; -- alarm clock + + SIGTERM : constant Interrupt_ID := + System.OS_Interface.SIGTERM; -- software termination signal from kill + + SIGURG : constant Interrupt_ID := + System.OS_Interface.SIGURG; -- urgent condition on IO channel + + SIGSTOP : constant Interrupt_ID := + System.OS_Interface.SIGSTOP; -- stop (cannot be caught or ignored) + + SIGTSTP : constant Interrupt_ID := + System.OS_Interface.SIGTSTP; -- user stop requested from tty + + SIGCONT : constant Interrupt_ID := + System.OS_Interface.SIGCONT; -- stopped process has been continued + + SIGCLD : constant Interrupt_ID := + System.OS_Interface.SIGCLD; -- child status change + + SIGCHLD : constant Interrupt_ID := + System.OS_Interface.SIGCHLD; -- 4.3BSD's/POSIX name for SIGCLD + + SIGTTIN : constant Interrupt_ID := + System.OS_Interface.SIGTTIN; -- background tty read attempted + + SIGTTOU : constant Interrupt_ID := + System.OS_Interface.SIGTTOU; -- background tty write attempted + + SIGPOLL : constant Interrupt_ID := + System.OS_Interface.SIGPOLL; -- pollable event occurred + + SIGIO : constant Interrupt_ID := -- input/output possible, + System.OS_Interface.SIGIO; -- SIGPOLL alias (Solaris) + + SIGXCPU : constant Interrupt_ID := + System.OS_Interface.SIGXCPU; -- CPU time limit exceeded + + SIGXFSZ : constant Interrupt_ID := + System.OS_Interface.SIGXFSZ; -- filesize limit exceeded + + SIGVTALRM : constant Interrupt_ID := + System.OS_Interface.SIGVTALRM; -- virtual timer expired + + SIGPROF : constant Interrupt_ID := + System.OS_Interface.SIGPROF; -- profiling timer expired + + SIGWINCH : constant Interrupt_ID := + System.OS_Interface.SIGWINCH; -- window size change + + SIGLOST : constant Interrupt_ID := + System.OS_Interface.SIGLOST; -- SUN 4.1 compatibility + + SIGUSR1 : constant Interrupt_ID := + System.OS_Interface.SIGUSR1; -- user defined signal 1 + + SIGUSR2 : constant Interrupt_ID := + System.OS_Interface.SIGUSR2; -- user defined signal 2 + + SIGPRIO : constant Interrupt_ID := + System.OS_Interface.SIGPRIO; + -- sent to a process with its priority + -- or group is changed +end Ada.Interrupts.Names; diff --git a/gcc/ada/4aintnam.ads b/gcc/ada/4aintnam.ads new file mode 100644 index 0000000..b882bcb --- /dev/null +++ b/gcc/ada/4aintnam.ads @@ -0,0 +1,155 @@ +------------------------------------------------------------------------------ +-- -- +-- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS -- +-- -- +-- A D A . I N T E R R U P T S . N A M E S -- +-- -- +-- S p e c -- +-- -- +-- $Revision: 1.4 $ -- +-- -- +-- Copyright (C) 1991-2001 Free Software Foundation, Inc. -- +-- -- +-- GNARL is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 2, or (at your option) any later ver- -- +-- sion. GNARL is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNARL; see file COPYING. If not, write -- +-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNARL was developed by the GNARL team at Florida State University. It is -- +-- now maintained by Ada Core Technologies Inc. in cooperation with Florida -- +-- State University (http://www.gnat.com). -- +-- -- +------------------------------------------------------------------------------ + +-- This is the DEC Unix 4.0 version of this package. +-- +-- The following signals are reserved by the run time: +-- +-- SIGFPE, SIGILL, SIGSEGV, SIGBUS, SIGABRT, SIGTRAP, SIGINT, SIGALRM, +-- SIGSTOP, SIGKILL +-- +-- The pragma Unreserve_All_Interrupts affects the following signal(s): +-- +-- SIGINT: made available for Ada handler +-- SIGILL, SIGBUS, SIGSEGV: disconnected from runtime exception mapping + +with System.OS_Interface; +-- used for names of interrupts + +package Ada.Interrupts.Names is + + -- Beware that the mapping of names to signals may be + -- many-to-one. There may be aliases. Also, for all + -- signal names that are not supported on the current system + -- the value of the corresponding constant will be zero. + + SIGHUP : constant Interrupt_ID := + System.OS_Interface.SIGHUP; -- hangup + + SIGINT : constant Interrupt_ID := + System.OS_Interface.SIGINT; -- interrupt (rubout) + + SIGQUIT : constant Interrupt_ID := + System.OS_Interface.SIGQUIT; -- quit (ASCD FS) + + SIGILL : constant Interrupt_ID := + System.OS_Interface.SIGILL; -- illegal instruction (not reset) + + SIGTRAP : constant Interrupt_ID := + System.OS_Interface.SIGTRAP; -- trace trap (not reset) + + SIGIOT : constant Interrupt_ID := + System.OS_Interface.SIGIOT; -- IOT instruction + + SIGABRT : constant Interrupt_ID := -- used by abort, + System.OS_Interface.SIGABRT; -- replace SIGIOT in the future + + SIGEMT : constant Interrupt_ID := + System.OS_Interface.SIGEMT; -- EMT instruction + + SIGFPE : constant Interrupt_ID := + System.OS_Interface.SIGFPE; -- floating point exception + + SIGKILL : constant Interrupt_ID := + System.OS_Interface.SIGKILL; -- kill (cannot be caught or ignored) + + SIGBUS : constant Interrupt_ID := + System.OS_Interface.SIGBUS; -- bus error + + SIGSEGV : constant Interrupt_ID := + System.OS_Interface.SIGSEGV; -- segmentation violation + + SIGSYS : constant Interrupt_ID := + System.OS_Interface.SIGSYS; -- bad argument to system call + + SIGPIPE : constant Interrupt_ID := -- write on a pipe with + System.OS_Interface.SIGPIPE; -- no one to read it + + SIGALRM : constant Interrupt_ID := + System.OS_Interface.SIGALRM; -- alarm clock + + SIGTERM : constant Interrupt_ID := + System.OS_Interface.SIGTERM; -- software termination signal from kill + + SIGUSR1 : constant Interrupt_ID := + System.OS_Interface.SIGUSR1; -- user defined signal 1 + + SIGUSR2 : constant Interrupt_ID := + System.OS_Interface.SIGUSR2; -- user defined signal 2 + + SIGCHLD : constant Interrupt_ID := + System.OS_Interface.SIGCHLD; -- 4.3BSD's/POSIX name for SIGCLD + + SIGWINCH : constant Interrupt_ID := + System.OS_Interface.SIGWINCH; -- window size change + + SIGURG : constant Interrupt_ID := + System.OS_Interface.SIGURG; -- urgent condition on IO channel + + SIGPOLL : constant Interrupt_ID := + System.OS_Interface.SIGPOLL; -- pollable event occurred + + SIGIO : constant Interrupt_ID := -- input/output possible, + System.OS_Interface.SIGIO; -- SIGPOLL alias (Solaris) + + SIGSTOP : constant Interrupt_ID := + System.OS_Interface.SIGSTOP; -- stop (cannot be caught or ignored) + + SIGTSTP : constant Interrupt_ID := + System.OS_Interface.SIGTSTP; -- user stop requested from tty + + SIGCONT : constant Interrupt_ID := + System.OS_Interface.SIGCONT; -- stopped process has been continued + + SIGTTIN : constant Interrupt_ID := + System.OS_Interface.SIGTTIN; -- background tty read attempted + + SIGTTOU : constant Interrupt_ID := + System.OS_Interface.SIGTTOU; -- background tty write attempted + + SIGVTALRM : constant Interrupt_ID := + System.OS_Interface.SIGVTALRM; -- virtual timer expired + + SIGPROF : constant Interrupt_ID := + System.OS_Interface.SIGPROF; -- profiling timer expired + + SIGXCPU : constant Interrupt_ID := + System.OS_Interface.SIGXCPU; -- CPU time limit exceeded + + SIGXFSZ : constant Interrupt_ID := + System.OS_Interface.SIGXFSZ; -- filesize limit exceeded + +end Ada.Interrupts.Names; diff --git a/gcc/ada/4cintnam.ads b/gcc/ada/4cintnam.ads new file mode 100644 index 0000000..2fd5046 --- /dev/null +++ b/gcc/ada/4cintnam.ads @@ -0,0 +1,205 @@ +------------------------------------------------------------------------------ +-- -- +-- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS -- +-- -- +-- A D A . I N T E R R U P T S . N A M E S -- +-- -- +-- S p e c -- +-- -- +-- $Revision: 1.4 $ -- +-- -- +-- Copyright (C) 1991-2001 Free Software Foundation, Inc. -- +-- -- +-- GNARL is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 2, or (at your option) any later ver- -- +-- sion. GNARL is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNARL; see file COPYING. If not, write -- +-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNARL was developed by the GNARL team at Florida State University. It is -- +-- now maintained by Ada Core Technologies Inc. in cooperation with Florida -- +-- State University (http://www.gnat.com). -- +-- -- +------------------------------------------------------------------------------ + +-- This is a AIX version of this package. +-- +-- The following signals are reserved by the run time (native threads): +-- +-- SIGFPE, SIGILL, SIGSEGV, SIGBUS, SIGABRT, SIGTRAP, SIGINT, SIGTERM, +-- SIGSTOP, SIGKILL +-- +-- The following signals are reserved by the run time (FSU threads): +-- +-- SIGFPE, SIGILL, SIGSEGV, SIGBUS, SIGABRT, SIGTRAP, SIGINT, SIGALRM, +-- SIGWAITING, SIGSTOP, SIGKILL +-- +-- The pragma Unreserve_All_Interrupts affects the following signal(s): +-- +-- SIGINT: made available for Ada handler +-- SIGILL, SIGBUS, SIGSEGV: disconnected from runtime exception mapping + +-- This target-dependent package spec contains names of interrupts +-- supported by the local system. + +with System.OS_Interface; +-- used for names of interrupts + +package Ada.Interrupts.Names is + + -- Beware that the mapping of names to signals may be + -- many-to-one. There may be aliases. Also, for all + -- signal names that are not supported on the current system + -- the value of the corresponding constant will be zero. + + SIGHUP : constant Interrupt_ID := + System.OS_Interface.SIGHUP; -- hangup + + SIGINT : constant Interrupt_ID := + System.OS_Interface.SIGINT; -- interrupt (rubout) + + SIGQUIT : constant Interrupt_ID := + System.OS_Interface.SIGQUIT; -- quit (ASCD FS) + + SIGILL : constant Interrupt_ID := + System.OS_Interface.SIGILL; -- illegal instruction (not reset) + + SIGTRAP : constant Interrupt_ID := + System.OS_Interface.SIGTRAP; -- trace trap (not reset) + + SIGIOT : constant Interrupt_ID := + System.OS_Interface.SIGIOT; -- IOT instruction + + SIGABRT : constant Interrupt_ID := -- used by abort, + System.OS_Interface.SIGABRT; -- replace SIGIOT in the future + + SIGEMT : constant Interrupt_ID := + System.OS_Interface.SIGEMT; -- EMT instruction + + SIGFPE : constant Interrupt_ID := + System.OS_Interface.SIGFPE; -- floating point exception + + SIGKILL : constant Interrupt_ID := + System.OS_Interface.SIGKILL; -- kill (cannot be caught or ignored) + + SIGBUS : constant Interrupt_ID := + System.OS_Interface.SIGBUS; -- bus error + + SIGSEGV : constant Interrupt_ID := + System.OS_Interface.SIGSEGV; -- segmentation violation + + SIGSYS : constant Interrupt_ID := + System.OS_Interface.SIGSYS; -- bad argument to system call + + SIGPIPE : constant Interrupt_ID := -- write on a pipe with + System.OS_Interface.SIGPIPE; -- no one to read it + + SIGALRM : constant Interrupt_ID := + System.OS_Interface.SIGALRM; -- alarm clock + + SIGTERM : constant Interrupt_ID := + System.OS_Interface.SIGTERM; -- software termination signal from kill + + SIGUSR1 : constant Interrupt_ID := + System.OS_Interface.SIGUSR1; -- user defined signal 1 + + SIGUSR2 : constant Interrupt_ID := + System.OS_Interface.SIGUSR2; -- user defined signal 2 + + SIGCLD : constant Interrupt_ID := + System.OS_Interface.SIGCLD; -- child status change + + SIGCHLD : constant Interrupt_ID := + System.OS_Interface.SIGCHLD; -- 4.3BSD's/POSIX name for SIGCLD + + SIGPWR : constant Interrupt_ID := + System.OS_Interface.SIGPWR; -- power-fail restart + + SIGWINCH : constant Interrupt_ID := + System.OS_Interface.SIGWINCH; -- window size change + + SIGURG : constant Interrupt_ID := + System.OS_Interface.SIGURG; -- urgent condition on IO channel + + SIGPOLL : constant Interrupt_ID := + System.OS_Interface.SIGPOLL; -- pollable event occurred + + SIGIO : constant Interrupt_ID := -- input/output possible, + System.OS_Interface.SIGIO; -- SIGPOLL alias (Solaris) + + SIGSTOP : constant Interrupt_ID := + System.OS_Interface.SIGSTOP; -- stop (cannot be caught or ignored) + + SIGTSTP : constant Interrupt_ID := + System.OS_Interface.SIGTSTP; -- user stop requested from tty + + SIGCONT : constant Interrupt_ID := + System.OS_Interface.SIGCONT; -- stopped process has been continued + + SIGTTIN : constant Interrupt_ID := + System.OS_Interface.SIGTTIN; -- background tty read attempted + + SIGTTOU : constant Interrupt_ID := + System.OS_Interface.SIGTTOU; -- background tty write attempted + + SIGVTALRM : constant Interrupt_ID := + System.OS_Interface.SIGVTALRM; -- virtual timer expired + + SIGPROF : constant Interrupt_ID := + System.OS_Interface.SIGPROF; -- profiling timer expired + + SIGXCPU : constant Interrupt_ID := + System.OS_Interface.SIGXCPU; -- CPU time limit exceeded + + SIGXFSZ : constant Interrupt_ID := + System.OS_Interface.SIGXFSZ; -- filesize limit exceeded + + SIGMSG : constant Interrupt_ID := + System.OS_Interface.SIGMSG; -- input data is in the ring buffer + + SIGDANGER : constant Interrupt_ID := + System.OS_Interface.SIGDANGER; -- system crash imminent; + + SIGMIGRATE : constant Interrupt_ID := + System.OS_Interface.SIGMIGRATE; -- migrate process + + SIGPRE : constant Interrupt_ID := + System.OS_Interface.SIGPRE; -- programming exception + + SIGVIRT : constant Interrupt_ID := + System.OS_Interface.SIGVIRT; -- AIX virtual time alarm + + SIGALRM1 : constant Interrupt_ID := + System.OS_Interface.SIGALRM1; -- m:n condition variables + + SIGWAITING : constant Interrupt_ID := + System.OS_Interface.SIGWAITING; -- m:n scheduling + + SIGKAP : constant Interrupt_ID := + System.OS_Interface.SIGKAP; -- keep alive poll from native keyboard + + SIGGRANT : constant Interrupt_ID := + System.OS_Interface.SIGGRANT; -- monitor mode granted + + SIGRETRACT : constant Interrupt_ID := + System.OS_Interface.SIGRETRACT; -- monitor mode should be relinguished + + SIGSOUND : constant Interrupt_ID := + System.OS_Interface.SIGSOUND; -- sound control has completed + + SIGSAK : constant Interrupt_ID := + System.OS_Interface.SIGSAK; -- secure attention key + +end Ada.Interrupts.Names; diff --git a/gcc/ada/4dintnam.ads b/gcc/ada/4dintnam.ads new file mode 100644 index 0000000..7904e9f --- /dev/null +++ b/gcc/ada/4dintnam.ads @@ -0,0 +1,101 @@ +------------------------------------------------------------------------------ +-- -- +-- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS -- +-- -- +-- A D A . I N T E R R U P T S . N A M E S -- +-- -- +-- S p e c -- +-- -- +-- $Revision: 1.4 $ -- +-- -- +-- Copyright (C) 1991-2001 Free Software Foundation, Inc. -- +-- -- +-- GNARL is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 2, or (at your option) any later ver- -- +-- sion. GNARL is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNARL; see file COPYING. If not, write -- +-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNARL was developed by the GNARL team at Florida State University. It is -- +-- now maintained by Ada Core Technologies Inc. in cooperation with Florida -- +-- State University (http://www.gnat.com). -- +-- -- +------------------------------------------------------------------------------ + +-- This is a DOS/DJGPPv2 (FSU THREAD) version of this package. +-- +-- The following signals are reserved by the run time: +-- +-- SIGFPE, SIGILL, SIGSEGV, SIGABRT, SIGTRAP, SIGINT, SIGALRM +-- SIGSTOP, SIGKILL +-- +-- The pragma Unreserve_All_Interrupts affects the following signal(s): +-- +-- SIGINT: Made available for Ada handler +-- SIGILL, SIGBUS, SIGSEGV: disconnected from runtime exception mapping + +-- This target-dependent package spec contains names of interrupts +-- supported by the local system. + +with System.OS_Interface; +-- used for names of interrupts + +package Ada.Interrupts.Names is + + -- Beware that the mapping of names to signals may be + -- many-to-one. There may be aliases. Also, for all + -- signal names that are not supported on the current system + -- the value of the corresponding constant will be zero. + + SIGHUP : constant Interrupt_ID := + System.OS_Interface.SIGHUP; -- hangup + + SIGINT : constant Interrupt_ID := + System.OS_Interface.SIGINT; -- interrupt (rubout) + + SIGQUIT : constant Interrupt_ID := + System.OS_Interface.SIGQUIT; -- quit (ASCD FS) + + SIGILL : constant Interrupt_ID := + System.OS_Interface.SIGILL; -- illegal instruction (not reset) + + SIGABRT : constant Interrupt_ID := -- used by abort, + System.OS_Interface.SIGABRT; -- replace SIGIOT in the future + + SIGFPE : constant Interrupt_ID := + System.OS_Interface.SIGFPE; -- floating point exception + + SIGKILL : constant Interrupt_ID := + System.OS_Interface.SIGKILL; -- kill (cannot be caught or ignored) + + SIGSEGV : constant Interrupt_ID := + System.OS_Interface.SIGSEGV; -- segmentation violation + + SIGPIPE : constant Interrupt_ID := -- write on a pipe with + System.OS_Interface.SIGPIPE; -- no one to read it + + SIGALRM : constant Interrupt_ID := + System.OS_Interface.SIGALRM; -- alarm clock + + SIGTERM : constant Interrupt_ID := + System.OS_Interface.SIGTERM; -- software termination signal from kill + + SIGUSR1 : constant Interrupt_ID := + System.OS_Interface.SIGUSR1; -- user defined signal 1 + + SIGUSR2 : constant Interrupt_ID := + System.OS_Interface.SIGUSR2; -- user defined signal 2 + +end Ada.Interrupts.Names; diff --git a/gcc/ada/4gintnam.ads b/gcc/ada/4gintnam.ads new file mode 100644 index 0000000..4e0ca4f --- /dev/null +++ b/gcc/ada/4gintnam.ads @@ -0,0 +1,199 @@ +------------------------------------------------------------------------------ +-- -- +-- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS -- +-- -- +-- A D A . I N T E R R U P T S . N A M E S -- +-- -- +-- S p e c -- +-- -- +-- $Revision: 1.5 $ -- +-- -- +-- Copyright (C) 1997-2001, Florida State University -- +-- -- +-- GNARL is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU Library General Public License as published by the -- +-- Free Software Foundation; either version 2, or (at your option) any -- +-- later version. GNARL is distributed in the hope that it will be use- -- +-- ful, but WITHOUT ANY WARRANTY; without even the implied warranty of -- +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Gen- -- +-- eral Library Public License for more details. You should have received -- +-- a copy of the GNU Library General Public License along with GNARL; see -- +-- file COPYING.LIB. If not, write to the Free Software Foundation, 675 -- +-- Mass Ave, Cambridge, MA 02139, 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. It is -- +-- now maintained by Ada Core Technologies Inc. in cooperation with Florida -- +-- State University (http://www.gnat.com). -- +-- -- +------------------------------------------------------------------------------ + +-- This is the Irix version of this package +-- +-- The following signals are reserved by the run time (Athread library): +-- +-- SIGFPE, SIGILL, SIGSEGV, SIGBUS, SIGTRAP, SIGSTOP, SIGKILL +-- +-- The following signals are reserved by the run time (Pthread library): +-- +-- SIGTSTP, SIGILL, SIGTRAP, SIGEMT, SIGFPE, SIGBUS, SIGSTOP, SIGKILL, +-- SIGSEGV, SIGSYS, SIGXCPU, SIGXFSZ, SIGPROF, SIGPTINTR, SIGPTRESCHED, +-- SIGABRT, SIGINT +-- +-- The pragma Unreserve_All_Interrupts affects the following signal +-- (Pthread library): +-- +-- SIGINT: made available for Ada handler +-- SIGILL, SIGBUS, SIGSEGV: disconnected from runtime exception mapping + +-- This target-dependent package spec contains names of interrupts +-- supported by the local system. + +with System.OS_Interface; +-- used for names of interrupts + +package Ada.Interrupts.Names is + + -- Beware that the mapping of names to signals may be + -- many-to-one. There may be aliases. Also, for all + -- signal names that are not supported on the current system + -- the value of the corresponding constant will be zero. + + SIGHUP : constant Interrupt_ID := + System.OS_Interface.SIGHUP; -- hangup + + SIGINT : constant Interrupt_ID := + System.OS_Interface.SIGINT; -- interrupt (rubout) + + SIGQUIT : constant Interrupt_ID := + System.OS_Interface.SIGQUIT; -- quit (ASCD FS) + + SIGILL : constant Interrupt_ID := + System.OS_Interface.SIGILL; -- illegal instruction (not reset) + + SIGTRAP : constant Interrupt_ID := + System.OS_Interface.SIGTRAP; -- trace trap (not reset) + + SIGIOT : constant Interrupt_ID := + System.OS_Interface.SIGIOT; -- IOT instruction + + SIGABRT : constant Interrupt_ID := + System.OS_Interface.SIGABRT; -- used by abort, replace SIGIOT in the + -- future + + SIGEMT : constant Interrupt_ID := + System.OS_Interface.SIGEMT; -- EMT instruction + + SIGFPE : constant Interrupt_ID := + System.OS_Interface.SIGFPE; -- floating point exception + + SIGKILL : constant Interrupt_ID := + System.OS_Interface.SIGKILL; -- kill (cannot be caught or ignored) + + SIGBUS : constant Interrupt_ID := + System.OS_Interface.SIGBUS; -- bus error + + SIGSEGV : constant Interrupt_ID := + System.OS_Interface.SIGSEGV; -- segmentation violation + + SIGSYS : constant Interrupt_ID := + System.OS_Interface.SIGSYS; -- bad argument to system call + + SIGPIPE : constant Interrupt_ID := + System.OS_Interface.SIGPIPE; -- write on pipe with no one to read it + + SIGALRM : constant Interrupt_ID := + System.OS_Interface.SIGALRM; -- alarm clock + + SIGTERM : constant Interrupt_ID := + System.OS_Interface.SIGTERM; -- software termination signal from kill + + SIGUSR1 : constant Interrupt_ID := + System.OS_Interface.SIGUSR1; -- user defined signal 1 + + SIGUSR2 : constant Interrupt_ID := + System.OS_Interface.SIGUSR2; -- user defined signal 2 + + SIGCLD : constant Interrupt_ID := + System.OS_Interface.SIGCLD; -- alias for SIGCHLD + + SIGCHLD : constant Interrupt_ID := + System.OS_Interface.SIGCHLD; -- child status change + + SIGPWR : constant Interrupt_ID := + System.OS_Interface.SIGPWR; -- power-fail restart + + SIGWINCH : constant Interrupt_ID := + System.OS_Interface.SIGWINCH; -- window size change + + SIGURG : constant Interrupt_ID := + System.OS_Interface.SIGURG; -- urgent condition on IO channel + + SIGPOLL : constant Interrupt_ID := + System.OS_Interface.SIGPOLL; -- pollable event occurred + + SIGIO : constant Interrupt_ID := + System.OS_Interface.SIGIO; -- I/O possible (Solaris SIGPOLL alias) + + SIGSTOP : constant Interrupt_ID := + System.OS_Interface.SIGSTOP; -- stop (cannot be caught or ignored) + + SIGTSTP : constant Interrupt_ID := + System.OS_Interface.SIGTSTP; -- user stop requested from tty + + SIGCONT : constant Interrupt_ID := + System.OS_Interface.SIGCONT; -- stopped process has been continued + + SIGTTIN : constant Interrupt_ID := + System.OS_Interface.SIGTTIN; -- background tty read attempted + + SIGTTOU : constant Interrupt_ID := + System.OS_Interface.SIGTTOU; -- background tty write attempted + + SIGVTALRM : constant Interrupt_ID := + System.OS_Interface.SIGVTALRM; -- virtual timer expired + + SIGPROF : constant Interrupt_ID := + System.OS_Interface.SIGPROF; -- profiling timer expired + + SIGXCPU : constant Interrupt_ID := + System.OS_Interface.SIGXCPU; -- CPU time limit exceeded + + SIGXFSZ : constant Interrupt_ID := + System.OS_Interface.SIGXFSZ; -- filesize limit exceeded + + SIGK32 : constant Interrupt_ID := + System.OS_Interface.SIGK32; -- reserved for kernel (IRIX) + + SIGCKPT : constant Interrupt_ID := + System.OS_Interface.SIGCKPT; -- Checkpoint warning + + SIGRESTART : constant Interrupt_ID := + System.OS_Interface.SIGRESTART; -- Restart warning + + SIGUME : constant Interrupt_ID := + System.OS_Interface.SIGUME; -- Uncorrectable memory error + + -- Signals defined for Posix 1003.1c. + + SIGPTINTR : constant Interrupt_ID := + System.OS_Interface.SIGPTINTR; -- Pthread Interrupt Signal + + SIGPTRESCHED : constant Interrupt_ID := + System.OS_Interface.SIGPTRESCHED; -- Pthread Rescheduling Signal + + -- Posix 1003.1b signals + + SIGRTMIN : constant Interrupt_ID := + System.OS_Interface.SIGRTMIN; -- Posix 1003.1b signals + + SIGRTMAX : constant Interrupt_ID := + System.OS_Interface.SIGRTMAX; -- Posix 1003.1b signals + +end Ada.Interrupts.Names; diff --git a/gcc/ada/4hexcpol.adb b/gcc/ada/4hexcpol.adb new file mode 100644 index 0000000..54b90618 --- /dev/null +++ b/gcc/ada/4hexcpol.adb @@ -0,0 +1,69 @@ +------------------------------------------------------------------------------ +-- -- +-- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS -- +-- -- +-- A D A . E X C E P T I O N S . P O L L -- +-- (version supporting asynchronous abort test and time slicing) -- +-- -- +-- B o d y -- +-- -- +-- $Revision: 1.4 $ +-- -- +-- Copyright (C) 1992-2000, Free Software Foundation, Inc. -- +-- -- +-- GNARL is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 2, or (at your option) any later ver- -- +-- sion. GNARL is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNARL; see file COPYING. If not, write -- +-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNARL was developed by the GNARL team at Florida State University. It is -- +-- now maintained by Ada Core Technologies Inc. in cooperation with Florida -- +-- State University (http://www.gnat.com). -- +-- -- +------------------------------------------------------------------------------ + +-- This version is for targets that do not support per-thread asynchronous +-- signals or that do not handle async timers properly. On such targets, we +-- require compilation with the -gnatP switch that activates periodic polling. +-- Then in the body of the polling routine we test for asynchronous abort and +-- yield periodically. + +-- HP-UX and SCO currently use this file + +with System.Soft_Links; +-- used for Check_Abort_Status + +separate (Ada.Exceptions) + +---------- +-- Poll -- +---------- + +procedure Poll is +begin + if Counter = 10000 then + Counter := 0; + delay 0.0; + else + Counter := Counter + 1; + end if; + + -- Test for asynchronous abort on each poll + + if System.Soft_Links.Check_Abort_Status.all /= 0 then + raise Standard'Abort_Signal; + end if; +end Poll; diff --git a/gcc/ada/4hintnam.ads b/gcc/ada/4hintnam.ads new file mode 100644 index 0000000..f224b9d --- /dev/null +++ b/gcc/ada/4hintnam.ads @@ -0,0 +1,158 @@ +------------------------------------------------------------------------------ +-- -- +-- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS -- +-- -- +-- A D A . I N T E R R U P T S . N A M E S -- +-- -- +-- S p e c -- +-- -- +-- $Revision: 1.5 $ -- +-- -- +-- Copyright (C) 1991-2001, 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- -- +-- ware Foundation; either version 2, or (at your option) any later ver- -- +-- sion. GNARL is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNARL; see file COPYING. If not, write -- +-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNARL was developed by the GNARL team at Florida State University. It is -- +-- now maintained by Ada Core Technologies Inc. in cooperation with Florida -- +-- State University (http://www.gnat.com). -- +-- -- +------------------------------------------------------------------------------ + +-- This is a HP-UX version of this package. +-- +-- The following signals are reserved by the run time: +-- +-- SIGFPE, SIGILL, SIGSEGV, SIGBUS, SIGTRAP, SIGTERM, SIGABRT, SIGINT, +-- SIGALRM, SIGSTOP, SIGKILL +-- +-- The pragma Unreserve_All_Interrupts affects the following signal(s): +-- +-- SIGINT: made available for Ada handler +-- SIGILL, SIGBUS, SIGSEGV: disconnected from runtime exception mapping + +-- This target-dependent package spec contains names of interrupts +-- supported by the local system. + +with System.OS_Interface; +-- used for names of interrupts + +package Ada.Interrupts.Names is + + -- Beware that the mapping of names to signals may be + -- many-to-one. There may be aliases. Also, for all + -- signal names that are not supported on the current system + -- the value of the corresponding constant will be zero. + + SIGHUP : constant Interrupt_ID := + System.OS_Interface.SIGHUP; -- hangup + + SIGINT : constant Interrupt_ID := + System.OS_Interface.SIGINT; -- interrupt (rubout) + + SIGQUIT : constant Interrupt_ID := + System.OS_Interface.SIGQUIT; -- quit (ASCD FS) + + SIGILL : constant Interrupt_ID := + System.OS_Interface.SIGILL; -- illegal instruction (not reset) + + SIGTRAP : constant Interrupt_ID := + System.OS_Interface.SIGTRAP; -- trace trap (not reset) + + SIGIOT : constant Interrupt_ID := + System.OS_Interface.SIGIOT; -- IOT instruction + + SIGABRT : constant Interrupt_ID := -- used by abort, + System.OS_Interface.SIGABRT; -- replace SIGIOT in the future + + SIGEMT : constant Interrupt_ID := + System.OS_Interface.SIGEMT; -- EMT instruction + + SIGFPE : constant Interrupt_ID := + System.OS_Interface.SIGFPE; -- floating point exception + + SIGKILL : constant Interrupt_ID := + System.OS_Interface.SIGKILL; -- kill (cannot be caught or ignored) + + SIGBUS : constant Interrupt_ID := + System.OS_Interface.SIGBUS; -- bus error + + SIGSEGV : constant Interrupt_ID := + System.OS_Interface.SIGSEGV; -- segmentation violation + + SIGSYS : constant Interrupt_ID := + System.OS_Interface.SIGSYS; -- bad argument to system call + + SIGPIPE : constant Interrupt_ID := -- write on a pipe with + System.OS_Interface.SIGPIPE; -- no one to read it + + SIGALRM : constant Interrupt_ID := + System.OS_Interface.SIGALRM; -- alarm clock + + SIGTERM : constant Interrupt_ID := + System.OS_Interface.SIGTERM; -- software termination signal from kill + + SIGUSR1 : constant Interrupt_ID := + System.OS_Interface.SIGUSR1; -- user defined signal 1 + + SIGUSR2 : constant Interrupt_ID := + System.OS_Interface.SIGUSR2; -- user defined signal 2 + + SIGCLD : constant Interrupt_ID := + System.OS_Interface.SIGCLD; -- child status change + + SIGCHLD : constant Interrupt_ID := + System.OS_Interface.SIGCHLD; -- 4.3BSD's/POSIX name for SIGCLD + + SIGWINCH : constant Interrupt_ID := + System.OS_Interface.SIGWINCH; -- window size change + + SIGURG : constant Interrupt_ID := + System.OS_Interface.SIGURG; -- urgent condition on IO channel + + SIGPOLL : constant Interrupt_ID := + System.OS_Interface.SIGPOLL; -- pollable event occurred + + SIGIO : constant Interrupt_ID := -- input/output possible, + System.OS_Interface.SIGIO; -- SIGPOLL alias + + SIGSTOP : constant Interrupt_ID := + System.OS_Interface.SIGSTOP; -- stop (cannot be caught or ignored) + + SIGTSTP : constant Interrupt_ID := + System.OS_Interface.SIGTSTP; -- user stop requested from tty + + SIGCONT : constant Interrupt_ID := + System.OS_Interface.SIGCONT; -- stopped process has been continued + + SIGTTIN : constant Interrupt_ID := + System.OS_Interface.SIGTTIN; -- background tty read attempted + + SIGTTOU : constant Interrupt_ID := + System.OS_Interface.SIGTTOU; -- background tty write attempted + + SIGVTALRM : constant Interrupt_ID := + System.OS_Interface.SIGVTALRM; -- virtual timer expired + + SIGPROF : constant Interrupt_ID := + System.OS_Interface.SIGPROF; -- profiling timer expired + + SIGPWR : constant Interrupt_ID := + System.OS_Interface.SIGPWR; -- power-fail restart + +end Ada.Interrupts.Names; diff --git a/gcc/ada/4lintnam.ads b/gcc/ada/4lintnam.ads new file mode 100644 index 0000000..997cfa3 --- /dev/null +++ b/gcc/ada/4lintnam.ads @@ -0,0 +1,172 @@ +------------------------------------------------------------------------------ +-- -- +-- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS -- +-- -- +-- A D A . I N T E R R U P T S . N A M E S -- +-- -- +-- S p e c -- +-- -- +-- $Revision: 1.5 $ -- +-- -- +-- Copyright (C) 1991-2001 Free Software Foundation, Inc. -- +-- -- +-- GNARL is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 2, or (at your option) any later ver- -- +-- sion. GNARL is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNARL; see file COPYING. If not, write -- +-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNARL was developed by the GNARL team at Florida State University. It is -- +-- now maintained by Ada Core Technologies Inc. in cooperation with Florida -- +-- State University (http://www.gnat.com). -- +-- -- +------------------------------------------------------------------------------ + +-- This is a Linux version of this package. +-- +-- The following signals are reserved by the run time (FSU threads): +-- +-- SIGFPE, SIGILL, SIGSEGV, SIGBUS, SIGTRAP, SIGABRT, SIGINT, +-- SIGALRM, SIGVTALRM, SIGUNUSED, SIGSTOP, SIGKILL +-- +-- The following signals are reserved by the run time (LinuxThreads): +-- +-- SIGFPE, SIGILL, SIGSEGV, SIGBUS, SIGTRAP, SIGABRT, SIGINT, +-- SIGUSR1, SIGUSR2, SIGVTALRM, SIGUNUSED, SIGSTOP, SIGKILL +-- +-- The pragma Unreserve_All_Interrupts affects the following signal(s): +-- +-- SIGINT: made available for Ada handler +-- SIGILL, SIGBUS, SIGSEGV: disconnected from runtime exception mapping + +-- This target-dependent package spec contains names of interrupts +-- supported by the local system. + +with System.OS_Interface; +-- used for names of interrupts + +package Ada.Interrupts.Names is + + -- Beware that the mapping of names to signals may be + -- many-to-one. There may be aliases. Also, for all + -- signal names that are not supported on the current system + -- the value of the corresponding constant will be zero. + + SIGHUP : constant Interrupt_ID := + System.OS_Interface.SIGHUP; -- hangup + + SIGINT : constant Interrupt_ID := + System.OS_Interface.SIGINT; -- interrupt (rubout) + + SIGQUIT : constant Interrupt_ID := + System.OS_Interface.SIGQUIT; -- quit (ASCD FS) + + SIGILL : constant Interrupt_ID := + System.OS_Interface.SIGILL; -- illegal instruction (not reset) + + SIGTRAP : constant Interrupt_ID := + System.OS_Interface.SIGTRAP; -- trace trap (not reset) + + SIGIOT : constant Interrupt_ID := + System.OS_Interface.SIGIOT; -- IOT instruction + + SIGABRT : constant Interrupt_ID := -- used by abort, + System.OS_Interface.SIGABRT; -- replace SIGIOT in the future + + SIGFPE : constant Interrupt_ID := + System.OS_Interface.SIGFPE; -- floating point exception + + SIGKILL : constant Interrupt_ID := + System.OS_Interface.SIGKILL; -- kill (cannot be caught or ignored) + + SIGBUS : constant Interrupt_ID := + System.OS_Interface.SIGBUS; -- bus error + + SIGSEGV : constant Interrupt_ID := + System.OS_Interface.SIGSEGV; -- segmentation violation + + SIGPIPE : constant Interrupt_ID := -- write on a pipe with + System.OS_Interface.SIGPIPE; -- no one to read it + + SIGALRM : constant Interrupt_ID := + System.OS_Interface.SIGALRM; -- alarm clock + + SIGTERM : constant Interrupt_ID := + System.OS_Interface.SIGTERM; -- software termination signal from kill + + SIGUSR1 : constant Interrupt_ID := + System.OS_Interface.SIGUSR1; -- user defined signal 1 + + SIGUSR2 : constant Interrupt_ID := + System.OS_Interface.SIGUSR2; -- user defined signal 2 + + SIGCLD : constant Interrupt_ID := + System.OS_Interface.SIGCLD; -- child status change + + SIGCHLD : constant Interrupt_ID := + System.OS_Interface.SIGCHLD; -- 4.3BSD's/POSIX name for SIGCLD + + SIGWINCH : constant Interrupt_ID := + System.OS_Interface.SIGWINCH; -- window size change + + SIGURG : constant Interrupt_ID := + System.OS_Interface.SIGURG; -- urgent condition on IO channel + + SIGPOLL : constant Interrupt_ID := + System.OS_Interface.SIGPOLL; -- pollable event occurred + + SIGIO : constant Interrupt_ID := -- input/output possible, + System.OS_Interface.SIGIO; -- SIGPOLL alias (Solaris) + + SIGSTOP : constant Interrupt_ID := + System.OS_Interface.SIGSTOP; -- stop (cannot be caught or ignored) + + SIGTSTP : constant Interrupt_ID := + System.OS_Interface.SIGTSTP; -- user stop requested from tty + + SIGCONT : constant Interrupt_ID := + System.OS_Interface.SIGCONT; -- stopped process has been continued + + SIGTTIN : constant Interrupt_ID := + System.OS_Interface.SIGTTIN; -- background tty read attempted + + SIGTTOU : constant Interrupt_ID := + System.OS_Interface.SIGTTOU; -- background tty write attempted + + SIGVTALRM : constant Interrupt_ID := + System.OS_Interface.SIGVTALRM; -- virtual timer expired + + SIGPROF : constant Interrupt_ID := + System.OS_Interface.SIGPROF; -- profiling timer expired + + SIGXCPU : constant Interrupt_ID := + System.OS_Interface.SIGXCPU; -- CPU time limit exceeded + + SIGXFSZ : constant Interrupt_ID := + System.OS_Interface.SIGXFSZ; -- filesize limit exceeded + + SIGUNUSED : constant Interrupt_ID := + System.OS_Interface.SIGUNUSED; -- unused signal + + SIGSTKFLT : constant Interrupt_ID := + System.OS_Interface.SIGSTKFLT; -- stack fault on coprocessor + + SIGLOST : constant Interrupt_ID := + System.OS_Interface.SIGLOST; -- Linux alias for SIGIO + + SIGPWR : constant Interrupt_ID := + System.OS_Interface.SIGPWR; -- Power failure + +end Ada.Interrupts.Names; diff --git a/gcc/ada/4mintnam.ads b/gcc/ada/4mintnam.ads new file mode 100644 index 0000000..5ecb26e --- /dev/null +++ b/gcc/ada/4mintnam.ads @@ -0,0 +1,149 @@ +------------------------------------------------------------------------------ +-- -- +-- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS -- +-- -- +-- A D A . I N T E R R U P T S . N A M E S -- +-- -- +-- S p e c -- +-- -- +-- $Revision: 1.4 $ -- +-- -- +-- Copyright (C) 1996-2001 Free Software Foundation, Inc. -- +-- -- +-- GNARL is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 2, or (at your option) any later ver- -- +-- sion. GNARL is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNARL; see file COPYING. If not, write -- +-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNARL was developed by the GNARL team at Florida State University. It is -- +-- now maintained by Ada Core Technologies Inc. in cooperation with Florida -- +-- State University (http://www.gnat.com). -- +-- -- +------------------------------------------------------------------------------ + +-- This is a Machten version of this package. +-- +-- The following signals are reserved by the run time: +-- +-- SIGFPE, SIGILL, SIGSEGV, SIGBUS, SIGTRAP, SIGABRT, SIGINT, +-- SIGALRM, SIGEMT, SIGCHLD, SIGSTOP, SIGKILL +-- +-- The pragma Unreserve_All_Interrupts affects the following signal(s): +-- +-- SIGINT: made available for Ada handlers +-- SIGILL, SIGBUS, SIGSEGV: disconnected from runtime exception mapping + +-- This target-dependent package spec contains names of interrupts +-- supported by the local system. + +with System.OS_Interface; +-- used for names of interrupts + +package Ada.Interrupts.Names is + + -- Beware that the mapping of names to signals may be + -- many-to-one. There may be aliases. Also, for all + -- signal names that are not supported on the current system + -- the value of the corresponding constant will be zero. + + SIGHUP : constant Interrupt_ID := + System.OS_Interface.SIGHUP; -- hangup + + SIGINT : constant Interrupt_ID := + System.OS_Interface.SIGINT; -- interrupt (rubout) + + SIGQUIT : constant Interrupt_ID := + System.OS_Interface.SIGQUIT; -- quit (ASCD FS) + + SIGILL : constant Interrupt_ID := + System.OS_Interface.SIGILL; -- illegal instruction (not reset) + + SIGTRAP : constant Interrupt_ID := + System.OS_Interface.SIGTRAP; -- trace trap (not reset) + + SIGABRT : constant Interrupt_ID := -- used by abort, + System.OS_Interface.SIGABRT; -- replace SIGIOT in the future + + SIGIOT : constant Interrupt_ID := + System.OS_Interface.SIGIOT; -- IOT instruction + + SIGBUS : constant Interrupt_ID := + System.OS_Interface.SIGBUS; -- bus error + + SIGFPE : constant Interrupt_ID := + System.OS_Interface.SIGFPE; -- floating point exception + + SIGKILL : constant Interrupt_ID := + System.OS_Interface.SIGKILL; -- kill (cannot be caught or ignored) + + SIGUSR1 : constant Interrupt_ID := + System.OS_Interface.SIGUSR1; -- user defined signal 1 + + SIGSEGV : constant Interrupt_ID := + System.OS_Interface.SIGSEGV; -- segmentation violation + + SIGUSR2 : constant Interrupt_ID := + System.OS_Interface.SIGUSR2; -- user defined signal 2 + + SIGPIPE : constant Interrupt_ID := -- write on a pipe with + System.OS_Interface.SIGPIPE; -- no one to read it + + SIGALRM : constant Interrupt_ID := + System.OS_Interface.SIGALRM; -- alarm clock + + SIGTERM : constant Interrupt_ID := + System.OS_Interface.SIGTERM; -- software termination signal from kill + + SIGCHLD : constant Interrupt_ID := + System.OS_Interface.SIGCHLD; -- 4.3BSD's/POSIX name for SIGCLD + + SIGCONT : constant Interrupt_ID := + System.OS_Interface.SIGCONT; -- stopped process has been continued + + SIGSTOP : constant Interrupt_ID := + System.OS_Interface.SIGSTOP; -- stop (cannot be caught or ignored) + + SIGTSTP : constant Interrupt_ID := + System.OS_Interface.SIGTSTP; -- user stop requested from tty + + SIGTTIN : constant Interrupt_ID := + System.OS_Interface.SIGTTIN; -- background tty read attempted + + SIGTTOU : constant Interrupt_ID := + System.OS_Interface.SIGTTOU; -- background tty write attempted + + SIGURG : constant Interrupt_ID := + System.OS_Interface.SIGURG; -- urgent condition on IO channel + + SIGXCPU : constant Interrupt_ID := + System.OS_Interface.SIGXCPU; -- CPU time limit exceeded + + SIGXFSZ : constant Interrupt_ID := + System.OS_Interface.SIGXFSZ; -- filesize limit exceeded + + SIGVTALRM : constant Interrupt_ID := + System.OS_Interface.SIGVTALRM; -- virtual timer expired + + SIGPROF : constant Interrupt_ID := + System.OS_Interface.SIGPROF; -- profiling timer expired + + SIGWINCH : constant Interrupt_ID := + System.OS_Interface.SIGWINCH; -- window size change + + SIGIO : constant Interrupt_ID := -- input/output possible, + System.OS_Interface.SIGIO; + +end Ada.Interrupts.Names; diff --git a/gcc/ada/4nintnam.ads b/gcc/ada/4nintnam.ads new file mode 100644 index 0000000..f494bde --- /dev/null +++ b/gcc/ada/4nintnam.ads @@ -0,0 +1,51 @@ +------------------------------------------------------------------------------ +-- -- +-- GNU ADA RUNTIME LIBRARY (GNARL) COMPONENTS -- +-- -- +-- A D A . I N T E R R U P T S . N A M E S -- +-- -- +-- S p e c -- +-- (No Tasking Version) -- +-- -- +-- $Revision: 1.2 $ -- +-- -- +-- Copyright (C) 1991,92,93,94,95,1996 Free Software Foundation, Inc. -- +-- -- +-- GNARL is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 2, or (at your option) any later ver- -- +-- sion. GNARL is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNARL; see file COPYING. If not, write -- +-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNARL was developed by the GNARL team at Florida State University. It is -- +-- now maintained by Ada Core Technologies Inc. in cooperation with Florida -- +-- State University (http://www.gnat.com). -- +-- -- +------------------------------------------------------------------------------ + +-- The standard implementation of this spec contains only dummy interrupt +-- names. These dummy entries permit checking out code for correctness of +-- semantics, even if interrupts are not supported. + +-- For specific implementations that fully support interrupts, this package +-- spec is replaced by an implementation dependent version that defines the +-- interrupts available on the system. + +package Ada.Interrupts.Names is + + DUMMY_INTERRUPT_1 : constant Interrupt_ID := 1; + DUMMY_INTERRUPT_2 : constant Interrupt_ID := 2; + +end Ada.Interrupts.Names; diff --git a/gcc/ada/4ointnam.ads b/gcc/ada/4ointnam.ads new file mode 100644 index 0000000..6638395 --- /dev/null +++ b/gcc/ada/4ointnam.ads @@ -0,0 +1,45 @@ +------------------------------------------------------------------------------ +-- -- +-- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS -- +-- -- +-- A D A . I N T E R R U P T S . N A M E S -- +-- -- +-- S p e c -- +-- -- +-- $Revision: 1.4 $ -- +-- -- +-- Copyright (C) 1991-1997 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- -- +-- ware Foundation; either version 2, or (at your option) any later ver- -- +-- sion. GNARL is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNARL; see file COPYING. If not, write -- +-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNARL was developed by the GNARL team at Florida State University. It is -- +-- now maintained by Ada Core Technologies Inc. in cooperation with Florida -- +-- State University (http://www.gnat.com). -- +-- -- +------------------------------------------------------------------------------ + +-- This is an OS/2 version of this package. + +-- This target-dependent package spec contains names of interrupts +-- supported by the local system. + +-- This is a stub, for systems that do not support interrupts (or signals) + +package Ada.Interrupts.Names is +end Ada.Interrupts.Names; diff --git a/gcc/ada/4onumaux.ads b/gcc/ada/4onumaux.ads new file mode 100644 index 0000000..3092196 --- /dev/null +++ b/gcc/ada/4onumaux.ads @@ -0,0 +1,94 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUNTIME COMPONENTS -- +-- -- +-- A D A . N U M E R I C S . A U X -- +-- -- +-- S p e c -- +-- (C Library Version for x86) -- +-- -- +-- $Revision: 1.11 $ -- +-- -- +-- Copyright (C) 1992-1998 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, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). -- +-- -- +------------------------------------------------------------------------------ + +-- This package provides the basic computational interface for the generic +-- elementary functions. The C library version interfaces with the routines +-- in the C mathematical library, and is thus quite portable, although it may +-- not necessarily meet the requirements for accuracy in the numerics annex. +-- One advantage of using this package is that it will interface directly to +-- hardware instructions, such as the those provided on the Intel x86. + +-- Note: there are two versions of this package. One using the 80-bit x86 +-- long double format (which is this version), and one using 64-bit IEEE +-- double (see file a-numaux.ads). + +package Ada.Numerics.Aux is +pragma Pure (Aux); + + pragma Linker_Options ("-lm"); + + type Double is digits 18; + + function Sin (X : Double) return Double; + pragma Import (C, Sin, "sinl"); + + function Cos (X : Double) return Double; + pragma Import (C, Cos, "cosl"); + + function Tan (X : Double) return Double; + pragma Import (C, Tan, "tanl"); + + function Exp (X : Double) return Double; + pragma Import (C, Exp, "expl"); + + function Sqrt (X : Double) return Double; + pragma Import (C, Sqrt, "sqrtl"); + + function Log (X : Double) return Double; + pragma Import (C, Log, "logl"); + + function Acos (X : Double) return Double; + pragma Import (C, Acos, "acosl"); + + function Asin (X : Double) return Double; + pragma Import (C, Asin, "asinl"); + + function Atan (X : Double) return Double; + pragma Import (C, Atan, "atanl"); + + function Sinh (X : Double) return Double; + pragma Import (C, Sinh, "sinhl"); + + function Cosh (X : Double) return Double; + pragma Import (C, Cosh, "coshl"); + + function Tanh (X : Double) return Double; + pragma Import (C, Tanh, "tanhl"); + + function Pow (X, Y : Double) return Double; + pragma Import (C, Pow, "powl"); + +end Ada.Numerics.Aux; diff --git a/gcc/ada/4pintnam.ads b/gcc/ada/4pintnam.ads new file mode 100644 index 0000000..f640d49 --- /dev/null +++ b/gcc/ada/4pintnam.ads @@ -0,0 +1,158 @@ +------------------------------------------------------------------------------ +-- -- +-- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS -- +-- -- +-- A D A . I N T E R R U P T S . N A M E S -- +-- -- +-- S p e c -- +-- -- +-- $Revision: 1.4 $ -- +-- -- +-- Copyright (C) 1991-2001 Free Software Foundation, Inc. -- +-- -- +-- GNARL is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 2, or (at your option) any later ver- -- +-- sion. GNARL is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNARL; see file COPYING. If not, write -- +-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNARL was developed by the GNARL team at Florida State University. It is -- +-- now maintained by Ada Core Technologies Inc. in cooperation with Florida -- +-- State University (http://www.gnat.com). -- +-- -- +------------------------------------------------------------------------------ + +-- This is a OpenNT (FSU THREAD) version of this package. +-- +-- The following signals are reserved by the run time: +-- +-- SIGFPE, SIGILL, SIGSEGV, SIGBUS, SIGTRAP, SIGABRT, SIGINT, +-- SIGALRM, SIGVTALRM, SIGSTOP, SIGKILL +-- +-- The pragma Unreserve_All_Interrupts affects the following signal(s): +-- +-- SIGINT: made available for Ada handlers +-- SIGILL, SIGBUS, SIGSEGV: disconnected from runtime exception mapping + +-- This target-dependent package spec contains names of interrupts +-- supported by the local system. + +with System.OS_Interface; +-- used for names of interrupts + +package Ada.Interrupts.Names is + + -- Beware that the mapping of names to signals may be + -- many-to-one. There may be aliases. Also, for all + -- signal names that are not supported on the current system + -- the value of the corresponding constant will be zero. + + SIGHUP : constant Interrupt_ID := + System.OS_Interface.SIGHUP; -- hangup + + SIGINT : constant Interrupt_ID := + System.OS_Interface.SIGINT; -- interrupt (rubout) + + SIGQUIT : constant Interrupt_ID := + System.OS_Interface.SIGQUIT; -- quit (ASCD FS) + + SIGILL : constant Interrupt_ID := + System.OS_Interface.SIGILL; -- illegal instruction (not reset) + + SIGTRAP : constant Interrupt_ID := + System.OS_Interface.SIGTRAP; -- trace trap (not reset) + + SIGIOT : constant Interrupt_ID := + System.OS_Interface.SIGIOT; -- IOT instruction + + SIGABRT : constant Interrupt_ID := -- used by abort, + System.OS_Interface.SIGABRT; -- replace SIGIOT in the future + + SIGFPE : constant Interrupt_ID := + System.OS_Interface.SIGFPE; -- floating point exception + + SIGKILL : constant Interrupt_ID := + System.OS_Interface.SIGKILL; -- kill (cannot be caught or ignored) + + SIGBUS : constant Interrupt_ID := + System.OS_Interface.SIGBUS; -- bus error + + SIGSEGV : constant Interrupt_ID := + System.OS_Interface.SIGSEGV; -- segmentation violation + + SIGSYS : constant Interrupt_ID := + System.OS_Interface.SIGSYS; -- bad argument to system call + + SIGPIPE : constant Interrupt_ID := -- write on a pipe with + System.OS_Interface.SIGPIPE; -- no one to read it + + SIGALRM : constant Interrupt_ID := + System.OS_Interface.SIGALRM; -- alarm clock + + SIGTERM : constant Interrupt_ID := + System.OS_Interface.SIGTERM; -- software termination signal from kill + + SIGUSR1 : constant Interrupt_ID := + System.OS_Interface.SIGUSR1; -- user defined signal 1 + + SIGUSR2 : constant Interrupt_ID := + System.OS_Interface.SIGUSR2; -- user defined signal 2 + + SIGCLD : constant Interrupt_ID := + System.OS_Interface.SIGCLD; -- child status change + + SIGCHLD : constant Interrupt_ID := + System.OS_Interface.SIGCHLD; -- 4.3BSD's/POSIX name for SIGCLD + + SIGWINCH : constant Interrupt_ID := + System.OS_Interface.SIGWINCH; -- window size change + + SIGURG : constant Interrupt_ID := + System.OS_Interface.SIGURG; -- urgent condition on IO channel + + SIGPOLL : constant Interrupt_ID := + System.OS_Interface.SIGPOLL; -- pollable event occurred + + SIGIO : constant Interrupt_ID := -- input/output possible, + System.OS_Interface.SIGIO; -- SIGPOLL alias (Solaris) + + SIGSTOP : constant Interrupt_ID := + System.OS_Interface.SIGSTOP; -- stop (cannot be caught or ignored) + + SIGTSTP : constant Interrupt_ID := + System.OS_Interface.SIGTSTP; -- user stop requested from tty + + SIGCONT : constant Interrupt_ID := + System.OS_Interface.SIGCONT; -- stopped process has been continued + + SIGTTIN : constant Interrupt_ID := + System.OS_Interface.SIGTTIN; -- background tty read attempted + + SIGTTOU : constant Interrupt_ID := + System.OS_Interface.SIGTTOU; -- background tty write attempted + + SIGVTALRM : constant Interrupt_ID := + System.OS_Interface.SIGVTALRM; -- virtual timer expired + + SIGPROF : constant Interrupt_ID := + System.OS_Interface.SIGPROF; -- profiling timer expired + + SIGXCPU : constant Interrupt_ID := + System.OS_Interface.SIGXCPU; -- CPU time limit exceeded + + SIGXFSZ : constant Interrupt_ID := + System.OS_Interface.SIGXFSZ; -- filesize limit exceeded + +end Ada.Interrupts.Names; diff --git a/gcc/ada/4rintnam.ads b/gcc/ada/4rintnam.ads new file mode 100644 index 0000000..53173a2 --- /dev/null +++ b/gcc/ada/4rintnam.ads @@ -0,0 +1,120 @@ +------------------------------------------------------------------------------ +-- -- +-- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS -- +-- -- +-- A D A . I N T E R R U P T S . N A M E S -- +-- -- +-- S p e c -- +-- -- +-- $Revision: 1.5 $ -- +-- -- +-- Copyright (C) 1991-2001 Free Software Foundation, Inc. -- +-- -- +-- GNARL is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 2, or (at your option) any later ver- -- +-- sion. GNARL is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNARL; see file COPYING. If not, write -- +-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNARL was developed by the GNARL team at Florida State University. It is -- +-- now maintained by Ada Core Technologies Inc. in cooperation with Florida -- +-- State University (http://www.gnat.com). -- +-- -- +-- The GNARL files that were developed for RTEMS are maintained by On-Line -- +-- Applications Research Corporation (http://www.oarcorp.com) in coopera- -- +-- tion with Ada Core Technologies Inc. and Florida State University. -- +-- -- +------------------------------------------------------------------------------ + +-- This is a RTEMS version of this package +-- +-- The following signals are reserved by the run time: +-- +-- SIGFPE, SIGILL, SIGSEGV, SIGBUS, SIGTRAP, SIGABRT, SIGINT, +-- SIGALRM, SIGEMT, SIGKILL +-- +-- The pragma Unreserve_All_Interrupts affects the following signal(s): +-- +-- SIGINT: made available for Ada handlers +-- SIGILL, SIGBUS, SIGSEGV: disconnected from runtime exception mapping + +-- This target-dependent package spec contains names of interrupts +-- supported by the local system. + +with System.OS_Interface; +-- used for names of interrupts + +package Ada.Interrupts.Names is + + -- Beware that the mapping of names to signals may be + -- many-to-one. There may be aliases. Also, for all + -- signal names that are not supported on the current system + -- the value of the corresponding constant will be zero. + + SIGHUP : constant Interrupt_ID := + System.OS_Interface.SIGHUP; -- hangup + + SIGINT : constant Interrupt_ID := + System.OS_Interface.SIGINT; -- interrupt (rubout) + + SIGQUIT : constant Interrupt_ID := + System.OS_Interface.SIGQUIT; -- quit (ASCD FS) + + SIGILL : constant Interrupt_ID := + System.OS_Interface.SIGILL; -- illegal instruction (not reset) + + SIGTRAP : constant Interrupt_ID := + System.OS_Interface.SIGTRAP; -- trace trap (not reset) + + SIGIOT : constant Interrupt_ID := + System.OS_Interface.SIGIOT; -- IOT instruction + + SIGABRT : constant Interrupt_ID := -- used by abort, + System.OS_Interface.SIGABRT; -- replace SIGIOT in the future + + SIGEMT : constant Interrupt_ID := + System.OS_Interface.SIGEMT; -- EMT instruction + + SIGFPE : constant Interrupt_ID := + System.OS_Interface.SIGFPE; -- floating point exception + + SIGKILL : constant Interrupt_ID := + System.OS_Interface.SIGKILL; -- kill (cannot be caught or ignored) + + SIGBUS : constant Interrupt_ID := + System.OS_Interface.SIGBUS; -- bus error + + SIGSEGV : constant Interrupt_ID := + System.OS_Interface.SIGSEGV; -- segmentation violation + + SIGSYS : constant Interrupt_ID := + System.OS_Interface.SIGSYS; -- bad argument to system call + + SIGPIPE : constant Interrupt_ID := -- write on a pipe with + System.OS_Interface.SIGPIPE; -- no one to read it + + SIGALRM : constant Interrupt_ID := + System.OS_Interface.SIGALRM; -- alarm clock + + SIGTERM : constant Interrupt_ID := + System.OS_Interface.SIGTERM; -- software termination signal from kill + + SIGUSR1 : constant Interrupt_ID := + System.OS_Interface.SIGUSR1; -- user defined signal 1 + + SIGUSR2 : constant Interrupt_ID := + System.OS_Interface.SIGUSR2; -- user defined signal 2 + +end Ada.Interrupts.Names; diff --git a/gcc/ada/4sintnam.ads b/gcc/ada/4sintnam.ads new file mode 100644 index 0000000..b66aa03 --- /dev/null +++ b/gcc/ada/4sintnam.ads @@ -0,0 +1,183 @@ +------------------------------------------------------------------------------ +-- -- +-- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS -- +-- -- +-- A D A . I N T E R R U P T S . N A M E S -- +-- -- +-- S p e c -- +-- -- +-- $Revision: 1.7 $ -- +-- -- +-- Copyright (C) 1991-2001 Free Software Foundation, Inc. -- +-- -- +-- GNARL is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 2, or (at your option) any later ver- -- +-- sion. GNARL is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNARL; see file COPYING. If not, write -- +-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNARL was developed by the GNARL team at Florida State University. It is -- +-- now maintained by Ada Core Technologies Inc. in cooperation with Florida -- +-- State University (http://www.gnat.com). -- +-- -- +------------------------------------------------------------------------------ + +-- This is a Solaris version of this package. +-- +-- The following signals are reserved by the run time (native threads): +-- +-- SIGFPE, SIGILL, SIGSEGV, SIGBUS, SIGTRAP, SIGABRT, SIGINT, +-- SIGLWP, SIGWAITING, SIGCANCEL, SIGSTOP, SIGKILL +-- +-- The following signals are reserved by the run time (FSU threads): +-- +-- SIGFPE, SIGILL, SIGSEGV, SIGBUS, SIGTRAP, SIGTERM, SIGABRT, SIGINT, +-- SIGLWP, SIGALRM, SIGVTALRM, SIGAITING, SIGSTOP, SIGKILL +-- +-- The pragma Unreserve_All_Interrupts affects the following signal(s): +-- +-- SIGINT: made available for Ada handlers +-- SIGILL, SIGBUS, SIGSEGV: disconnected from runtime exception mapping + +with System.OS_Interface; +-- used for names of interrupts + +package Ada.Interrupts.Names is + + -- Beware that the mapping of names to signals may be + -- many-to-one. There may be aliases. Also, for all + -- signal names that are not supported on the current system + -- the value of the corresponding constant will be zero. + + SIGHUP : constant Interrupt_ID := + System.OS_Interface.SIGHUP; -- hangup + + SIGINT : constant Interrupt_ID := + System.OS_Interface.SIGINT; -- interrupt (rubout) + + SIGQUIT : constant Interrupt_ID := + System.OS_Interface.SIGQUIT; -- quit (ASCD FS) + + SIGILL : constant Interrupt_ID := + System.OS_Interface.SIGILL; -- illegal instruction (not reset) + + SIGTRAP : constant Interrupt_ID := + System.OS_Interface.SIGTRAP; -- trace trap (not reset) + + SIGIOT : constant Interrupt_ID := + System.OS_Interface.SIGIOT; -- IOT instruction + + SIGABRT : constant Interrupt_ID := -- used by abort, + System.OS_Interface.SIGABRT; -- replace SIGIOT in the future + + SIGEMT : constant Interrupt_ID := + System.OS_Interface.SIGEMT; -- EMT instruction + + SIGFPE : constant Interrupt_ID := + System.OS_Interface.SIGFPE; -- floating point exception + + SIGKILL : constant Interrupt_ID := + System.OS_Interface.SIGKILL; -- kill (cannot be caught or ignored) + + SIGBUS : constant Interrupt_ID := + System.OS_Interface.SIGBUS; -- bus error + + SIGSEGV : constant Interrupt_ID := + System.OS_Interface.SIGSEGV; -- segmentation violation + + SIGSYS : constant Interrupt_ID := + System.OS_Interface.SIGSYS; -- bad argument to system call + + SIGPIPE : constant Interrupt_ID := -- write on a pipe with + System.OS_Interface.SIGPIPE; -- no one to read it + + SIGALRM : constant Interrupt_ID := + System.OS_Interface.SIGALRM; -- alarm clock + + SIGTERM : constant Interrupt_ID := + System.OS_Interface.SIGTERM; -- software termination signal from kill + + SIGUSR1 : constant Interrupt_ID := + System.OS_Interface.SIGUSR1; -- user defined signal 1 + + SIGUSR2 : constant Interrupt_ID := + System.OS_Interface.SIGUSR2; -- user defined signal 2 + + SIGCLD : constant Interrupt_ID := + System.OS_Interface.SIGCLD; -- child status change + + SIGCHLD : constant Interrupt_ID := + System.OS_Interface.SIGCHLD; -- 4.3BSD's/POSIX name for SIGCLD + + SIGWINCH : constant Interrupt_ID := + System.OS_Interface.SIGWINCH; -- window size change + + SIGURG : constant Interrupt_ID := + System.OS_Interface.SIGURG; -- urgent condition on IO channel + + SIGPOLL : constant Interrupt_ID := + System.OS_Interface.SIGPOLL; -- pollable event occurred + + SIGIO : constant Interrupt_ID := -- input/output possible, + System.OS_Interface.SIGIO; -- SIGPOLL alias (Solaris) + + SIGSTOP : constant Interrupt_ID := + System.OS_Interface.SIGSTOP; -- stop (cannot be caught or ignored) + + SIGTSTP : constant Interrupt_ID := + System.OS_Interface.SIGTSTP; -- user stop requested from tty + + SIGCONT : constant Interrupt_ID := + System.OS_Interface.SIGCONT; -- stopped process has been continued + + SIGTTIN : constant Interrupt_ID := + System.OS_Interface.SIGTTIN; -- background tty read attempted + + SIGTTOU : constant Interrupt_ID := + System.OS_Interface.SIGTTOU; -- background tty write attempted + + SIGVTALRM : constant Interrupt_ID := + System.OS_Interface.SIGVTALRM; -- virtual timer expired + + SIGPROF : constant Interrupt_ID := + System.OS_Interface.SIGPROF; -- profiling timer expired + + SIGXCPU : constant Interrupt_ID := + System.OS_Interface.SIGXCPU; -- CPU time limit exceeded + + SIGXFSZ : constant Interrupt_ID := + System.OS_Interface.SIGXFSZ; -- filesize limit exceeded + + SIGPWR : constant Interrupt_ID := + System.OS_Interface.SIGPWR; -- power-fail restart + + SIGWAITING : constant Interrupt_ID := + System.OS_Interface.SIGWAITING; -- process's lwps blocked (Solaris) + + SIGLWP : constant Interrupt_ID := + System.OS_Interface.SIGLWP; -- used by thread library (Solaris) + + SIGFREEZE : constant Interrupt_ID := + System.OS_Interface.SIGFREEZE; -- used by CPR (Solaris) + +-- what is CPR???? + + SIGTHAW : constant Interrupt_ID := + System.OS_Interface.SIGTHAW; -- used by CPR (Solaris) + + SIGCANCEL : constant Interrupt_ID := + System.OS_Interface.SIGCANCEL; -- used for thread cancel (Solaris) + +end Ada.Interrupts.Names; diff --git a/gcc/ada/4uintnam.ads b/gcc/ada/4uintnam.ads new file mode 100644 index 0000000..80d354c --- /dev/null +++ b/gcc/ada/4uintnam.ads @@ -0,0 +1,158 @@ +------------------------------------------------------------------------------ +-- -- +-- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS -- +-- -- +-- A D A . I N T E R R U P T S . N A M E S -- +-- -- +-- S p e c -- +-- -- +-- $Revision: 1.7 $ -- +-- -- +-- Copyright (C) 1991-2001 Free Software Foundation, Inc. -- +-- -- +-- GNARL is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 2, or (at your option) any later ver- -- +-- sion. GNARL is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNARL; see file COPYING. If not, write -- +-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNARL was developed by the GNARL team at Florida State University. It is -- +-- now maintained by Ada Core Technologies Inc. in cooperation with Florida -- +-- State University (http://www.gnat.com). -- +-- -- +------------------------------------------------------------------------------ + +-- This is a Sun OS (FSU THREADS) version of this package. +-- +-- The following signals are reserved by the run time: +-- +-- SIGFPE, SIGILL, SIGSEGV, SIGBUS, SIGTRAP, SIGABRT, SIGINT, +-- SIGALRM, SIGEMT, SIGCHLD, SIGSTOP, SIGKILL +-- +-- The pragma Unreserve_All_Interrupts affects the following signal(s): +-- +-- SIGINT: made available for Ada handlers +-- SIGILL, SIGBUS, SIGSEGV: disconnected from runtime exception mapping + +with System.OS_Interface; +-- used for names of interrupts + +package Ada.Interrupts.Names is + + -- Beware that the mapping of names to signals may be + -- many-to-one. There may be aliases. Also, for all + -- signal names that are not supported on the current system + -- the value of the corresponding constant will be zero. + + SIGHUP : constant Interrupt_ID := + System.OS_Interface.SIGHUP; -- hangup + + SIGINT : constant Interrupt_ID := + System.OS_Interface.SIGINT; -- interrupt (rubout) + + SIGQUIT : constant Interrupt_ID := + System.OS_Interface.SIGQUIT; -- quit (ASCD FS) + + SIGILL : constant Interrupt_ID := + System.OS_Interface.SIGILL; -- illegal instruction (not reset) + + SIGTRAP : constant Interrupt_ID := + System.OS_Interface.SIGTRAP; -- trace trap (not reset) + + SIGIOT : constant Interrupt_ID := + System.OS_Interface.SIGIOT; -- IOT instruction + + SIGABRT : constant Interrupt_ID := -- used by abort, + System.OS_Interface.SIGABRT; -- replace SIGIOT in the future + + SIGEMT : constant Interrupt_ID := + System.OS_Interface.SIGEMT; -- EMT instruction + + SIGFPE : constant Interrupt_ID := + System.OS_Interface.SIGFPE; -- floating point exception + + SIGKILL : constant Interrupt_ID := + System.OS_Interface.SIGKILL; -- kill (cannot be caught or ignored) + + SIGBUS : constant Interrupt_ID := + System.OS_Interface.SIGBUS; -- bus error + + SIGSEGV : constant Interrupt_ID := + System.OS_Interface.SIGSEGV; -- segmentation violation + + SIGSYS : constant Interrupt_ID := + System.OS_Interface.SIGSYS; -- bad argument to system call + + SIGPIPE : constant Interrupt_ID := -- write on a pipe with + System.OS_Interface.SIGPIPE; -- no one to read it + + SIGALRM : constant Interrupt_ID := + System.OS_Interface.SIGALRM; -- alarm clock + + SIGTERM : constant Interrupt_ID := + System.OS_Interface.SIGTERM; -- software termination signal from kill + + SIGUSR1 : constant Interrupt_ID := + System.OS_Interface.SIGUSR1; -- user defined signal 1 + + SIGUSR2 : constant Interrupt_ID := + System.OS_Interface.SIGUSR2; -- user defined signal 2 + + SIGCLD : constant Interrupt_ID := + System.OS_Interface.SIGCLD; -- child status change + + SIGCHLD : constant Interrupt_ID := + System.OS_Interface.SIGCHLD; -- 4.3BSD's/POSIX name for SIGCLD + + SIGWINCH : constant Interrupt_ID := + System.OS_Interface.SIGWINCH; -- window size change + + SIGURG : constant Interrupt_ID := + System.OS_Interface.SIGURG; -- urgent condition on IO channel + + SIGPOLL : constant Interrupt_ID := + System.OS_Interface.SIGPOLL; -- pollable event occurred + + SIGIO : constant Interrupt_ID := -- input/output possible, + System.OS_Interface.SIGIO; -- SIGPOLL alias (Solaris) + + SIGSTOP : constant Interrupt_ID := + System.OS_Interface.SIGSTOP; -- stop (cannot be caught or ignored) + + SIGTSTP : constant Interrupt_ID := + System.OS_Interface.SIGTSTP; -- user stop requested from tty + + SIGCONT : constant Interrupt_ID := + System.OS_Interface.SIGCONT; -- stopped process has been continued + + SIGTTIN : constant Interrupt_ID := + System.OS_Interface.SIGTTIN; -- background tty read attempted + + SIGTTOU : constant Interrupt_ID := + System.OS_Interface.SIGTTOU; -- background tty write attempted + + SIGVTALRM : constant Interrupt_ID := + System.OS_Interface.SIGVTALRM; -- virtual timer expired + + SIGPROF : constant Interrupt_ID := + System.OS_Interface.SIGPROF; -- profiling timer expired + + SIGXCPU : constant Interrupt_ID := + System.OS_Interface.SIGXCPU; -- CPU time limit exceeded + + SIGXFSZ : constant Interrupt_ID := + System.OS_Interface.SIGXFSZ; -- filesize limit exceeded + +end Ada.Interrupts.Names; diff --git a/gcc/ada/4vcaldel.adb b/gcc/ada/4vcaldel.adb new file mode 100644 index 0000000..ac3bd2d --- /dev/null +++ b/gcc/ada/4vcaldel.adb @@ -0,0 +1,101 @@ +------------------------------------------------------------------------------ +-- -- +-- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS -- +-- -- +-- A D A . C A L E N D A R . D E L A Y S -- +-- -- +-- B o d y -- +-- -- +-- $Revision: 1.18 $ +-- -- +-- Copyright (C) 1991-2000 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- -- +-- ware Foundation; either version 2, or (at your option) any later ver- -- +-- sion. GNARL is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNARL; see file COPYING. If not, write -- +-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNARL was developed by the GNARL team at Florida State University. It is -- +-- now maintained by Ada Core Technologies Inc. in cooperation with Florida -- +-- State University (http://www.gnat.com). -- +-- -- +------------------------------------------------------------------------------ + +-- This is the Alpha/VMS version. + +with System.OS_Primitives; +-- Used for Max_Sensible_Delay + +with System.Soft_Links; +-- Used for Timed_Delay + +package body Ada.Calendar.Delays is + + package OSP renames System.OS_Primitives; + package TSL renames System.Soft_Links; + + use type TSL.Timed_Delay_Call; + + --------------- + -- Delay_For -- + --------------- + + procedure Delay_For (D : Duration) is + begin + TSL.Timed_Delay.all + (Duration'Min (D, OSP.Max_Sensible_Delay), OSP.Relative); + end Delay_For; + + ----------------- + -- Delay_Until -- + ----------------- + + procedure Delay_Until (T : Time) is + begin + TSL.Timed_Delay.all (To_Duration (T), OSP.Absolute_Calendar); + end Delay_Until; + + ----------------- + -- To_Duration -- + ----------------- + + function To_Duration (T : Time) return Duration is + begin + return OSP.To_Duration (OSP.OS_Time (T), OSP.Absolute_Calendar); + end To_Duration; + + -------------------- + -- Timed_Delay_NT -- + -------------------- + + procedure Timed_Delay_NT (Time : Duration; Mode : Integer); + + procedure Timed_Delay_NT (Time : Duration; Mode : Integer) is + begin + OSP.Timed_Delay (Time, Mode); + end Timed_Delay_NT; + +begin + -- Set up the Timed_Delay soft link to the non tasking version if it has + -- not been already set. + -- If tasking is present, Timed_Delay has already set this soft link, or + -- this will be overriden during the elaboration of + -- System.Tasking.Initialization + + if TSL.Timed_Delay = null then + TSL.Timed_Delay := Timed_Delay_NT'Access; + end if; +end Ada.Calendar.Delays; diff --git a/gcc/ada/4vcalend.adb b/gcc/ada/4vcalend.adb new file mode 100644 index 0000000..0c29f60 --- /dev/null +++ b/gcc/ada/4vcalend.adb @@ -0,0 +1,373 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- A D A . C A L E N D A R -- +-- -- +-- B o d y -- +-- -- +-- $Revision: 1.19 $ +-- -- +-- Copyright (C) 1992-2000 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, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). -- +-- -- +------------------------------------------------------------------------------ + +-- This is the Alpha/VMS version. + +with System.Aux_DEC; use System.Aux_DEC; + +package body Ada.Calendar is + + ------------------------------ + -- Use of Pragma Unsuppress -- + ------------------------------ + + -- This implementation of Calendar takes advantage of the permission in + -- Ada 95 of using arithmetic overflow checks to check for out of bounds + -- time values. This means that we must catch the constraint error that + -- results from arithmetic overflow, so we use pragma Unsuppress to make + -- sure that overflow is enabled, using software overflow checking if + -- necessary. That way, compiling Calendar with options to suppress this + -- checking will not affect its correctness. + + ------------------------ + -- Local Declarations -- + ------------------------ + + Ada_Year_Min : constant := 1901; + Ada_Year_Max : constant := 2099; + + -- Some basic constants used throughout + + Days_In_Month : constant array (Month_Number) of Day_Number := + (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31); + + function To_Relative_Time (D : Duration) return Time; + + function To_Relative_Time (D : Duration) return Time is + begin + return Time (Long_Integer'Integer_Value (D) / 100); + end To_Relative_Time; + + --------- + -- "+" -- + --------- + + function "+" (Left : Time; Right : Duration) return Time is + pragma Unsuppress (Overflow_Check); + begin + return (Left + To_Relative_Time (Right)); + + exception + when Constraint_Error => + raise Time_Error; + end "+"; + + function "+" (Left : Duration; Right : Time) return Time is + pragma Unsuppress (Overflow_Check); + begin + return (To_Relative_Time (Left) + Right); + + exception + when Constraint_Error => + raise Time_Error; + end "+"; + + --------- + -- "-" -- + --------- + + function "-" (Left : Time; Right : Duration) return Time is + pragma Unsuppress (Overflow_Check); + begin + return Left - To_Relative_Time (Right); + + exception + when Constraint_Error => + raise Time_Error; + end "-"; + + function "-" (Left : Time; Right : Time) return Duration is + pragma Unsuppress (Overflow_Check); + begin + return Duration'Fixed_Value + ((Long_Integer (Left) - Long_Integer (Right)) * 100); + + exception + when Constraint_Error => + raise Time_Error; + end "-"; + + --------- + -- "<" -- + --------- + + function "<" (Left, Right : Time) return Boolean is + begin + return Long_Integer (Left) < Long_Integer (Right); + end "<"; + + ---------- + -- "<=" -- + ---------- + + function "<=" (Left, Right : Time) return Boolean is + begin + return Long_Integer (Left) <= Long_Integer (Right); + end "<="; + + --------- + -- ">" -- + --------- + + function ">" (Left, Right : Time) return Boolean is + begin + return Long_Integer (Left) > Long_Integer (Right); + end ">"; + + ---------- + -- ">=" -- + ---------- + + function ">=" (Left, Right : Time) return Boolean is + begin + return Long_Integer (Left) >= Long_Integer (Right); + end ">="; + + ----------- + -- Clock -- + ----------- + + -- The Ada.Calendar.Clock function gets the time. + -- Note that on other targets a soft-link is used to get a different clock + -- depending whether tasking is used or not. On VMS this isn't needed + -- since all clock calls end up using SYS$GETTIM, so call the + -- OS_Primitives version for efficiency. + + function Clock return Time is + begin + return Time (OSP.OS_Clock); + end Clock; + + --------- + -- Day -- + --------- + + function Day (Date : Time) return Day_Number is + DY : Year_Number; + DM : Month_Number; + DD : Day_Number; + DS : Day_Duration; + + begin + Split (Date, DY, DM, DD, DS); + return DD; + end Day; + + ----------- + -- Month -- + ----------- + + function Month (Date : Time) return Month_Number is + DY : Year_Number; + DM : Month_Number; + DD : Day_Number; + DS : Day_Duration; + + begin + Split (Date, DY, DM, DD, DS); + return DM; + end Month; + + ------------- + -- Seconds -- + ------------- + + function Seconds (Date : Time) return Day_Duration is + DY : Year_Number; + DM : Month_Number; + DD : Day_Number; + DS : Day_Duration; + + begin + Split (Date, DY, DM, DD, DS); + return DS; + end Seconds; + + ----------- + -- Split -- + ----------- + + procedure Split + (Date : Time; + Year : out Year_Number; + Month : out Month_Number; + Day : out Day_Number; + Seconds : out Day_Duration) + is + procedure Numtim ( + Status : out Unsigned_Longword; + Timbuf : out Unsigned_Word_Array; + Timadr : in Time); + + pragma Interface (External, Numtim); + + pragma Import_Valued_Procedure (Numtim, "SYS$NUMTIM", + (Unsigned_Longword, Unsigned_Word_Array, Time), + (Value, Reference, Reference)); + + Status : Unsigned_Longword; + Timbuf : Unsigned_Word_Array (1 .. 7); + + begin + Numtim (Status, Timbuf, Date); + + if Status mod 2 /= 1 + or else Timbuf (1) not in Ada_Year_Min .. Ada_Year_Max + then + raise Time_Error; + end if; + + Seconds + := Day_Duration (Timbuf (6) + 60 * (Timbuf (5) + 60 * Timbuf (4))) + + Day_Duration (Timbuf (7)) / 100.0; + Day := Integer (Timbuf (3)); + Month := Integer (Timbuf (2)); + Year := Integer (Timbuf (1)); + end Split; + + ------------- + -- Time_Of -- + ------------- + + function Time_Of + (Year : Year_Number; + Month : Month_Number; + Day : Day_Number; + Seconds : Day_Duration := 0.0) + return Time + is + + procedure Cvt_Vectim ( + Status : out Unsigned_Longword; + Input_Time : in Unsigned_Word_Array; + Resultant_Time : out Time); + + pragma Interface (External, Cvt_Vectim); + + pragma Import_Valued_Procedure (Cvt_Vectim, "LIB$CVT_VECTIM", + (Unsigned_Longword, Unsigned_Word_Array, Time), + (Value, Reference, Reference)); + + Status : Unsigned_Longword; + Timbuf : Unsigned_Word_Array (1 .. 7); + Date : Time; + Int_Secs : Integer; + Day_Hack : Boolean := False; + begin + -- The following checks are redundant with respect to the constraint + -- error checks that should normally be made on parameters, but we + -- decide to raise Constraint_Error in any case if bad values come + -- in (as a result of checks being off in the caller, or for other + -- erroneous or bounded error cases). + + if not Year 'Valid + or else not Month 'Valid + or else not Day 'Valid + or else not Seconds'Valid + then + raise Constraint_Error; + end if; + + -- Truncate seconds value by subtracting 0.5 and rounding, + -- but be careful with 0.0 since that will give -1.0 unless + -- it is treated specially. + + if Seconds > 0.0 then + Int_Secs := Integer (Seconds - 0.5); + else + Int_Secs := Integer (Seconds); + end if; + + -- Cvt_Vectim barfs on the largest Day_Duration, so trick it by + -- setting it to zero and then adding the difference after conversion. + + if Int_Secs = 86_400 then + Int_Secs := 0; + Day_Hack := True; + Timbuf (7) := 0; + else + Timbuf (7) := Unsigned_Word + (100.0 * Duration (Seconds - Day_Duration (Int_Secs))); + -- Cvt_Vectim accurate only to within .01 seconds + end if; + + -- Similar hack needed for 86399 and 100/100ths, since that gets + -- treated as 86400 (largest Day_Duration). This can happen because + -- Duration has more accuracy than VMS system time conversion calls + -- can handle. + + if Int_Secs = 86_399 and then Timbuf (7) = 100 then + Int_Secs := 0; + Day_Hack := True; + Timbuf (7) := 0; + end if; + + Timbuf (6) := Unsigned_Word (Int_Secs mod 60); + Timbuf (5) := Unsigned_Word ((Int_Secs / 60) mod 60); + Timbuf (4) := Unsigned_Word (Int_Secs / 3600); + Timbuf (3) := Unsigned_Word (Day); + Timbuf (2) := Unsigned_Word (Month); + Timbuf (1) := Unsigned_Word (Year); + + Cvt_Vectim (Status, Timbuf, Date); + + if Status mod 2 /= 1 then + raise Time_Error; + end if; + + if Day_Hack then + Date := Date + 10_000_000 * 86_400; + end if; + + return Date; + + end Time_Of; + + ---------- + -- Year -- + ---------- + + function Year (Date : Time) return Year_Number is + DY : Year_Number; + DM : Month_Number; + DD : Day_Number; + DS : Day_Duration; + + begin + Split (Date, DY, DM, DD, DS); + return DY; + end Year; + +end Ada.Calendar; diff --git a/gcc/ada/4vcalend.ads b/gcc/ada/4vcalend.ads new file mode 100644 index 0000000..3d6b736 --- /dev/null +++ b/gcc/ada/4vcalend.ads @@ -0,0 +1,101 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUNTIME COMPONENTS -- +-- -- +-- A D A . C A L E N D A R -- +-- -- +-- S p e c -- +-- -- +-- $Revision: 1.3 $ -- +-- -- +-- This specification is adapted from the Ada Reference Manual for use with -- +-- GNAT. In accordance with the copyright of that document, you can freely -- +-- copy and modify this specification, provided that if you redistribute a -- +-- modified version, any changes that you have made are clearly indicated. -- +-- -- +------------------------------------------------------------------------------ + +-- This is the Alpha/VMS version. + +with System.OS_Primitives; +package Ada.Calendar is + + package OSP renames System.OS_Primitives; + + type Time is private; + + -- Declarations representing limits of allowed local time values. Note that + -- these do NOT constrain the possible stored values of time which may well + -- permit a larger range of times (this is explicitly allowed in Ada 95). + + subtype Year_Number is Integer range 1901 .. 2099; + subtype Month_Number is Integer range 1 .. 12; + subtype Day_Number is Integer range 1 .. 31; + + subtype Day_Duration is Duration range 0.0 .. 86_400.0; + + function Clock return Time; + + function Year (Date : Time) return Year_Number; + function Month (Date : Time) return Month_Number; + function Day (Date : Time) return Day_Number; + function Seconds (Date : Time) return Day_Duration; + + procedure Split + (Date : Time; + Year : out Year_Number; + Month : out Month_Number; + Day : out Day_Number; + Seconds : out Day_Duration); + + function Time_Of + (Year : Year_Number; + Month : Month_Number; + Day : Day_Number; + Seconds : Day_Duration := 0.0) + return Time; + + function "+" (Left : Time; Right : Duration) return Time; + function "+" (Left : Duration; Right : Time) return Time; + function "-" (Left : Time; Right : Duration) return Time; + function "-" (Left : Time; Right : Time) return Duration; + + function "<" (Left, Right : Time) return Boolean; + function "<=" (Left, Right : Time) return Boolean; + function ">" (Left, Right : Time) return Boolean; + function ">=" (Left, Right : Time) return Boolean; + + Time_Error : exception; + +private + + pragma Inline (Clock); + + pragma Inline (Year); + pragma Inline (Month); + pragma Inline (Day); + + pragma Inline ("+"); + pragma Inline ("-"); + + pragma Inline ("<"); + pragma Inline ("<="); + pragma Inline (">"); + pragma Inline (">="); + + -- Time is represented as the number of 100-nanosecond (ns) units offset + -- from the system base date and time, which is 00:00 o'clock, + -- November 17, 1858 (the Smithsonian base date and time for the + -- astronomic calendar). + + -- The time value stored is typically a GMT value, as provided in standard + -- Unix environments. If this is the case then Split and Time_Of perform + -- required conversions to and from local times. + + type Time is new OSP.OS_Time; + + -- Notwithstanding this definition, Time is not quite the same as OS_Time. + -- Relative Time is positive, whereas relative OS_Time is negative, + -- but this declaration makes for easier conversion. + +end Ada.Calendar; diff --git a/gcc/ada/4vintnam.ads b/gcc/ada/4vintnam.ads new file mode 100644 index 0000000..9c1df02 --- /dev/null +++ b/gcc/ada/4vintnam.ads @@ -0,0 +1,80 @@ +------------------------------------------------------------------------------ +-- -- +-- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS -- +-- -- +-- A D A . I N T E R R U P T S . N A M E S -- +-- -- +-- S p e c -- +-- -- +-- $Revision: 1.5 $ -- +-- -- +-- Copyright (C) 1991-2000 Free Software Foundation, Inc. -- +-- -- +-- GNARL is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 2, or (at your option) any later ver- -- +-- sion. GNARL is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNARL; see file COPYING. If not, write -- +-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNARL was developed by the GNARL team at Florida State University. It is -- +-- now maintained by Ada Core Technologies Inc. in cooperation with Florida -- +-- State University (http://www.gnat.com). -- +-- -- +------------------------------------------------------------------------------ + +-- This is a OpenVMS/Alpha version of this package. +-- +-- This target-dependent package spec contains names of interrupts +-- supported by the local system. + +with System.OS_Interface; +package Ada.Interrupts.Names is + + package OS renames System.OS_Interface; + + Interrupt_ID_0 : constant Interrupt_ID := OS.Interrupt_ID_0; + Interrupt_ID_1 : constant Interrupt_ID := OS.Interrupt_ID_1; + Interrupt_ID_2 : constant Interrupt_ID := OS.Interrupt_ID_2; + Interrupt_ID_3 : constant Interrupt_ID := OS.Interrupt_ID_3; + Interrupt_ID_4 : constant Interrupt_ID := OS.Interrupt_ID_4; + Interrupt_ID_5 : constant Interrupt_ID := OS.Interrupt_ID_5; + Interrupt_ID_6 : constant Interrupt_ID := OS.Interrupt_ID_6; + Interrupt_ID_7 : constant Interrupt_ID := OS.Interrupt_ID_7; + Interrupt_ID_8 : constant Interrupt_ID := OS.Interrupt_ID_8; + Interrupt_ID_9 : constant Interrupt_ID := OS.Interrupt_ID_9; + Interrupt_ID_10 : constant Interrupt_ID := OS.Interrupt_ID_10; + Interrupt_ID_11 : constant Interrupt_ID := OS.Interrupt_ID_11; + Interrupt_ID_12 : constant Interrupt_ID := OS.Interrupt_ID_12; + Interrupt_ID_13 : constant Interrupt_ID := OS.Interrupt_ID_13; + Interrupt_ID_14 : constant Interrupt_ID := OS.Interrupt_ID_14; + Interrupt_ID_15 : constant Interrupt_ID := OS.Interrupt_ID_15; + Interrupt_ID_16 : constant Interrupt_ID := OS.Interrupt_ID_16; + Interrupt_ID_17 : constant Interrupt_ID := OS.Interrupt_ID_17; + Interrupt_ID_18 : constant Interrupt_ID := OS.Interrupt_ID_18; + Interrupt_ID_19 : constant Interrupt_ID := OS.Interrupt_ID_19; + Interrupt_ID_20 : constant Interrupt_ID := OS.Interrupt_ID_20; + Interrupt_ID_21 : constant Interrupt_ID := OS.Interrupt_ID_21; + Interrupt_ID_22 : constant Interrupt_ID := OS.Interrupt_ID_22; + Interrupt_ID_23 : constant Interrupt_ID := OS.Interrupt_ID_23; + Interrupt_ID_24 : constant Interrupt_ID := OS.Interrupt_ID_24; + Interrupt_ID_25 : constant Interrupt_ID := OS.Interrupt_ID_25; + Interrupt_ID_26 : constant Interrupt_ID := OS.Interrupt_ID_26; + Interrupt_ID_27 : constant Interrupt_ID := OS.Interrupt_ID_27; + Interrupt_ID_28 : constant Interrupt_ID := OS.Interrupt_ID_28; + Interrupt_ID_29 : constant Interrupt_ID := OS.Interrupt_ID_29; + Interrupt_ID_30 : constant Interrupt_ID := OS.Interrupt_ID_30; + Interrupt_ID_31 : constant Interrupt_ID := OS.Interrupt_ID_31; + +end Ada.Interrupts.Names; diff --git a/gcc/ada/4wcalend.adb b/gcc/ada/4wcalend.adb new file mode 100644 index 0000000..b6a6bf7 --- /dev/null +++ b/gcc/ada/4wcalend.adb @@ -0,0 +1,396 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- A D A . C A L E N D A R -- +-- -- +-- B o d y -- +-- -- +-- $Revision: 1.14 $ +-- -- +-- Copyright (C) 1997-2001 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, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). -- +-- -- +------------------------------------------------------------------------------ + +-- This is the Windows NT/95 version. + +with System.OS_Primitives; +-- used for Clock + +with System.OS_Interface; + +package body Ada.Calendar is + + use System.OS_Interface; + + ------------------------------ + -- Use of Pragma Unsuppress -- + ------------------------------ + + -- This implementation of Calendar takes advantage of the permission in + -- Ada 95 of using arithmetic overflow checks to check for out of bounds + -- time values. This means that we must catch the constraint error that + -- results from arithmetic overflow, so we use pragma Unsuppress to make + -- sure that overflow is enabled, using software overflow checking if + -- necessary. That way, compiling Calendar with options to suppress this + -- checking will not affect its correctness. + + ------------------------ + -- Local Declarations -- + ------------------------ + + Ada_Year_Min : constant := 1901; + Ada_Year_Max : constant := 2099; + + -- Win32 time constants + + epoch_1970 : constant := 16#19D_B1DE_D53E_8000#; -- win32 UTC epoch + system_time_ns : constant := 100; -- 100 ns per tick + Sec_Unit : constant := 10#1#E9; + + --------- + -- "+" -- + --------- + + function "+" (Left : Time; Right : Duration) return Time is + pragma Unsuppress (Overflow_Check); + begin + return (Left + Time (Right)); + + exception + when Constraint_Error => + raise Time_Error; + end "+"; + + function "+" (Left : Duration; Right : Time) return Time is + pragma Unsuppress (Overflow_Check); + begin + return (Time (Left) + Right); + + exception + when Constraint_Error => + raise Time_Error; + end "+"; + + --------- + -- "-" -- + --------- + + function "-" (Left : Time; Right : Duration) return Time is + pragma Unsuppress (Overflow_Check); + begin + return Left - Time (Right); + + exception + when Constraint_Error => + raise Time_Error; + end "-"; + + function "-" (Left : Time; Right : Time) return Duration is + pragma Unsuppress (Overflow_Check); + begin + return Duration (Left) - Duration (Right); + + exception + when Constraint_Error => + raise Time_Error; + end "-"; + + --------- + -- "<" -- + --------- + + function "<" (Left, Right : Time) return Boolean is + begin + return Duration (Left) < Duration (Right); + end "<"; + + ---------- + -- "<=" -- + ---------- + + function "<=" (Left, Right : Time) return Boolean is + begin + return Duration (Left) <= Duration (Right); + end "<="; + + --------- + -- ">" -- + --------- + + function ">" (Left, Right : Time) return Boolean is + begin + return Duration (Left) > Duration (Right); + end ">"; + + ---------- + -- ">=" -- + ---------- + + function ">=" (Left, Right : Time) return Boolean is + begin + return Duration (Left) >= Duration (Right); + end ">="; + + ----------- + -- Clock -- + ----------- + + -- The Ada.Calendar.Clock function gets the time from the soft links + -- interface which will call the appropriate function depending wether + -- tasking is involved or not. + + function Clock return Time is + begin + return Time (System.OS_Primitives.Clock); + end Clock; + + --------- + -- Day -- + --------- + + function Day (Date : Time) return Day_Number is + DY : Year_Number; + DM : Month_Number; + DD : Day_Number; + DS : Day_Duration; + + begin + Split (Date, DY, DM, DD, DS); + return DD; + end Day; + + ----------- + -- Month -- + ----------- + + function Month (Date : Time) return Month_Number is + DY : Year_Number; + DM : Month_Number; + DD : Day_Number; + DS : Day_Duration; + + begin + Split (Date, DY, DM, DD, DS); + return DM; + end Month; + + ------------- + -- Seconds -- + ------------- + + function Seconds (Date : Time) return Day_Duration is + DY : Year_Number; + DM : Month_Number; + DD : Day_Number; + DS : Day_Duration; + + begin + Split (Date, DY, DM, DD, DS); + return DS; + end Seconds; + + ----------- + -- Split -- + ----------- + + procedure Split + (Date : Time; + Year : out Year_Number; + Month : out Month_Number; + Day : out Day_Number; + Seconds : out Day_Duration) + is + + Date_Int : aliased Long_Long_Integer; + Date_Loc : aliased Long_Long_Integer; + Timbuf : aliased SYSTEMTIME; + Int_Date : Long_Long_Integer; + Sub_Seconds : Duration; + + begin + -- We take the sub-seconds (decimal part) of Date and this is added + -- to compute the Seconds. This way we keep the precision of the + -- high-precision clock that was lost with the Win32 API calls + -- below. + + if Date < 0.0 then + + -- this is a Date before Epoch (January 1st, 1970) + + Sub_Seconds := Duration (Date) - + Duration (Long_Long_Integer (Date + Duration'(0.5))); + + Int_Date := Long_Long_Integer (Date - Sub_Seconds); + + -- For Date = -86400.1 we are 2 days before Epoch at 0.1 seconds + -- from day 1 before Epoch. It means that it is 23h 59m 59.9s. + -- here we adjust for that. + + if Sub_Seconds < 0.0 then + Int_Date := Int_Date - 1; + Sub_Seconds := 1.0 + Sub_Seconds; + end if; + + else + + -- this is a Date after Epoch (January 1st, 1970) + + Sub_Seconds := Duration (Date) - + Duration (Long_Long_Integer (Date - Duration'(0.5))); + + Int_Date := Long_Long_Integer (Date - Sub_Seconds); + + end if; + + -- Date_Int is the number of seconds from Epoch. + + Date_Int := Long_Long_Integer + (Int_Date * Sec_Unit / system_time_ns) + epoch_1970; + + if not FileTimeToLocalFileTime (Date_Int'Access, Date_Loc'Access) then + raise Time_Error; + end if; + + if not FileTimeToSystemTime (Date_Loc'Access, Timbuf'Access) then + raise Time_Error; + end if; + + if Timbuf.wYear not in Ada_Year_Min .. Ada_Year_Max then + raise Time_Error; + end if; + + Seconds := + Duration (Timbuf.wHour) * 3_600.0 + + Duration (Timbuf.wMinute) * 60.0 + + Duration (Timbuf.wSecond) + + Sub_Seconds; + + Day := Integer (Timbuf.wDay); + Month := Integer (Timbuf.wMonth); + Year := Integer (Timbuf.wYear); + end Split; + + ------------- + -- Time_Of -- + ------------- + + function Time_Of + (Year : Year_Number; + Month : Month_Number; + Day : Day_Number; + Seconds : Day_Duration := 0.0) + return Time + is + + Timbuf : aliased SYSTEMTIME; + Now : aliased Long_Long_Integer; + Loc : aliased Long_Long_Integer; + Int_Secs : Integer; + Secs : Integer; + Add_One_Day : Boolean := False; + Date : Time; + + begin + -- The following checks are redundant with respect to the constraint + -- error checks that should normally be made on parameters, but we + -- decide to raise Constraint_Error in any case if bad values come + -- in (as a result of checks being off in the caller, or for other + -- erroneous or bounded error cases). + + if not Year 'Valid + or else not Month 'Valid + or else not Day 'Valid + or else not Seconds'Valid + then + raise Constraint_Error; + end if; + + if Seconds = 0.0 then + Int_Secs := 0; + else + Int_Secs := Integer (Seconds - 0.5); + end if; + + -- Timbuf.wMillisec is to keep the msec. We can't use that because the + -- high-resolution clock has a precision of 1 Microsecond. + -- Anyway the sub-seconds part is not needed to compute the number + -- of seconds in UTC. + + if Int_Secs = 86_400 then + Secs := 0; + Add_One_Day := True; + else + Secs := Int_Secs; + end if; + + Timbuf.wMilliseconds := 0; + Timbuf.wSecond := WORD (Secs mod 60); + Timbuf.wMinute := WORD ((Secs / 60) mod 60); + Timbuf.wHour := WORD (Secs / 3600); + Timbuf.wDay := WORD (Day); + Timbuf.wMonth := WORD (Month); + Timbuf.wYear := WORD (Year); + + if not SystemTimeToFileTime (Timbuf'Access, Loc'Access) then + raise Time_Error; + end if; + + if not LocalFileTimeToFileTime (Loc'Access, Now'Access) then + raise Time_Error; + end if; + + -- Here we have the UTC now translate UTC to Epoch time (UNIX style + -- time based on 1 january 1970) and add there the sub-seconds part. + + declare + Sub_Sec : Duration := Seconds - Duration (Int_Secs); + begin + Date := Time ((Now - epoch_1970) * system_time_ns / Sec_Unit) + + Sub_Sec; + end; + + if Add_One_Day then + Date := Date + Duration (86400.0); + end if; + + return Date; + end Time_Of; + + ---------- + -- Year -- + ---------- + + function Year (Date : Time) return Year_Number is + DY : Year_Number; + DM : Month_Number; + DD : Day_Number; + DS : Day_Duration; + + begin + Split (Date, DY, DM, DD, DS); + return DY; + end Year; + +end Ada.Calendar; diff --git a/gcc/ada/4wexcpol.adb b/gcc/ada/4wexcpol.adb new file mode 100644 index 0000000..3a56def --- /dev/null +++ b/gcc/ada/4wexcpol.adb @@ -0,0 +1,61 @@ +------------------------------------------------------------------------------ +-- -- +-- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS -- +-- -- +-- A D A . E X C E P T I O N S . P O L L -- +-- (version supporting asynchronous abort test) -- +-- -- +-- B o d y -- +-- -- +-- $Revision: 1.9 $ +-- -- +-- Copyright (C) 1992-2000, Free Software Foundation, Inc. -- +-- -- +-- GNARL is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 2, or (at your option) any later ver- -- +-- sion. GNARL is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNARL; see file COPYING. If not, write -- +-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNARL was developed by the GNARL team at Florida State University. It is -- +-- now maintained by Ada Core Technologies Inc. in cooperation with Florida -- +-- State University (http://www.gnat.com). -- +-- -- +------------------------------------------------------------------------------ + +-- This version is for targets that do not support per-thread asynchronous +-- signals. On such targets, we require compilation with the -gnatP switch +-- that activates periodic polling. Then in the body of the polling routine +-- we test for asynchronous abort. + +-- NT, OS/2, HPUX/DCE and SCO currently use this file + +with System.Soft_Links; +-- used for Check_Abort_Status + +separate (Ada.Exceptions) + +---------- +-- Poll -- +---------- + +procedure Poll is +begin + -- Test for asynchronous abort on each poll + + if System.Soft_Links.Check_Abort_Status.all /= 0 then + raise Standard'Abort_Signal; + end if; +end Poll; diff --git a/gcc/ada/4wintnam.ads b/gcc/ada/4wintnam.ads new file mode 100644 index 0000000..e1cc02c --- /dev/null +++ b/gcc/ada/4wintnam.ads @@ -0,0 +1,70 @@ +------------------------------------------------------------------------------ +-- -- +-- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS -- +-- -- +-- A D A . I N T E R R U P T S . N A M E S -- +-- -- +-- S p e c -- +-- -- +-- $Revision: 1.3 $ -- +-- -- +-- Copyright (C) 1997-1998 Free Software Foundation, Inc. -- +-- -- +-- GNARL is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 2, or (at your option) any later ver- -- +-- sion. GNARL is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNARL; see file COPYING. If not, write -- +-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNARL was developed by the GNARL team at Florida State University. It is -- +-- now maintained by Ada Core Technologies Inc. in cooperation with Florida -- +-- State University (http://www.gnat.com). -- +-- -- +------------------------------------------------------------------------------ + +-- This is a NT (native) version of this package. + +-- This target-dependent package spec contains names of interrupts +-- supported by the local system. + +with System.OS_Interface; +-- used for names of interrupts + +package Ada.Interrupts.Names is + + -- Beware that the mapping of names to signals may be + -- many-to-one. There may be aliases. Also, for all + -- signal names that are not supported on the current system + -- the value of the corresponding constant will be zero. + + SIGINT : constant Interrupt_ID := + System.OS_Interface.SIGINT; -- interrupt (rubout) + + SIGILL : constant Interrupt_ID := + System.OS_Interface.SIGILL; -- illegal instruction (not reset) + + SIGABRT : constant Interrupt_ID := -- used by abort, + System.OS_Interface.SIGABRT; -- replace SIGIOT in the future + + SIGFPE : constant Interrupt_ID := + System.OS_Interface.SIGFPE; -- floating point exception + + SIGSEGV : constant Interrupt_ID := + System.OS_Interface.SIGSEGV; -- segmentation violation + + SIGTERM : constant Interrupt_ID := + System.OS_Interface.SIGTERM; -- software termination signal from kill + +end Ada.Interrupts.Names; diff --git a/gcc/ada/4zintnam.ads b/gcc/ada/4zintnam.ads new file mode 100644 index 0000000..7bb4192 --- /dev/null +++ b/gcc/ada/4zintnam.ads @@ -0,0 +1,191 @@ +------------------------------------------------------------------------------ +-- -- +-- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS -- +-- -- +-- A D A . I N T E R R U P T S . N A M E S -- +-- -- +-- S p e c -- +-- -- +-- $Revision: 1.3 $ -- +-- -- +-- Copyright (C) 1991-2001 Free Software Foundation, Inc. -- +-- -- +-- GNARL is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 2, or (at your option) any later ver- -- +-- sion. GNARL is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNARL; see file COPYING. If not, write -- +-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNARL was developed by the GNARL team at Florida State University. It is -- +-- now maintained by Ada Core Technologies Inc. in cooperation with Florida -- +-- State University (http://www.gnat.com). -- +-- -- +------------------------------------------------------------------------------ + +-- This is the VxWorks version of this package. +-- +-- The following signals are reserved by the run time: +-- +-- SIGFPE, SIGILL, SIGSEGV, SIGBUS, SIGABRT +-- +-- The pragma Unreserve_All_Interrupts affects the following signal(s): +-- +-- none + +-- This target-dependent package spec contains names of interrupts +-- supported by the local system. + +with System.OS_Interface; +with System.VxWorks; + +package Ada.Interrupts.Names is + + subtype Hardware_Interrupts is Interrupt_ID + range Interrupt_ID'First .. System.OS_Interface.Max_HW_Interrupt; + -- Range of values that can be used for hardware interrupts. + + -- The following constants can be used for software interrupts mapped to + -- user-level signals: + + SIGHUP : constant Interrupt_ID; + -- hangup + + SIGINT : constant Interrupt_ID; + -- interrupt + + SIGQUIT : constant Interrupt_ID; + -- quit + + SIGILL : constant Interrupt_ID; + -- illegal instruction (not reset) + + SIGTRAP : constant Interrupt_ID; + -- trace trap (not reset) + + SIGIOT : constant Interrupt_ID; + -- IOT instruction + + SIGABRT : constant Interrupt_ID; + -- used by abort, replace SIGIOT + + SIGEMT : constant Interrupt_ID; + -- EMT instruction + + SIGFPE : constant Interrupt_ID; + -- floating point exception + + SIGKILL : constant Interrupt_ID; + -- kill (cannot be caught or ignored) + + SIGBUS : constant Interrupt_ID; + -- bus error + + SIGSEGV : constant Interrupt_ID; + -- segmentation violation + + SIGSYS : constant Interrupt_ID; + -- bad argument to system call + + SIGPIPE : constant Interrupt_ID; + -- no one to read it + + SIGALRM : constant Interrupt_ID; + -- alarm clock + + SIGTERM : constant Interrupt_ID; + -- software termination signal from kill + + SIGURG : constant Interrupt_ID; + -- urgent condition on IO channel + + SIGSTOP : constant Interrupt_ID; + -- stop (cannot be caught or ignored) + + SIGTSTP : constant Interrupt_ID; + -- user stop requested from tty + + SIGCONT : constant Interrupt_ID; + -- stopped process has been continued + + SIGCHLD : constant Interrupt_ID; + -- child status change + + SIGTTIN : constant Interrupt_ID; + -- background tty read attempted + + SIGTTOU : constant Interrupt_ID; + -- background tty write attempted + + SIGIO : constant Interrupt_ID; + -- input/output possible, + + SIGXCPU : constant Interrupt_ID; + -- CPU time limit exceeded + + SIGXFSZ : constant Interrupt_ID; + -- filesize limit exceeded + + SIGVTALRM : constant Interrupt_ID; + -- virtual timer expired + + SIGPROF : constant Interrupt_ID; + -- profiling timer expired + + SIGWINCH : constant Interrupt_ID; + -- window size change + + SIGUSR1 : constant Interrupt_ID; + -- user defined signal 1 + + SIGUSR2 : constant Interrupt_ID; + -- user defined signal 2 + +private + + Signal_Base : constant := System.VxWorks.Num_HW_Interrupts; + + SIGHUP : constant Interrupt_ID := 1 + Signal_Base; + SIGINT : constant Interrupt_ID := 2 + Signal_Base; + SIGQUIT : constant Interrupt_ID := 3 + Signal_Base; + SIGILL : constant Interrupt_ID := 4 + Signal_Base; + SIGTRAP : constant Interrupt_ID := 5 + Signal_Base; + SIGIOT : constant Interrupt_ID := 6 + Signal_Base; + SIGABRT : constant Interrupt_ID := 6 + Signal_Base; + SIGEMT : constant Interrupt_ID := 7 + Signal_Base; + SIGFPE : constant Interrupt_ID := 8 + Signal_Base; + SIGKILL : constant Interrupt_ID := 9 + Signal_Base; + SIGBUS : constant Interrupt_ID := 10 + Signal_Base; + SIGSEGV : constant Interrupt_ID := 11 + Signal_Base; + SIGSYS : constant Interrupt_ID := 12 + Signal_Base; + SIGPIPE : constant Interrupt_ID := 13 + Signal_Base; + SIGALRM : constant Interrupt_ID := 14 + Signal_Base; + SIGTERM : constant Interrupt_ID := 15 + Signal_Base; + SIGURG : constant Interrupt_ID := 16 + Signal_Base; + SIGSTOP : constant Interrupt_ID := 17 + Signal_Base; + SIGTSTP : constant Interrupt_ID := 18 + Signal_Base; + SIGCONT : constant Interrupt_ID := 19 + Signal_Base; + SIGCHLD : constant Interrupt_ID := 20 + Signal_Base; + SIGTTIN : constant Interrupt_ID := 21 + Signal_Base; + SIGTTOU : constant Interrupt_ID := 22 + Signal_Base; + SIGIO : constant Interrupt_ID := 23 + Signal_Base; + SIGXCPU : constant Interrupt_ID := 24 + Signal_Base; + SIGXFSZ : constant Interrupt_ID := 25 + Signal_Base; + SIGVTALRM : constant Interrupt_ID := 26 + Signal_Base; + SIGPROF : constant Interrupt_ID := 27 + Signal_Base; + SIGWINCH : constant Interrupt_ID := 28 + Signal_Base; + SIGUSR1 : constant Interrupt_ID := 30 + Signal_Base; + SIGUSR2 : constant Interrupt_ID := 31 + Signal_Base; + +end Ada.Interrupts.Names; diff --git a/gcc/ada/4znumaux.ads b/gcc/ada/4znumaux.ads new file mode 100644 index 0000000..33540f3 --- /dev/null +++ b/gcc/ada/4znumaux.ads @@ -0,0 +1,99 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUNTIME COMPONENTS -- +-- -- +-- A D A . N U M E R I C S . A U X -- +-- -- +-- S p e c -- +-- (C Library Version, VxWorks) -- +-- -- +-- $Revision: 1.1 $ -- +-- -- +-- Copyright (C) 1992-1998 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, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). -- +-- -- +------------------------------------------------------------------------------ + +-- This package provides the basic computational interface for the generic +-- elementary functions. The C library version interfaces with the routines +-- in the C mathematical library, and is thus quite portable, although it may +-- not necessarily meet the requirements for accuracy in the numerics annex. +-- One advantage of using this package is that it will interface directly to +-- hardware instructions, such as the those provided on the Intel x86. + +-- Note: there are two versions of this package. One using the normal IEEE +-- 64-bit double format (which is this version), and one using 80-bit x86 +-- long double (see file 4onumaux.ads). + +package Ada.Numerics.Aux is +pragma Pure (Aux); + + -- This version omits the pragma linker_options ("-lm") since there is + -- no libm.a library for VxWorks. + + type Double is digits 15; + pragma Float_Representation (IEEE_Float, Double); + -- Type Double is the type used to call the C routines. Note that this + -- is IEEE format even when running on VMS with Vax_Float representation + -- since we use the IEEE version of the C library with VMS. + + function Sin (X : Double) return Double; + pragma Import (C, Sin, "sin"); + + function Cos (X : Double) return Double; + pragma Import (C, Cos, "cos"); + + function Tan (X : Double) return Double; + pragma Import (C, Tan, "tan"); + + function Exp (X : Double) return Double; + pragma Import (C, Exp, "exp"); + + function Sqrt (X : Double) return Double; + pragma Import (C, Sqrt, "sqrt"); + + function Log (X : Double) return Double; + pragma Import (C, Log, "log"); + + function Acos (X : Double) return Double; + pragma Import (C, Acos, "acos"); + + function Asin (X : Double) return Double; + pragma Import (C, Asin, "asin"); + + function Atan (X : Double) return Double; + pragma Import (C, Atan, "atan"); + + function Sinh (X : Double) return Double; + pragma Import (C, Sinh, "sinh"); + + function Cosh (X : Double) return Double; + pragma Import (C, Cosh, "cosh"); + + function Tanh (X : Double) return Double; + pragma Import (C, Tanh, "tanh"); + + function Pow (X, Y : Double) return Double; + pragma Import (C, Pow, "pow"); + +end Ada.Numerics.Aux; diff --git a/gcc/ada/4zsytaco.adb b/gcc/ada/4zsytaco.adb new file mode 100644 index 0000000..2bc0235 --- /dev/null +++ b/gcc/ada/4zsytaco.adb @@ -0,0 +1,142 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUNTIME COMPONENTS -- +-- -- +-- A D A . S Y N C H R O N O U S _ T A S K _ C O N T R O L -- +-- -- +-- B o d y -- +-- -- +-- $Revision: 1.1 $ +-- -- +-- Copyright (C) 1992-2001 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, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). -- +-- -- +------------------------------------------------------------------------------ + +with Interfaces.C; +package body Ada.Synchronous_Task_Control is + use System.OS_Interface; + use type Interfaces.C.int; + + ------------------- + -- Current_State -- + ------------------- + + function Current_State (S : Suspension_Object) return Boolean is + St : STATUS; + Result : Boolean := False; + + begin + -- Determine state by attempting to take the semaphore with + -- a 0 timeout value. Status = OK indicates the semaphore was + -- full, so reset it to the full state. + + St := semTake (S.Sema, NO_WAIT); + + if St = OK then + -- Took the semaphore. Reset semaphore state to FULL + Result := True; + St := semGive (S.Sema); + end if; + + return Result; + end Current_State; + + --------------- + -- Set_False -- + --------------- + + procedure Set_False (S : in out Suspension_Object) is + St : STATUS; + begin + -- Need to get the semaphore into the "empty" state. + -- On return, this task will have made the semaphore + -- empty (St = OK) or have left it empty. + St := semTake (S.Sema, NO_WAIT); + end Set_False; + + -------------- + -- Set_True -- + -------------- + + procedure Set_True (S : in out Suspension_Object) is + St : STATUS; + begin + St := semGive (S.Sema); + end Set_True; + + ------------------------ + -- Suspend_Until_True -- + ------------------------ + + procedure Suspend_Until_True (S : in out Suspension_Object) is + St : STATUS; + + -- Declare local exception so the mutex can still be reset + -- to full if Program_Error is raised + + Task_Already_Pending : exception; + begin + -- Determine whether another task is pending on the suspension + -- object. Should never be called from an ISR. Therefore semTake can + -- be called on the mutex + St := semTake (S.Mutex, NO_WAIT); + + if St = OK then + -- Wait for suspension object + + St := semTake (S.Sema, WAIT_FOREVER); + St := semGive (S.Mutex); + + else + -- Another task is pending on the suspension object + + raise Task_Already_Pending; + end if; + exception + when Task_Already_Pending => + raise Program_Error; + when others => + St := semGive (S.Mutex); + raise; + end Suspend_Until_True; + + procedure Initialize (S : in out Suspension_Object) is + begin + S.Sema := semBCreate (SEM_Q_FIFO, SEM_EMPTY); + + -- Use simpler binary semaphore instead of VxWorks + -- mutual exclusion semaphore, because we don't need + -- the fancier semantics and their overhead. + + S.Mutex := semBCreate (SEM_Q_FIFO, SEM_FULL); + end Initialize; + + procedure Finalize (S : in out Suspension_Object) is + St : STATUS; + begin + St := semDelete (S.Sema); + St := semDelete (S.Mutex); + end Finalize; + +end Ada.Synchronous_Task_Control; diff --git a/gcc/ada/4zsytaco.ads b/gcc/ada/4zsytaco.ads new file mode 100644 index 0000000..a3eb0aa --- /dev/null +++ b/gcc/ada/4zsytaco.ads @@ -0,0 +1,70 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- A D A . S Y N C H R O N O U S _ T A S K _ C O N T R O L -- +-- -- +-- S p e c -- +-- -- +-- $Revision: 1.1 $ +-- -- +-- Copyright (C) 1992-2001 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, 59 Temple Place - Suite 330, Boston, -- +-- MA 02111-1307, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). -- +-- -- +------------------------------------------------------------------------------ + +with System.OS_Interface; +with Ada.Finalization; +package Ada.Synchronous_Task_Control is + + type Suspension_Object is limited private; + + procedure Set_True (S : in out Suspension_Object); + + procedure Set_False (S : in out Suspension_Object); + + function Current_State (S : Suspension_Object) return Boolean; + + procedure Suspend_Until_True (S : in out Suspension_Object); + +private + + procedure Initialize (S : in out Suspension_Object); + + procedure Finalize (S : in out Suspension_Object); + + -- Implement with a VxWorks binary semaphore. A second semaphore + -- is used to avoid a race condition related to the implementation of + -- the STC requirement to raise Program_Error when Suspend_Until_True is + -- called with a task already pending on the suspension object + + type Suspension_Object is new Ada.Finalization.Controlled with record + Sema : System.OS_Interface.SEM_ID; + Mutex : System.OS_Interface.SEM_ID; + end record; + +end Ada.Synchronous_Task_Control; |