g-soccon.ads: Add new constant Thread_Blocking_IO...

2007-04-20  Thomas Quinot  <quinot@adacore.com>

	* g-soccon.ads: Add new constant Thread_Blocking_IO, always True by
	default, set False on a per-runtime basis.
	(Need_Netdb_Buffer): New constant.

	* g-socket.ads, g-socket.adb: Import new package
	GNAT.Sockets.Thin.Task_Safe_NetDB.
	(Raise_Host_Error): Use Host_Error_Message from platform-specific thin
	binding to obtain proper message.
	(Close_Selector): Use GNAT.Sockets.Thin.Signalling_Fds.Close.
	Replace various occurrences of Arry (Arry'First)'Address with the
	equivalent Arry'Address (GNAT always follows implementation advice from
	13.3(14)).
	(Get_Host_By_Address, Get_Host_By_Name,
	Get_Service_By_Name, Get_Service_By_Port): Do not use GNAT.Task_Lock;
	instead, rely on platform-specific task safe netdb operations provided
	by g-socthi.

	* g-socthi.ads, g-socthi.adb (Initialize): Remove obsolete formal
	parameter Process_Blocking_IO.
	(Host_Error_Messages): Add stub body.
	(GNAT.Sockets.Thin.Signalling_Fds): New procedure Close.
	(Safe_Gethostbyname, Safe_Gethostbyaddr, Safe_Getservbyname,
	Safe_Getservbyport): Move functions into new child package
	Task_Safe_NetDB.
	(Nonreentrant_Gethostbyname, Nonreentrant_Gethostbyaddr,
	Nonreentrant_Getservbyname, Nonreentrant_Getservbyport): New routines.
	(In_Addr): Add alignment clause.

From-SVN: r125424

gcc/ada/g-soccon.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2000-2005, Free Software Foundation, Inc.         --
+--          Copyright (C) 2000-2007, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -43,6 +43,9 @@
 --  but are for illustration purposes only. As noted above, part of a port
 --  to a new target is to replace this file appropriately.
 
+--  This file is generated automatically, do not modify it by hand! Instead,
+--  make changes to gen-soccon.c and re-run it on each target.
+
 package GNAT.Sockets.Constants is
 
    --------------
@@ -182,4 +185,17 @@ package GNAT.Sockets.Constants is
    SIZEOF_tv_sec      : constant :=            4; --  tv_sec
    SIZEOF_tv_usec     : constant :=            4; --  tv_usec
 
+   ----------------------------------------
+   -- Properties of supported interfaces --
+   ----------------------------------------
+
+   Need_Netdb_Buffer  : constant :=            1; --  Need buffer for Netdb ops
+
+   ----------------------
+   -- Additional flags --
+   ----------------------
+
+   Thread_Blocking_IO : constant Boolean := True;
+   --  Set False for contexts where socket i/o are process blocking
+
 end GNAT.Sockets.Constants;

gcc/ada/g-socket.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---                     Copyright (C) 2001-2006, AdaCore                     --
+--                     Copyright (C) 2001-2007, 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- --
@@ -36,10 +36,9 @@ with Ada.Exceptions;             use Ada.Exceptions;
 with Ada.Unchecked_Conversion;
 
 with Interfaces.C.Strings;
-
 with GNAT.Sockets.Constants;
 with GNAT.Sockets.Thin;                 use GNAT.Sockets.Thin;
-with GNAT.Task_Lock;
+with GNAT.Sockets.Thin.Task_Safe_NetDB; use GNAT.Sockets.Thin.Task_Safe_NetDB;
 
 with GNAT.Sockets.Linker_Options;
 pragma Warnings (Off, GNAT.Sockets.Linker_Options);
@@ -56,6 +55,12 @@ package body GNAT.Sockets is
 
    ENOERROR : constant := 0;
 
+   Netdb_Buffer_Size : constant := Constants.Need_Netdb_Buffer * 1024;
+   --  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.
+
    --  Correspondance tables
 
    Families : constant array (Family_Type) of C.int :=
@@ -497,7 +502,6 @@ package body GNAT.Sockets is
          E_Socket_Set := ESet;
 
       exception
-
          when Socket_Error =>
 
             --  The local socket sets must be emptied before propagating
@@ -533,27 +537,11 @@ package body GNAT.Sockets is
 
    procedure Close_Selector (Selector : in out Selector_Type) is
    begin
+      --  Close the signalling file descriptors used internally for the
+      --  implementation of Abort_Selector.
 
