diff options
author | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2004-05-14 10:02:00 +0000 |
---|---|---|
committer | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2004-05-14 10:02:00 +0000 |
commit | 3e55413dd9a577b7b270e04f09ccb3f13a90a3cb (patch) | |
tree | ad67eadab2c2032169ff2f33eb289b29a4e7e3a9 /gcc/ada/g-socthi-mingw.adb | |
parent | 7e0c7e2e8e2c055a2751d8dbd5cdd4bd70fe316e (diff) | |
download | gcc-3e55413dd9a577b7b270e04f09ccb3f13a90a3cb.tar.gz |
Renaming of target specific files for clarity
* Makefile.in: Rename GNAT target specific files.
* 31soccon.ads, 31soliop.ads 35soccon.ads, 3asoccon.ads,
3bsoccon.ads, 3gsoccon.ads, 3hsoccon.ads, 3psoccon.ads,
3ssoccon.ads, 3ssoliop.ads, 3veacodu.adb, 3vexpect.adb,
3vsoccon.ads, 3vsocthi.adb, 3vsocthi.ads, 3vtrasym.adb,
3wsoccon.ads, 3wsocthi.adb, 3wsocthi.ads, 3wsoliop.ads,
3zsoccon.ads, 3zsocthi.adb, 3zsocthi.ads, 41intnam.ads,
42intnam.ads, 45intnam.ads, 4aintnam.ads, 4cintnam.ads,
4gintnam.ads, 4hexcpol.adb, 4hintnam.ads, 4lintnam.ads,
4nintnam.ads, 4ointnam.ads, 4onumaux.ads, 4pintnam.ads,
4sintnam.ads, 4vcaldel.adb, 4vcalend.adb, 4vcalend.ads,
4vintnam.ads, 4wcalend.adb, 4wexcpol.adb, 4wintnam.ads,
4zintnam.ads, 4znumaux.ads, 4zsytaco.adb, 4zsytaco.ads,
51osinte.adb, 51osinte.ads, 51system.ads,
52osinte.adb, 52osinte.ads, 53osinte.ads, 54osinte.ads,
55osinte.adb, 55osinte.ads, 55system.ads, 56osinte.adb,
56osinte.ads, 56system.ads, 56taprop.adb, 56taspri.ads,
56tpopsp.adb, 57system.ads, 58system.ads,
5amastop.adb, 5aml-tgt.adb, 5aosinte.adb, 5aosinte.ads,
5asystem.ads, 5ataprop.adb, 5atasinf.ads, 5ataspri.ads,
5atpopsp.adb, 5avxwork.ads, 5bml-tgt.adb, 5bosinte.adb,
5bosinte.ads, 5bsystem.ads, 5cosinte.ads, 5csystem.ads,
5dsystem.ads, 5esystem.ads, 5fintman.adb, 5fosinte.adb,
5fosinte.ads, 5fsystem.ads, 5ftaprop.adb, 5ftasinf.ads,
5ginterr.adb, 5gintman.adb, 5gmastop.adb, 5gml-tgt.adb,
5gosinte.ads, 5gproinf.adb, 5gproinf.ads, 5gsystem.ads,
5gtaprop.adb, 5gtasinf.adb, 5gtasinf.ads, 5gtpgetc.adb,
5hml-tgt.adb, 5hosinte.adb, 5hosinte.ads, 5hparame.ads,
5hsystem.ads, 5htaprop.adb, 5htaspri.ads, 5htraceb.adb,
5iosinte.adb, 5iosinte.ads, 5itaprop.adb, 5itaspri.ads,
5ksystem.ads, 5kvxwork.ads, 5lml-tgt.adb, 5losinte.ads,
5lparame.adb, 5lsystem.ads, 5msystem.ads, 5mvxwork.ads,
5ninmaop.adb, 5nintman.adb, 5nosinte.ads, 5nsystem.ads,
5ntaprop.adb, 5ntaspri.ads, 5ointerr.adb, 5omastop.adb,
5oosinte.adb, 5oosinte.ads, 5oosprim.adb, 5oparame.adb,
5osystem.ads, 5otaprop.adb, 5otaspri.ads, 5posinte.ads,
5posprim.adb, 5psystem.ads, 5pvxwork.ads, 5sintman.adb,
5sml-tgt.adb, 5sosinte.adb, 5sosinte.ads, 5sosprim.adb,
5sparame.adb, 5ssystem.ads, 5staprop.adb, 5stasinf.adb,
5stasinf.ads, 5staspri.ads, 5stpopsp.adb, 5svxwork.ads,
5tosinte.ads, 5usystem.ads, 5vasthan.adb, 5vdirval.adb,
5vinmaop.adb, 5vinterr.adb, 5vintman.adb, 5vintman.ads,
5vmastop.adb, 5vml-tgt.adb, 5vosinte.adb, 5vosinte.ads,
5vosprim.adb, 5vosprim.ads, 5vparame.ads, 5vsymbol.adb,
5vsystem.ads, 5vtaprop.adb, 5vtaspri.ads, 5vtpopde.adb,
5vtpopde.ads, 5vtraent.adb, 5vtraent.ads, 5vvaflop.adb,
5wdirval.adb, 5wgloloc.adb, 5wintman.adb, 5wmemory.adb,
5wml-tgt.adb, 5wosinte.ads, 5wosprim.adb, 5wsystem.ads,
5wtaprop.adb, 5wtaspri.ads, 5xparame.ads, 5xsystem.ads,
5xvxwork.ads, 5yparame.ads, 5ysystem.ads, 5zinterr.adb,
5zintman.adb, 5zintman.ads, 5zml-tgt.adb, 5zosinte.adb,
5zosinte.ads, 5zosprim.adb, 5zparame.ads, 5zstchop.adb,
5zsystem.ads, 5ztaprop.adb, 5ztaspri.ads, 5ztfsetr.adb,
5ztpopsp.adb, 6vcpp.adb, 6vcstrea.adb, 6vinterf.ads,
7sinmaop.adb, 7sintman.adb, 7sosinte.adb, 7sosprim.adb,
7staprop.adb, 7staspri.ads, 7stfsetr.adb, 7stpopsp.adb,
7straceb.adb, 7straces.adb, 7strafor.adb, 7strafor.ads,
7stratas.adb, 86numaux.adb, 86numaux.ads: Replaced by files below.
* a-caldel-vms.adb, a-calend-mingw.adb, a-calend-vms.adb,
a-calend-vms.ads, a-dirval-mingw.adb, a-dirval-vms.adb,
a-excpol-abort.adb, a-excpol-interix.adb, a-intnam-aix.ads,
a-intnam-dummy.ads, a-intnam-freebsd.ads, a-intnam-hpux.ads,
a-intnam-interix.ads, a-intnam-irix.ads, a-intnam-linux.ads,
a-intnam-lynxos.ads, a-intnam-mingw.ads, a-intnam-os2.ads,
a-intnam-solaris.ads, a-intnam-tru64.ads, a-intnam-unixware.ads,
a-intnam-vms.ads, a-intnam-vxworks.ads, a-numaux-libc-x86.ads,
a-numaux-vxworks.ads, a-numaux-x86.adb, a-numaux-x86.ads,
a-sytaco-vxworks.adb, a-sytaco-vxworks.ads, g-eacodu-vms.adb,
g-expect-vms.adb, g-soccon-aix.ads, g-soccon-freebsd.ads,
g-soccon-hpux.ads, g-soccon-interix.ads, g-soccon-irix.ads,
g-soccon-mingw.ads, g-soccon-solaris.ads, g-soccon-tru64.ads,
g-soccon-unixware.ads, g-soccon-vms.adb, g-soccon-vxworks.ads,
g-socthi-mingw.adb, g-socthi-mingw.ads, g-socthi-vms.adb,
g-socthi-vms.ads, g-socthi-vxworks.adb, g-socthi-vxworks.ads,
g-soliop-mingw.ads, g-soliop-solaris.ads, g-soliop-unixware.ads,
g-trasym-vms.adb, i-cpp-vms.adb, i-cstrea-vms.adb,
interfac-vms.ads, mlib-tgt-aix.adb, mlib-tgt-hpux.adb,
mlib-tgt-irix.adb, mlib-tgt-linux.adb, mlib-tgt-mingw.adb,
mlib-tgt-solaris.adb, mlib-tgt-tru64.adb, mlib-tgt-vms.adb,
mlib-tgt-vxworks.adb, s-asthan-vms.adb, s-gloloc-mingw.adb,
s-inmaop-dummy.adb, s-inmaop-posix.adb, s-inmaop-vms.adb,
s-interr-dummy.adb, s-interr-sigaction.adb, s-interr-vms.adb,
s-interr-vxworks.adb, s-intman-dummy.adb, s-intman-irix.adb,
s-intman-irix-athread.adb, s-intman-mingw.adb, s-intman-posix.adb,
s-intman-solaris.adb, s-intman-vms.adb, s-intman-vms.ads,
s-intman-vxworks.adb, s-intman-vxworks.ads, s-mastop-irix.adb,
s-mastop-tru64.adb, s-mastop-vms.adb, s-mastop-x86.adb,
s-memory-mingw.adb, s-osinte-aix.adb, s-osinte-aix.ads,
s-osinte-aix-fsu.ads, s-osinte-dummy.ads, s-osinte-freebsd.adb,
s-osinte-freebsd.ads, s-osinte-fsu.adb, s-osinte-hpux.ads,
s-osinte-hpux-dce.adb, s-osinte-hpux-dce.ads, s-osinte-interix.ads,
s-osinte-irix.adb, s-osinte-irix.ads, s-osinte-irix-athread.ads,
s-osinte-linux.ads, s-osinte-linux-fsu.ads, s-osinte-linux-ia64.ads,
s-osinte-lynxos-3.adb, s-osinte-lynxos-3.ads, s-osinte-lynxos.adb,
s-osinte-lynxos.ads, s-osinte-mingw.ads, s-osinte-os2.adb,
s-osinte-os2.ads, s-osinte-posix.adb, s-osinte-solaris.adb,
s-osinte-solaris.ads, s-osinte-solaris-fsu.ads,
s-osinte-solaris-posix.ads, s-osinte-tru64.adb, s-osinte-tru64.ads,
s-osinte-unixware.adb, s-osinte-unixware.ads, s-osinte-vms.adb,
s-osinte-vms.ads, s-osinte-vxworks.adb,
s-osinte-vxworks.ads, s-osprim-mingw.adb,
s-osprim-os2.adb, s-osprim-posix.adb, s-osprim-solaris.adb,
s-osprim-unix.adb, s-osprim-vms.adb, s-osprim-vms.ads,
s-osprim-vxworks.adb, s-parame-ae653.ads, s-parame-hpux.ads,
s-parame-linux.adb, s-parame-os2.adb, s-parame-solaris.adb,
s-parame-vms.ads, s-parame-vms-restrict.ads, s-parame-vxworks.ads,
s-proinf-irix-athread.adb, s-proinf-irix-athread.ads,
s-stchop-vxworks.adb, s-taprop-dummy.adb,
s-taprop-hpux-dce.adb, s-taprop-irix.adb,
s-taprop-irix-athread.adb, s-taprop-linux.adb, s-taprop-lynxos.adb,
s-taprop-mingw.adb, s-taprop-os2.adb, s-taprop-posix.adb,
s-taprop-solaris.adb, s-taprop-tru64.adb, s-taprop-vms.adb,
s-taprop-vxworks.adb, s-tasinf-irix.ads, s-tasinf-irix-athread.adb,
s-tasinf-irix-athread.ads, s-tasinf-solaris.adb, s-tasinf-solaris.ads,
s-tasinf-tru64.ads, s-taspri-dummy.ads, s-taspri-hpux-dce.ads,
s-taspri-linux.ads, s-taspri-lynxos.ads, s-taspri-mingw.ads,
s-taspri-os2.ads, s-taspri-posix.ads, s-taspri-solaris.ads,
s-taspri-tru64.ads, s-taspri-vms.ads, s-taspri-vxworks.ads,
s-tfsetr-default.adb, s-tfsetr-vxworks.adb, s-tpopde-vms.adb,
s-tpopde-vms.ads, s-tpopsp-lynxos.adb, s-tpopsp-posix.adb,
s-tpopsp-posix-foreign.adb, s-tpopsp-solaris.adb, s-tpopsp-vxworks.adb,
s-traceb-hpux.adb, s-traceb-mastop.adb, s-traces-default.adb,
s-traent-vms.adb, s-traent-vms.ads, s-trafor-default.adb,
s-trafor-default.ads, s-tratas-default.adb, s-vaflop-vms.adb,
s-vxwork-alpha.ads, s-vxwork-m68k.ads, s-vxwork-mips.ads,
s-vxwork-ppc.ads, s-vxwork-sparcv9.ads, s-vxwork-xscale.ads,
symbols-vms.adb, system-aix.ads, system-freebsd-x86.ads,
system-hpux.ads, system-interix.ads, system-irix-n32.ads,
system-irix-o32.ads, system-linux-x86_64.ads,
system-linux-x86.ads, system-lynxos-ppc.ads, system-lynxos-x86.ads,
system-mingw.ads, system-os2.ads, system-solaris-sparc.ads,
system-solaris-sparcv9.ads, system-solaris-x86.ads, system-tru64.ads,
system-unixware.ads, system-vms.ads, system-vms-zcx.ads,
system-vxworks-alpha.ads, system-vxworks-m68k.ads,
system-vxworks-mips.ads, system-vxworks-ppc.ads,
system-vxworks-sparcv9.ads, system-vxworks-xscale.ads: Replace files
above.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@81834 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/ada/g-socthi-mingw.adb')
-rw-r--r-- | gcc/ada/g-socthi-mingw.adb | 587 |
1 files changed, 587 insertions, 0 deletions
diff --git a/gcc/ada/g-socthi-mingw.adb b/gcc/ada/g-socthi-mingw.adb new file mode 100644 index 00000000000..a948bdeedfa --- /dev/null +++ b/gcc/ada/g-socthi-mingw.adb @@ -0,0 +1,587 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- G N A T . S O C K E T S . T H I N -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 2001-2004 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 was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +-- This package provides a target dependent thin interface to the sockets +-- layer for use by the GNAT.Sockets package (g-socket.ads). This package +-- should not be directly with'ed by an applications program. + +-- This version is for NT. + +with GNAT.Sockets.Constants; use GNAT.Sockets.Constants; +with Interfaces.C.Strings; use Interfaces.C.Strings; + +with System; use System; + +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; + + SYSNOTREADY : constant := 10091; + VERNOTSUPPORTED : constant := 10092; + NOTINITIALISED : constant := 10093; + EDISCON : constant := 10101; + + function Standard_Connect + (S : C.int; + Name : System.Address; + Namelen : C.int) + return C.int; + pragma Import (Stdcall, Standard_Connect, "connect"); + + function Standard_Select + (Nfds : C.int; + Readfds : Fd_Set_Access; + Writefds : Fd_Set_Access; + Exceptfds : Fd_Set_Access; + Timeout : Timeval_Access) + return C.int; + pragma Import (Stdcall, Standard_Select, "select"); + + type Error_Type is + (N_EINTR, + N_EBADF, + N_EACCES, + N_EFAULT, + N_EINVAL, + N_EMFILE, + N_EWOULDBLOCK, + N_EINPROGRESS, + N_EALREADY, + N_ENOTSOCK, + N_EDESTADDRREQ, + N_EMSGSIZE, + N_EPROTOTYPE, + N_ENOPROTOOPT, + N_EPROTONOSUPPORT, + N_ESOCKTNOSUPPORT, + N_EOPNOTSUPP, + N_EPFNOSUPPORT, + N_EAFNOSUPPORT, + N_EADDRINUSE, + N_EADDRNOTAVAIL, + N_ENETDOWN, + N_ENETUNREACH, + N_ENETRESET, + N_ECONNABORTED, + N_ECONNRESET, + N_ENOBUFS, + N_EISCONN, + N_ENOTCONN, + N_ESHUTDOWN, + N_ETOOMANYREFS, + N_ETIMEDOUT, + N_ECONNREFUSED, + N_ELOOP, + N_ENAMETOOLONG, + N_EHOSTDOWN, + N_EHOSTUNREACH, + N_SYSNOTREADY, + N_VERNOTSUPPORTED, + N_NOTINITIALISED, + N_EDISCON, + N_HOST_NOT_FOUND, + N_TRY_AGAIN, + N_NO_RECOVERY, + N_NO_DATA, + N_OTHERS); + + Error_Messages : constant array (Error_Type) of chars_ptr := + (N_EINTR => + New_String ("Interrupted system call"), + N_EBADF => + New_String ("Bad file number"), + N_EACCES => + New_String ("Permission denied"), + N_EFAULT => + New_String ("Bad address"), + N_EINVAL => + New_String ("Invalid argument"), + N_EMFILE => + New_String ("Too many open files"), + N_EWOULDBLOCK => + New_String ("Operation would block"), + N_EINPROGRESS => + New_String ("Operation now in progress. This error is " + & "returned if any Windows Sockets API " + & "function is called while a blocking " + & "function is in progress"), + N_EALREADY => + New_String ("Operation already in progress"), + N_ENOTSOCK => + New_String ("Socket operation on nonsocket"), + N_EDESTADDRREQ => + New_String ("Destination address required"), + N_EMSGSIZE => + New_String ("Message too long"), + N_EPROTOTYPE => + New_String ("Protocol wrong type for socket"), + N_ENOPROTOOPT => + New_String ("Protocol not available"), + N_EPROTONOSUPPORT => + New_String ("Protocol not supported"), + N_ESOCKTNOSUPPORT => + New_String ("Socket type not supported"), + N_EOPNOTSUPP => + New_String ("Operation not supported on socket"), + N_EPFNOSUPPORT => + New_String ("Protocol family not supported"), + N_EAFNOSUPPORT => + New_String ("Address family not supported by protocol family"), + N_EADDRINUSE => + New_String ("Address already in use"), + N_EADDRNOTAVAIL => + New_String ("Cannot assign requested address"), + N_ENETDOWN => + New_String ("Network is down. This error may be " + & "reported at any time if the Windows " + & "Sockets implementation detects an " + & "underlying failure"), + N_ENETUNREACH => + New_String ("Network is unreachable"), + N_ENETRESET => + New_String ("Network dropped connection on reset"), + N_ECONNABORTED => + New_String ("Software caused connection abort"), + N_ECONNRESET => + New_String ("Connection reset by peer"), + N_ENOBUFS => + New_String ("No buffer space available"), + N_EISCONN => + New_String ("Socket is already connected"), + N_ENOTCONN => + New_String ("Socket is not connected"), + N_ESHUTDOWN => + New_String ("Cannot send after socket shutdown"), + N_ETOOMANYREFS => + New_String ("Too many references: cannot splice"), + N_ETIMEDOUT => + New_String ("Connection timed out"), + N_ECONNREFUSED => + New_String ("Connection refused"), + N_ELOOP => + New_String ("Too many levels of symbolic links"), + N_ENAMETOOLONG => + New_String ("File name too long"), + N_EHOSTDOWN => + New_String ("Host is down"), + N_EHOSTUNREACH => + New_String ("No route to host"), + N_SYSNOTREADY => + New_String ("Returned by WSAStartup(), indicating that " + & "the network subsystem is unusable"), + N_VERNOTSUPPORTED => + New_String ("Returned by WSAStartup(), indicating that " + & "the Windows Sockets DLL cannot support " + & "this application"), + N_NOTINITIALISED => + New_String ("Winsock not initialized. This message is " + & "returned by any function except WSAStartup(), " + & "indicating that a successful WSAStartup() has " + & "not yet been performed"), + N_EDISCON => + New_String ("Disconnect"), + N_HOST_NOT_FOUND => + New_String ("Host not found. This message indicates " + & "that the key (name, address, and so on) was not found"), + N_TRY_AGAIN => + New_String ("Nonauthoritative host not found. This error may " + & "suggest that the name service itself is not " + & "functioning"), + N_NO_RECOVERY => + New_String ("Nonrecoverable error. This error may suggest that the " + & "name service itself is not functioning"), + N_NO_DATA => + New_String ("Valid name, no data record of requested type. " + & "This error indicates that the key (name, address, " + & "and so on) was not found."), + N_OTHERS => + New_String ("Unknown system error")); + + --------------- + -- C_Connect -- + --------------- + + function C_Connect + (S : C.int; + Name : System.Address; + Namelen : C.int) + return C.int + is + Res : C.int; + + begin + Res := Standard_Connect (S, Name, Namelen); + + if Res = -1 then + if Socket_Errno = EWOULDBLOCK then + Set_Socket_Errno (EINPROGRESS); + end if; + end if; + + return Res; + end C_Connect; + + ------------- + -- C_Readv -- + ------------- + + function C_Readv + (Socket : C.int; + Iov : System.Address; + Iovcnt : C.int) + return C.int + is + Res : C.int; + Count : C.int := 0; + + Iovec : array (0 .. Iovcnt - 1) of Vector_Element; + for Iovec'Address use Iov; + pragma Import (Ada, Iovec); + + begin + for J in Iovec'Range loop + Res := C_Recv + (Socket, + Iovec (J).Base.all'Address, + C.int (Iovec (J).Length), + 0); + + if Res < 0 then + return Res; + else + Count := Count + Res; + end if; + end loop; + return Count; + end C_Readv; + + -------------- + -- C_Select -- + -------------- + + function C_Select + (Nfds : C.int; + Readfds : Fd_Set_Access; + Writefds : Fd_Set_Access; + Exceptfds : Fd_Set_Access; + Timeout : Timeval_Access) + return C.int + is + pragma Warnings (Off, Exceptfds); + + RFS : constant Fd_Set_Access := Readfds; + WFS : constant Fd_Set_Access := Writefds; + WFSC : Fd_Set_Access := No_Fd_Set; + EFS : Fd_Set_Access := Exceptfds; + Res : C.int; + S : aliased C.int; + Last : aliased C.int; + + begin + -- Asynchronous connection failures are notified in the + -- exception fd set instead of the write fd set. To ensure + -- POSIX compatitibility, copy write fd set into exception fd + -- set. Once select() returns, check any socket present in the + -- exception fd set and peek at incoming out-of-band data. If + -- the test is not successfull and if the socket is present in + -- the initial write fd set, then move the socket from the + -- exception fd set to the write fd set. + + if WFS /= No_Fd_Set then + -- Add any socket present in write fd set into exception fd set + + if EFS = No_Fd_Set then + EFS := New_Socket_Set (WFS); + + else + WFSC := New_Socket_Set (WFS); + + Last := Nfds - 1; + loop + Get_Socket_From_Set + (WFSC, S'Unchecked_Access, Last'Unchecked_Access); + exit when S = -1; + Insert_Socket_In_Set (EFS, S); + end loop; + + Free_Socket_Set (WFSC); + end if; + + -- Keep a copy of write fd set + + WFSC := New_Socket_Set (WFS); + end if; + + Res := Standard_Select (Nfds, RFS, WFS, EFS, Timeout); + + if EFS /= No_Fd_Set then + declare + EFSC : constant Fd_Set_Access := New_Socket_Set (EFS); + Flag : constant C.int := MSG_PEEK + MSG_OOB; + Buffer : Character; + Length : C.int; + Fromlen : aliased C.int; + + begin + Last := Nfds - 1; + loop + Get_Socket_From_Set + (EFSC, S'Unchecked_Access, Last'Unchecked_Access); + + -- No more sockets in EFSC + + exit when S = -1; + + -- Check out-of-band data + + Length := C_Recvfrom + (S, Buffer'Address, 1, Flag, + null, Fromlen'Unchecked_Access); + + -- If the signal is not an out-of-band data, then it + -- is a connection failure notification. + + if Length = -1 then + Remove_Socket_From_Set (EFS, S); + + -- If S is present in the initial write fd set, + -- move it from exception fd set back to write fd + -- set. Otherwise, ignore this event since the user + -- is not watching for it. + + if WFSC /= No_Fd_Set + and then Is_Socket_In_Set (WFSC, S) + then + Insert_Socket_In_Set (WFS, S); + end if; + end if; + end loop; + + Free_Socket_Set (EFSC); + end; + + if Exceptfds = No_Fd_Set then + Free_Socket_Set (EFS); + end if; + end if; + + -- Free any copy of write fd set + + if WFSC /= No_Fd_Set then + Free_Socket_Set (WFSC); + end if; + + return Res; + end C_Select; + + -------------- + -- C_Writev -- + -------------- + + function C_Writev + (Socket : C.int; + Iov : System.Address; + Iovcnt : C.int) + return C.int + is + Res : C.int; + Count : C.int := 0; + + Iovec : array (0 .. Iovcnt - 1) of Vector_Element; + for Iovec'Address use Iov; + pragma Import (Ada, Iovec); + + begin + for J in Iovec'Range loop + Res := C_Send + (Socket, + Iovec (J).Base.all'Address, + C.int (Iovec (J).Length), + 0); + + if Res < 0 then + return Res; + else + Count := Count + Res; + end if; + end loop; + return Count; + end C_Writev; + + -------------- + -- Finalize -- + -------------- + + procedure Finalize is + begin + if Initialized then + WSACleanup; + Initialized := False; + end if; + end Finalize; + + ---------------- + -- Initialize -- + ---------------- + + procedure Initialize (Process_Blocking_IO : Boolean := False) is + pragma Unreferenced (Process_Blocking_IO); + + 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; + + ----------------- + -- Set_Address -- + ----------------- + + procedure Set_Address + (Sin : Sockaddr_In_Access; + Address : In_Addr) + is + begin + Sin.Sin_Addr := Address; + end Set_Address; + + ---------------- + -- Set_Family -- + ---------------- + + procedure Set_Family + (Sin : Sockaddr_In_Access; + Family : C.int) + is + begin + Sin.Sin_Family := C.unsigned_short (Family); + end Set_Family; + + ---------------- + -- Set_Length -- + ---------------- + + procedure Set_Length + (Sin : Sockaddr_In_Access; + Len : C.int) + is + pragma Unreferenced (Sin); + pragma Unreferenced (Len); + + begin + null; + end Set_Length; + + -------------- + -- Set_Port -- + -------------- + + procedure Set_Port + (Sin : Sockaddr_In_Access; + Port : C.unsigned_short) + is + begin + Sin.Sin_Port := Port; + end Set_Port; + + -------------------------- + -- Socket_Error_Message -- + -------------------------- + + function Socket_Error_Message + (Errno : Integer) + return C.Strings.chars_ptr + is + use GNAT.Sockets.Constants; + + begin + case Errno is + when EINTR => return Error_Messages (N_EINTR); + when EBADF => return Error_Messages (N_EBADF); + when EACCES => return Error_Messages (N_EACCES); + when EFAULT => return Error_Messages (N_EFAULT); + when EINVAL => return Error_Messages (N_EINVAL); + when EMFILE => return Error_Messages (N_EMFILE); + when EWOULDBLOCK => return Error_Messages (N_EWOULDBLOCK); + when EINPROGRESS => return Error_Messages (N_EINPROGRESS); + when EALREADY => return Error_Messages (N_EALREADY); + when ENOTSOCK => return Error_Messages (N_ENOTSOCK); + when EDESTADDRREQ => return Error_Messages (N_EDESTADDRREQ); + when EMSGSIZE => return Error_Messages (N_EMSGSIZE); + when EPROTOTYPE => return Error_Messages (N_EPROTOTYPE); + when ENOPROTOOPT => return Error_Messages (N_ENOPROTOOPT); + when EPROTONOSUPPORT => return Error_Messages (N_EPROTONOSUPPORT); + when ESOCKTNOSUPPORT => return Error_Messages (N_ESOCKTNOSUPPORT); + when EOPNOTSUPP => return Error_Messages (N_EOPNOTSUPP); + when EPFNOSUPPORT => return Error_Messages (N_EPFNOSUPPORT); + when EAFNOSUPPORT => return Error_Messages (N_EAFNOSUPPORT); + when EADDRINUSE => return Error_Messages (N_EADDRINUSE); + when EADDRNOTAVAIL => return Error_Messages (N_EADDRNOTAVAIL); + when ENETDOWN => return Error_Messages (N_ENETDOWN); + when ENETUNREACH => return Error_Messages (N_ENETUNREACH); + when ENETRESET => return Error_Messages (N_ENETRESET); + when ECONNABORTED => return Error_Messages (N_ECONNABORTED); + when ECONNRESET => return Error_Messages (N_ECONNRESET); + when ENOBUFS => return Error_Messages (N_ENOBUFS); + when EISCONN => return Error_Messages (N_EISCONN); + when ENOTCONN => return Error_Messages (N_ENOTCONN); + when ESHUTDOWN => return Error_Messages (N_ESHUTDOWN); + when ETOOMANYREFS => return Error_Messages (N_ETOOMANYREFS); + when ETIMEDOUT => return Error_Messages (N_ETIMEDOUT); + when ECONNREFUSED => return Error_Messages (N_ECONNREFUSED); + when ELOOP => return Error_Messages (N_ELOOP); + when ENAMETOOLONG => return Error_Messages (N_ENAMETOOLONG); + when EHOSTDOWN => return Error_Messages (N_EHOSTDOWN); + when EHOSTUNREACH => return Error_Messages (N_EHOSTUNREACH); + when SYSNOTREADY => return Error_Messages (N_SYSNOTREADY); + when VERNOTSUPPORTED => return Error_Messages (N_VERNOTSUPPORTED); + when NOTINITIALISED => return Error_Messages (N_NOTINITIALISED); + when EDISCON => return Error_Messages (N_EDISCON); + when HOST_NOT_FOUND => return Error_Messages (N_HOST_NOT_FOUND); + when TRY_AGAIN => return Error_Messages (N_TRY_AGAIN); + when NO_RECOVERY => return Error_Messages (N_NO_RECOVERY); + when NO_DATA => return Error_Messages (N_NO_DATA); + when others => return Error_Messages (N_OTHERS); + end case; + end Socket_Error_Message; + +end GNAT.Sockets.Thin; |