Richard Kenner
parent
644eddaac5
commit
6cbd1b6f7e
|
|
@ -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;
|
||||
|
|
@ -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;
|
||||
|
|
@ -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;
|
||||
|
|
@ -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;
|
||||
|
|
@ -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;
|
||||
|
|
@ -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;
|
||||
|
|
@ -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;
|
||||
|
|
@ -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;
|
||||
|
|
@ -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;
|
||||
|
|
@ -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;
|
||||
|
|
@ -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;
|
||||
|
|
@ -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;
|
||||
|
|
@ -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;
|
||||
|
|
@ -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;
|
||||
|
|
@ -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;
|
||||
|
|
@ -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;
|
||||
|
|
@ -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;
|
||||
|
|
@ -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;
|
||||
|
|
@ -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;
|
||||
|
|
@ -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;
|
||||
|
|
@ -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;
|
||||
|
|
@ -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;
|
||||
|
|
@ -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;
|
||||
|
|
@ -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;
|
||||
|
|
@ -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;
|
||||
|
|
@ -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;
|
||||
|
|
@ -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;
|
||||
|
|
@ -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;
|
||||
|
|
@ -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;
|
||||
|
|
@ -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;
|
||||
|
|
@ -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;
|
||||
|
|
@ -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;
|
||||
|
|
@ -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;
|
||||
|
|
@ -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;
|
||||
|
|
@ -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;
|
||||
|
|
@ -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;
|
||||
|
|
@ -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;
|
||||
|
|
@ -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;
|
||||
|
|
@ -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;
|
||||
|
|
@ -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;
|
||||
|
|
@ -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;
|
||||
|
|
@ -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;
|
||||
|
|
@ -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;
|
||||
Loading…
Reference in New Issue