-      --  Close the signalling sockets used internally for the implementation
-      --  of Abort_Selector. Exceptions are ignored because these sockets
-      --  are implementation artefacts of no interest to the user, and
-      --  there is little that can be done if either Close_Socket call fails
-      --  (which theoretically should not happen anyway). We also want to try
-      --  to perform the second Close_Socket even if the first one failed.
-
-      begin
-         Close_Socket (Selector.R_Sig_Socket);
-      exception
-         when Socket_Error =>
-            null;
-      end;
-
-      begin
-         Close_Socket (Selector.W_Sig_Socket);
-      exception
-         when Socket_Error =>
-            null;
-      end;
+      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
       --  (errneous) subsequent attempt to use this selector properly fails.
@@ -626,7 +614,6 @@ package body GNAT.Sockets is
 
          when N_Bytes_To_Read =>
             null;
-
       end case;
 
       Res := C_Ioctl
@@ -795,31 +782,19 @@ package body GNAT.Sockets is
       pragma Unreferenced (Family);
 
       HA     : aliased In_Addr := To_In_Addr (Address);
-      Res : Hostent_Access;
-      Err : Integer;
+      Buflen : constant C.int := Netdb_Buffer_Size;
+      Buf    : aliased C.char_array (1 .. Netdb_Buffer_Size);
+      Res    : aliased Hostent;
+      Err    : aliased C.int;
 
    begin
