------------------------------------------------------------------------------
--                                                                          --
--                         GNAT COMPILER COMPONENTS                         --
--                                                                          --
--                    G N A T . S O C K E T S . T H I N                     --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--                            $Revision: 1.5 $
--                                                                          --
--              Copyright (C) 2001 Ada Core Technologies, Inc.              --
--                                                                          --
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
-- for  more details.  You should have  received  a copy of the GNU General --
-- Public License  distributed with GNAT;  see file COPYING.  If not, write --
-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
-- MA 02111-1307, USA.                                                      --
--                                                                          --
-- As a special exception,  if other files  instantiate  generics from this --
-- unit, or you link  this unit with other files  to produce an executable, --
-- this  unit  does not  by itself cause  the resulting  executable  to  be --
-- covered  by the  GNU  General  Public  License.  This exception does not --
-- however invalidate  any other reasons why  the executable file  might be --
-- covered by the  GNU Public License.                                      --
--                                                                          --
-- GNAT is maintained by Ada Core Technologies Inc (http://www.gnat.com).   --
--                                                                          --
------------------------------------------------------------------------------

--  This version is for NT.

package body GNAT.Sockets.Thin is

   use type C.unsigned;

   WSAData_Dummy : array (1 .. 512) of C.int;

   WS_Version  : constant := 16#0101#;
   Initialized : Boolean := False;

   -----------
   -- Clear --
   -----------

   procedure Clear
     (Item   : in out Fd_Set;
      Socket : C.int)
   is
   begin
      for J in 1 .. Item.fd_count loop
         if Item.fd_array (J) = Socket then
            Item.fd_array (J .. Item.fd_count - 1) :=
              Item.fd_array (J + 1 .. Item.fd_count);
            Item.fd_count := Item.fd_count - 1;
            exit;
         end if;
      end loop;
   end Clear;

   -----------
   -- Empty --
   -----------

   procedure Empty  (Item : in out Fd_Set) is
   begin
      Item := Null_Fd_Set;
   end Empty;

   --------------
   -- Finalize --
   --------------

   procedure Finalize is
   begin
      if Initialized then
         WSACleanup;
         Initialized := False;
      end if;
   end Finalize;

   --------------
   -- Is_Empty --
   --------------

   function Is_Empty (Item : Fd_Set) return Boolean is
   begin
      return Item.fd_count = 0;
   end Is_Empty;

   ------------
   -- Is_Set --
   ------------

   function Is_Set (Item : Fd_Set; Socket : C.int) return Boolean is
   begin
      for J in 1 .. Item.fd_count loop
         if Item.fd_array (J) = Socket then
            return True;
         end if;
      end loop;

      return False;
   end Is_Set;

   ----------------
   -- Initialize --
   ----------------

   procedure Initialize (Process_Blocking_IO : Boolean := False) is
      Return_Value : Interfaces.C.int;

   begin
      if not Initialized then
         Return_Value := WSAStartup (WS_Version, WSAData_Dummy'Address);
         pragma Assert (Interfaces.C."=" (Return_Value, 0));
         Initialized := True;
      end if;
   end Initialize;

   ---------
   -- Max --
   ---------

   function Max (Item : Fd_Set) return C.int is
      L : C.int := 0;

   begin
      for J in 1 .. Item.fd_count loop
         if Item.fd_array (J) > L then
            L := Item.fd_array (J);
         end if;
      end loop;

      return L;
   end Max;

   ---------
   -- Set --
   ---------

   procedure Set (Item : in out Fd_Set; Socket : in C.int) is
   begin
      Item.fd_count := Item.fd_count + 1;
      Item.fd_array (Item.fd_count) := Socket;
   end Set;

   --------------------------
   -- Socket_Error_Message --
   --------------------------

   function Socket_Error_Message (Errno : Integer) return String is
      use GNAT.Sockets.Constants;

   begin
      case Errno is
         when EINTR =>
            return "Interrupted system call";

         when EBADF =>
            return "Bad file number";

         when EACCES =>
            return "Permission denied";

         when EFAULT =>
            return "Bad address";

         when EINVAL =>
            return "Invalid argument";

         when EMFILE =>
            return "Too many open files";

         when EWOULDBLOCK =>
            return "Operation would block";

         when EINPROGRESS =>
            return "Operation now in progress. This error is "
              & "returned if any Windows Sockets API "
              & "function is called while a blocking "
              & "function is in progress";

         when EALREADY =>
            return "Operation already in progress";

         when ENOTSOCK =>
            return "Socket operation on nonsocket";

         when EDESTADDRREQ =>
            return "Destination address required";

         when EMSGSIZE =>
            return "Message too long";

         when EPROTOTYPE =>
            return "Protocol wrong type for socket";

         when ENOPROTOOPT =>
            return "Protocol not available";

         when EPROTONOSUPPORT =>
            return "Protocol not supported";

         when ESOCKTNOSUPPORT =>
            return "Socket type not supported";

         when EOPNOTSUPP =>
            return "Operation not supported on socket";

         when EPFNOSUPPORT =>
            return "Protocol family not supported";

         when EAFNOSUPPORT =>
            return "Address family not supported by protocol family";

         when EADDRINUSE =>
            return "Address already in use";

         when EADDRNOTAVAIL =>
            return "Cannot assign requested address";

         when ENETDOWN =>
            return "Network is down. This error may be "
              & "reported at any time if the Windows "
              & "Sockets implementation detects an "
              & "underlying failure";

         when ENETUNREACH =>
            return "Network is unreachable";

         when ENETRESET =>
            return "Network dropped connection on reset";

         when ECONNABORTED =>
            return "Software caused connection abort";

         when ECONNRESET =>
            return "Connection reset by peer";

         when ENOBUFS =>
            return "No buffer space available";

         when EISCONN  =>
            return "Socket is already connected";

         when ENOTCONN =>
            return "Socket is not connected";

         when ESHUTDOWN =>
            return "Cannot send after socket shutdown";

         when ETOOMANYREFS =>
            return "Too many references: cannot splice";

         when ETIMEDOUT =>
            return "Connection timed out";

         when ECONNREFUSED =>
            return "Connection refused";

         when ELOOP =>
            return "Too many levels of symbolic links";

         when ENAMETOOLONG =>
            return "File name too long";

         when EHOSTDOWN =>
            return "Host is down";

         when EHOSTUNREACH =>
            return "No route to host";

         when SYSNOTREADY =>
            return "Returned by WSAStartup(), indicating that "
              & "the network subsystem is unusable";

         when VERNOTSUPPORTED =>
            return "Returned by WSAStartup(), indicating that "
              & "the Windows Sockets DLL cannot support this application";

         when NOTINITIALISED =>
            return "Winsock not initialized. This message is "
              & "returned by any function except WSAStartup(), "
              & "indicating that a successful WSAStartup() has "
              & "not yet been performed";

         when EDISCON =>
            return "Disconnect";

         when HOST_NOT_FOUND =>
            return "Host not found. This message indicates "
              & "that the key (name, address, and so on) was not found";

         when TRY_AGAIN =>
            return "Nonauthoritative host not found. This error may "
              & "suggest that the name service itself is not functioning";

         when NO_RECOVERY =>
            return "Nonrecoverable error. This error may suggest that the "
              & "name service itself is not functioning";

         when NO_DATA =>
            return "Valid name, no data record of requested type. "
              & "This error indicates that the key (name, address, "
              & "and so on) was not found.";

         when others =>
            return "Unknown system error";

      end case;
   end Socket_Error_Message;

end GNAT.Sockets.Thin;