From: Thomas Quinot Date: Fri, 6 Apr 2007 09:15:09 +0000 (+0200) Subject: g-stsifd-sockets.adb: New file. X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=3d3bf932b985baee7ac3973208c0d775dcb93b5d;p=gcc.git g-stsifd-sockets.adb: New file. 2007-04-06 Thomas Quinot Pat Rogers Pascal Obry * g-stsifd-sockets.adb: New file. * g-socthi.ads, g-socket.adb, g-socthi-vxworks.adb, g-socthi-vxworks.ads, g-socthi-mingw.ads, g-socthi-vms.ads, g-socthi-vms.adb: Move signalling fd management to a nested package, so that they can conveniently be moved to a subunit that is shared across Windows, VMS, and VxWorks (Ada implementation) or completed with imported bodies from socket.c (UNIX case). (Read_Signalling_Fd, Write_Signalling_Fd, Create_Signalling_Fds): New subprograms. (Check_Selector): Use Read_Signalling_Fd to read and discard data from the signalling file descriptor. (Abort_Selector): Use Write_Signalling_Fd to write dummy data to the signalling file descriptor. (Create_Selector): Use new C-imported subprogram Create_Signalling_Fds instead of creating a pair of sockets for signalling here. * g-socthi.adb: Ditto. Set the runtime process to ignore SIGPIPEs on platforms that support neither SO_NOSIGPIPE nor MSG_NOSIGNAL functionality. * g-socthi-mingw.adb: Ditto. (WS_Version): Use Windows 2.2. Use Winsock 2.2 (instead of 1.1) for the GNAT.Socket API. * g-soliop-mingw.ads: Link with ws2_32 for Windows 2.x support. Use Winsock 2.2 (instead of 1.1) for the GNAT.Socket API. * Makefile.in: New libgnat pair g-stsifd.adb Item, Target => Unsigned_16); + + function As_Item is new Ada.Unchecked_Conversion + (Source => Unsigned_16, Target => Item); + + X : Unsigned_16 := As_U16 (Input); + + begin + Asm ("xchgb %b0,%h0", + Unsigned_16'Asm_Output ("=q", X), + Unsigned_16'Asm_Input ("0", X)); + return As_Item (X); + end Swapped2; + + -------------- + -- Swapped4 -- + -------------- + + function Swapped4 (Input : Item) return Item is + + function As_U32 is new Ada.Unchecked_Conversion + (Source => Item, Target => Unsigned_32); + + function As_Item is new Ada.Unchecked_Conversion + (Source => Unsigned_32, Target => Item); + + X : Unsigned_32 := As_U32 (Input); + + begin + Asm ("bswap %0", + Unsigned_32'Asm_Output ("=r", X), + Unsigned_32'Asm_Input ("0", X)); + return As_Item (X); + end Swapped4; + + -------------- + -- Swapped8 -- + -------------- + + function Swapped8 (Input : Item) return Item is + + function As_U64 is new Ada.Unchecked_Conversion + (Source => Item, Target => Unsigned_64); + + X : Unsigned_64 renames As_U64 (Input); + + type Two_Words is array (0 .. 1) of Unsigned_32; + for Two_Words'Component_Size use Unsigned_32'Size; + + function As_Item is new Ada.Unchecked_Conversion + (Source => Two_Words, Target => Item); + + Result : Two_Words; + + begin + Asm ("xchgl %0,%1", + Outputs => + (Unsigned_32'Asm_Output ("=r", Result (0)), + Unsigned_32'Asm_Output ("=r", Result (1))), + Inputs => + (Unsigned_32'Asm_Input ("0", + Swapped32 (Unsigned_32 (X and 16#0000_0000_FFFF_FFFF#))), + Unsigned_32'Asm_Input ("1", + Swapped32 (Unsigned_32 (Shift_Right (X, 32)))))); + return As_Item (Result); + end Swapped8; + + ----------- + -- Swap2 -- + ----------- + + procedure Swap2 (Location : in System.Address) is + + X : Unsigned_16; + for X'Address use Location; + + begin + Asm ("xchgb %b0,%h0", + Unsigned_16'Asm_Output ("=q", X), + Unsigned_16'Asm_Input ("0", X)); + end Swap2; + + ----------- + -- Swap4 -- + ----------- + + procedure Swap4 (Location : in System.Address) is + + X : Unsigned_32; + for X'Address use Location; + + begin + Asm ("bswap %0", + Unsigned_32'Asm_Output ("=r", X), + Unsigned_32'Asm_Input ("0", X)); + end Swap4; + + --------------- + -- Swapped32 -- + --------------- + + function Swapped32 (Value : Unsigned_32) return Unsigned_32 is + X : Unsigned_32 := Value; + begin + Asm ("bswap %0", + Unsigned_32'Asm_Output ("=r", X), + Unsigned_32'Asm_Input ("0", X)); + return X; + end Swapped32; + + ----------- + -- Swap8 -- + ----------- + + procedure Swap8 (Location : in System.Address) is + + X : Unsigned_64; + for X'Address use Location; + + type Two_Words is array (0 .. 1) of Unsigned_32; + for Two_Words'Component_Size use Unsigned_32'Size; + + Words : Two_Words; + for Words'Address use Location; + + begin + Asm ("xchgl %0,%1", + Outputs => + (Unsigned_32'Asm_Output ("=r", Words (0)), + Unsigned_32'Asm_Output ("=r", Words (1))), + Inputs => + (Unsigned_32'Asm_Input ("0", + Swapped32 (Unsigned_32 (X and 16#0000_0000_FFFF_FFFF#))), + Unsigned_32'Asm_Input ("1", + Swapped32 (Unsigned_32 (Shift_Right (X, 32)))))); + end Swap8; + +end GNAT.Byte_Swapping; diff --git a/gcc/ada/g-bytswa.adb b/gcc/ada/g-bytswa.adb new file mode 100644 index 00000000000..254e638bed5 --- /dev/null +++ b/gcc/ada/g-bytswa.adb @@ -0,0 +1,156 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- G N A T . B Y T E _ S W A P P I N G -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 2006, AdaCore -- +-- -- +-- GNAT is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 2, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNAT; see file COPYING. If not, write -- +-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, -- +-- Boston, MA 02110-1301, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +-- This is a general implementation that does not take advantage of +-- any machine-specific instructions. + +with Interfaces; use Interfaces; +with Ada.Unchecked_Conversion; + +package body GNAT.Byte_Swapping is + + -------------- + -- Swapped2 -- + -------------- + + function Swapped2 (Input : Item) return Item is + + function As_U16 is new Ada.Unchecked_Conversion + (Source => Item, Target => Unsigned_16); + + function As_Item is new Ada.Unchecked_Conversion + (Source => Unsigned_16, Target => Item); + + X : Unsigned_16 renames As_U16 (Input); + + begin + return As_Item ((Shift_Left (X, 8) and 16#FF00#) or + (Shift_Right (X, 8) and 16#00FF#)); + end Swapped2; + + -------------- + -- Swapped4 -- + -------------- + + function Swapped4 (Input : Item) return Item is + + function As_U32 is new Ada.Unchecked_Conversion + (Source => Item, Target => Unsigned_32); + + function As_Item is new Ada.Unchecked_Conversion + (Source => Unsigned_32, Target => Item); + + X : Unsigned_32 renames As_U32 (Input); + + begin + return As_Item ((Shift_Right (X, 24) and 16#0000_00FF#) or + (Shift_Right (X, 8) and 16#0000_FF00#) or + (Shift_Left (X, 8) and 16#00FF_0000#) or + (Shift_Left (X, 24) and 16#FF00_0000#)); + end Swapped4; + + -------------- + -- Swapped8 -- + -------------- + + function Swapped8 (Input : Item) return Item is + + function As_U64 is new Ada.Unchecked_Conversion + (Source => Item, Target => Unsigned_64); + + function As_Item is new Ada.Unchecked_Conversion + (Source => Unsigned_64, Target => Item); + + X : Unsigned_64 renames As_U64 (Input); + + Low, High : aliased Unsigned_32; + + begin + Low := Unsigned_32 (X and 16#0000_0000_FFFF_FFFF#); + Swap4 (Low'Address); + High := Unsigned_32 (Shift_Right (X, 32)); + Swap4 (High'Address); + return As_Item + (Shift_Left (Unsigned_64 (Low), 32) or Unsigned_64 (High)); + end Swapped8; + + ----------- + -- Swap2 -- + ----------- + + procedure Swap2 (Location : System.Address) is + + X : Unsigned_16; + for X'Address use Location; + + begin + X := (Shift_Left (X, 8) and 16#FF00#) or + (Shift_Right (X, 8) and 16#00FF#); + end Swap2; + + ----------- + -- Swap4 -- + ----------- + + procedure Swap4 (Location : System.Address) is + + X : Unsigned_32; + for X'Address use Location; + + begin + X := (Shift_Right (X, 24) and 16#0000_00FF#) or + (Shift_Right (X, 8) and 16#0000_FF00#) or + (Shift_Left (X, 8) and 16#00FF_0000#) or + (Shift_Left (X, 24) and 16#FF00_0000#); + end Swap4; + + ----------- + -- Swap8 -- + ----------- + + procedure Swap8 (Location : System.Address) is + + X : Unsigned_64; + for X'Address use Location; + + Low, High : aliased Unsigned_32; + + begin + Low := Unsigned_32 (X and 16#0000_0000_FFFF_FFFF#); + Swap4 (Low'Address); + High := Unsigned_32 (Shift_Right (X, 32)); + Swap4 (High'Address); + X := Shift_Left (Unsigned_64 (Low), 32) or Unsigned_64 (High); + end Swap8; + +end GNAT.Byte_Swapping; diff --git a/gcc/ada/g-bytswa.ads b/gcc/ada/g-bytswa.ads new file mode 100644 index 00000000000..5c9741482ea --- /dev/null +++ b/gcc/ada/g-bytswa.ads @@ -0,0 +1,206 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- G N A T . B Y T E _ S W A P P I N G -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 2006, AdaCore -- +-- -- +-- GNAT is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 2, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNAT; see file COPYING. If not, write -- +-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, -- +-- Boston, MA 02110-1301, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +-- Simple routines for swapping the bytes of 16-, 32-, and 64-bit objects. + +-- The generic functions should be instantiated with types that +-- are of a size in bytes corresponding to the name of the generic. For +-- example, a 2-byte integer type would be compatible with Swapped2, 4-byte +-- integer with Swapped4, and so on. Failure to do so will result in a +-- warning when compiling the instantiation; this warning should be heeded. +-- Ignoring this warning can result in unexpected results. + +-- An example of proper usage follows: + +-- declare +-- type Short_Integer is range -32768 .. 32767; +-- for Short_Integer'Size use 16; -- for confirmation + +-- X : Short_Integer := 16#7FFF#; + +-- function Swapped is new Byte_Swapping.Swapped2 (Short_Integer); + +-- begin +-- Put_Line (X'Img); +-- X := Swapped (X); +-- Put_Line (X'Img); +-- end; + +-- Note that the generic actual types need not be scalars, but must be +-- 'definite' types. They can, for example, be constrained subtypes of +-- unconstrained array types as long as the size is correct. For instance, +-- a subtype of String with length of 4 would be compatible with the +-- Swapped4 generic: + +-- declare +-- subtype String4 is String (1 .. 4); +-- function Swapped is new Byte_Swapping.Swapped4 (String4); +-- S : String4 := "ABCD"; +-- begin +-- Put_Line (S); +-- S := Swapped (S); +-- Put_Line (S); +-- end; + +-- Similarly, a constrained array type is also acceptable: + +-- declare +-- type Mask is array (0 .. 15) of Boolean; +-- for Mask'Component_Size use Boolean'Size; +-- X : Mask := (0 .. 7 => True, others => False); +-- function Swapped is new Byte_Swapping.Swapped2 (Mask); +-- begin +-- ... +-- X := Swapped (X); +-- ... +-- end; + +-- A properly-sized record type will also be acceptable, and so forth. + +-- However, as described, a size mismatch must be avoided. In the following +-- we instantiate one of the generics with a type that is too large. The +-- result of the function call is undefined, such that assignment to an +-- object can result in garbage values. + +-- Wrong: declare +-- subtype String16 is String (1 .. 16); + +-- function Swapped is new Byte_Swapping.Swapped8 (String16); +-- -- Instantiation generates a compiler warning about +-- -- mismatched sizes + +-- S : String16; + +-- begin +-- S := "ABCDEFGHDEADBEEF"; +-- +-- Put_Line (S); +-- +-- -- the following assignment results in garbage in S after the +-- -- first 8 bytes +-- +-- S := Swapped (S); +-- +-- Put_Line (S); +-- end Wrong; + +-- When the size of the type is larger than 8 bytes, the use of the +-- non-generic procedures is an alternative because no function result is +-- involved; manipulation of the object is direct. + +-- The procedures are passed the address of an object to manipulate. They will +-- swap the first N bytes of that object corresponding to the name of the +-- procedure. For example: + +-- declare +-- S2 : String := "AB"; +-- for S2'Alignment use 2; +-- S4 : String := "ABCD"; +-- for S4'Alignment use 4; +-- S8 : String := "ABCDEFGH"; +-- for S8'Alignment use 8; + +-- begin +-- Swap2 (S2'Address); +-- Put_Line (S2); + +-- Swap4 (S4'Address); +-- Put_Line (S4); + +-- Swap8 (S8'Address); +-- Put_Line (S8); +-- end; + +-- If an object of a type larger than N is passed, the remaining +-- bytes of the object are undisturbed. For example: + +-- declare +-- subtype String16 is String (1 .. 16); + +-- S : String16; +-- for S'Alignment use 8; + +-- begin +-- S := "ABCDEFGHDEADBEEF"; +-- Put_Line (S); +-- Swap8 (S'Address); +-- Put_Line (S); +-- end; + +with System; + +package GNAT.Byte_Swapping is + pragma Pure; + + -- NB: all the routines in this package treat the application objects as + -- unsigned (modular) types of a size in bytes corresponding to the routine + -- name. For example, the generic function Swapped2 manipulates the object + -- passed to the formal parameter Input as a value of an unsigned type that + -- is 2 bytes long. Therefore clients are responsible for the compatibility + -- of application types manipulated by these routines and these modular + -- types, in terms of both size and alignment. This requirement applies to + -- the generic actual type passed to the generic formal type Item in the + -- generic functions, as well as to the type of the object implicitly + -- designated by the address passed to the non-generic procedures. Use of + -- incompatible types can result in implementation- defined effects. + + generic + type Item is limited private; + function Swapped2 (Input : Item) return Item; + -- Return the 2-byte value of Input with the bytes swapped + + generic + type Item is limited private; + function Swapped4 (Input : Item) return Item; + -- Return the 4-byte value of Input with the bytes swapped + + generic + type Item is limited private; + function Swapped8 (Input : Item) return Item; + -- Return the 8-byte value of Input with the bytes swapped + + procedure Swap2 (Location : System.Address); + -- Swap the first 2 bytes of the object starting at the address specified + -- by Location. + + procedure Swap4 (Location : System.Address); + -- Swap the first 4 bytes of the object starting at the address specified + -- by Location. + + procedure Swap8 (Location : System.Address); + -- Swap the first 8 bytes of the object starting at the address specified + -- by Location. + + pragma Inline (Swap2, Swap4, Swap8, Swapped2, Swapped4, Swapped8); + +end GNAT.Byte_Swapping; diff --git a/gcc/ada/g-socket.adb b/gcc/ada/g-socket.adb index 01765a70715..2773b7ab036 100644 --- a/gcc/ada/g-socket.adb +++ b/gcc/ada/g-socket.adb @@ -236,14 +236,13 @@ package body GNAT.Sockets is -------------------- procedure Abort_Selector (Selector : Selector_Type) is - Buf : aliased Character := ASCII.NUL; Res : C.int; begin - -- Send an empty array to unblock C select system call + -- Send one byte to unblock select system call + + Res := Signalling_Fds.Write (C.int (Selector.W_Sig_Socket)); - Res := C_Send (C.int (Selector.W_Sig_Socket), Buf'Address, 1, - Constants.MSG_Forced_Flags); if Res = Failure then Raise_Socket_Error (Socket_Errno); end if; @@ -454,16 +453,11 @@ package body GNAT.Sockets is if Is_Set (RSet, RSig) then Clear (RSet, RSig); - declare - Buf : Character; - - begin - Res := C_Recv (C.int (RSig), Buf'Address, 1, 0); + Res := Signalling_Fds.Read (C.int (RSig)); - if Res = Failure then - Raise_Socket_Error (Socket_Errno); - end if; - end; + if Res = Failure then + Raise_Socket_Error (Socket_Errno); + end if; Status := Aborted; @@ -674,105 +668,23 @@ package body GNAT.Sockets is --------------------- procedure Create_Selector (Selector : out Selector_Type) is - S0 : C.int; - S1 : C.int; - S2 : C.int; - Res : C.int; - Sin : aliased Sockaddr_In; - Len : aliased C.int := Sin'Size / 8; - Err : Integer; + Two_Fds : aliased Fd_Pair; + Res : C.int; begin - -- We open two signalling sockets. One of them is used to send data to - -- the other, which is included in a C_Select socket set. The - -- communication is used to force the call to C_Select to complete, and + -- We open two signalling file descriptors. One of them is used to send + -- data to the other, which is included in a C_Select socket set. The + -- communication is used to force a call to C_Select to complete, and -- the waiting task to resume its execution. - -- Create a listening socket - - S0 := C_Socket (Constants.AF_INET, Constants.SOCK_STREAM, 0); - - if S0 = Failure then - Raise_Socket_Error (Socket_Errno); - end if; - - -- Bind the socket to any unused port on localhost - - Sin.Sin_Addr.S_B1 := 127; - Sin.Sin_Addr.S_B2 := 0; - Sin.Sin_Addr.S_B3 := 0; - Sin.Sin_Addr.S_B4 := 1; - Sin.Sin_Port := 0; - - Res := C_Bind (S0, Sin'Address, Len); - - if Res = Failure then - Err := Socket_Errno; - Res := C_Close (S0); - Raise_Socket_Error (Err); - end if; - - -- Get the port used by the socket - - Res := C_Getsockname (S0, Sin'Address, Len'Access); - - if Res = Failure then - Err := Socket_Errno; - Res := C_Close (S0); - Raise_Socket_Error (Err); - end if; - - -- Set backlog to 1 to guarantee that exactly one call to connect(2) - -- can succeed. - - Res := C_Listen (S0, 1); - - if Res = Failure then - Err := Socket_Errno; - Res := C_Close (S0); - Raise_Socket_Error (Err); - end if; - - S1 := C_Socket (Constants.AF_INET, Constants.SOCK_STREAM, 0); - - if S1 = Failure then - Err := Socket_Errno; - Res := C_Close (S0); - Raise_Socket_Error (Err); - end if; - - -- Do a connect and accept the connection - - Res := C_Connect (S1, Sin'Address, Len); - - if Res = Failure then - Err := Socket_Errno; - Res := C_Close (S0); - Res := C_Close (S1); - Raise_Socket_Error (Err); - end if; - - -- Since the call to connect(2) has suceeded and the backlog limit on - -- the listening socket is 1, we know that there is now exactly one - -- pending connection on S0, which is the one from S1. - - S2 := C_Accept (S0, Sin'Address, Len'Access); - - if S2 = Failure then - Err := Socket_Errno; - Res := C_Close (S0); - Res := C_Close (S1); - Raise_Socket_Error (Err); - end if; - - Res := C_Close (S0); + Res := Signalling_Fds.Create (Two_Fds'Access); if Res = Failure then Raise_Socket_Error (Socket_Errno); end if; - Selector.R_Sig_Socket := Socket_Type (S1); - Selector.W_Sig_Socket := Socket_Type (S2); + Selector.R_Sig_Socket := Socket_Type (Two_Fds (Read_End)); + Selector.W_Sig_Socket := Socket_Type (Two_Fds (Write_End)); end Create_Selector; ------------------- @@ -1073,7 +985,7 @@ package body GNAT.Sockets is is use type C.unsigned_char; - V8 : aliased Two_Int; + V8 : aliased Two_Ints; V4 : aliased C.int; V1 : aliased C.unsigned_char; VT : aliased Timeval; @@ -1899,7 +1811,7 @@ package body GNAT.Sockets is Level : Level_Type := Socket_Level; Option : Option_Type) is - V8 : aliased Two_Int; + V8 : aliased Two_Ints; V4 : aliased C.int; V1 : aliased C.unsigned_char; VT : aliased Timeval; diff --git a/gcc/ada/g-socthi-mingw.adb b/gcc/ada/g-socthi-mingw.adb index 862305dbd2e..1b74d907670 100644 --- a/gcc/ada/g-socthi-mingw.adb +++ b/gcc/ada/g-socthi-mingw.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2005, AdaCore -- +-- Copyright (C) 2001-2006, AdaCore -- -- -- -- 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- -- @@ -48,13 +48,13 @@ package body GNAT.Sockets.Thin is WSAData_Dummy : array (1 .. 512) of C.int; - WS_Version : constant := 16#0101#; + WS_Version : constant := 16#0202#; Initialized : Boolean := False; - SYSNOTREADY : constant := 10091; - VERNOTSUPPORTED : constant := 10092; - NOTINITIALISED : constant := 10093; - EDISCON : constant := 10101; + SYSNOTREADY : constant := 10091; + VERNOTSUPPORTED : constant := 10092; + NOTINITIALISED : constant := 10093; + EDISCON : constant := 10101; function Standard_Connect (S : C.int; @@ -258,11 +258,11 @@ package body GNAT.Sockets.Thin is ------------- function C_Readv - (Socket : C.int; + (Fd : C.int; Iov : System.Address; Iovcnt : C.int) return C.int is - Res : C.int; + Res : C.int; Count : C.int := 0; Iovec : array (0 .. Iovcnt - 1) of Vector_Element; @@ -272,7 +272,7 @@ package body GNAT.Sockets.Thin is begin for J in Iovec'Range loop Res := C_Recv - (Socket, + (Fd, Iovec (J).Base.all'Address, C.int (Iovec (J).Length), 0); @@ -434,11 +434,11 @@ package body GNAT.Sockets.Thin is -------------- function C_Writev - (Socket : C.int; + (Fd : C.int; Iov : System.Address; Iovcnt : C.int) return C.int is - Res : C.int; + Res : C.int; Count : C.int := 0; Iovec : array (0 .. Iovcnt - 1) of Vector_Element; @@ -448,7 +448,7 @@ package body GNAT.Sockets.Thin is begin for J in Iovec'Range loop Res := C_Send - (Socket, + (Fd, Iovec (J).Base.all'Address, C.int (Iovec (J).Length), 0); @@ -478,7 +478,7 @@ package body GNAT.Sockets.Thin is -- Initialize -- ---------------- - procedure Initialize (Process_Blocking_IO : Boolean := False) is + procedure Initialize (Process_Blocking_IO : Boolean) is pragma Unreferenced (Process_Blocking_IO); Return_Value : Interfaces.C.int; @@ -542,6 +542,12 @@ package body GNAT.Sockets.Thin is Sin.Sin_Port := Port; end Set_Port; + -------------------- + -- Signalling_Fds -- + -------------------- + + package body Signalling_Fds is separate; + -------------------------- -- Socket_Error_Message -- -------------------------- diff --git a/gcc/ada/g-socthi-mingw.ads b/gcc/ada/g-socthi-mingw.ads index 11509c095ea..9db2866f5cf 100644 --- a/gcc/ada/g-socthi-mingw.ads +++ b/gcc/ada/g-socthi-mingw.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2001-2005, AdaCore -- +-- Copyright (C) 2001-2006, AdaCore -- -- -- -- 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- -- @@ -60,10 +60,9 @@ package GNAT.Sockets.Thin is procedure Set_Socket_Errno (Errno : Integer); -- Set last socket error number - function Socket_Error_Message - (Errno : Integer) return C.Strings.chars_ptr; - -- Returns the error message string for the error number Errno. If - -- Errno is not known it returns "Unknown system error". + function Socket_Error_Message (Errno : Integer) return C.Strings.chars_ptr; + -- Returns the error message string for the error number Errno. If Errno is + -- not known it returns "Unknown system error". function Host_Errno return Integer; pragma Import (C, Host_Errno, "__gnat_get_h_errno"); @@ -73,14 +72,14 @@ package GNAT.Sockets.Thin is No_Fd_Set : constant Fd_Set_Access := System.Null_Address; type time_t is - range -(2 ** (8 * Constants.SIZEOF_tv_sec - 1)) - .. 2 ** (8 * Constants.SIZEOF_tv_sec - 1) - 1; + range -2 ** (8 * Constants.SIZEOF_tv_sec - 1) + .. 2 ** (8 * Constants.SIZEOF_tv_sec - 1) - 1; for time_t'Size use 8 * Constants.SIZEOF_tv_sec; pragma Convention (C, time_t); type suseconds_t is - range -(2 ** (8 * Constants.SIZEOF_tv_usec - 1)) - .. 2 ** (8 * Constants.SIZEOF_tv_usec - 1) - 1; + range -2 ** (8 * Constants.SIZEOF_tv_usec - 1) + .. 2 ** (8 * Constants.SIZEOF_tv_usec - 1) - 1; for suseconds_t'Size use 8 * Constants.SIZEOF_tv_usec; pragma Convention (C, suseconds_t); @@ -104,7 +103,7 @@ package GNAT.Sockets.Thin is package Chars_Ptr_Pointers is new C.Pointers (C.size_t, C.Strings.chars_ptr, Chars_Ptr_Array, - C.Strings.Null_Ptr); + C.Strings.Null_Ptr); -- Arrays of C (char *) type In_Addr is record @@ -123,6 +122,7 @@ package GNAT.Sockets.Thin is 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 @@ -203,14 +203,24 @@ package GNAT.Sockets.Thin is pragma Convention (C, Servent_Access); -- Access to service entry - type Two_Int is array (0 .. 1) of C.int; - pragma Convention (C, Two_Int); - -- Used with pipe() + type Two_Ints is array (0 .. 1) of C.int; + pragma Convention (C, Two_Ints); + -- Container for two int values + + subtype Fd_Pair is Two_Ints; + -- Two_Ints as used for Create_Signalling_Fds: a pair of connected file + -- descriptors, one of which (the "read end" of the connection) being used + -- for reading, the other one (the "write end") being used for writing. + + Read_End : constant := 0; + Write_End : constant := 1; + -- Indices into an Fd_Pair value providing access to each of the connected + -- file descriptors. function C_Accept (S : C.int; Addr : System.Address; - Addrlen : access C.int) return C.int; + Addrlen : not null access C.int) return C.int; function C_Bind (S : C.int; @@ -226,9 +236,9 @@ package GNAT.Sockets.Thin is Namelen : C.int) return C.int; function C_Gethostbyaddr - (Addr : System.Address; - Length : C.int; - Typ : C.int) return Hostent_Access; + (Addr : System.Address; + Len : C.int; + Typ : C.int) return Hostent_Access; function C_Gethostbyname (Name : C.char_array) return Hostent_Access; @@ -240,7 +250,7 @@ package GNAT.Sockets.Thin is function C_Getpeername (S : C.int; Name : System.Address; - Namelen : access C.int) return C.int; + Namelen : not null access C.int) return C.int; function C_Getservbyname (Name : C.char_array; @@ -253,14 +263,14 @@ package GNAT.Sockets.Thin is function C_Getsockname (S : C.int; Name : System.Address; - Namelen : access C.int) return C.int; + Namelen : not null 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; + Optlen : not null access C.int) return C.int; function C_Inet_Addr (Cp : C.Strings.chars_ptr) return C.int; @@ -275,23 +285,23 @@ package GNAT.Sockets.Thin is Backlog : C.int) return C.int; function C_Readv - (Socket : C.int; + (Fd : C.int; Iov : System.Address; Iovcnt : C.int) return C.int; function C_Recv (S : C.int; - Buf : System.Address; + Msg : System.Address; Len : C.int; Flags : C.int) return C.int; function C_Recvfrom (S : C.int; - Buf : System.Address; + Msg : System.Address; Len : C.int; Flags : C.int; From : Sockaddr_In_Access; - Fromlen : access C.int) return C.int; + Fromlen : not null access C.int) return C.int; function C_Select (Nfds : C.int; @@ -302,7 +312,7 @@ package GNAT.Sockets.Thin is function C_Send (S : C.int; - Buf : System.Address; + Msg : System.Address; Len : C.int; Flags : C.int) return C.int; @@ -322,8 +332,8 @@ package GNAT.Sockets.Thin is Optlen : C.int) return C.int; function C_Shutdown - (S : C.int; - How : C.int) return C.int; + (S : C.int; + How : C.int) return C.int; function C_Socket (Domain : C.int; @@ -337,7 +347,7 @@ package GNAT.Sockets.Thin is (Command : System.Address) return C.int; function C_Writev - (Socket : C.int; + (Fd : C.int; Iov : System.Address; Iovcnt : C.int) return C.int; @@ -345,6 +355,25 @@ package GNAT.Sockets.Thin is (WS_Version : Interfaces.C.int; WSADataAddress : System.Address) return Interfaces.C.int; + package Signalling_Fds is + + function Create (Fds : not null access Fd_Pair) return C.int; + pragma Convention (C, Create); + -- Create a pair of connected descriptors suitable for use with C_Select + -- (used for signalling in Selector objects). + + function Read (Rsig : C.int) return C.int; + pragma Convention (C, Read); + -- Read one byte of data from rsig, the read end of a pair of signalling + -- fds created by Create_Signalling_Fds. + + function Write (Wsig : C.int) return C.int; + pragma Convention (C, Write); + -- Write one byte of data to wsig, the write end of a pair of signalling + -- fds created by Create_Signalling_Fds. + + end Signalling_Fds; + procedure Free_Socket_Set (Set : Fd_Set_Access); -- Free system-dependent socket set @@ -371,19 +400,19 @@ package GNAT.Sockets.Thin is -- value if it is, zero if it is not. procedure Last_Socket_In_Set - (Set : Fd_Set_Access; - Last : Int_Access); - -- Find the largest socket in the socket set. This is needed for - -- select(). When Last_Socket_In_Set is called, parameter Last is - -- a maximum value of the largest socket. This hint is used to - -- avoid scanning very large socket sets. After the call, Last is - -- set back to the real largest socket in the socket set. + (Set : Fd_Set_Access; + Last : Int_Access); + -- Find the largest socket in the socket set. This is needed for select(). + -- When Last_Socket_In_Set is called, parameter Last is a maximum value of + -- the largest socket. This hint is used to avoid scanning very large + -- socket sets. After the call, Last is set back to the real largest socket + -- in the socket set. function New_Socket_Set (Set : Fd_Set_Access) return Fd_Set_Access; - -- Allocate a new socket set which is a system-dependent structure - -- and initialize by copying Set if it is non-null, by making it - -- empty otherwise. + -- Allocate a new socket set which is a system-dependent structure and + -- initialize by copying Set if it is non-null, by making it empty + -- otherwise. procedure Remove_Socket_From_Set (Set : Fd_Set_Access; @@ -393,7 +422,7 @@ package GNAT.Sockets.Thin is procedure WSACleanup; procedure Finalize; - procedure Initialize (Process_Blocking_IO : Boolean := False); + procedure Initialize (Process_Blocking_IO : Boolean); private pragma Import (Stdcall, C_Accept, "accept"); @@ -430,4 +459,5 @@ private pragma Import (C, New_Socket_Set, "__gnat_new_socket_set"); pragma Import (C, Insert_Socket_In_Set, "__gnat_insert_socket_in_set"); pragma Import (C, Remove_Socket_From_Set, "__gnat_remove_socket_from_set"); + end GNAT.Sockets.Thin; diff --git a/gcc/ada/g-socthi-vms.adb b/gcc/ada/g-socthi-vms.adb index d1545e050fe..0ede7e7973d 100644 --- a/gcc/ada/g-socthi-vms.adb +++ b/gcc/ada/g-socthi-vms.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2005, AdaCore -- +-- Copyright (C) 2001-2006, AdaCore -- -- -- -- 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- -- @@ -64,7 +64,7 @@ package body GNAT.Sockets.Thin is function Syscall_Accept (S : C.int; Addr : System.Address; - Addrlen : access C.int) return C.int; + Addrlen : not null access C.int) return C.int; pragma Import (C, Syscall_Accept, "accept"); function Syscall_Connect @@ -92,7 +92,7 @@ package body GNAT.Sockets.Thin is Len : C.int; Flags : C.int; From : Sockaddr_In_Access; - Fromlen : access C.int) return C.int; + Fromlen : not null access C.int) return C.int; pragma Import (C, Syscall_Recvfrom, "recvfrom"); function Syscall_Send @@ -125,7 +125,7 @@ package body GNAT.Sockets.Thin is function C_Accept (S : C.int; Addr : System.Address; - Addrlen : access C.int) return C.int + Addrlen : not null access C.int) return C.int is R : C.int; Val : aliased C.int := 1; @@ -275,7 +275,7 @@ package body GNAT.Sockets.Thin is Len : C.int; Flags : C.int; From : Sockaddr_In_Access; - Fromlen : access C.int) return C.int + Fromlen : not null access C.int) return C.int is Res : C.int; @@ -461,6 +461,12 @@ package body GNAT.Sockets.Thin is Sin.Sin_Port := Port; end Set_Port; + -------------------- + -- Signalling_Fds -- + -------------------- + + package body Signalling_Fds is separate; + -------------------------- -- Socket_Error_Message -- -------------------------- diff --git a/gcc/ada/g-socthi-vms.ads b/gcc/ada/g-socthi-vms.ads index 1b05e4719bc..c1bd1164371 100644 --- a/gcc/ada/g-socthi-vms.ads +++ b/gcc/ada/g-socthi-vms.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2002-2005, AdaCore -- +-- Copyright (C) 2002-2006, AdaCore -- -- -- -- 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- -- @@ -38,8 +38,8 @@ -- This is the Alpha/VMS version with Interfaces.C.Pointers; - with Interfaces.C.Strings; + with GNAT.Sockets.Constants; with GNAT.OS_Lib; @@ -60,9 +60,12 @@ package GNAT.Sockets.Thin is function Socket_Errno return Integer renames GNAT.OS_Lib.Errno; -- Returns last socket error number + procedure Set_Socket_Errno (Errno : Integer) renames GNAT.OS_Lib.Set_Errno; + -- Set last socket error number + function Socket_Error_Message (Errno : Integer) return C.Strings.chars_ptr; - -- Returns the error message string for the error number Errno. If - -- Errno is not known it returns "Unknown system error". + -- Returns the error message string for the error number Errno. If Errno is + -- not known it returns "Unknown system error". function Host_Errno return Integer; pragma Import (C, Host_Errno, "__gnat_get_h_errno"); @@ -165,8 +168,8 @@ package GNAT.Sockets.Thin is -- Set Sin.Sin_Family to Family procedure Set_Port - (Sin : Sockaddr_In_Access; - Port : C.unsigned_short); + (Sin : Sockaddr_In_Access; + Port : C.unsigned_short); pragma Inline (Set_Port); -- Set Sin.Sin_Port to Port @@ -203,14 +206,24 @@ package GNAT.Sockets.Thin is pragma Convention (C, Servent_Access); -- Access to service entry - type Two_Int is array (0 .. 1) of C.int; - pragma Convention (C, Two_Int); - -- Used with pipe() + type Two_Ints is array (0 .. 1) of C.int; + pragma Convention (C, Two_Ints); + -- Container for two int values + + subtype Fd_Pair is Two_Ints; + -- Two_Ints as used for Create_Signalling_Fds: a pair of connected file + -- descriptors, one of which (the "read end" of the connection) being used + -- for reading, the other one (the "write end") being used for writing. + + Read_End : constant := 0; + Write_End : constant := 1; + -- Indices into an Fd_Pair value providing access to each of the connected + -- file descriptors. function C_Accept (S : C.int; Addr : System.Address; - Addrlen : access C.int) return C.int; + Addrlen : not null access C.int) return C.int; function C_Bind (S : C.int; @@ -240,7 +253,7 @@ package GNAT.Sockets.Thin is function C_Getpeername (S : C.int; Name : System.Address; - Namelen : access C.int) return C.int; + Namelen : not null access C.int) return C.int; function C_Getservbyname (Name : C.char_array; @@ -253,24 +266,26 @@ package GNAT.Sockets.Thin is function C_Getsockname (S : C.int; Name : System.Address; - Namelen : access C.int) return C.int; + Namelen : not null 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; + Optlen : not null access C.int) return C.int; function C_Inet_Addr - (Cp : C.Strings.chars_ptr) return C.int; + (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_Listen + (S : C.int; + Backlog : C.int) return C.int; function C_Readv (Fd : C.int; @@ -289,7 +304,7 @@ package GNAT.Sockets.Thin is Len : C.int; Flags : C.int; From : Sockaddr_In_Access; - Fromlen : access C.int) return C.int; + Fromlen : not null access C.int) return C.int; function C_Select (Nfds : C.int; @@ -320,8 +335,8 @@ package GNAT.Sockets.Thin is Optlen : C.int) return C.int; function C_Shutdown - (S : C.int; - How : C.int) return C.int; + (S : C.int; + How : C.int) return C.int; function C_Socket (Domain : C.int; @@ -339,6 +354,25 @@ package GNAT.Sockets.Thin is Iov : System.Address; Iovcnt : C.int) return C.int; + package Signalling_Fds is + + function Create (Fds : not null access Fd_Pair) return C.int; + pragma Convention (C, Create); + -- Create a pair of connected descriptors suitable for use with C_Select + -- (used for signalling in Selector objects). + + function Read (Rsig : C.int) return C.int; + pragma Convention (C, Read); + -- Read one byte of data from rsig, the read end of a pair of signalling + -- fds created by Create_Signalling_Fds. + + function Write (Wsig : C.int) return C.int; + pragma Convention (C, Write); + -- Write one byte of data to wsig, the write end of a pair of signalling + -- fds created by Create_Signalling_Fds. + + end Signalling_Fds; + procedure Free_Socket_Set (Set : Fd_Set_Access); -- Free system-dependent socket set @@ -367,17 +401,17 @@ package GNAT.Sockets.Thin is procedure Last_Socket_In_Set (Set : Fd_Set_Access; Last : Int_Access); - -- Find the largest socket in the socket set. This is needed for - -- select(). When Last_Socket_In_Set is called, parameter Last is - -- a maximum value of the largest socket. This hint is used to - -- avoid scanning very large socket sets. After the call, Last is - -- set back to the real largest socket in the socket set. + -- Find the largest socket in the socket set. This is needed for select(). + -- When Last_Socket_In_Set is called, parameter Last is a maximum value of + -- the largest socket. This hint is used to avoid scanning very large + -- socket sets. After the call, Last is set back to the real largest socket + -- in the socket set. function New_Socket_Set (Set : Fd_Set_Access) return Fd_Set_Access; - -- Allocate a new socket set which is a system-dependent structure - -- and initialize by copying Set if it is non-null, by making it - -- empty otherwise. + -- Allocate a new socket set which is a system-dependent structure and + -- initialize by copying Set if it is non-null, by making it empty + -- otherwise. procedure Remove_Socket_From_Set (Set : Fd_Set_Access; @@ -414,4 +448,5 @@ private pragma Import (C, New_Socket_Set, "__gnat_new_socket_set"); pragma Import (C, Insert_Socket_In_Set, "__gnat_insert_socket_in_set"); pragma Import (C, Remove_Socket_From_Set, "__gnat_remove_socket_from_set"); + end GNAT.Sockets.Thin; diff --git a/gcc/ada/g-socthi-vxworks.adb b/gcc/ada/g-socthi-vxworks.adb index cb72c9fde86..e0539a9d12b 100644 --- a/gcc/ada/g-socthi-vxworks.adb +++ b/gcc/ada/g-socthi-vxworks.adb @@ -92,7 +92,7 @@ package body GNAT.Sockets.Thin is function Syscall_Accept (S : C.int; Addr : System.Address; - Addrlen : access C.int) return C.int; + Addrlen : not null access C.int) return C.int; pragma Import (C, Syscall_Accept, "accept"); function Syscall_Connect @@ -120,7 +120,7 @@ package body GNAT.Sockets.Thin is Len : C.int; Flags : C.int; From : Sockaddr_In_Access; - Fromlen : access C.int) return C.int; + Fromlen : not null access C.int) return C.int; pragma Import (C, Syscall_Recvfrom, "recvfrom"); function Syscall_Send @@ -155,7 +155,7 @@ package body GNAT.Sockets.Thin is function C_Accept (S : C.int; Addr : System.Address; - Addrlen : access C.int) return C.int + Addrlen : not null access C.int) return C.int is R : C.int; Val : aliased C.int := 1; @@ -398,7 +398,7 @@ package body GNAT.Sockets.Thin is Len : C.int; Flags : C.int; From : Sockaddr_In_Access; - Fromlen : access C.int) return C.int + Fromlen : not null access C.int) return C.int is Res : C.int; @@ -594,6 +594,12 @@ package body GNAT.Sockets.Thin is Sin.Sin_Port := Port; end Set_Port; + -------------------- + -- Signalling_Fds -- + -------------------- + + package body Signalling_Fds is separate; + -------------------------- -- Socket_Error_Message -- -------------------------- diff --git a/gcc/ada/g-socthi-vxworks.ads b/gcc/ada/g-socthi-vxworks.ads index 6aee25d4ef4..6e598b7dbc6 100644 --- a/gcc/ada/g-socthi-vxworks.ads +++ b/gcc/ada/g-socthi-vxworks.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2002-2005, AdaCore -- +-- Copyright (C) 2002-2006, AdaCore -- -- -- -- 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- -- @@ -38,9 +38,10 @@ -- This is the version for VxWorks with Interfaces.C.Pointers; +with Interfaces.C.Strings; with Ada.Unchecked_Conversion; -with Interfaces.C.Strings; + with GNAT.Sockets.Constants; with GNAT.OS_Lib; @@ -59,6 +60,9 @@ package GNAT.Sockets.Thin is function Socket_Errno return Integer renames GNAT.OS_Lib.Errno; -- Returns last socket error number + procedure Set_Socket_Errno (Errno : Integer) renames GNAT.OS_Lib.Set_Errno; + -- Set last socket error number + function Socket_Error_Message (Errno : Integer) return C.Strings.chars_ptr; -- Returns the error message string for the error number Errno. If Errno is -- not known it returns "Unknown system error". @@ -161,20 +165,20 @@ package GNAT.Sockets.Thin is -- Set Sin.Sin_Length to Len procedure Set_Family - (Sin : Sockaddr_In_Access; - Family : C.int); + (Sin : Sockaddr_In_Access; + Family : C.int); pragma Inline (Set_Family); -- Set Sin.Sin_Family to Family procedure Set_Port - (Sin : Sockaddr_In_Access; - Port : C.unsigned_short); + (Sin : Sockaddr_In_Access; + Port : C.unsigned_short); pragma Inline (Set_Port); -- Set Sin.Sin_Port to Port procedure Set_Address - (Sin : Sockaddr_In_Access; - Address : In_Addr); + (Sin : Sockaddr_In_Access; + Address : In_Addr); pragma Inline (Set_Address); -- Set Sin.Sin_Addr to Address @@ -193,10 +197,10 @@ package GNAT.Sockets.Thin is -- Access to host entry type Servent is record - S_Name : C.Strings.chars_ptr; - S_Aliases : Chars_Ptr_Pointers.Pointer; - S_Port : C.int; - S_Proto : C.Strings.chars_ptr; + S_Name : C.Strings.chars_ptr; + S_Aliases : Chars_Ptr_Pointers.Pointer; + S_Port : C.int; + S_Proto : C.Strings.chars_ptr; end record; pragma Convention (C, Servent); -- Service entry @@ -205,14 +209,24 @@ package GNAT.Sockets.Thin is pragma Convention (C, Servent_Access); -- Access to service entry - type Two_Int is array (0 .. 1) of C.int; - pragma Convention (C, Two_Int); - -- Used with pipe() + type Two_Ints is array (0 .. 1) of C.int; + pragma Convention (C, Two_Ints); + -- Container for two int values + + subtype Fd_Pair is Two_Ints; + -- Two_Ints as used for Create_Signalling_Fds: a pair of connected file + -- descriptors, one of which (the "read end" of the connection) being used + -- for reading, the other one (the "write end") being used for writing. + + Read_End : constant := 0; + Write_End : constant := 1; + -- Indices into an Fd_Pair value providing access to each of the connected + -- file descriptors. function C_Accept (S : C.int; Addr : System.Address; - Addrlen : access C.int) return C.int; + Addrlen : not null access C.int) return C.int; function C_Bind (S : C.int; @@ -242,7 +256,7 @@ package GNAT.Sockets.Thin is function C_Getpeername (S : C.int; Name : System.Address; - Namelen : access C.int) return C.int; + Namelen : not null access C.int) return C.int; function C_Getservbyname (Name : C.char_array; @@ -255,24 +269,26 @@ package GNAT.Sockets.Thin is function C_Getsockname (S : C.int; Name : System.Address; - Namelen : access C.int) return C.int; + Namelen : not null 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; + Optlen : not null 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; + (S : C.int; + Req : C.int; + Arg : Int_Access) return C.int; - function C_Listen (S, Backlog : C.int) return C.int; + function C_Listen + (S : C.int; + Backlog : C.int) return C.int; function C_Readv (Fd : C.int; @@ -291,7 +307,7 @@ package GNAT.Sockets.Thin is Len : C.int; Flags : C.int; From : Sockaddr_In_Access; - Fromlen : access C.int) return C.int; + Fromlen : not null access C.int) return C.int; function C_Select (Nfds : C.int; @@ -341,6 +357,25 @@ package GNAT.Sockets.Thin is Iov : System.Address; Iovcnt : C.int) return C.int; + package Signalling_Fds is + + function Create (Fds : not null access Fd_Pair) return C.int; + pragma Convention (C, Create); + -- Create a pair of connected descriptors suitable for use with C_Select + -- (used for signalling in Selector objects). + + function Read (Rsig : C.int) return C.int; + pragma Convention (C, Read); + -- Read one byte of data from rsig, the read end of a pair of signalling + -- fds created by Create_Signalling_Fds. + + function Write (Wsig : C.int) return C.int; + pragma Convention (C, Write); + -- Write one byte of data to wsig, the write end of a pair of signalling + -- fds created by Create_Signalling_Fds. + + end Signalling_Fds; + procedure Free_Socket_Set (Set : Fd_Set_Access); -- Free system-dependent socket set @@ -369,17 +404,17 @@ package GNAT.Sockets.Thin is procedure Last_Socket_In_Set (Set : Fd_Set_Access; Last : Int_Access); - -- Find the largest socket in the socket set. This is needed for - -- select(). When Last_Socket_In_Set is called, parameter Last is - -- a maximum value of the largest socket. This hint is used to - -- avoid scanning very large socket sets. After the call, Last is - -- set back to the real largest socket in the socket set. + -- Find the largest socket in the socket set. This is needed for select(). + -- When Last_Socket_In_Set is called, parameter Last is a maximum value of + -- the largest socket. This hint is used to avoid scanning very large + -- socket sets. After the call, Last is set back to the real largest socket + -- in the socket set. function New_Socket_Set (Set : Fd_Set_Access) return Fd_Set_Access; - -- Allocate a new socket set which is a system-dependent structure - -- and initialize by copying Set if it is non-null, by making it - -- empty otherwise. + -- Allocate a new socket set which is a system-dependent structure and + -- initialize by copying Set if it is non-null, by making it empty + -- otherwise. procedure Remove_Socket_From_Set (Set : Fd_Set_Access; @@ -390,7 +425,6 @@ package GNAT.Sockets.Thin is procedure Initialize (Process_Blocking_IO : Boolean); private - pragma Import (C, C_Bind, "bind"); pragma Import (C, C_Close, "close"); pragma Import (C, C_Gethostname, "gethostname"); diff --git a/gcc/ada/g-socthi.adb b/gcc/ada/g-socthi.adb index 914b787a41c..7ca1c1cdfdf 100644 --- a/gcc/ada/g-socthi.adb +++ b/gcc/ada/g-socthi.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2005, AdaCore -- +-- Copyright (C) 2001-2006, AdaCore -- -- -- -- 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- -- @@ -71,7 +71,7 @@ package body GNAT.Sockets.Thin is function Syscall_Accept (S : C.int; Addr : System.Address; - Addrlen : access C.int) return C.int; + Addrlen : not null access C.int) return C.int; pragma Import (C, Syscall_Accept, "accept"); function Syscall_Connect @@ -99,7 +99,7 @@ package body GNAT.Sockets.Thin is Len : C.int; Flags : C.int; From : Sockaddr_In_Access; - Fromlen : access C.int) return C.int; + Fromlen : not null access C.int) return C.int; pragma Import (C, Syscall_Recvfrom, "recvfrom"); function Syscall_Send @@ -127,6 +127,11 @@ package body GNAT.Sockets.Thin is procedure Disable_SIGPIPE (S : C.int); pragma Import (C, Disable_SIGPIPE, "__gnat_disable_sigpipe"); + procedure Disable_All_SIGPIPEs; + pragma Import (C, Disable_All_SIGPIPEs, "__gnat_disable_all_sigpipes"); + -- Sets the process to ignore all SIGPIPE signals on platforms that + -- don't support Disable_SIGPIPE for particular streams. + function Non_Blocking_Socket (S : C.int) return Boolean; procedure Set_Non_Blocking_Socket (S : C.int; V : Boolean); @@ -137,7 +142,7 @@ package body GNAT.Sockets.Thin is function C_Accept (S : C.int; Addr : System.Address; - Addrlen : access C.int) return C.int + Addrlen : not null access C.int) return C.int is R : C.int; Val : aliased C.int := 1; @@ -288,7 +293,7 @@ package body GNAT.Sockets.Thin is Len : C.int; Flags : C.int; From : Sockaddr_In_Access; - Fromlen : access C.int) return C.int + Fromlen : not null access C.int) return C.int is Res : C.int; @@ -404,6 +409,7 @@ package body GNAT.Sockets.Thin is procedure Initialize (Process_Blocking_IO : Boolean) is begin Thread_Blocking_IO := not Process_Blocking_IO; + Disable_All_SIGPIPEs; end Initialize; ------------------------- @@ -487,6 +493,32 @@ package body GNAT.Sockets.Thin is Sin.Sin_Port := Port; end Set_Port; + -------------------- + -- Signalling_Fds -- + -------------------- + + package body Signalling_Fds is + + -- In this default implementation, we use a C version of these + -- subprograms provided by socket.c. + + function C_Create (Fds : not null access Fd_Pair) return C.int; + function C_Read (Rsig : C.int) return C.int; + function C_Write (Wsig : C.int) return C.int; + + pragma Import (C, C_Create, "__gnat_create_signalling_fds"); + pragma Import (C, C_Read, "__gnat_read_signalling_fd"); + pragma Import (C, C_Write, "__gnat_write_signalling_fd"); + + function Create (Fds : not null access Fd_Pair) return C.int + renames C_Create; + + function Read (Rsig : C.int) return C.int renames C_Read; + + function Write (Wsig : C.int) return C.int renames C_Write; + + end Signalling_Fds; + -------------------------- -- Socket_Error_Message -- -------------------------- diff --git a/gcc/ada/g-socthi.ads b/gcc/ada/g-socthi.ads index 5d06d99bcae..ce3f7586f1b 100644 --- a/gcc/ada/g-socthi.ads +++ b/gcc/ada/g-socthi.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2001-2005, AdaCore -- +-- Copyright (C) 2001-2006, AdaCore -- -- -- -- 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- -- @@ -39,6 +39,7 @@ with Interfaces.C.Pointers; with Interfaces.C.Strings; + with GNAT.Sockets.Constants; with GNAT.OS_Lib; @@ -204,14 +205,24 @@ package GNAT.Sockets.Thin is pragma Convention (C, Servent_Access); -- Access to service entry - type Two_Int is array (0 .. 1) of C.int; - pragma Convention (C, Two_Int); - -- Used with pipe() + type Two_Ints is array (0 .. 1) of C.int; + pragma Convention (C, Two_Ints); + -- Container for two int values + + subtype Fd_Pair is Two_Ints; + -- Two_Ints as used for Create_Signalling_Fds: a pair of connected file + -- descriptors, one of which (the "read end" of the connection) being used + -- for reading, the other one (the "write end") being used for writing. + + Read_End : constant := 0; + Write_End : constant := 1; + -- Indices into an Fd_Pair value providing access to each of the connected + -- file descriptors. function C_Accept (S : C.int; Addr : System.Address; - Addrlen : access C.int) return C.int; + Addrlen : not null access C.int) return C.int; function C_Bind (S : C.int; @@ -241,7 +252,7 @@ package GNAT.Sockets.Thin is function C_Getpeername (S : C.int; Name : System.Address; - Namelen : access C.int) return C.int; + Namelen : not null access C.int) return C.int; function C_Getservbyname (Name : C.char_array; @@ -254,14 +265,14 @@ package GNAT.Sockets.Thin is function C_Getsockname (S : C.int; Name : System.Address; - Namelen : access C.int) return C.int; + Namelen : not null 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; + Optlen : not null access C.int) return C.int; function C_Inet_Addr (Cp : C.Strings.chars_ptr) return C.int; @@ -292,7 +303,7 @@ package GNAT.Sockets.Thin is Len : C.int; Flags : C.int; From : Sockaddr_In_Access; - Fromlen : access C.int) return C.int; + Fromlen : not null access C.int) return C.int; function C_Select (Nfds : C.int; @@ -342,6 +353,25 @@ package GNAT.Sockets.Thin is Iov : System.Address; Iovcnt : C.int) return C.int; + package Signalling_Fds is + + function Create (Fds : not null access Fd_Pair) return C.int; + pragma Convention (C, Create); + -- Create a pair of connected descriptors suitable for use with C_Select + -- (used for signalling in Selector objects). + + function Read (Rsig : C.int) return C.int; + pragma Convention (C, Read); + -- Read one byte of data from rsig, the read end of a pair of signalling + -- fds created by Create_Signalling_Fds. + + function Write (Wsig : C.int) return C.int; + pragma Convention (C, Write); + -- Write one byte of data to wsig, the write end of a pair of signalling + -- fds created by Create_Signalling_Fds. + + end Signalling_Fds; + procedure Free_Socket_Set (Set : Fd_Set_Access); -- Free system-dependent socket set @@ -418,4 +448,5 @@ private pragma Import (C, New_Socket_Set, "__gnat_new_socket_set"); pragma Import (C, Insert_Socket_In_Set, "__gnat_insert_socket_in_set"); pragma Import (C, Remove_Socket_From_Set, "__gnat_remove_socket_from_set"); + end GNAT.Sockets.Thin; diff --git a/gcc/ada/g-soliop-mingw.ads b/gcc/ada/g-soliop-mingw.ads index 2966df635e5..039d3754c04 100644 --- a/gcc/ada/g-soliop-mingw.ads +++ b/gcc/ada/g-soliop-mingw.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2001-2005, AdaCore -- +-- Copyright (C) 2001-2006, AdaCore -- -- -- -- 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- -- @@ -38,5 +38,5 @@ package GNAT.Sockets.Linker_Options is private - pragma Linker_Options ("-lwsock32"); + pragma Linker_Options ("-lws2_32"); end GNAT.Sockets.Linker_Options; diff --git a/gcc/ada/g-stsifd-sockets.adb b/gcc/ada/g-stsifd-sockets.adb new file mode 100644 index 00000000000..eb480b90328 --- /dev/null +++ b/gcc/ada/g-stsifd-sockets.adb @@ -0,0 +1,191 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- G N A T . S O C K E T S . T H I N . S I G N A L L I N G _ F D S -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 2001-2006, AdaCore -- +-- -- +-- GNAT is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 2, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- +-- for more details. You should have received a copy of the GNU General -- +-- Public License distributed with GNAT; see file COPYING. If not, write -- +-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, -- +-- Boston, MA 02110-1301, USA. -- +-- -- +-- As a special exception, if other files instantiate generics from this -- +-- unit, or you link this unit with other files to produce an executable, -- +-- this unit does not by itself cause the resulting executable to be -- +-- covered by the GNU General Public License. This exception does not -- +-- however invalidate any other reasons why the executable file might be -- +-- covered by the GNU Public License. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +-- Portable sockets-based implementation of GNAT.Sockets.Thin.Signalling_Fds +-- used for platforms that do not support UNIX pipes. + +-- Note: this code used to be in GNAT.Sockets, but has been moved to a +-- platform-specific file. It is now used only for non-UNIX platforms. + +separate + (GNAT.Sockets.Thin) +package body Signalling_Fds is + + ------------ + -- Create -- + ------------ + + function Create (Fds : not null access Fd_Pair) return C.int is + L_Sock, R_Sock, W_Sock : C.int := Failure; + -- Listening socket, read socket and write socket + + Sin : aliased Sockaddr_In; + Len : aliased C.int := Sin'Size / 8; + -- Address of listening socket + + Res : C.int; + -- Return status of system calls + + Err : Integer; + -- Saved errno value + + begin + Fds (Read_End) := Failure; + Fds (Write_End) := Failure; + + -- We open two signalling sockets. One of them is used to send data + -- to the other, which is included in a C_Select socket set. The + -- communication is used to force the call to C_Select to complete, + -- and the waiting task to resume its execution. + + -- Create a listening socket + + L_Sock := C_Socket (Constants.AF_INET, Constants.SOCK_STREAM, 0); + + if L_Sock = Failure then + goto Fail; + end if; + + -- Bind the socket to an available port on localhost + + Sin.Sin_Addr.S_B1 := 127; + Sin.Sin_Addr.S_B2 := 0; + Sin.Sin_Addr.S_B3 := 0; + Sin.Sin_Addr.S_B4 := 1; + Sin.Sin_Port := 0; + + Res := C_Bind (L_Sock, Sin'Address, Len); + + if Res = Failure then + goto Fail; + end if; + + -- Get assigned port + + Res := C_Getsockname (L_Sock, Sin'Address, Len'Access); + if Res = Failure then + goto Fail; + end if; + + -- Set socket to listen mode, with a backlog of 1 to guarantee that + -- exactly one call to connect(2) succeeds. + + Res := C_Listen (L_Sock, 1); + + if Res = Failure then + goto Fail; + end if; + + -- Create read end (client) socket + + R_Sock := C_Socket (Constants.AF_INET, Constants.SOCK_STREAM, 0); + + if R_Sock = Failure then + goto Fail; + end if; + + -- Connect listening socket + + Res := C_Connect (R_Sock, Sin'Address, Len); + + if Res = Failure then + goto Fail; + end if; + + -- Since the call to connect(2) has suceeded and the backlog limit on + -- the listening socket is 1, we know that there is now exactly one + -- pending connection on L_Sock, which is the one from R_Sock. + + W_Sock := C_Accept (L_Sock, Sin'Address, Len'Access); + if W_Sock = Failure then + goto Fail; + end if; + + -- Set TCP_NODELAY on W_Sock, since we always want to send the data out + -- immediately. + + Set_Socket_Option + (Socket => Socket_Type (W_Sock), + Level => IP_Protocol_For_TCP_Level, + Option => (Name => No_Delay, Enabled => True)); + + -- Close listening socket (ignore exit status) + + Res := C_Close (L_Sock); + + Fds (Read_End) := R_Sock; + Fds (Write_End) := W_Sock; + + return Success; + + <> + Err := Socket_Errno; + + if W_Sock /= Failure then + Res := C_Close (W_Sock); + end if; + + if R_Sock /= Failure then + Res := C_Close (R_Sock); + end if; + + if L_Sock /= Failure then + Res := C_Close (L_Sock); + end if; + + Set_Socket_Errno (Err); + + return Failure; + end Create; + + ---------- + -- Read -- + ---------- + + function Read (Rsig : C.int) return C.int is + Buf : aliased Character; + begin + return C_Recv (Rsig, Buf'Address, 1, Constants.MSG_Forced_Flags); + end Read; + + ----------- + -- Write -- + ----------- + + function Write (Wsig : C.int) return C.int is + Buf : aliased Character := ASCII.NUL; + begin + return C_Send (Wsig, Buf'Address, 1, Constants.MSG_Forced_Flags); + end Write; + +end Signalling_Fds; diff --git a/gcc/ada/socket.c b/gcc/ada/socket.c index bb79ac30a72..ef8e26581a7 100644 --- a/gcc/ada/socket.c +++ b/gcc/ada/socket.c @@ -6,7 +6,7 @@ * * * C Implementation File * * * - * Copyright (C) 2003-2005 Free Software Foundation, Inc. * + * Copyright (C) 2003-2006, 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- * @@ -36,6 +36,11 @@ /* Include all the necessary system-specific headers and define the necessary macros (shared with gen-soccon). */ +#if !defined(SO_NOSIGPIPE) && !defined (MSG_NOSIGNAL) +#include +#endif +/* Required if we will be calling signal() in __gnat_disable_all_sigpipes() */ + #include "raise.h" /* Required for __gnat_malloc() */ @@ -43,6 +48,10 @@ /* Required for memcpy() */ extern void __gnat_disable_sigpipe (int fd); +extern void __gnat_disable_all_sigpipes (void); +extern int __gnat_create_signalling_fds (int *fds); +extern int __gnat_read_signalling_fd (int rsig); +extern int __gnat_write_signalling_fd (int wsig); extern void __gnat_free_socket_set (fd_set *); extern void __gnat_last_socket_in_set (fd_set *, int *); extern void __gnat_get_socket_from_set (fd_set *, int *, int *); @@ -50,7 +59,7 @@ extern void __gnat_insert_socket_in_set (fd_set *, int); extern int __gnat_is_socket_in_set (fd_set *, int); extern fd_set *__gnat_new_socket_set (fd_set *); extern void __gnat_remove_socket_from_set (fd_set *, int); -extern int __gnat_get_h_errno (void); +extern int __gnat_get_h_errno (void); /* Disable the sending of SIGPIPE for writes on a broken stream */ @@ -63,6 +72,51 @@ __gnat_disable_sigpipe (int fd) #endif } +void +__gnat_disable_all_sigpipes (void) +{ +#if !defined(SO_NOSIGPIPE) && !defined(MSG_NOSIGNAL) && defined(SIGPIPE) + (void) signal (SIGPIPE, SIG_IGN); +#endif +} + +#if defined (_WIN32) || defined (__vxworks) || defined (VMS) +/* + * Signalling FDs operations are implemented in Ada for these platforms + * (see subunit GNAT.Sockets.Thin.Signalling_Fds). + */ +#else +/* + * Create a pair of connected file descriptors fds[0] and fds[1] used for + * signalling by a Selector object. fds[0] is the read end, and fds[1] the + * write end. + */ +int +__gnat_create_signalling_fds (int *fds) { + return pipe (fds); +} + +/* + * Read one byte of data from rsig, the read end of a pair of signalling fds + * created by __gnat_create_signalling_fds. + */ +int +__gnat_read_signalling_fd (int rsig) { + char c; + return read (rsig, &c, 1); +} + +/* + * Write one byte of data to wsig, the write end of a pair of signalling fds + * created by __gnat_create_signalling_fds. + */ +int +__gnat_write_signalling_fd (int wsig) { + char c = 0; + return write (wsig, &c, 1); +} +#endif + /* Free socket set. */ void @@ -83,7 +137,7 @@ __gnat_last_socket_in_set (fd_set *set, int *last) int l; l = -1; -#ifdef WINNT +#ifdef _WIN32 /* More efficient method for NT. */ for (s = 0; s < set->fd_count; s++) if ((int) set->fd_array[s] > l)