-      --  This C function is not always thread-safe. Protect against
-      --  concurrent access.
-
-      Task_Lock.Lock;
-      Res := C_Gethostbyaddr (HA'Address, HA'Size / 8, Constants.AF_INET);
-
-      if Res = null then
-         Err := Host_Errno;
-         Task_Lock.Unlock;
-         Raise_Host_Error (Err);
+      if Safe_Gethostbyaddr (HA'Address, HA'Size / 8, Constants.AF_INET,
+                             Res'Access, Buf'Address, Buflen, Err'Access) /= 0
+      then
+         Raise_Host_Error (Integer (Err));
       end if;
 
-      --  Translate from the C format to the API format
-
-      declare
-         HE : constant Host_Entry_Type := To_Host_Entry (Res.all);
-
-      begin
-         Task_Lock.Unlock;
-         return HE;
-      end;
+      return To_Host_Entry (Res);
    end Get_Host_By_Address;
 
    ----------------------
@@ -827,10 +802,6 @@ package body GNAT.Sockets is
    ----------------------
 
    function Get_Host_By_Name (Name : String) return Host_Entry_Type is
-      HN  : constant C.char_array := C.To_C (Name);
-      Res : Hostent_Access;
-      Err : Integer;
-
    begin
       --  Detect IP address name and redirect to Inet_Addr
 
@@ -838,25 +809,21 @@ package body GNAT.Sockets is
          return Get_Host_By_Address (Inet_Addr (Name));
       end if;
 
-      --  This C function is not always thread-safe. Protect against
-      --  concurrent access.
-
-      Task_Lock.Lock;
-      Res := C_Gethostbyname (HN);
+      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;
 
-      if Res = null then
-         Err := Host_Errno;
-         Task_Lock.Unlock;
-         Raise_Host_Error (Err);
+      begin
+         if Safe_Gethostbyname
+           (HN, Res'Access, Buf'Address, Buflen, Err'Access) /= 0
+         then
+            Raise_Host_Error (Integer (Err));
          end if;
 
-      --  Translate from the C format to the API format
-
-      declare
-         HE : constant Host_Entry_Type := To_Host_Entry (Res.all);
-      begin
-         Task_Lock.Unlock;
-         return HE;
+         return To_Host_Entry (Res);
       end;
    end Get_Host_By_Name;
 
@@ -890,30 +857,19 @@ package body GNAT.Sockets is
    is
       SN     : constant C.char_array := C.To_C (Name);
       SP     : constant C.char_array := C.To_C (Protocol);
-      Res : Servent_Access;
+      Buflen : constant C.int := Netdb_Buffer_Size;
+      Buf    : aliased C.char_array (1 .. Netdb_Buffer_Size);
+      Res    : aliased Servent;
 
    begin
-      --  This C function is not always thread-safe. Protect against
-      --  concurrent access.
-
-      Task_Lock.Lock;
-      Res := C_Getservbyname (SN, SP);
-
-      if Res = null then
-         Task_Lock.Unlock;
+      if Safe_Getservbyname (SN, SP, Res'Access, Buf'Address, Buflen) /= 0 then
          Ada.Exceptions.Raise_Exception
            (Service_Error'Identity, "Service not found");
       end if;
 
       --  Translate from the C format to the API format
 
-      declare
-         SE : constant Service_Entry_Type := To_Service_Entry (Res.all);
-
-      begin
-         Task_Lock.Unlock;
-         return SE;
-      end;
+      return To_Service_Entry (Res);
    end Get_Service_By_Name;
 
    -------------------------
@@ -925,31 +881,22 @@ package body GNAT.Sockets is
       Protocol : String) return Service_Entry_Type
    is
       SP     : constant C.char_array := C.To_C (Protocol);
-      Res : Servent_Access;
+      Buflen : constant C.int := Netdb_Buffer_Size;
+      Buf    : aliased C.char_array (1 .. Netdb_Buffer_Size);
+      Res    : aliased Servent;
 
    begin
-      --  This C function is not always thread-safe. Protect against
-      --  concurrent access.
-
-      Task_Lock.Lock;
-      Res := C_Getservbyport
-        (C.int (Short_To_Network (C.unsigned_short (Port))), SP);
-
-      if Res = null then
-         Task_Lock.Unlock;
+      if Safe_Getservbyport
+        (C.int (Short_To_Network (C.unsigned_short (Port))), SP,
+         Res'Access, Buf'Address, Buflen) /= 0
+      then
          Ada.Exceptions.Raise_Exception
            (Service_Error'Identity, "Service not found");
       end if;
 
       --  Translate from the C format to the API format
 
-      declare
-         SE : constant Service_Entry_Type := To_Service_Entry (Res.all);
-
-      begin
-         Task_Lock.Unlock;
-         return SE;
-      end;
+      return To_Service_Entry (Res);
    end Get_Service_By_Port;
 
    ---------------------
@@ -966,6 +913,7 @@ package body GNAT.Sockets is
 
    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));
@@ -1071,7 +1019,6 @@ package body GNAT.Sockets is
          when Send_Timeout    |
               Receive_Timeout =>
             Opt.Timeout := To_Duration (VT);
-
       end case;
 
       return Opt;
@@ -1208,9 +1155,9 @@ package body GNAT.Sockets is
       Result : Inet_Addr_Type;
 
    begin
-      --  Special case for the all-ones broadcast address: this address
-      --  has the same in_addr_t value as Failure, and thus cannot be
-      --  properly returned by inet_addr(3).
+      --  Special case for the all-ones broadcast address: this address has the
+      --  same in_addr_t value as Failure, and thus cannot be properly returned
+      --  by inet_addr(3).
 
       if Image = "255.255.255.255" then
          return Broadcast_Inet_Addr;
@@ -1238,11 +1185,26 @@ package body GNAT.Sockets is
    -- Initialize --
    ----------------
 
-   procedure Initialize (Process_Blocking_IO : Boolean := False) is
+   procedure Initialize (Process_Blocking_IO : Boolean) is
+      Expected : constant Boolean := not Constants.Thread_Blocking_IO;
+   begin
+      if Process_Blocking_IO /= Expected then
+         raise Socket_Error with
+           "incorrect Process_Blocking_IO setting, expected " & Expected'Img;
+      end if;
+
+      Initialize;
+   end Initialize;
+
+   ----------------
+   -- Initialize --
+   ----------------
+
+   procedure Initialize is
    begin
       if not Initialized then
          Initialized := True;
-         Thin.Initialize (Process_Blocking_IO);
+         Thin.Initialize;
       end if;
    end Initialize;
 
@@ -1355,32 +1317,10 @@ package body GNAT.Sockets is
    ----------------------
 
    procedure Raise_Host_Error (H_Error : Integer) is
-
-      function Host_Error_Message return String;
-      --  We do not use a C function like strerror because hstrerror that would
-      --  correspond is obsolete. Return appropriate string for error value.
-
-      ------------------------
-      -- Host_Error_Message --
-      ------------------------
-
-      function Host_Error_Message return String is
-      begin
-         case H_Error is
-            when Constants.HOST_NOT_FOUND => return "Host not found";
-            when Constants.TRY_AGAIN      => return "Try again";
-            when Constants.NO_RECOVERY    => return "No recovery";
-            when Constants.NO_DATA        => return "No address";
-            when others                   => return "Unknown error";
-         end case;
-      end Host_Error_Message;
-
-   --  Start of processing for Raise_Host_Error
-
    begin
       Ada.Exceptions.Raise_Exception (Host_Error'Identity,
         Err_Code_Image (H_Error)
-        & Host_Error_Message);
+        & C.Strings.Value (Host_Error_Messages.Host_Error_Message (H_Error)));
    end Raise_Host_Error;
 
    ------------------------
