obtained gcc-4.6.4.tar.bz2 from upstream website;upstream

verified gcc-4.6.4.tar.bz2.sig;
imported gcc-4.6.4 source tree from verified upstream tarball.

downloading a git-generated archive based on the 'upstream' tag
should provide you with a source tree that is binary identical
to the one extracted from the above tarball.

if you have obtained the source via the command 'git clone',
however, do note that line-endings of files in your working
directory might differ from line-endings of the respective
files in the upstream repository.

1 files changed, 2577 insertions, 0 deletions

diff --git a/gcc/ada/g-socket.adb b/gcc/ada/g-socket.adb
new file mode 100644
index 000000000..6bca4909a
--- /dev/null
+++ b/gcc/ada/g-socket.adb
@@ -0,0 +1,2577 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                         G N A T . S O C K E T S                          --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--                     Copyright (C) 2001-2010, 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.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with Ada.Streams;              use Ada.Streams;
+with Ada.Exceptions;           use Ada.Exceptions;
+with Ada.Finalization;
+with Ada.Unchecked_Conversion;
+
+with Interfaces.C.Strings;
+
+with GNAT.Sockets.Thin_Common;          use GNAT.Sockets.Thin_Common;
+with GNAT.Sockets.Thin;                 use GNAT.Sockets.Thin;
+
+with GNAT.Sockets.Linker_Options;
+pragma Warnings (Off, GNAT.Sockets.Linker_Options);
+--  Need to include pragma Linker_Options which is platform dependent
+
+with System;               use System;
+with System.Communication; use System.Communication;
+with System.CRTL;          use System.CRTL;
+with System.Task_Lock;
+
+package body GNAT.Sockets is
+
+   package C renames Interfaces.C;
+
+   use type C.int;
+
+   ENOERROR : constant := 0;
+
+   Netdb_Buffer_Size : constant := SOSC.Need_Netdb_Buffer * 1024;
+   Need_Netdb_Lock   : constant Boolean := SOSC.Need_Netdb_Lock /= 0;
+   --  The network database functions gethostbyname, gethostbyaddr,
+   --  getservbyname and getservbyport can either be guaranteed task safe by
+   --  the operating system, or else return data through a user-provided buffer
+   --  to ensure concurrent uses do not interfere.
+
+   --  Correspondence tables
+
+   Levels : constant array (Level_Type) of C.int :=
+              (Socket_Level              => SOSC.SOL_SOCKET,
+               IP_Protocol_For_IP_Level  => SOSC.IPPROTO_IP,
+               IP_Protocol_For_UDP_Level => SOSC.IPPROTO_UDP,
+               IP_Protocol_For_TCP_Level => SOSC.IPPROTO_TCP);
+
+   Modes : constant array (Mode_Type) of C.int :=
+             (Socket_Stream   => SOSC.SOCK_STREAM,
+              Socket_Datagram => SOSC.SOCK_DGRAM);
+
+   Shutmodes : constant array (Shutmode_Type) of C.int :=
+                 (Shut_Read       => SOSC.SHUT_RD,
+                  Shut_Write      => SOSC.SHUT_WR,
+                  Shut_Read_Write => SOSC.SHUT_RDWR);
+
+   Requests : constant array (Request_Name) of C.int :=
+                (Non_Blocking_IO => SOSC.FIONBIO,
+                 N_Bytes_To_Read => SOSC.FIONREAD);
+
+   Options : constant array (Option_Name) of C.int :=
+               (Keep_Alive          => SOSC.SO_KEEPALIVE,
+                Reuse_Address       => SOSC.SO_REUSEADDR,
+                Broadcast           => SOSC.SO_BROADCAST,
+                Send_Buffer         => SOSC.SO_SNDBUF,
+                Receive_Buffer      => SOSC.SO_RCVBUF,
+                Linger              => SOSC.SO_LINGER,
+                Error               => SOSC.SO_ERROR,
+                No_Delay            => SOSC.TCP_NODELAY,
+                Add_Membership      => SOSC.IP_ADD_MEMBERSHIP,
+                Drop_Membership     => SOSC.IP_DROP_MEMBERSHIP,
+                Multicast_If        => SOSC.IP_MULTICAST_IF,
+                Multicast_TTL       => SOSC.IP_MULTICAST_TTL,
+                Multicast_Loop      => SOSC.IP_MULTICAST_LOOP,
+                Receive_Packet_Info => SOSC.IP_PKTINFO,
+                Send_Timeout        => SOSC.SO_SNDTIMEO,
+                Receive_Timeout     => SOSC.SO_RCVTIMEO);
+   --  ??? Note: for OpenSolaris, Receive_Packet_Info should be IP_RECVPKTINFO,
+   --  but for Linux compatibility this constant is the same as IP_PKTINFO.
+
+   Flags : constant array (0 .. 3) of C.int :=
+             (0 => SOSC.MSG_OOB,     --  Process_Out_Of_Band_Data
+              1 => SOSC.MSG_PEEK,    --  Peek_At_Incoming_Data
+              2 => SOSC.MSG_WAITALL, --  Wait_For_A_Full_Reception
+              3 => SOSC.MSG_EOR);    --  Send_End_Of_Record
+
+   Socket_Error_Id : constant Exception_Id := Socket_Error'Identity;
+   Host_Error_Id   : constant Exception_Id := Host_Error'Identity;
+
+   Hex_To_Char : constant String (1 .. 16) := "0123456789ABCDEF";
+   --  Use to print in hexadecimal format
+
+   -----------------------
+   -- Local subprograms --
+   -----------------------
+
+   function Resolve_Error
+     (Error_Value : Integer;
+      From_Errno  : Boolean := True) return Error_Type;
+   --  Associate an enumeration value (error_type) to en error value (errno).
+   --  From_Errno prevents from mixing h_errno with errno.
+
+   function To_Name   (N  : String) return Name_Type;
+   function To_String (HN : Name_Type) return String;
+   --  Conversion functions
+
+   function To_Int (F : Request_Flag_Type) return C.int;
+   --  Return the int value corresponding to the specified flags combination
+
+   function Set_Forced_Flags (F : C.int) return C.int;
+   --  Return F with the bits from SOSC.MSG_Forced_Flags forced set
+
+   function Short_To_Network
+     (S : C.unsigned_short) return C.unsigned_short;
+   pragma Inline (Short_To_Network);
+   --  Convert a port number into a network port number
+
+   function Network_To_Short
+     (S : C.unsigned_short) return C.unsigned_short
+   renames Short_To_Network;
+   --  Symmetric operation
+
+   function Image
+     (Val :  Inet_Addr_VN_Type;
+      Hex :  Boolean := False) return String;
+   --  Output an array of inet address components in hex or decimal mode
+
+   function Is_IP_Address (Name : String) return Boolean;
+   --  Return true when Name is an IP address in standard dot notation
+
+   procedure Netdb_Lock;
+   pragma Inline (Netdb_Lock);
+   procedure Netdb_Unlock;
+   pragma Inline (Netdb_Unlock);
+   --  Lock/unlock operation used to protect netdb access for platforms that
+   --  require such protection.
+
+   function To_In_Addr (Addr : Inet_Addr_Type) return In_Addr;
+   procedure To_Inet_Addr
+     (Addr   : In_Addr;
+      Result : out Inet_Addr_Type);
+   --  Conversion functions
+
+   function To_Host_Entry (E : Hostent_Access) return Host_Entry_Type;
+   --  Conversion function
+
+   function To_Service_Entry (E : Servent_Access) return Service_Entry_Type;
+   --  Conversion function
+
+   function Value (S : System.Address) return String;
+   --  Same as Interfaces.C.Strings.Value but taking a System.Address (on VMS,
+   --  chars_ptr is a 32-bit pointer, and here we need a 64-bit version).
+
+   function To_Timeval (Val : Timeval_Duration) return Timeval;
+   --  Separate Val in seconds and microseconds
+
+   function To_Duration (Val : Timeval) return Timeval_Duration;
+   --  Reconstruct a Duration value from a Timeval record (seconds and
+   --  microseconds).
+
+   procedure Raise_Socket_Error (Error : Integer);
+   --  Raise Socket_Error with an exception message describing the error code
+   --  from errno.
+
+   procedure Raise_Host_Error (H_Error : Integer);
+   --  Raise Host_Error exception with message describing error code (note
+   --  hstrerror seems to be obsolete) from h_errno.
+
+   procedure Narrow (Item : in out Socket_Set_Type);
+   --  Update Last as it may be greater than the real last socket
+
+   --  Types needed for Datagram_Socket_Stream_Type
+
+   type Datagram_Socket_Stream_Type is new Root_Stream_Type with record
+      Socket : Socket_Type;
+      To     : Sock_Addr_Type;
+      From   : Sock_Addr_Type;
+   end record;
+
+   type Datagram_Socket_Stream_Access is
+     access all Datagram_Socket_Stream_Type;
+
+   procedure Read
+     (Stream : in out Datagram_Socket_Stream_Type;
+      Item   : out Ada.Streams.Stream_Element_Array;
+      Last   : out Ada.Streams.Stream_Element_Offset);
+
+   procedure Write
+     (Stream : in out Datagram_Socket_Stream_Type;
+      Item   : Ada.Streams.Stream_Element_Array);
+
+   --  Types needed for Stream_Socket_Stream_Type
+
+   type Stream_Socket_Stream_Type is new Root_Stream_Type with record
+      Socket : Socket_Type;
+   end record;
+
+   type Stream_Socket_Stream_Access is
+     access all Stream_Socket_Stream_Type;
+
+   procedure Read
+     (Stream : in out Stream_Socket_Stream_Type;
+      Item   : out Ada.Streams.Stream_Element_Array;
+      Last   : out Ada.Streams.Stream_Element_Offset);
+
+   procedure Write
+     (Stream : in out Stream_Socket_Stream_Type;
+      Item   : Ada.Streams.Stream_Element_Array);
+
+   procedure Stream_Write
+     (Socket : Socket_Type;
+      Item   : Ada.Streams.Stream_Element_Array;
+      To     : access Sock_Addr_Type);
+   --  Common implementation for the Write operation of Datagram_Socket_Stream_
+   --  Type and Stream_Socket_Stream_Type.
+
+   procedure Wait_On_Socket
+     (Socket    : Socket_Type;
+      For_Read  : Boolean;
+      Timeout   : Selector_Duration;
+      Selector  : access Selector_Type := null;
+      Status    : out Selector_Status);
+   --  Common code for variants of socket operations supporting a timeout:
+   --  block in Check_Selector on Socket for at most the indicated timeout.
+   --  If For_Read is True, Socket is added to the read set for this call, else
+   --  it is added to the write set. If no selector is provided, a local one is
+   --  created for this call and destroyed prior to returning.
+
+   type Sockets_Library_Controller is new Ada.Finalization.Limited_Controlled
+     with null record;
+   --  This type is used to generate automatic calls to Initialize and Finalize
+   --  during the elaboration and finalization of this package. A single object
+   --  of this type must exist at library level.
+
+   function Err_Code_Image (E : Integer) return String;
+   --  Return the value of E surrounded with brackets
+
+   procedure Initialize (X : in out Sockets_Library_Controller);
+   procedure Finalize   (X : in out Sockets_Library_Controller);
+
+   procedure Normalize_Empty_Socket_Set (S : in out Socket_Set_Type);
+   --  If S is the empty set (detected by Last = No_Socket), make sure its
+   --  fd_set component is actually cleared. Note that the case where it is
+   --  not can occur for an uninitialized Socket_Set_Type object.
+
+   function Is_Open (S : Selector_Type) return Boolean;
+   --  Return True for an "open" Selector_Type object, i.e. one for which
+   --  Create_Selector has been called and Close_Selector has not been called,
+   --  or the null selector.
+
+   ---------
+   -- "+" --
+   ---------
+
+   function "+" (L, R : Request_Flag_Type) return Request_Flag_Type is
+   begin
+      return L or R;
+   end "+";
+
+   --------------------
+   -- Abort_Selector --
+   --------------------
+
+   procedure Abort_Selector (Selector : Selector_Type) is
+      Res : C.int;
+
+   begin
+      if not Is_Open (Selector) then
+         raise Program_Error with "closed selector";
+
+      elsif Selector.Is_Null then
+         raise Program_Error with "null selector";
+
+      end if;
+
+      --  Send one byte to unblock select system call
+
+      Res := Signalling_Fds.Write (C.int (Selector.W_Sig_Socket));
+
+      if Res = Failure then
+         Raise_Socket_Error (Socket_Errno);
+      end if;
+   end Abort_Selector;
+
+   -------------------
+   -- Accept_Socket --
+   -------------------
+
+   procedure Accept_Socket
+     (Server  : Socket_Type;
+      Socket  : out Socket_Type;
+      Address : out Sock_Addr_Type)
+   is
+      Res : C.int;
+      Sin : aliased Sockaddr_In;
+      Len : aliased C.int := Sin'Size / 8;
+
+   begin
+      Res := C_Accept (C.int (Server), Sin'Address, Len'Access);
+
+      if Res = Failure then
+         Raise_Socket_Error (Socket_Errno);
+      end if;
+
+      Socket := Socket_Type (Res);
+
+      To_Inet_Addr (Sin.Sin_Addr, Address.Addr);
+      Address.Port := Port_Type (Network_To_Short (Sin.Sin_Port));
+   end Accept_Socket;
+
+   -------------------
+   -- Accept_Socket --
+   -------------------
+
+   procedure Accept_Socket
+     (Server   : Socket_Type;
+      Socket   : out Socket_Type;
+      Address  : out Sock_Addr_Type;
+      Timeout  : Selector_Duration;
+      Selector : access Selector_Type := null;
+      Status   : out Selector_Status)
+   is
+   begin
+      if Selector /= null and then not Is_Open (Selector.all) then
+         raise Program_Error with "closed selector";
+      end if;
+
+      --  Wait for socket to become available for reading
+
+      Wait_On_Socket
+        (Socket    => Server,
+         For_Read  => True,
+         Timeout   => Timeout,
+         Selector  => Selector,
+         Status    => Status);
+
+      --  Accept connection if available
+
+      if Status = Completed then
+         Accept_Socket (Server, Socket, Address);
+      else
+         Socket := No_Socket;
+      end if;
+   end Accept_Socket;
+
+   ---------------
+   -- Addresses --
+   ---------------
+
+   function Addresses
+     (E : Host_Entry_Type;
+      N : Positive := 1) return Inet_Addr_Type
+   is
+   begin
+      return E.Addresses (N);
+   end Addresses;
+
+   ----------------------
+   -- Addresses_Length --
+   ----------------------
+
+   function Addresses_Length (E : Host_Entry_Type) return Natural is
+   begin
+      return E.Addresses_Length;
+   end Addresses_Length;
+
+   -------------
+   -- Aliases --
+   -------------
+
+   function Aliases
+     (E : Host_Entry_Type;
+      N : Positive := 1) return String
+   is
+   begin
+      return To_String (E.Aliases (N));
+   end Aliases;
+
+   -------------
+   -- Aliases --
+   -------------
+
+   function Aliases
+     (S : Service_Entry_Type;
+      N : Positive := 1) return String
+   is
+   begin
+      return To_String (S.Aliases (N));
+   end Aliases;
+
+   --------------------
+   -- Aliases_Length --
+   --------------------
+
+   function Aliases_Length (E : Host_Entry_Type) return Natural is
+   begin
+      return E.Aliases_Length;
+   end Aliases_Length;
+
+   --------------------
+   -- Aliases_Length --
+   --------------------
+
+   function Aliases_Length (S : Service_Entry_Type) return Natural is
+   begin
+      return S.Aliases_Length;
+   end Aliases_Length;
+
+   -----------------
+   -- Bind_Socket --
+   -----------------
+
+   procedure Bind_Socket
+     (Socket  : Socket_Type;
+      Address : Sock_Addr_Type)
+   is
+      Res : C.int;
+      Sin : aliased Sockaddr_In;
+      Len : constant C.int := Sin'Size / 8;
+      --  This assumes that Address.Family = Family_Inet???
+
+   begin
+      if Address.Family = Family_Inet6 then
+         raise Socket_Error with "IPv6 not supported";
+      end if;
+
+      Set_Family  (Sin.Sin_Family, Address.Family);
+      Set_Address (Sin'Unchecked_Access, To_In_Addr (Address.Addr));
+      Set_Port
+        (Sin'Unchecked_Access,
+         Short_To_Network (C.unsigned_short (Address.Port)));
+
+      Res := C_Bind (C.int (Socket), Sin'Address, Len);
+
+      if Res = Failure then
+         Raise_Socket_Error (Socket_Errno);
+      end if;
+   end Bind_Socket;
+
+   --------------------
+   -- Check_Selector --
+   --------------------
+
+   procedure Check_Selector
+     (Selector     : Selector_Type;
+      R_Socket_Set : in out Socket_Set_Type;
+      W_Socket_Set : in out Socket_Set_Type;
+      Status       : out Selector_Status;
+      Timeout      : Selector_Duration := Forever)
+   is
+      E_Socket_Set : Socket_Set_Type;
+   begin
+      Check_Selector
+        (Selector, R_Socket_Set, W_Socket_Set, E_Socket_Set, Status, Timeout);
+   end Check_Selector;
+
+   --------------------
+   -- Check_Selector --
+   --------------------
+
+   procedure Check_Selector
+     (Selector     : Selector_Type;
+      R_Socket_Set : in out Socket_Set_Type;
+      W_Socket_Set : in out Socket_Set_Type;
+      E_Socket_Set : in out Socket_Set_Type;
+      Status       : out Selector_Status;
+      Timeout      : Selector_Duration := Forever)
+   is
+      Res  : C.int;
+      Last : C.int;
+      RSig : Socket_Type := No_Socket;
+      TVal : aliased Timeval;
+      TPtr : Timeval_Access;
+
+   begin
+      if not Is_Open (Selector) then
+         raise Program_Error with "closed selector";
+      end if;
+
+      Status := Completed;
+
+      --  No timeout or Forever is indicated by a null timeval pointer
+
+      if Timeout = Forever then
+         TPtr := null;
+      else
+         TVal := To_Timeval (Timeout);
+         TPtr := TVal'Unchecked_Access;
+      end if;
+
+      --  Add read signalling socket, if present
+
+      if not Selector.Is_Null then
+         RSig := Selector.R_Sig_Socket;
+         Set (R_Socket_Set, RSig);
+      end if;
+
+      Last := C.int'Max (C.int'Max (C.int (R_Socket_Set.Last),
+                                    C.int (W_Socket_Set.Last)),
+                                    C.int (E_Socket_Set.Last));
+
+      --  Zero out fd_set for empty Socket_Set_Type objects
+
+      Normalize_Empty_Socket_Set (R_Socket_Set);
+      Normalize_Empty_Socket_Set (W_Socket_Set);
+      Normalize_Empty_Socket_Set (E_Socket_Set);
+
+      Res :=
+        C_Select
+         (Last + 1,
+          R_Socket_Set.Set'Access,
+          W_Socket_Set.Set'Access,
+          E_Socket_Set.Set'Access,
+          TPtr);
+
+      if Res = Failure then
+         Raise_Socket_Error (Socket_Errno);
+      end if;
+
+      --  If Select was resumed because of read signalling socket, read this
+      --  data and remove socket from set.
+
+      if RSig /= No_Socket and then Is_Set (R_Socket_Set, RSig) then
+         Clear (R_Socket_Set, RSig);
+
+         Res := Signalling_Fds.Read (C.int (RSig));
+
+         if Res = Failure then
+            Raise_Socket_Error (Socket_Errno);
+         end if;
+
+         Status := Aborted;
+
+      elsif Res = 0 then
+         Status := Expired;
+      end if;
+
+      --  Update socket sets in regard to their new contents
+
+      Narrow (R_Socket_Set);
+      Narrow (W_Socket_Set);
+      Narrow (E_Socket_Set);
+   end Check_Selector;
+
+   -----------
+   -- Clear --
+   -----------
+
+   procedure Clear
+     (Item   : in out Socket_Set_Type;
+      Socket : Socket_Type)
+   is
+      Last : aliased C.int := C.int (Item.Last);
+   begin
+      if Item.Last /= No_Socket then
+         Remove_Socket_From_Set (Item.Set'Access, C.int (Socket));
+         Last_Socket_In_Set (Item.Set'Access, Last'Unchecked_Access);
+         Item.Last := Socket_Type (Last);
+      end if;
+   end Clear;
+
+   --------------------
+   -- Close_Selector --
+   --------------------
+
+   procedure Close_Selector (Selector : in out Selector_Type) is
+   begin
+      --  Nothing to do if selector already in closed state
+
+      if Selector.Is_Null or else not Is_Open (Selector) then
+         return;
+      end if;
+
+      --  Close the signalling file descriptors used internally for the
+      --  implementation of Abort_Selector.
+
+      Signalling_Fds.Close (C.int (Selector.R_Sig_Socket));
+      Signalling_Fds.Close (C.int (Selector.W_Sig_Socket));
+
+      --  Reset R_Sig_Socket and W_Sig_Socket to No_Socket to ensure that any
+      --  (erroneous) subsequent attempt to use this selector properly fails.
+
+      Selector.R_Sig_Socket := No_Socket;
+      Selector.W_Sig_Socket := No_Socket;
+   end Close_Selector;
+
+   ------------------
+   -- Close_Socket --
+   ------------------
+
+   procedure Close_Socket (Socket : Socket_Type) is
+      Res : C.int;
+
+   begin
+      Res := C_Close (C.int (Socket));
+
+      if Res = Failure then
+         Raise_Socket_Error (Socket_Errno);
+      end if;
+   end Close_Socket;
+
+   --------------------
+   -- Connect_Socket --
+   --------------------
+
+   procedure Connect_Socket
+     (Socket : Socket_Type;
+      Server : Sock_Addr_Type)
+   is
+      Res : C.int;
+      Sin : aliased Sockaddr_In;
+      Len : constant C.int := Sin'Size / 8;
+
+   begin
+      if Server.Family = Family_Inet6 then
+         raise Socket_Error with "IPv6 not supported";
+      end if;
+
+      Set_Family  (Sin.Sin_Family, Server.Family);
+      Set_Address (Sin'Unchecked_Access, To_In_Addr (Server.Addr));
+      Set_Port
+        (Sin'Unchecked_Access,
+         Short_To_Network (C.unsigned_short (Server.Port)));
+
+      Res := C_Connect (C.int (Socket), Sin'Address, Len);
+
+      if Res = Failure then
+         Raise_Socket_Error (Socket_Errno);
+      end if;
+   end Connect_Socket;
+
+   --------------------
+   -- Connect_Socket --
+   --------------------
+
+   procedure Connect_Socket
+     (Socket   : Socket_Type;
+      Server   : Sock_Addr_Type;
+      Timeout  : Selector_Duration;
+      Selector : access Selector_Type := null;
+      Status   : out Selector_Status)
+   is
+      Req : Request_Type;
+      --  Used to set Socket to non-blocking I/O
+
+   begin
+      if Selector /= null and then not Is_Open (Selector.all) then
+         raise Program_Error with "closed selector";
+      end if;
+
+      --  Set the socket to non-blocking I/O
+
+      Req := (Name => Non_Blocking_IO, Enabled => True);
+      Control_Socket (Socket, Request => Req);
+
+      --  Start operation (non-blocking), will raise Socket_Error with
+      --  EINPROGRESS.
+
+      begin
+         Connect_Socket (Socket, Server);
+      exception
+         when E : Socket_Error =>
+            if Resolve_Exception (E) = Operation_Now_In_Progress then
+               null;
+            else
+               raise;
+            end if;
+      end;
+
+      --  Wait for socket to become available for writing
+
+      Wait_On_Socket
+        (Socket    => Socket,
+         For_Read  => False,
+         Timeout   => Timeout,
+         Selector  => Selector,
+         Status    => Status);
+
+      --  Reset the socket to blocking I/O
+
+      Req := (Name => Non_Blocking_IO, Enabled => False);
+      Control_Socket (Socket, Request => Req);
+   end Connect_Socket;
+
+   --------------------
+   -- Control_Socket --
+   --------------------
+
+   procedure Control_Socket
+     (Socket  : Socket_Type;
+      Request : in out Request_Type)
+   is
+      Arg : aliased C.int;
+      Res : C.int;
+
+   begin
+      case Request.Name is
+         when Non_Blocking_IO =>
+            Arg := C.int (Boolean'Pos (Request.Enabled));
+
+         when N_Bytes_To_Read =>
+            null;
+      end case;
+
+      Res := Socket_Ioctl
+               (C.int (Socket), Requests (Request.Name), Arg'Unchecked_Access);
+
+      if Res = Failure then
+         Raise_Socket_Error (Socket_Errno);
+      end if;
+
+      case Request.Name is
+         when Non_Blocking_IO =>
+            null;
+
+         when N_Bytes_To_Read =>
+            Request.Size := Natural (Arg);
+      end case;
+   end Control_Socket;
+
+   ----------
+   -- Copy --
+   ----------
+
+   procedure Copy
+     (Source : Socket_Set_Type;
+      Target : out Socket_Set_Type)
+   is
+   begin
+      Target := Source;
+   end Copy;
+
+   ---------------------
+   -- Create_Selector --
+   ---------------------
+
+   procedure Create_Selector (Selector : out Selector_Type) is
+      Two_Fds : aliased Fd_Pair;
+      Res     : C.int;
+
+   begin
+      if Is_Open (Selector) then
+         --  Raise exception to prevent socket descriptor leak
+
+         raise Program_Error with "selector already open";
+      end if;
+
+      --  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.
+
+      Res := Signalling_Fds.Create (Two_Fds'Access);
+
+      if Res = Failure then
+         Raise_Socket_Error (Socket_Errno);
+      end if;
+
+      Selector.R_Sig_Socket := Socket_Type (Two_Fds (Read_End));
+      Selector.W_Sig_Socket := Socket_Type (Two_Fds (Write_End));
+   end Create_Selector;
+
+   -------------------
+   -- Create_Socket --
+   -------------------
+
+   procedure Create_Socket
+     (Socket : out Socket_Type;
+      Family : Family_Type := Family_Inet;
+      Mode   : Mode_Type   := Socket_Stream)
+   is
+      Res : C.int;
+
+   begin
+      Res := C_Socket (Families (Family), Modes (Mode), 0);
+
+      if Res = Failure then
+         Raise_Socket_Error (Socket_Errno);
+      end if;
+
+      Socket := Socket_Type (Res);
+   end Create_Socket;
+
+   -----------
+   -- Empty --
+   -----------
+
+   procedure Empty (Item : out Socket_Set_Type) is
+   begin
+      Reset_Socket_Set (Item.Set'Access);
+      Item.Last := No_Socket;
+   end Empty;
+
+   --------------------
+   -- Err_Code_Image --
+   --------------------
+
+   function Err_Code_Image (E : Integer) return String is
+      Msg : String := E'Img & "] ";
+   begin
+      Msg (Msg'First) := '[';
+      return Msg;
+   end Err_Code_Image;
+
+   --------------
+   -- Finalize --
+   --------------
+
+   procedure Finalize (X : in out Sockets_Library_Controller) is
+      pragma Unreferenced (X);
+
+   begin
+      --  Finalization operation for the GNAT.Sockets package
+
+      Thin.Finalize;
+   end Finalize;
+
+   --------------
+   -- Finalize --
+   --------------
+
+   procedure Finalize is
+   begin
+      --  This is a dummy placeholder for an obsolete API.
+      --  The real finalization actions are in Initialize primitive operation
+      --  of Sockets_Library_Controller.
+
+      null;
+   end Finalize;
+
+   ---------
+   -- Get --
+   ---------
+
+   procedure Get
+     (Item   : in out Socket_Set_Type;
+      Socket : out Socket_Type)
+   is
+      S : aliased C.int;
+      L : aliased C.int := C.int (Item.Last);
+
+   begin
+      if Item.Last /= No_Socket then
+         Get_Socket_From_Set
+           (Item.Set'Access, Last => L'Access, Socket => S'Access);
+         Item.Last := Socket_Type (L);
+         Socket    := Socket_Type (S);
+      else
+         Socket := No_Socket;
+      end if;
+   end Get;
+
+   -----------------
+   -- Get_Address --
+   -----------------
+
+   function Get_Address
+     (Stream : not null Stream_Access) return Sock_Addr_Type
+   is
+   begin
+      if Stream.all in Datagram_Socket_Stream_Type then
+         return Datagram_Socket_Stream_Type (Stream.all).From;
+      else
+         return Get_Peer_Name (Stream_Socket_Stream_Type (Stream.all).Socket);
+      end if;
+   end Get_Address;
+
+   -------------------------
+   -- Get_Host_By_Address --
+   -------------------------
+
+   function Get_Host_By_Address
+     (Address : Inet_Addr_Type;
+      Family  : Family_Type := Family_Inet) return Host_Entry_Type
+   is
+      pragma Unreferenced (Family);
+
+      HA     : aliased In_Addr := To_In_Addr (Address);
+      Buflen : constant C.int := Netdb_Buffer_Size;
+      Buf    : aliased C.char_array (1 .. Netdb_Buffer_Size);
+      Res    : aliased Hostent;
+      Err    : aliased C.int;
+
+   begin
+      Netdb_Lock;
+
+      if C_Gethostbyaddr (HA'Address, HA'Size / 8, SOSC.AF_INET,
+                             Res'Access, Buf'Address, Buflen, Err'Access) /= 0
+      then
+         Netdb_Unlock;
+         Raise_Host_Error (Integer (Err));
+      end if;
+
+      return H : constant Host_Entry_Type :=
+                   To_Host_Entry (Res'Unchecked_Access)
+      do
+         Netdb_Unlock;
+      end return;
+   end Get_Host_By_Address;
+
+   ----------------------
+   -- Get_Host_By_Name --
+   ----------------------
+
+   function Get_Host_By_Name (Name : String) return Host_Entry_Type is
+   begin
+      --  Detect IP address name and redirect to Inet_Addr
+
+      if Is_IP_Address (Name) then
+         return Get_Host_By_Address (Inet_Addr (Name));
+      end if;
+
+      declare
+         HN     : constant C.char_array := C.To_C (Name);
+         Buflen : constant C.int := Netdb_Buffer_Size;
+         Buf    : aliased C.char_array (1 .. Netdb_Buffer_Size);
+         Res    : aliased Hostent;
+         Err    : aliased C.int;
+
+      begin
+         Netdb_Lock;
+
+         if C_Gethostbyname
+           (HN, Res'Access, Buf'Address, Buflen, Err'Access) /= 0
+         then
+            Netdb_Unlock;
+            Raise_Host_Error (Integer (Err));
+         end if;
+
+         return H : constant Host_Entry_Type :=
+                      To_Host_Entry (Res'Unchecked_Access)
+         do
+            Netdb_Unlock;
+         end return;
+      end;
+   end Get_Host_By_Name;
+
+   -------------------
+   -- Get_Peer_Name --
+   -------------------
+
+   function Get_Peer_Name (Socket : Socket_Type) return Sock_Addr_Type is
+      Sin : aliased Sockaddr_In;
+      Len : aliased C.int := Sin'Size / 8;
+      Res : Sock_Addr_Type (Family_Inet);
+
+   begin
+      if C_Getpeername (C.int (Socket), Sin'Address, Len'Access) = Failure then
+         Raise_Socket_Error (Socket_Errno);
+      end if;
+
+      To_Inet_Addr (Sin.Sin_Addr, Res.Addr);
+      Res.Port := Port_Type (Network_To_Short (Sin.Sin_Port));
+
+      return Res;
+   end Get_Peer_Name;
+
+   -------------------------
+   -- Get_Service_By_Name --
+   -------------------------
+
+   function Get_Service_By_Name
+     (Name     : String;
+      Protocol : String) return Service_Entry_Type
+   is
+      SN     : constant C.char_array := C.To_C (Name);
+      SP     : constant C.char_array := C.To_C (Protocol);
+      Buflen : constant C.int := Netdb_Buffer_Size;
+      Buf    : aliased C.char_array (1 .. Netdb_Buffer_Size);
+      Res    : aliased Servent;
+
+   begin
+      Netdb_Lock;
+
+      if C_Getservbyname (SN, SP, Res'Access, Buf'Address, Buflen) /= 0 then
+         Netdb_Unlock;
+         raise Service_Error with "Service not found";
+      end if;
+
+      --  Translate from the C format to the API format
+
+      return S : constant Service_Entry_Type :=
+                   To_Service_Entry (Res'Unchecked_Access)
+      do
+         Netdb_Unlock;
+      end return;
+   end Get_Service_By_Name;
+
+   -------------------------
+   -- Get_Service_By_Port --
+   -------------------------
+
+   function Get_Service_By_Port
+     (Port     : Port_Type;
+      Protocol : String) return Service_Entry_Type
+   is
+      SP     : constant C.char_array := C.To_C (Protocol);
+      Buflen : constant C.int := Netdb_Buffer_Size;
+      Buf    : aliased C.char_array (1 .. Netdb_Buffer_Size);
+      Res    : aliased Servent;
+
+   begin
+      Netdb_Lock;
+
+      if C_Getservbyport
+        (C.int (Short_To_Network (C.unsigned_short (Port))), SP,
+         Res'Access, Buf'Address, Buflen) /= 0
+      then
+         Netdb_Unlock;
+         raise Service_Error with "Service not found";
+      end if;
+
+      --  Translate from the C format to the API format
+
+      return S : constant Service_Entry_Type :=
+                   To_Service_Entry (Res'Unchecked_Access)
+      do
+         Netdb_Unlock;
+      end return;
+   end Get_Service_By_Port;
+
+   ---------------------
+   -- Get_Socket_Name --
+   ---------------------
+
+   function Get_Socket_Name
+     (Socket : Socket_Type) return Sock_Addr_Type
+   is
+      Sin  : aliased Sockaddr_In;
+      Len  : aliased C.int := Sin'Size / 8;
+      Res  : C.int;
+      Addr : Sock_Addr_Type := No_Sock_Addr;
+
+   begin
+      Res := C_Getsockname (C.int (Socket), Sin'Address, Len'Access);
+
+      if Res /= Failure then
+         To_Inet_Addr (Sin.Sin_Addr, Addr.Addr);
+         Addr.Port := Port_Type (Network_To_Short (Sin.Sin_Port));
+      end if;
+
+      return Addr;
+   end Get_Socket_Name;
+
+   -----------------------
+   -- Get_Socket_Option --
+   -----------------------
+
+   function Get_Socket_Option
+     (Socket : Socket_Type;
+      Level  : Level_Type := Socket_Level;
+      Name   : Option_Name) return Option_Type
+   is
+      use type C.unsigned_char;
+
+      V8  : aliased Two_Ints;
+      V4  : aliased C.int;
+      V1  : aliased C.unsigned_char;
+      VT  : aliased Timeval;
+      Len : aliased C.int;
+      Add : System.Address;
+      Res : C.int;
+      Opt : Option_Type (Name);
+
+   begin
+      case Name is
+         when Multicast_Loop      |
+              Multicast_TTL       |
+              Receive_Packet_Info =>
+            Len := V1'Size / 8;
+            Add := V1'Address;
+
+         when Keep_Alive      |
+              Reuse_Address   |
+              Broadcast       |
+              No_Delay        |
+              Send_Buffer     |
+              Receive_Buffer  |
+              Multicast_If    |
+              Error           =>
+            Len := V4'Size / 8;
+            Add := V4'Address;
+
+         when Send_Timeout    |
+              Receive_Timeout =>
+            Len := VT'Size / 8;
+            Add := VT'Address;
+
+         when Linger          |
+              Add_Membership  |
+              Drop_Membership =>
+            Len := V8'Size / 8;
+            Add := V8'Address;
+
+      end case;
+
+      Res :=
+        C_Getsockopt
+          (C.int (Socket),
+           Levels (Level),
+           Options (Name),
+           Add, Len'Access);
+
+      if Res = Failure then
+         Raise_Socket_Error (Socket_Errno);
+      end if;
+
+      case Name is
+         when Keep_Alive      |
+              Reuse_Address   |
+              Broadcast       |
+              No_Delay        =>
+            Opt.Enabled := (V4 /= 0);
+
+         when Linger          =>
+            Opt.Enabled := (V8 (V8'First) /= 0);
+            Opt.Seconds := Natural (V8 (V8'Last));
+
+         when Send_Buffer     |
+              Receive_Buffer  =>
+            Opt.Size := Natural (V4);
+
+         when Error           =>
+            Opt.Error := Resolve_Error (Integer (V4));
+
+         when Add_Membership  |
+              Drop_Membership =>
+            To_Inet_Addr (To_In_Addr (V8 (V8'First)), Opt.Multicast_Address);
+            To_Inet_Addr (To_In_Addr (V8 (V8'Last)), Opt.Local_Interface);
+
+         when Multicast_If    =>
+            To_Inet_Addr (To_In_Addr (V4), Opt.Outgoing_If);
+
+         when Multicast_TTL   =>
+            Opt.Time_To_Live := Integer (V1);
+
+         when Multicast_Loop      |
+              Receive_Packet_Info =>
+            Opt.Enabled := (V1 /= 0);
+
+         when Send_Timeout    |
+              Receive_Timeout =>
+            Opt.Timeout := To_Duration (VT);
+      end case;
+
+      return Opt;
+   end Get_Socket_Option;
+
+   ---------------
+   -- Host_Name --
+   ---------------
+
+   function Host_Name return String is
+      Name : aliased C.char_array (1 .. 64);
+      Res  : C.int;
+
+   begin
+      Res := C_Gethostname (Name'Address, Name'Length);
+
+      if Res = Failure then
+         Raise_Socket_Error (Socket_Errno);
+      end if;
+
+      return C.To_Ada (Name);
+   end Host_Name;
+
+   -----------
+   -- Image --
+   -----------
+
+   function Image
+     (Val : Inet_Addr_VN_Type;
+      Hex : Boolean := False) return String
+   is
+      --  The largest Inet_Addr_Comp_Type image occurs with IPv4. It
+      --  has at most a length of 3 plus one '.' character.
+
+      Buffer    : String (1 .. 4 * Val'Length);
+      Length    : Natural := 1;
+      Separator : Character;
+
+      procedure Img10 (V : Inet_Addr_Comp_Type);
+      --  Append to Buffer image of V in decimal format
+
+      procedure Img16 (V : Inet_Addr_Comp_Type);
+      --  Append to Buffer image of V in hexadecimal format
+
+      -----------
+      -- Img10 --
+      -----------
+
+      procedure Img10 (V : Inet_Addr_Comp_Type) is
+         Img : constant String := V'Img;
+         Len : constant Natural := Img'Length - 1;
+      begin
+         Buffer (Length .. Length + Len - 1) := Img (2 .. Img'Last);
+         Length := Length + Len;
+      end Img10;
+
+      -----------
+      -- Img16 --
+      -----------
+
+      procedure Img16 (V : Inet_Addr_Comp_Type) is
+      begin
+         Buffer (Length)     := Hex_To_Char (Natural (V / 16) + 1);
+         Buffer (Length + 1) := Hex_To_Char (Natural (V mod 16) + 1);
+         Length := Length + 2;
+      end Img16;
+
+   --  Start of processing for Image
+
+   begin
+      Separator := (if Hex then ':' else '.');
+
+      for J in Val'Range loop
+         if Hex then
+            Img16 (Val (J));
+         else
+            Img10 (Val (J));
+         end if;
+
+         if J /= Val'Last then
+            Buffer (Length) := Separator;
+            Length := Length + 1;
+         end if;
+      end loop;
+
+      return Buffer (1 .. Length - 1);
+   end Image;
+
+   -----------
+   -- Image --
+   -----------
+
+   function Image (Value : Inet_Addr_Type) return String is
+   begin
+      if Value.Family = Family_Inet then
+         return Image (Inet_Addr_VN_Type (Value.Sin_V4), Hex => False);
+      else
+         return Image (Inet_Addr_VN_Type (Value.Sin_V6), Hex => True);
+      end if;
+   end Image;
+
+   -----------
+   -- Image --
+   -----------
+
+   function Image (Value : Sock_Addr_Type) return String is
+      Port : constant String := Value.Port'Img;
+   begin
+      return Image (Value.Addr) & ':' & Port (2 .. Port'Last);
+   end Image;
+
+   -----------
+   -- Image --
+   -----------
+
+   function Image (Socket : Socket_Type) return String is
+   begin
+      return Socket'Img;
+   end Image;
+
+   -----------
+   -- Image --
+   -----------
+
+   function Image (Item : Socket_Set_Type) return String is
+      Socket_Set : Socket_Set_Type := Item;
+
+   begin
+      declare
+         Last_Img : constant String := Socket_Set.Last'Img;
+         Buffer   : String
+                      (1 .. (Integer (Socket_Set.Last) + 1) * Last_Img'Length);
+         Index    : Positive := 1;
+         Socket   : Socket_Type;
+
+      begin
+         while not Is_Empty (Socket_Set) loop
+            Get (Socket_Set, Socket);
+
+            declare
+               Socket_Img : constant String := Socket'Img;
+            begin
+               Buffer (Index .. Index + Socket_Img'Length - 1) := Socket_Img;
+               Index := Index + Socket_Img'Length;
+            end;
+         end loop;
+
+         return "[" & Last_Img & "]" & Buffer (1 .. Index - 1);
+      end;
+   end Image;
+
+   ---------------
+   -- Inet_Addr --
+   ---------------
+
+   function Inet_Addr (Image : String) return Inet_Addr_Type is
+      use Interfaces.C;
+      use Interfaces.C.Strings;
+
+      Img    : aliased char_array := To_C (Image);
+      Addr   : aliased C.int;
+      Res    : C.int;
+      Result : Inet_Addr_Type;
+
+   begin
+      --  Special case for an empty Image as on some platforms (e.g. Windows)
+      --  calling Inet_Addr("") will not return an error.
+
+      if Image = "" then
+         Raise_Socket_Error (SOSC.EINVAL);
+      end if;
+
+      Res := Inet_Pton (SOSC.AF_INET, Img'Address, Addr'Address);
+
+      if Res < 0 then
+         Raise_Socket_Error (Socket_Errno);
+
+      elsif Res = 0 then
+         Raise_Socket_Error (SOSC.EINVAL);
+      end if;
+
+      To_Inet_Addr (To_In_Addr (Addr), Result);
+      return Result;
+   end Inet_Addr;
+
+   ----------------
+   -- Initialize --
+   ----------------
+
+   procedure Initialize (X : in out Sockets_Library_Controller) is
+      pragma Unreferenced (X);
+
+   begin
+      Thin.Initialize;
+   end Initialize;
+
+   ----------------
+   -- Initialize --
+   ----------------
+
+   procedure Initialize (Process_Blocking_IO : Boolean) is
+      Expected : constant Boolean := not SOSC.Thread_Blocking_IO;
+
+   begin
+      if Process_Blocking_IO /= Expected then
+         raise Socket_Error with
+           "incorrect Process_Blocking_IO setting, expected " & Expected'Img;
+      end if;
+
+      --  This is a dummy placeholder for an obsolete API
+
+      --  Real initialization actions are in Initialize primitive operation
+      --  of Sockets_Library_Controller.
+
+      null;
+   end Initialize;
+
+   ----------------
+   -- Initialize --
+   ----------------
+
+   procedure Initialize is
+   begin
+      --  This is a dummy placeholder for an obsolete API
+
+      --  Real initialization actions are in Initialize primitive operation
+      --  of Sockets_Library_Controller.
+
+      null;
+   end Initialize;
+
+   --------------
+   -- Is_Empty --
+   --------------
+
+   function Is_Empty (Item : Socket_Set_Type) return Boolean is
+   begin
+      return Item.Last = No_Socket;
+   end Is_Empty;
+
+   -------------------
+   -- Is_IP_Address --
+   -------------------
+
+   function Is_IP_Address (Name : String) return Boolean is
+   begin
+      for J in Name'Range loop
+         if Name (J) /= '.'
+           and then Name (J) not in '0' .. '9'
+         then
+            return False;
+         end if;
+      end loop;
+
+      return True;
+   end Is_IP_Address;
+
+   -------------
+   -- Is_Open --
+   -------------
+
+   function Is_Open (S : Selector_Type) return Boolean is
+   begin
+      if S.Is_Null then
+         return True;
+
+      else
+         --  Either both controlling socket descriptors are valid (case of an
+         --  open selector) or neither (case of a closed selector).
+
+         pragma Assert ((S.R_Sig_Socket /= No_Socket)
+                          =
+                        (S.W_Sig_Socket /= No_Socket));
+
+         return S.R_Sig_Socket /= No_Socket;
+      end if;
+   end Is_Open;
+
+   ------------
+   -- Is_Set --
+   ------------
+
+   function Is_Set
+     (Item   : Socket_Set_Type;
+      Socket : Socket_Type) return Boolean
+   is
+   begin
+      return Item.Last /= No_Socket
+        and then Socket <= Item.Last
+        and then Is_Socket_In_Set (Item.Set'Access, C.int (Socket)) /= 0;
+   end Is_Set;
+
+   -------------------
+   -- Listen_Socket --
+   -------------------
+
+   procedure Listen_Socket
+     (Socket : Socket_Type;
+      Length : Natural := 15)
+   is
+      Res : constant C.int := C_Listen (C.int (Socket), C.int (Length));
+   begin
+      if Res = Failure then
+         Raise_Socket_Error (Socket_Errno);
+      end if;
+   end Listen_Socket;
+
+   ------------
+   -- Narrow --
+   ------------
+
+   procedure Narrow (Item : in out Socket_Set_Type) is
+      Last : aliased C.int := C.int (Item.Last);
+   begin
+      if Item.Last /= No_Socket then
+         Last_Socket_In_Set (Item.Set'Access, Last'Unchecked_Access);
+         Item.Last := Socket_Type (Last);
+      end if;
+   end Narrow;
+
+   ----------------
+   -- Netdb_Lock --
+   ----------------
+
+   procedure Netdb_Lock is
+   begin
+      if Need_Netdb_Lock then
+         System.Task_Lock.Lock;
+      end if;
+   end Netdb_Lock;
+
+   ------------------
+   -- Netdb_Unlock --
+   ------------------
+
+   procedure Netdb_Unlock is
+   begin
+      if Need_Netdb_Lock then
+         System.Task_Lock.Unlock;
+      end if;
+   end Netdb_Unlock;
+
+   --------------------------------
+   -- Normalize_Empty_Socket_Set --
+   --------------------------------
+
+   procedure Normalize_Empty_Socket_Set (S : in out Socket_Set_Type) is
+   begin
+      if S.Last = No_Socket then
+         Reset_Socket_Set (S.Set'Access);
+      end if;
+   end Normalize_Empty_Socket_Set;
+
+   -------------------
+   -- Official_Name --
+   -------------------
+
+   function Official_Name (E : Host_Entry_Type) return String is
+   begin
+      return To_String (E.Official);
+   end Official_Name;
+
+   -------------------
+   -- Official_Name --
+   -------------------
+
+   function Official_Name (S : Service_Entry_Type) return String is
+   begin
+      return To_String (S.Official);
+   end Official_Name;
+
+   --------------------
+   -- Wait_On_Socket --
+   --------------------
+
+   procedure Wait_On_Socket
+     (Socket    : Socket_Type;
+      For_Read  : Boolean;
+      Timeout   : Selector_Duration;
+      Selector  : access Selector_Type := null;
+      Status    : out Selector_Status)
+   is
+      type Local_Selector_Access is access Selector_Type;
+      for Local_Selector_Access'Storage_Size use Selector_Type'Size;
+
+      S : Selector_Access;
+      --  Selector to use for waiting
+
+      R_Fd_Set : Socket_Set_Type;
+      W_Fd_Set : Socket_Set_Type;
+
+   begin
+      --  Create selector if not provided by the user
+
+      if Selector = null then
+         declare
+            Local_S : constant Local_Selector_Access := new Selector_Type;
+         begin
+            S := Local_S.all'Unchecked_Access;
+            Create_Selector (S.all);
+         end;
+
+      else
+         S := Selector.all'Access;
+      end if;
+
+      if For_Read then
+         Set (R_Fd_Set, Socket);
+      else
+         Set (W_Fd_Set, Socket);
+      end if;
+
+      Check_Selector (S.all, R_Fd_Set, W_Fd_Set, Status, Timeout);
+
+      if Selector = null then
+         Close_Selector (S.all);
+      end if;
+   end Wait_On_Socket;
+
+   -----------------
+   -- Port_Number --
+   -----------------
+
+   function Port_Number (S : Service_Entry_Type) return Port_Type is
+   begin
+      return S.Port;
+   end Port_Number;
+
+   -------------------
+   -- Protocol_Name --
+   -------------------
+
+   function Protocol_Name (S : Service_Entry_Type) return String is
+   begin
+      return To_String (S.Protocol);
+   end Protocol_Name;
+
+   ----------------------
+   -- Raise_Host_Error --
+   ----------------------
+
+   procedure Raise_Host_Error (H_Error : Integer) is
+   begin
+      raise Host_Error with
+        Err_Code_Image (H_Error)
+        & C.Strings.Value (Host_Error_Messages.Host_Error_Message (H_Error));
+   end Raise_Host_Error;
+
+   ------------------------
+   -- Raise_Socket_Error --
+   ------------------------
+
+   procedure Raise_Socket_Error (Error : Integer) is
+      use type C.Strings.chars_ptr;
+   begin
+      raise Socket_Error with
+        Err_Code_Image (Error)
+        & C.Strings.Value (Socket_Error_Message (Error));
+   end Raise_Socket_Error;
+
+   ----------
+   -- Read --
+   ----------
+
+   procedure Read
+     (Stream : in out Datagram_Socket_Stream_Type;
+      Item   : out Ada.Streams.Stream_Element_Array;
+      Last   : out Ada.Streams.Stream_Element_Offset)
+   is
+      First : Ada.Streams.Stream_Element_Offset          := Item'First;
+      Index : Ada.Streams.Stream_Element_Offset          := First - 1;
+      Max   : constant Ada.Streams.Stream_Element_Offset := Item'Last;
+
+   begin
+      loop
+         Receive_Socket
+           (Stream.Socket,
+            Item (First .. Max),
+            Index,
+            Stream.From);
+
+         Last := Index;
+
+         --  Exit when all or zero data received. Zero means that the socket
+         --  peer is closed.
+
+         exit when Index < First or else Index = Max;
+
+         First := Index + 1;
+      end loop;
+   end Read;
+
+   ----------
+   -- Read --
+   ----------
+
+   procedure Read
+     (Stream : in out Stream_Socket_Stream_Type;
+      Item   : out Ada.Streams.Stream_Element_Array;
+      Last   : out Ada.Streams.Stream_Element_Offset)
+   is
+      pragma Warnings (Off, Stream);
+
+      First : Ada.Streams.Stream_Element_Offset          := Item'First;
+      Index : Ada.Streams.Stream_Element_Offset          := First - 1;
+      Max   : constant Ada.Streams.Stream_Element_Offset := Item'Last;
+
+   begin
+      loop
+         Receive_Socket (Stream.Socket, Item (First .. Max), Index);
+         Last  := Index;
+
+         --  Exit when all or zero data received. Zero means that the socket
+         --  peer is closed.
+
+         exit when Index < First or else Index = Max;
+
+         First := Index + 1;
+      end loop;
+   end Read;
+
+   --------------------
+   -- Receive_Socket --
+   --------------------
+
+   procedure Receive_Socket
+     (Socket : Socket_Type;
+      Item   : out Ada.Streams.Stream_Element_Array;
+      Last   : out Ada.Streams.Stream_Element_Offset;
+      Flags  : Request_Flag_Type := No_Request_Flag)
+   is
+      Res : C.int;
+
+   begin
+      Res :=
+        C_Recv (C.int (Socket), Item'Address, Item'Length, To_Int (Flags));
+
+      if Res = Failure then
+         Raise_Socket_Error (Socket_Errno);
+      end if;
+
+      Last := Last_Index (First => Item'First, Count => size_t (Res));
+   end Receive_Socket;
+
+   --------------------
+   -- Receive_Socket --
+   --------------------
+
+   procedure Receive_Socket
+     (Socket : Socket_Type;
+      Item   : out Ada.Streams.Stream_Element_Array;
+      Last   : out Ada.Streams.Stream_Element_Offset;
+      From   : out Sock_Addr_Type;
+      Flags  : Request_Flag_Type := No_Request_Flag)
+   is
+      Res : C.int;
+      Sin : aliased Sockaddr_In;
+      Len : aliased C.int := Sin'Size / 8;
+
+   begin
+      Res :=
+        C_Recvfrom
+          (C.int (Socket),
+           Item'Address,
+           Item'Length,
+           To_Int (Flags),
+           Sin'Address,
+           Len'Access);
+
+      if Res = Failure then
+         Raise_Socket_Error (Socket_Errno);
+      end if;
+
+      Last := Last_Index (First => Item'First, Count => size_t (Res));
+
+      To_Inet_Addr (Sin.Sin_Addr, From.Addr);
+      From.Port := Port_Type (Network_To_Short (Sin.Sin_Port));
+   end Receive_Socket;
+
+   --------------------
+   -- Receive_Vector --
+   --------------------
+
+   procedure Receive_Vector
+     (Socket : Socket_Type;
+      Vector : Vector_Type;
+      Count  : out Ada.Streams.Stream_Element_Count;
+      Flags  : Request_Flag_Type := No_Request_Flag)
+   is
+      Res : ssize_t;
+
+      Msg : Msghdr :=
+              (Msg_Name       => System.Null_Address,
+               Msg_Namelen    => 0,
+               Msg_Iov        => Vector'Address,
+
+               --  recvmsg(2) returns EMSGSIZE on Linux (and probably on other
+               --  platforms) when the supplied vector is longer than IOV_MAX,
+               --  so use minimum of the two lengths.
+
+               Msg_Iovlen     => SOSC.Msg_Iovlen_T'Min
+                                   (Vector'Length, SOSC.IOV_MAX),
+
+               Msg_Control    => System.Null_Address,
+               Msg_Controllen => 0,
+               Msg_Flags      => 0);
+
+   begin
+      Res :=
+        C_Recvmsg
+          (C.int (Socket),
+           Msg'Address,
+           To_Int (Flags));
+
+      if Res = ssize_t (Failure) then
+         Raise_Socket_Error (Socket_Errno);
+      end if;
+
+      Count := Ada.Streams.Stream_Element_Count (Res);
+   end Receive_Vector;
+
+   -------------------
+   -- Resolve_Error --
+   -------------------
+
+   function Resolve_Error
+     (Error_Value : Integer;
+      From_Errno  : Boolean := True) return Error_Type
+   is
+      use GNAT.Sockets.SOSC;
+
+   begin
+      if not From_Errno then
+         case Error_Value is
+            when SOSC.HOST_NOT_FOUND => return Unknown_Host;
+            when SOSC.TRY_AGAIN      => return Host_Name_Lookup_Failure;
+            when SOSC.NO_RECOVERY    => return Non_Recoverable_Error;
+            when SOSC.NO_DATA        => return Unknown_Server_Error;
+            when others              => return Cannot_Resolve_Error;
+         end case;
+      end if;
+
+      --  Special case: EAGAIN may be the same value as EWOULDBLOCK, so we
+      --  can't include it in the case statement below.
+
+      pragma Warnings (Off);
+      --  Condition "EAGAIN /= EWOULDBLOCK" is known at compile time
+
+      if EAGAIN /= EWOULDBLOCK and then Error_Value = EAGAIN then
+         return Resource_Temporarily_Unavailable;
+      end if;
+
+      --  This is not a case statement because if a particular error
+      --  number constant is not defined, s-oscons-tmplt.c defines
+      --  it to -1.  If multiple constants are not defined, they
+      --  would each be -1 and result in a "duplicate value in case" error.
+      --
+      --  But we have to leave warnings off because the compiler is also
+      --  smart enough to note that when two errnos have the same value,
+      --  the second if condition is useless.
+      if Error_Value = ENOERROR then
+         return Success;
+      elsif Error_Value = EACCES then
+         return Permission_Denied;
+      elsif Error_Value = EADDRINUSE then
+         return Address_Already_In_Use;
+      elsif Error_Value = EADDRNOTAVAIL then
+         return Cannot_Assign_Requested_Address;
+      elsif Error_Value = EAFNOSUPPORT then
+         return Address_Family_Not_Supported_By_Protocol;
+      elsif Error_Value = EALREADY then
+         return Operation_Already_In_Progress;
+      elsif Error_Value = EBADF then
+         return Bad_File_Descriptor;
+      elsif Error_Value = ECONNABORTED then
+         return Software_Caused_Connection_Abort;
+      elsif Error_Value = ECONNREFUSED then
+         return Connection_Refused;
+      elsif Error_Value = ECONNRESET then
+         return Connection_Reset_By_Peer;
+      elsif Error_Value = EDESTADDRREQ then
+         return Destination_Address_Required;
+      elsif Error_Value = EFAULT then
+         return Bad_Address;
+      elsif Error_Value = EHOSTDOWN then
+         return Host_Is_Down;
+      elsif Error_Value = EHOSTUNREACH then
+         return No_Route_To_Host;
+      elsif Error_Value = EINPROGRESS then
+         return Operation_Now_In_Progress;
+      elsif Error_Value = EINTR then
+         return Interrupted_System_Call;
+      elsif Error_Value = EINVAL then
+         return Invalid_Argument;
+      elsif Error_Value = EIO then
+         return Input_Output_Error;
+      elsif Error_Value = EISCONN then
+         return Transport_Endpoint_Already_Connected;
+      elsif Error_Value = ELOOP then
+         return Too_Many_Symbolic_Links;
+      elsif Error_Value = EMFILE then
+         return Too_Many_Open_Files;
+      elsif Error_Value = EMSGSIZE then
+         return Message_Too_Long;
+      elsif Error_Value = ENAMETOOLONG then
+         return File_Name_Too_Long;
+      elsif Error_Value = ENETDOWN then
+         return Network_Is_Down;
+      elsif Error_Value = ENETRESET then
+         return Network_Dropped_Connection_Because_Of_Reset;
+      elsif Error_Value = ENETUNREACH then
+         return Network_Is_Unreachable;
+      elsif Error_Value = ENOBUFS then
+         return No_Buffer_Space_Available;
+      elsif Error_Value = ENOPROTOOPT then
+         return Protocol_Not_Available;
+      elsif Error_Value = ENOTCONN then
+         return Transport_Endpoint_Not_Connected;
+      elsif Error_Value = ENOTSOCK then
+         return Socket_Operation_On_Non_Socket;
+      elsif Error_Value = EOPNOTSUPP then
+         return Operation_Not_Supported;
+      elsif Error_Value = EPFNOSUPPORT then
+         return Protocol_Family_Not_Supported;
+      elsif Error_Value = EPIPE then
+         return Broken_Pipe;
+      elsif Error_Value = EPROTONOSUPPORT then
+         return Protocol_Not_Supported;
+      elsif Error_Value = EPROTOTYPE then
+         return Protocol_Wrong_Type_For_Socket;
+      elsif Error_Value = ESHUTDOWN then
+         return Cannot_Send_After_Transport_Endpoint_Shutdown;
+      elsif Error_Value = ESOCKTNOSUPPORT then
+         return Socket_Type_Not_Supported;
+      elsif Error_Value = ETIMEDOUT then
+         return Connection_Timed_Out;
+      elsif Error_Value = ETOOMANYREFS then
+         return Too_Many_References;
+      elsif Error_Value = EWOULDBLOCK then
+         return Resource_Temporarily_Unavailable;
+      else
+         return Cannot_Resolve_Error;
+      end if;
+      pragma Warnings (On);
+
+   end Resolve_Error;
+
+   -----------------------
+   -- Resolve_Exception --
+   -----------------------
+
+   function Resolve_Exception
+     (Occurrence : Exception_Occurrence) return Error_Type
+   is
+      Id    : constant Exception_Id := Exception_Identity (Occurrence);
+      Msg   : constant String       := Exception_Message (Occurrence);
+      First : Natural;
+      Last  : Natural;
+      Val   : Integer;
+
+   begin
+      First := Msg'First;
+      while First <= Msg'Last
+        and then Msg (First) not in '0' .. '9'
+      loop
+         First := First + 1;
+      end loop;
+
+      if First > Msg'Last then
+         return Cannot_Resolve_Error;
+      end if;
+
+      Last := First;
+      while Last < Msg'Last
+        and then Msg (Last + 1) in '0' .. '9'
+      loop
+         Last := Last + 1;
+      end loop;
+
+      Val := Integer'Value (Msg (First .. Last));
+
+      if Id = Socket_Error_Id then
+         return Resolve_Error (Val);
+
+      elsif Id = Host_Error_Id then
+         return Resolve_Error (Val, False);
+
+      else
+         return Cannot_Resolve_Error;
+      end if;
+   end Resolve_Exception;
+
+   -----------------
+   -- Send_Socket --
+   -----------------
+
+   procedure Send_Socket
+     (Socket : Socket_Type;
+      Item   : Ada.Streams.Stream_Element_Array;
+      Last   : out Ada.Streams.Stream_Element_Offset;
+      Flags  : Request_Flag_Type := No_Request_Flag)
+   is
+   begin
+      Send_Socket (Socket, Item, Last, To => null, Flags => Flags);
+   end Send_Socket;
+
+   -----------------
+   -- Send_Socket --
+   -----------------
+
+   procedure Send_Socket
+     (Socket : Socket_Type;
+      Item   : Ada.Streams.Stream_Element_Array;
+      Last   : out Ada.Streams.Stream_Element_Offset;
+      To     : Sock_Addr_Type;
+      Flags  : Request_Flag_Type := No_Request_Flag)
+   is
+   begin
+      Send_Socket
+        (Socket, Item, Last, To => To'Unrestricted_Access, Flags => Flags);
+   end Send_Socket;
+
+   -----------------
+   -- Send_Socket --
+   -----------------
+
+   procedure Send_Socket
+     (Socket : Socket_Type;
+      Item   : Ada.Streams.Stream_Element_Array;
+      Last   : out Ada.Streams.Stream_Element_Offset;
+      To     : access Sock_Addr_Type;
+      Flags  : Request_Flag_Type := No_Request_Flag)
+   is
+      Res  : C.int;
+
+      Sin  : aliased Sockaddr_In;
+      C_To : System.Address;
+      Len  : C.int;
+
+   begin
+      if To /= null then
+         Set_Family  (Sin.Sin_Family, To.Family);
+         Set_Address (Sin'Unchecked_Access, To_In_Addr (To.Addr));
+         Set_Port
+           (Sin'Unchecked_Access,
+            Short_To_Network (C.unsigned_short (To.Port)));
+         C_To := Sin'Address;
+         Len := Sin'Size / 8;
+
+      else
+         C_To := System.Null_Address;
+         Len := 0;
+      end if;
+
+      Res := C_Sendto
+        (C.int (Socket),
+         Item'Address,
+         Item'Length,
+         Set_Forced_Flags (To_Int (Flags)),
+         C_To,
+         Len);
+
+      if Res = Failure then
+         Raise_Socket_Error (Socket_Errno);
+      end if;
+
+      Last := Last_Index (First => Item'First, Count => size_t (Res));
+   end Send_Socket;
+
+   -----------------
+   -- Send_Vector --
+   -----------------
+
+   procedure Send_Vector
+     (Socket : Socket_Type;
+      Vector : Vector_Type;
+      Count  : out Ada.Streams.Stream_Element_Count;
+      Flags  : Request_Flag_Type := No_Request_Flag)
+   is
+      use SOSC;
+      use Interfaces.C;
+
+      Res            : ssize_t;
+      Iov_Count      : SOSC.Msg_Iovlen_T;
+      This_Iov_Count : SOSC.Msg_Iovlen_T;
+      Msg            : Msghdr;
+
+   begin
+      Count := 0;
+      Iov_Count := 0;
+      while Iov_Count < Vector'Length loop
+
+         pragma Warnings (Off);
+         --  Following test may be compile time known on some targets
+
+         This_Iov_Count :=
+           (if Vector'Length - Iov_Count > SOSC.IOV_MAX
+            then SOSC.IOV_MAX
+            else Vector'Length - Iov_Count);
+
+         pragma Warnings (On);
+
+         Msg :=
+           (Msg_Name       => System.Null_Address,
+            Msg_Namelen    => 0,
+            Msg_Iov        => Vector
+                                (Vector'First + Integer (Iov_Count))'Address,
+            Msg_Iovlen     => This_Iov_Count,
+            Msg_Control    => System.Null_Address,
+            Msg_Controllen => 0,
+            Msg_Flags      => 0);
+
+         Res :=
+           C_Sendmsg
+             (C.int (Socket),
+              Msg'Address,
+              Set_Forced_Flags (To_Int (Flags)));
+
+         if Res = ssize_t (Failure) then
+            Raise_Socket_Error (Socket_Errno);
+         end if;
+
+         Count := Count + Ada.Streams.Stream_Element_Count (Res);
+         Iov_Count := Iov_Count + This_Iov_Count;
+      end loop;
+   end Send_Vector;
+
+   ---------
+   -- Set --
+   ---------
+
+   procedure Set (Item : in out Socket_Set_Type; Socket : Socket_Type) is
+   begin
+      if Item.Last = No_Socket then
+
+         --  Uninitialized socket set, make sure it is properly zeroed out
+
+         Reset_Socket_Set (Item.Set'Access);
+         Item.Last := Socket;
+
+      elsif Item.Last < Socket then
+         Item.Last := Socket;
+      end if;
+
+      Insert_Socket_In_Set (Item.Set'Access, C.int (Socket));
+   end Set;
+
+   ----------------------
+   -- Set_Forced_Flags --
+   ----------------------
+
+   function Set_Forced_Flags (F : C.int) return C.int is
+      use type C.unsigned;
+      function To_unsigned is
+        new Ada.Unchecked_Conversion (C.int, C.unsigned);
+      function To_int is
+        new Ada.Unchecked_Conversion (C.unsigned, C.int);
+   begin
+      return To_int (To_unsigned (F) or SOSC.MSG_Forced_Flags);
+   end Set_Forced_Flags;
+
+   -----------------------
+   -- Set_Socket_Option --
+   -----------------------
+
+   procedure Set_Socket_Option
+     (Socket : Socket_Type;
+      Level  : Level_Type := Socket_Level;
+      Option : Option_Type)
+   is
+      V8  : aliased Two_Ints;
+      V4  : aliased C.int;
+      V1  : aliased C.unsigned_char;
+      VT  : aliased Timeval;
+      Len : C.int;
+      Add : System.Address := Null_Address;
+      Res : C.int;
+
+   begin
+      case Option.Name is
+         when Keep_Alive      |
+              Reuse_Address   |
+              Broadcast       |
+              No_Delay        =>
+            V4  := C.int (Boolean'Pos (Option.Enabled));
+            Len := V4'Size / 8;
+            Add := V4'Address;
+
+         when Linger          =>
+            V8 (V8'First) := C.int (Boolean'Pos (Option.Enabled));
+            V8 (V8'Last)  := C.int (Option.Seconds);
+            Len := V8'Size / 8;
+            Add := V8'Address;
+
+         when Send_Buffer     |
+              Receive_Buffer  =>
+            V4  := C.int (Option.Size);
+            Len := V4'Size / 8;
+            Add := V4'Address;
+
+         when Error           =>
+            V4  := C.int (Boolean'Pos (True));
+            Len := V4'Size / 8;
+            Add := V4'Address;
+
+         when Add_Membership  |
+              Drop_Membership =>
+            V8 (V8'First) := To_Int (To_In_Addr (Option.Multicast_Address));
+            V8 (V8'Last)  := To_Int (To_In_Addr (Option.Local_Interface));
+            Len := V8'Size / 8;
+            Add := V8'Address;
+
+         when Multicast_If    =>
+            V4  := To_Int (To_In_Addr (Option.Outgoing_If));
+            Len := V4'Size / 8;
+            Add := V4'Address;
+
+         when Multicast_TTL   =>
+            V1  := C.unsigned_char (Option.Time_To_Live);
+            Len := V1'Size / 8;
+            Add := V1'Address;
+
+         when Multicast_Loop      |
+              Receive_Packet_Info =>
+            V1  := C.unsigned_char (Boolean'Pos (Option.Enabled));
+            Len := V1'Size / 8;
+            Add := V1'Address;
+
+         when Send_Timeout    |
+              Receive_Timeout =>
+            VT  := To_Timeval (Option.Timeout);
+            Len := VT'Size / 8;
+            Add := VT'Address;
+
+      end case;
+
+      Res := C_Setsockopt
+        (C.int (Socket),
+         Levels (Level),
+         Options (Option.Name),
+         Add, Len);
+
+      if Res = Failure then
+         Raise_Socket_Error (Socket_Errno);
+      end if;
+   end Set_Socket_Option;
+
+   ----------------------
+   -- Short_To_Network --
+   ----------------------
+
+   function Short_To_Network (S : C.unsigned_short) return C.unsigned_short is
+      use type C.unsigned_short;
+
+   begin
+      --  Big-endian case. No conversion needed. On these platforms,
+      --  htons() defaults to a null procedure.
+
+      pragma Warnings (Off);
+      --  Since the test can generate "always True/False" warning
+
+      if Default_Bit_Order = High_Order_First then
+         return S;
+
+         pragma Warnings (On);
+
+      --  Little-endian case. We must swap the high and low bytes of this
+      --  short to make the port number network compliant.
+
+      else
+         return (S / 256) + (S mod 256) * 256;
+      end if;
+   end Short_To_Network;
+
+   ---------------------
+   -- Shutdown_Socket --
+   ---------------------
+
+   procedure Shutdown_Socket
+     (Socket : Socket_Type;
+      How    : Shutmode_Type := Shut_Read_Write)
+   is
+      Res : C.int;
+
+   begin
+      Res := C_Shutdown (C.int (Socket), Shutmodes (How));
+
+      if Res = Failure then
+         Raise_Socket_Error (Socket_Errno);
+      end if;
+   end Shutdown_Socket;
+
+   ------------
+   -- Stream --
+   ------------
+
+   function Stream
+     (Socket  : Socket_Type;
+      Send_To : Sock_Addr_Type) return Stream_Access
+   is
+      S : Datagram_Socket_Stream_Access;
+
+   begin
+      S        := new Datagram_Socket_Stream_Type;
+      S.Socket := Socket;
+      S.To     := Send_To;
+      S.From   := Get_Socket_Name (Socket);
+      return Stream_Access (S);
+   end Stream;
+
+   ------------
+   -- Stream --
+   ------------
+
+   function Stream (Socket : Socket_Type) return Stream_Access is
+      S : Stream_Socket_Stream_Access;
+   begin
+      S := new Stream_Socket_Stream_Type;
+      S.Socket := Socket;
+      return Stream_Access (S);
+   end Stream;
+
+   ------------------
+   -- Stream_Write --
+   ------------------
+
+   procedure Stream_Write
+     (Socket : Socket_Type;
+      Item   : Ada.Streams.Stream_Element_Array;
+      To     : access Sock_Addr_Type)
+   is
+      First : Ada.Streams.Stream_Element_Offset;
+      Index : Ada.Streams.Stream_Element_Offset;
+      Max   : constant Ada.Streams.Stream_Element_Offset := Item'Last;
+
+   begin
+      First := Item'First;
+      Index := First - 1;
+      while First <= Max loop
+         Send_Socket (Socket, Item (First .. Max), Index, To);
+
+         --  Exit when all or zero data sent. Zero means that the socket has
+         --  been closed by peer.
+
+         exit when Index < First or else Index = Max;
+
+         First := Index + 1;
+      end loop;
+
+      --  For an empty array, we have First > Max, and hence Index >= Max (no
+      --  error, the loop above is never executed). After a successful send,
+      --  Index = Max. The only remaining case, Index < Max, is therefore
+      --  always an actual send failure.
+
+      if Index < Max then
+         Raise_Socket_Error (Socket_Errno);
+      end if;
+   end Stream_Write;
+
+   ----------
+   -- To_C --
+   ----------
+
+   function To_C (Socket : Socket_Type) return Integer is
+   begin
+      return Integer (Socket);
+   end To_C;
+
+   -----------------
+   -- To_Duration --
+   -----------------
+
+   function To_Duration (Val : Timeval) return Timeval_Duration is
+   begin
+      return Natural (Val.Tv_Sec) * 1.0 + Natural (Val.Tv_Usec) * 1.0E-6;
+   end To_Duration;
+
+   -------------------
+   -- To_Host_Entry --
+   -------------------
+
+   function To_Host_Entry (E : Hostent_Access) return Host_Entry_Type is
+      use type C.size_t;
+      use C.Strings;
+
+      Aliases_Count, Addresses_Count : Natural;
+
+      --  H_Length is not used because it is currently only set to 4
+      --  H_Addrtype is always AF_INET
+
+   begin
+      Aliases_Count := 0;
+      while Hostent_H_Alias (E, C.int (Aliases_Count)) /= Null_Address loop
+         Aliases_Count := Aliases_Count + 1;
+      end loop;
+
+      Addresses_Count := 0;
+      while Hostent_H_Addr (E, C.int (Addresses_Count)) /= Null_Address loop
+         Addresses_Count := Addresses_Count + 1;
+      end loop;
+
+      return Result : Host_Entry_Type
+                        (Aliases_Length   => Aliases_Count,
+                         Addresses_Length => Addresses_Count)
+      do
+         Result.Official := To_Name (Value (Hostent_H_Name (E)));
+
+         for J in Result.Aliases'Range loop
+            Result.Aliases (J) :=
+              To_Name (Value (Hostent_H_Alias
+                                (E, C.int (J - Result.Aliases'First))));
+         end loop;
+
+         for J in Result.Addresses'Range loop
+            declare
+               Addr : In_Addr;
+               for Addr'Address use
+                 Hostent_H_Addr (E, C.int (J - Result.Addresses'First));
+               pragma Import (Ada, Addr);
+            begin
+               To_Inet_Addr (Addr, Result.Addresses (J));
+            end;
+         end loop;
+      end return;
+   end To_Host_Entry;
+
+   ----------------
+   -- To_In_Addr --
+   ----------------
+
+   function To_In_Addr (Addr : Inet_Addr_Type) return In_Addr is
+   begin
+      if Addr.Family = Family_Inet then
+         return (S_B1 => C.unsigned_char (Addr.Sin_V4 (1)),
+                 S_B2 => C.unsigned_char (Addr.Sin_V4 (2)),
+                 S_B3 => C.unsigned_char (Addr.Sin_V4 (3)),
+                 S_B4 => C.unsigned_char (Addr.Sin_V4 (4)));
+      end if;
+
+      raise Socket_Error with "IPv6 not supported";
+   end To_In_Addr;
+
+   ------------------
+   -- To_Inet_Addr --
+   ------------------
+
+   procedure To_Inet_Addr
+     (Addr   : In_Addr;
+      Result : out Inet_Addr_Type) is
+   begin
+      Result.Sin_V4 (1) := Inet_Addr_Comp_Type (Addr.S_B1);
+      Result.Sin_V4 (2) := Inet_Addr_Comp_Type (Addr.S_B2);
+      Result.Sin_V4 (3) := Inet_Addr_Comp_Type (Addr.S_B3);
+      Result.Sin_V4 (4) := Inet_Addr_Comp_Type (Addr.S_B4);
+   end To_Inet_Addr;
+
+   ------------
+   -- To_Int --
+   ------------
+
+   function To_Int (F : Request_Flag_Type) return C.int
+   is
+      Current : Request_Flag_Type := F;
+      Result  : C.int := 0;
+
+   begin
+      for J in Flags'Range loop
+         exit when Current = 0;
+
+         if Current mod 2 /= 0 then
+            if Flags (J) = -1 then
+               Raise_Socket_Error (SOSC.EOPNOTSUPP);
+            end if;
+
+            Result := Result + Flags (J);
+         end if;
+
+         Current := Current / 2;
+      end loop;
+
+      return Result;
+   end To_Int;
+
+   -------------
+   -- To_Name --
+   -------------
+
+   function To_Name (N : String) return Name_Type is
+   begin
+      return Name_Type'(N'Length, N);
+   end To_Name;
+
+   ----------------------
+   -- To_Service_Entry --
+   ----------------------
+
+   function To_Service_Entry (E : Servent_Access) return Service_Entry_Type is
+      use C.Strings;
+      use type C.size_t;
+
+      Aliases_Count : Natural;
+
+   begin
+      Aliases_Count := 0;
+      while Servent_S_Alias (E, C.int (Aliases_Count)) /= Null_Address loop
+         Aliases_Count := Aliases_Count + 1;
+      end loop;
+
+      return Result : Service_Entry_Type (Aliases_Length   => Aliases_Count) do
+         Result.Official := To_Name (Value (Servent_S_Name (E)));
+
+         for J in Result.Aliases'Range loop
+            Result.Aliases (J) :=
+              To_Name (Value (Servent_S_Alias
+                                (E, C.int (J - Result.Aliases'First))));
+         end loop;
+
+         Result.Protocol := To_Name (Value (Servent_S_Proto (E)));
+         Result.Port :=
+           Port_Type (Network_To_Short (Servent_S_Port (E)));
+      end return;
+   end To_Service_Entry;
+
+   ---------------
+   -- To_String --
+   ---------------
+
+   function To_String (HN : Name_Type) return String is
+   begin
+      return HN.Name (1 .. HN.Length);
+   end To_String;
+
+   ----------------
+   -- To_Timeval --
+   ----------------
+
+   function To_Timeval (Val : Timeval_Duration) return Timeval is
+      S  : time_t;
+      uS : suseconds_t;
+
+   begin
+      --  If zero, set result as zero (otherwise it gets rounded down to -1)
+
+      if Val = 0.0 then
+         S  := 0;
+         uS := 0;
+
+      --  Normal case where we do round down
+
+      else
+         S  := time_t (Val - 0.5);
+         uS := suseconds_t (1_000_000 * (Val - Selector_Duration (S)));
+      end if;
+
+      return (S, uS);
+   end To_Timeval;
+
+   -----------
+   -- Value --
+   -----------
+
+   function Value (S : System.Address) return String is
+      Str : String (1 .. Positive'Last);
+      for Str'Address use S;
+      pragma Import (Ada, Str);
+
+      Terminator : Positive := Str'First;
+
+   begin
+      while Str (Terminator) /= ASCII.NUL loop
+         Terminator := Terminator + 1;
+      end loop;
+
+      return Str (1 .. Terminator - 1);
+   end Value;
+
+   -----------
+   -- Write --
+   -----------
+
+   procedure Write
+     (Stream : in out Datagram_Socket_Stream_Type;
+      Item   : Ada.Streams.Stream_Element_Array)
+   is
+   begin
+      Stream_Write (Stream.Socket, Item, To => Stream.To'Unrestricted_Access);
+   end Write;
+
+   -----------
+   -- Write --
+   -----------
+
+   procedure Write
+     (Stream : in out Stream_Socket_Stream_Type;
+      Item   : Ada.Streams.Stream_Element_Array)
+   is
+   begin
+      Stream_Write (Stream.Socket, Item, To => null);
+   end Write;
+
+   Sockets_Library_Controller_Object : Sockets_Library_Controller;
+   pragma Unreferenced (Sockets_Library_Controller_Object);
+   --  The elaboration and finalization of this object perform the required
+   --  initialization and cleanup actions for the sockets library.
+
+end GNAT.Sockets;