@@ -1469,11 +1409,8 @@ package body GNAT.Sockets is
       Res : C.int;
 
    begin
-      Res := C_Recv
-        (C.int (Socket),
-         Item (Item'First)'Address,
-         Item'Length,
-         To_Int (Flags));
+      Res :=
+        C_Recv (C.int (Socket), Item'Address, Item'Length, To_Int (Flags));
 
       if Res = Failure then
          Raise_Socket_Error (Socket_Errno);
@@ -1503,7 +1440,7 @@ package body GNAT.Sockets is
       Res :=
         C_Recvfrom
           (C.int (Socket),
-           Item (Item'First)'Address,
+           Item'Address,
            Item'Length,
            To_Int (Flags),
            Sin'Unchecked_Access,
@@ -1534,8 +1471,7 @@ package body GNAT.Sockets is
          case Error_Value is
             when Constants.HOST_NOT_FOUND => return Unknown_Host;
             when Constants.TRY_AGAIN      => return Host_Name_Lookup_Failure;
-            when Constants.NO_RECOVERY    =>
-               return Non_Recoverable_Error;
+            when Constants.NO_RECOVERY    => return Non_Recoverable_Error;
             when Constants.NO_DATA        => return Unknown_Server_Error;
             when others                   => return Cannot_Resolve_Error;
          end case;
@@ -1546,8 +1482,8 @@ package body GNAT.Sockets is
          when EACCES          => return Permission_Denied;
          when EADDRINUSE      => return Address_Already_In_Use;
          when EADDRNOTAVAIL   => return Cannot_Assign_Requested_Address;
-         when EAFNOSUPPORT    =>
-            return Address_Family_Not_Supported_By_Protocol;
+         when EAFNOSUPPORT    => return
+                                 Address_Family_Not_Supported_By_Protocol;
          when EALREADY        => return Operation_Already_In_Progress;
          when EBADF           => return Bad_File_Descriptor;
          when ECONNABORTED    => return Software_Caused_Connection_Abort;
@@ -1567,8 +1503,8 @@ package body GNAT.Sockets is
          when EMSGSIZE        => return Message_Too_Long;
          when ENAMETOOLONG    => return File_Name_Too_Long;
          when ENETDOWN        => return Network_Is_Down;
-         when ENETRESET       =>
-            return Network_Dropped_Connection_Because_Of_Reset;
+         when ENETRESET       => return
+                                 Network_Dropped_Connection_Because_Of_Reset;
          when ENETUNREACH     => return Network_Is_Unreachable;
          when ENOBUFS         => return No_Buffer_Space_Available;
          when ENOPROTOOPT     => return Protocol_Not_Available;
@@ -1578,8 +1514,8 @@ package body GNAT.Sockets is
          when EPFNOSUPPORT    => return Protocol_Family_Not_Supported;
          when EPROTONOSUPPORT => return Protocol_Not_Supported;
          when EPROTOTYPE      => return Protocol_Wrong_Type_For_Socket;
-         when ESHUTDOWN       =>
-            return Cannot_Send_After_Transport_Endpoint_Shutdown;
+         when ESHUTDOWN       => return
+                                 Cannot_Send_After_Transport_Endpoint_Shutdown;
          when ESOCKTNOSUPPORT => return Socket_Type_Not_Supported;
          when ETIMEDOUT       => return Connection_Timed_Out;
          when ETOOMANYREFS    => return Too_Many_References;
@@ -1648,7 +1584,7 @@ package body GNAT.Sockets is
       Res :=
         C_Readv
           (C.int (Socket),
-           Vector (Vector'First)'Address,
+           Vector'Address,
            Vector'Length);
 
       if Res = Failure then
@@ -1676,7 +1612,7 @@ package body GNAT.Sockets is
       Res :=
         C_Send
           (C.int (Socket),
-           Item (Item'First)'Address,
+           Item'Address,
            Item'Length,
            Set_Forced_Flags (To_Int (Flags)));
 
@@ -1714,7 +1650,7 @@ package body GNAT.Sockets is
 
       Res := C_Sendto
         (C.int (Socket),
-         Item (Item'First)'Address,
+         Item'Address,
          Item'Length,
          Set_Forced_Flags (To_Int (Flags)),
          Sin'Unchecked_Access,
@@ -2107,19 +2043,16 @@ package body GNAT.Sockets is
    function To_Service_Entry (E : Servent) return Service_Entry_Type is
       use type C.size_t;
 
-      Official : constant String :=
-                  C.Strings.Value (E.S_Name);
+      Official : constant String := C.Strings.Value (E.S_Name);
 
       Aliases : constant Chars_Ptr_Array :=
                   Chars_Ptr_Pointers.Value (E.S_Aliases);
       --  S_Aliases points to a list of name aliases. The list is
       --  terminated by a NULL pointer.
 
-      Protocol : constant String :=
-                   C.Strings.Value (E.S_Proto);
+      Protocol : constant String := C.Strings.Value (E.S_Proto);
 
-      Result   : Service_Entry_Type
-        (Aliases_Length   => Aliases'Length - 1);
+      Result : Service_Entry_Type (Aliases_Length => Aliases'Length - 1);
       --  The last element is a null pointer
 
       Source : C.size_t;
@@ -2141,7 +2074,6 @@ package body GNAT.Sockets is
         Port_Type (Network_To_Short (C.unsigned_short (E.S_Port)));
 
       Result.Protocol := To_Name (Protocol);
-
       return Result;
    end To_Service_Entry;
 

gcc/ada/g-socket.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---                     Copyright (C) 2001-2006, AdaCore                     --
+--                     Copyright (C) 2001-2007, 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- --
@@ -42,7 +42,7 @@
 --       installed. In particular Multicast is not available with the Windows
 --       version.
 
---       The VMS implementation has implemented using the DECC RTL Socket API,
+--       The VMS implementation was implemented using the DECC RTL Socket API,
 --       and is thus subject to limitations in the implementation of this API.
 
 --     VxWorks cross ports fully implement this package
@@ -354,11 +354,7 @@ package GNAT.Sockets is
    --     end Ping;
 
    --  begin
-   --     --  Indicate whether the thread library provides process
-   --     --  blocking IO. Basically, if you are not using FSU threads
-   --     --  the default is ok.
-
-   --     Initialize (Process_Blocking_IO => False);
+   --     Initialize;
    --     Ping.Start;
    --     Pong.Start;
    --     Ping.Stop;
@@ -366,18 +362,22 @@ package GNAT.Sockets is
    --     Finalize;
    --  end PingPong;
 
-   procedure Initialize (Process_Blocking_IO : Boolean := False);
-   --  Initialize must be called before using any other socket routines. The
-   --  Process_Blocking_IO parameter indicates whether the thread library
-   --  provides process-blocking or thread-blocking input/output operations.
-   --  In the former case (typically with FSU threads) GNAT.Sockets should be
-   --  initialized with a value of True to provide task-blocking IO through an
-   --  emulation mechanism. Only the first call to Initialize is taken into
-   --  account (further calls will be ignored). Note that with the default
-   --  value of Process_Blocking_IO, this operation is a no-op on UNIX
-   --  platforms, but applications should make sure to call it if portability
-   --  is expected: some platforms (such as Windows) require initialization
-   --  before any other socket operations.
+   procedure Initialize;
+   --  Initialize must be called before using any other socket routines.
+   --  Note that this operation is a no-op on UNIX platforms, but applications
+   --  should make sure to call it if portability is expected: some platforms
+   --  (such as Windows) require initialization before any socket operation.
+
+   procedure Initialize (Process_Blocking_IO : Boolean);
+   pragma Obsolescent
+     (Entity => Initialize,
+      "passing a parameter to Initialize is not supported anymore");
+   --  Previous versions of GNAT.Sockets used to require the user to indicate
+   --  whether socket I/O was process- or thread-blocking on the platform.
+   --  This property is now determined automatically when the run-time library
+   --  is built. The old version of Initialize, taking a parameter, is kept
+   --  for compatibility reasons, but this interface is obsolete (and if the
+   --  value given is wrong, an exception will be raised at run time).
 
    procedure Finalize;
    --  After Finalize is called it is not possible to use any routines
@@ -976,12 +976,10 @@ package GNAT.Sockets is
    --  cases Status is set to Completed and sockets that are ready are set in
    --  R_Socket_Set or W_Socket_Set. Status is set to Expired if no socket was
    --  ready after a Timeout expiration. Status is set to Aborted if an abort
-   --  signal has been received while checking socket status. As this
-   --  procedure returns when Timeout occurs, it is a design choice to keep
-   --  this procedure process blocking. Note that a Timeout of 0.0 returns
-   --  immediately. Also note that two different Socket_Set_Type objects must
-   --  be passed as R_Socket_Set and W_Socket_Set (even if they denote the
-   --  same set of Sockets), or some event may be lost.
+   --  signal has been received while checking socket status.
+   --  Note that two different Socket_Set_Type objects must be passed as
+   --  R_Socket_Set and W_Socket_Set (even if they denote the same set of
+   --  Sockets), or some event may be lost.
    --  Socket_Error is raised when the select(2) system call returns an
    --  error condition, or when a read error occurs on the signalling socket
    --  used for the implementation of Abort_Selector.

gcc/ada/g-socthi.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---                     Copyright (C) 2001-2006, AdaCore                     --
+--                     Copyright (C) 2001-2007, 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- --
@@ -56,13 +56,10 @@ package body GNAT.Sockets.Thin is
    --  been set in non-blocking mode by the user.
 
    Quantum : constant Duration := 0.2;
-   --  When Thread_Blocking_IO is False, we set sockets in
+   --  When Constants.Thread_Blocking_IO is False, we set sockets in
    --  non-blocking mode and we spend a period of time Quantum between
    --  two attempts on a blocking operation.
 
-   Thread_Blocking_IO : Boolean := True;
-   --  Comment required for this ???
-
    Unknown_System_Error : constant C.Strings.chars_ptr :=
                             C.Strings.New_String ("Unknown system error");
 
@@ -153,14 +150,14 @@ package body GNAT.Sockets.Thin is
    begin
       loop
          R := Syscall_Accept (S, Addr, Addrlen);
-         exit when Thread_Blocking_IO
+         exit when Constants.Thread_Blocking_IO
            or else R /= Failure
            or else Non_Blocking_Socket (S)
            or else Errno /= Constants.EWOULDBLOCK;
          delay Quantum;
       end loop;
 
-      if not Thread_Blocking_IO
+      if not Constants.Thread_Blocking_IO
         and then R /= Failure
       then
          --  A socket inherits the properties ot its server especially
@@ -189,7 +186,7 @@ package body GNAT.Sockets.Thin is
    begin
       Res := Syscall_Connect (S, Name, Namelen);
 
-      if Thread_Blocking_IO
+      if Constants.Thread_Blocking_IO
         or else Res /= Failure
         or else Non_Blocking_Socket (S)
         or else Errno /= Constants.EINPROGRESS
@@ -247,7 +244,7 @@ package body GNAT.Sockets.Thin is
       Arg : Int_Access) return C.int
    is
    begin
-      if not Thread_Blocking_IO
+      if not Constants.Thread_Blocking_IO
         and then Req = Constants.FIONBIO
       then
          if Arg.all /= 0 then
@@ -273,7 +270,7 @@ package body GNAT.Sockets.Thin is
    begin
       loop
          Res := Syscall_Recv (S, Msg, Len, Flags);
-         exit when Thread_Blocking_IO
+         exit when Constants.Thread_Blocking_IO
            or else Res /= Failure
            or else Non_Blocking_Socket (S)
            or else Errno /= Constants.EWOULDBLOCK;
@@ -300,7 +297,7 @@ package body GNAT.Sockets.Thin is
    begin
       loop
          Res := Syscall_Recvfrom (S, Msg, Len, Flags, From, Fromlen);
-         exit when Thread_Blocking_IO
+         exit when Constants.Thread_Blocking_IO
            or else Res /= Failure
            or else Non_Blocking_Socket (S)
            or else Errno /= Constants.EWOULDBLOCK;
@@ -325,7 +322,7 @@ package body GNAT.Sockets.Thin is
    begin
       loop
          Res := Syscall_Send (S, Msg, Len, Flags);
-         exit when Thread_Blocking_IO
+         exit when Constants.Thread_Blocking_IO
            or else Res /= Failure
            or else Non_Blocking_Socket (S)
            or else Errno /= Constants.EWOULDBLOCK;
@@ -352,7 +349,7 @@ package body GNAT.Sockets.Thin is
    begin
       loop
          Res := Syscall_Sendto (S, Msg, Len, Flags, To, Tolen);
-         exit when Thread_Blocking_IO
+         exit when Constants.Thread_Blocking_IO
            or else Res /= Failure
            or else Non_Blocking_Socket (S)
            or else Errno /= Constants.EWOULDBLOCK;
@@ -380,7 +377,7 @@ package body GNAT.Sockets.Thin is
    begin
       R := Syscall_Socket (Domain, Typ, Protocol);
 
-      if not Thread_Blocking_IO
+      if not Constants.Thread_Blocking_IO
         and then R /= Failure
       then
          --  Do not use C_Ioctl as this subprogram tracks sockets set
@@ -402,13 +399,18 @@ package body GNAT.Sockets.Thin is
       null;
    end Finalize;
 
+   -------------------------
+   -- Host_Error_Messages --
+   -------------------------
+
+   package body Host_Error_Messages is separate;
+
    ----------------
    -- Initialize --
    ----------------
 
-   procedure Initialize (Process_Blocking_IO : Boolean) is
+   procedure Initialize is
    begin
-      Thread_Blocking_IO := not Process_Blocking_IO;
       Disable_All_SIGPIPEs;
    end Initialize;
 
@@ -505,17 +507,18 @@ package body GNAT.Sockets.Thin is
       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;
+      procedure C_Close (Sig : 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");
+      pragma Import (C, C_Close,  "__gnat_close_signalling_fd");
 
-      function Create (Fds : not null access Fd_Pair) return C.int
-        renames C_Create;
-
+      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;
+      procedure Close (Sig : C.int) renames C_Close;
 
    end Signalling_Fds;
 

gcc/ada/g-socthi.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---                     Copyright (C) 2001-2006, AdaCore                     --
+--                     Copyright (C) 2001-2007, 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- --
@@ -40,8 +40,8 @@
 with Interfaces.C.Pointers;
 with Interfaces.C.Strings;
 
-with GNAT.Sockets.Constants;
 with GNAT.OS_Lib;
+with GNAT.Sockets.Constants;
 
 with System;
 
@@ -64,12 +64,21 @@ package GNAT.Sockets.Thin is
 
    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".
+   --  not known, returns "Unknown system error".
 
    function Host_Errno return Integer;
    pragma Import (C, Host_Errno, "__gnat_get_h_errno");
    --  Returns last host error number
 
+   package Host_Error_Messages is
+
+      function Host_Error_Message
+        (H_Errno : Integer) return C.Strings.chars_ptr;
+      --  Returns the error message string for the host error number H_Errno.
+      --  If H_Errno is not known, returns "Unknown system error".
+
+   end Host_Error_Messages;
+
    subtype Fd_Set_Access is System.Address;
    No_Fd_Set : constant Fd_Set_Access := System.Null_Address;
 
@@ -111,8 +120,11 @@ package GNAT.Sockets.Thin is
    type In_Addr is record
       S_B1, S_B2, S_B3, S_B4 : C.unsigned_char;
    end record;
+   for In_Addr'Alignment use C.int'Alignment;
    pragma Convention (C, In_Addr);
-   --  Internet address
+   --  IPv4 address, represented as a network-order C.int. Note that the
+   --  underlying operating system may assume that values of this type have
+   --  C.int alignment, so we need to provide a suitable alignment clause here.
 
    type In_Addr_Access is access all In_Addr;
    pragma Convention (C, In_Addr_Access);
@@ -219,6 +231,10 @@ package GNAT.Sockets.Thin is
    --  Indices into an Fd_Pair value providing access to each of the connected
    --  file descriptors.
 
+   --------------------------------
+   -- Standard library functions --
+   --------------------------------
+
    function C_Accept
      (S       : C.int;
       Addr    : System.Address;
@@ -237,14 +253,6 @@ package GNAT.Sockets.Thin is
       Name    : System.Address;
       Namelen : C.int) return C.int;
 
-   function C_Gethostbyaddr
-     (Addr : System.Address;
-      Len  : C.int;
-      Typ  : C.int) return Hostent_Access;
-
-   function C_Gethostbyname
-     (Name : C.char_array) return Hostent_Access;
-
    function C_Gethostname
      (Name    : System.Address;
       Namelen : C.int) return C.int;
@@ -254,14 +262,6 @@ package GNAT.Sockets.Thin is
       Name    : System.Address;
       Namelen : not null access C.int) return C.int;
 
-   function C_Getservbyname
-     (Name  : C.char_array;
-      Proto : C.char_array) return Servent_Access;
-
-   function C_Getservbyport
-     (Port  : C.int;
-      Proto : C.char_array) return Servent_Access;
-
    function C_Getsockname
      (S       : C.int;
       Name    : System.Address;
@@ -353,6 +353,10 @@ package GNAT.Sockets.Thin is
       Iov    : System.Address;
       Iovcnt : C.int) return C.int;
 
+   -------------------------------------------------------
+   -- Signalling file descriptors for selector abortion --
+   -------------------------------------------------------
+
    package Signalling_Fds is
 
       function Create (Fds : not null access Fd_Pair) return C.int;
@@ -370,8 +374,16 @@ package GNAT.Sockets.Thin is
       --  Write one byte of data to wsig, the write end of a pair of signalling
       --  fds created by Create_Signalling_Fds.
 
+      procedure Close (Sig : C.int);
+      pragma Convention (C, Close);
+      --  Close one end of a pair of signalling fds (ignoring any error)
+
    end Signalling_Fds;
 
+   ----------------------------
+   -- Socket sets management --
+   ----------------------------
+
    procedure Free_Socket_Set
      (Set : Fd_Set_Access);
    --  Free system-dependent socket set
@@ -380,11 +392,11 @@ package GNAT.Sockets.Thin is
      (Set    : Fd_Set_Access;
       Socket : Int_Access;
       Last   : Int_Access);
-   --  Get last socket in Socket and remove it from the socket
-   --  set. The parameter Last is a maximum value of the largest
-   --  socket. This hint is used to avoid scanning very large socket
-   --  sets. After a call to Get_Socket_From_Set, Last is set back to
-   --  the real largest socket in the socket set.
+   --  Get last socket in Socket and remove it from the socket set. The
+   --  parameter Last is a maximum value of the largest socket. This hint is
+   --  used to avoid scanning very large socket sets. After a call to
+   --  Get_Socket_From_Set, Last is set back to the real largest socket in the
+   --  socket set.
 
    procedure Insert_Socket_In_Set
      (Set    : Fd_Set_Access;
@@ -417,18 +429,38 @@ package GNAT.Sockets.Thin is
       Socket : C.int);
    --  Remove socket from the socket set
 
+   -------------------------------------------
+   -- Nonreentrant network databases access --
+   -------------------------------------------
+
+   --  The following are used only on systems that have nonreentrant
+   --  getXXXbyYYY functions, and do NOT have corresponding getXXXbyYYY_
+   --  functions. Currently, LynxOS is the only such system.
+
+   function Nonreentrant_Gethostbyname
+     (Name : C.char_array) return Hostent_Access;
+
+   function Nonreentrant_Gethostbyaddr
+     (Addr      : System.Address;
+      Addr_Len  : C.int;
+      Addr_Type : C.int) return Hostent_Access;
+
+   function Nonreentrant_Getservbyname
+     (Name  : C.char_array;
+      Proto : C.char_array) return Servent_Access;
+
+   function Nonreentrant_Getservbyport
+     (Port  : C.int;
+      Proto : C.char_array) return Servent_Access;
+
+   procedure Initialize;
    procedure Finalize;
-   procedure Initialize (Process_Blocking_IO : Boolean);
 
 private
    pragma Import (C, C_Bind, "bind");
    pragma Import (C, C_Close, "close");
-   pragma Import (C, C_Gethostbyaddr, "gethostbyaddr");
-   pragma Import (C, C_Gethostbyname, "gethostbyname");
    pragma Import (C, C_Gethostname, "gethostname");
    pragma Import (C, C_Getpeername, "getpeername");
-   pragma Import (C, C_Getservbyname, "getservbyname");
-   pragma Import (C, C_Getservbyport, "getservbyport");
    pragma Import (C, C_Getsockname, "getsockname");
    pragma Import (C, C_Getsockopt, "getsockopt");
    pragma Import (C, C_Inet_Addr, "inet_addr");
@@ -449,4 +481,9 @@ private
    pragma Import (C, Insert_Socket_In_Set, "__gnat_insert_socket_in_set");
    pragma Import (C, Remove_Socket_From_Set, "__gnat_remove_socket_from_set");
 
+   pragma Import (C, Nonreentrant_Gethostbyname, "gethostbyname");
+   pragma Import (C, Nonreentrant_Gethostbyaddr, "gethostbyaddr");
+   pragma Import (C, Nonreentrant_Getservbyname, "getservbyname");
+   pragma Import (C, Nonreentrant_Getservbyport, "getservbyport");
+
 end GNAT.Sockets.Thin;