mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-15 16:20:17 +02:00
Code Activity

2001-11-07 Stefan Jahn <stefan@lkcc.org>

Browse source 
* configure.in: Include `win32-socket.o' in the list of object
        files if networking is enabled on Win32.

2001-11-07  Stefan Jahn  <stefan@lkcc.org>

        * win32-socket.[ch]: New files.  Defines Winsock-API error codes
        and makes them available through Guile.  That is because the
        Winsock-API does not store its errors in `errno' and thus cannot
        return error messages via `strerror (errno)'.

        * socket.c (scm_init_socket): Initialize `win32-socket' part
        here under M$-Windows.

        * numbers.h: Added missing declaration of
        `scm_sys_check_number_conversions()'.

        * error.c: Local definition of SCM_I_STRERROR and SCM_I_ERRNO
        and use in `(strerror)' and `(system-error)'.

        * Makefile.am (EXTRA_libguile_la_SOURCES): Added
        `win32-socket.[ch]' to extra source and header files.
This commit is contained in:
Stefan Jahn 2001-11-07 15:08:45 +00:00
parent 2ca222c2e9
commit b4e15479e9
12 changed files with 525 additions and 14 deletions
Download patch file Download diff file Expand all files Collapse all files

5
ChangeLog
View file

@ -1,3 +1,8 @@
2001-11-07 Stefan Jahn <stefan@lkcc.org>
* configure.in: Include `win32-socket.o' in the list of object
files if networking is enabled on Win32.
2001-11-06 Thien-Thi Nguyen <ttn@glug.org> 2001-11-06 Thien-Thi Nguyen <ttn@glug.org>
* TODO (sync srfi-modules.texi): New, done. * TODO (sync srfi-modules.texi): New, done.

5
configure.in
View file

@ -233,7 +233,10 @@ if test "$MINGW32" = "yes" ; then
[Define if you have the <winsock2.h> header file.])]) [Define if you have the <winsock2.h> header file.])])
AC_CHECK_LIB(ws2_32, main) AC_CHECK_LIB(ws2_32, main)
LIBOBJS="$LIBOBJS win32-uname.o win32-dirent.o" LIBOBJS="$LIBOBJS win32-uname.o win32-dirent.o"
if test $enable_shared = yes ; then if test "$enable_networking" = yes ; then
LIBOBJS="$LIBOBJS win32-socket.o"
fi
if test "$enable_shared" = yes ; then
EXTRA_DEFS="-DSCM_IMPORT" EXTRA_DEFS="-DSCM_IMPORT"
AC_DEFINE(USE_DLL_IMPORT, 1, AC_DEFINE(USE_DLL_IMPORT, 1,
[Define if you need additional CPP macros on Win32 platforms.]) [Define if you need additional CPP macros on Win32 platforms.])

19
libguile/ChangeLog
View file

@ -1,3 +1,22 @@
2001-11-07 Stefan Jahn <stefan@lkcc.org>
* win32-socket.[ch]: New files. Defines Winsock-API error codes
and makes them available through Guile. That is because the
Winsock-API does not store its errors in `errno' and thus cannot
return error messages via `strerror (errno)'.
* socket.c (scm_init_socket): Initialize `win32-socket' part
here under M$-Windows.
* numbers.h: Added missing declaration of
`scm_sys_check_number_conversions()'.
* error.c: Local definition of SCM_I_STRERROR and SCM_I_ERRNO
and use in `(strerror)' and `(system-error)'.
* Makefile.am (EXTRA_libguile_la_SOURCES): Added
`win32-socket.[ch]' to extra source and header files.
2001-11-06 Marius Vollmer <mvo@zagadka.ping.de> 2001-11-06 Marius Vollmer <mvo@zagadka.ping.de>
* script.c (scm_shell_usage, scm_compile_shell_switches): Prepend * script.c (scm_shell_usage, scm_compile_shell_switches): Prepend

6
libguile/Makefile.am
View file

@ -94,7 +94,8 @@ EXTRA_libguile_la_SOURCES = _scm.h \
alloca.c inet_aton.c memmove.c putenv.c strerror.c \ alloca.c inet_aton.c memmove.c putenv.c strerror.c \
threads.c regex-posix.c \ threads.c regex-posix.c \
filesys.c posix.c net_db.c socket.c \ filesys.c posix.c net_db.c socket.c \
ramap.c unif.c debug-malloc.c mkstemp.c win32-uname.c win32-dirent.c ramap.c unif.c debug-malloc.c mkstemp.c \
win32-uname.c win32-dirent.c win32-socket.c
## In next release, threads will be factored out of libguile. ## In next release, threads will be factored out of libguile.
## Until then, the machine specific headers is a temporary kludge. ## Until then, the machine specific headers is a temporary kludge.
@ -112,7 +113,8 @@ install-exec-hook:
## Perhaps we can deal with them normally once the merge seems to be ## Perhaps we can deal with them normally once the merge seems to be
## working. ## working.
noinst_HEADERS = coop-threads.c coop-threads.h coop.c \ noinst_HEADERS = coop-threads.c coop-threads.h coop.c \
num2integral.i.c num2float.i.c win32-uname.h win32-dirent.h num2integral.i.c num2float.i.c \
win32-uname.h win32-dirent.h win32-socket.h
libguile_la_DEPENDENCIES = @LIBLOBJS@ libguile_la_DEPENDENCIES = @LIBLOBJS@
libguile_la_LIBADD = @LIBLOBJS@ $(LIBLTDL) $(THREAD_LIBS_LOCAL) libguile_la_LIBADD = @LIBLOBJS@ $(LIBLTDL) $(THREAD_LIBS_LOCAL)

17
libguile/error.c
View file

@ -151,6 +151,17 @@ SCM_DEFINE (scm_error_scm, "scm-error", 5, 0, 0,
} }
#undef FUNC_NAME #undef FUNC_NAME
#ifdef __MINGW32__
# include "win32-socket.h"
# define SCM_I_STRERROR(err) \
((err >= WSABASEERR) ? scm_i_socket_strerror (err) : strerror (err))
# define SCM_I_ERRNO() \
(errno ? errno : scm_i_socket_errno ())
#else
# define SCM_I_STRERROR(err) strerror (err)
# define SCM_I_ERRNO() errno
#endif /* __MINGW32__ */
SCM_DEFINE (scm_strerror, "strerror", 1, 0, 0, SCM_DEFINE (scm_strerror, "strerror", 1, 0, 0,
(SCM err), (SCM err),
"Return the Unix error message corresponding to @var{err}, which\n" "Return the Unix error message corresponding to @var{err}, which\n"
@ -158,7 +169,7 @@ SCM_DEFINE (scm_strerror, "strerror", 1, 0, 0,
#define FUNC_NAME s_scm_strerror #define FUNC_NAME s_scm_strerror
{ {
SCM_VALIDATE_INUM (1,err); SCM_VALIDATE_INUM (1,err);
return scm_makfrom0str (strerror (SCM_INUM (err))); return scm_makfrom0str (SCM_I_STRERROR (SCM_INUM (err)));
} }
#undef FUNC_NAME #undef FUNC_NAME
@ -166,12 +177,12 @@ SCM_GLOBAL_SYMBOL (scm_system_error_key, "system-error");
void void
scm_syserror (const char *subr) scm_syserror (const char *subr)
{ {
int save_errno = errno; int save_errno = SCM_I_ERRNO ();
scm_error (scm_system_error_key, scm_error (scm_system_error_key,
subr, subr,
"~A", "~A",
scm_cons (scm_makfrom0str (strerror (save_errno)), SCM_EOL), scm_cons (scm_makfrom0str (SCM_I_STRERROR (save_errno)), SCM_EOL),
scm_cons (SCM_MAKINUM (save_errno), SCM_EOL)); scm_cons (SCM_MAKINUM (save_errno), SCM_EOL));
} }

2
libguile/numbers.c
View file

@ -4448,7 +4448,7 @@ check_handler (void *data, SCM tag, SCM throw_args)
} }
SCM_DEFINE (scm_sys_check_number_conversions, "%check-number-conversions", 0, 0, 0, SCM_DEFINE (scm_sys_check_number_conversions, "%check-number-conversions", 0, 0, 0,
(), (void),
"Number conversion sanity checking.") "Number conversion sanity checking.")
#define FUNC_NAME s_scm_sys_check_number_conversions #define FUNC_NAME s_scm_sys_check_number_conversions
{ {

4
libguile/numbers.h
View file

@ -333,6 +333,10 @@ SCM_API float scm_num2float (SCM num, unsigned long int pos,
SCM_API double scm_num2double (SCM num, unsigned long int pos, SCM_API double scm_num2double (SCM num, unsigned long int pos,
const char *s_caller); const char *s_caller);
#ifdef GUILE_DEBUG
SCM_API SCM scm_sys_check_number_conversions (void);
#endif
SCM_API void scm_init_numbers (void); SCM_API void scm_init_numbers (void);
#endif /* SCM_NUMBERS_H */ #endif /* SCM_NUMBERS_H */

8
libguile/socket.c
View file

@ -54,6 +54,10 @@
#include "libguile/validate.h" #include "libguile/validate.h"
#include "libguile/socket.h" #include "libguile/socket.h"
#ifdef __MINGW32__
#include "win32-socket.h"
#endif
#ifdef HAVE_STRING_H #ifdef HAVE_STRING_H
#include <string.h> #include <string.h>
#endif #endif
@ -1383,6 +1387,10 @@ scm_init_socket ()
scm_c_define ("MSG_DONTROUTE", SCM_MAKINUM (MSG_DONTROUTE)); scm_c_define ("MSG_DONTROUTE", SCM_MAKINUM (MSG_DONTROUTE));
#endif #endif
#ifdef __MINGW32__
scm_i_init_socket_Win32 ();
#endif
scm_add_feature ("socket"); scm_add_feature ("socket");
#ifndef SCM_MAGIC_SNARFER #ifndef SCM_MAGIC_SNARFER

6
libguile/win32-dirent.h
View file

@ -1,7 +1,7 @@
/* classes: h_files */ /* classes: h_files */
#ifndef SCM_DIRENT_H #ifndef SCM_WIN32_DIRENT_H
#define SCM_DIRENT_H #define SCM_WIN32_DIRENT_H
/* Copyright (C) 2001 Free Software Foundation, Inc. /* Copyright (C) 2001 Free Software Foundation, Inc.
* *
@ -85,4 +85,4 @@ void seekdir (DIR * dir, off_t offset);
off_t telldir (DIR * dir); off_t telldir (DIR * dir);
int dirfd (DIR * dir); int dirfd (DIR * dir);
#endif /* SCM_DIRENT_H */ #endif /* SCM_WIN32_DIRENT_H */

403
libguile/win32-socket.c Normal file
View file

@ -0,0 +1,403 @@
/* Copyright (C) 2001 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT 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
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice. */
#include "libguile/__scm.h"
#include "libguile/modules.h"
#include "libguile/numbers.h"
#include <errno.h>
#include "win32-socket.h"
/* Winsock API error description structure. The error description is
necessary because there is no error list available. */
typedef struct
{
int error; /* Error code. */
char *str; /* Error description. */
int replace; /* Possible error code replacement. */
char *replace_str; /* Replacement symbol. */
char *correct_str; /* Original symbol. */
}
socket_error_t;
/* Define replacement symbols for most of the WSA* error codes. */
#ifndef EWOULDBLOCK
# define EWOULDBLOCK WSAEWOULDBLOCK
#endif
#ifndef EINPROGRESS
# define EINPROGRESS WSAEINPROGRESS
#endif
#ifndef EALREADY
# define EALREADY WSAEALREADY
#endif
#ifndef EDESTADDRREQ
# define EDESTADDRREQ WSAEDESTADDRREQ
#endif
#ifndef EMSGSIZE
# define EMSGSIZE WSAEMSGSIZE
#endif
#ifndef EPROTOTYPE
# define EPROTOTYPE WSAEPROTOTYPE
#endif
#ifndef ENOTSOCK
# define ENOTSOCK WSAENOTSOCK
#endif
#ifndef ENOPROTOOPT
# define ENOPROTOOPT WSAENOPROTOOPT
#endif
#ifndef EPROTONOSUPPORT
# define EPROTONOSUPPORT WSAEPROTONOSUPPORT
#endif
#ifndef ESOCKTNOSUPPORT
# define ESOCKTNOSUPPORT WSAESOCKTNOSUPPORT
#endif
#ifndef EOPNOTSUPP
# define EOPNOTSUPP WSAEOPNOTSUPP
#endif
#ifndef EPFNOSUPPORT
# define EPFNOSUPPORT WSAEPFNOSUPPORT
#endif
#ifndef EAFNOSUPPORT
# define EAFNOSUPPORT WSAEAFNOSUPPORT
#endif
#ifndef EADDRINUSE
# define EADDRINUSE WSAEADDRINUSE
#endif
#ifndef EADDRNOTAVAIL
# define EADDRNOTAVAIL WSAEADDRNOTAVAIL
#endif
#ifndef ENETDOWN
# define ENETDOWN WSAENETDOWN
#endif
#ifndef ENETUNREACH
# define ENETUNREACH WSAENETUNREACH
#endif
#ifndef ENETRESET
# define ENETRESET WSAENETRESET
#endif
#ifndef ECONNABORTED
# define ECONNABORTED WSAECONNABORTED
#endif
#ifndef ECONNRESET
# define ECONNRESET WSAECONNRESET
#endif
#ifndef ENOBUFS
# define ENOBUFS WSAENOBUFS
#endif
#ifndef EISCONN
# define EISCONN WSAEISCONN
#endif
#ifndef ENOTCONN
# define ENOTCONN WSAENOTCONN
#endif
#ifndef ESHUTDOWN
# define ESHUTDOWN WSAESHUTDOWN
#endif
#ifndef ETOOMANYREFS
# define ETOOMANYREFS WSAETOOMANYREFS
#endif
#ifndef ETIMEDOUT
# define ETIMEDOUT WSAETIMEDOUT
#endif
#ifndef ECONNREFUSED
# define ECONNREFUSED WSAECONNREFUSED
#endif
#ifndef ELOOP
# define ELOOP WSAELOOP
#endif
#ifndef EHOSTDOWN
# define EHOSTDOWN WSAEHOSTDOWN
#endif
#ifndef EHOSTUNREACH
# define EHOSTUNREACH WSAEHOSTUNREACH
#endif
#ifndef EPROCLIM
# define EPROCLIM WSAEPROCLIM
#endif
#ifndef EUSERS
# define EUSERS WSAEUSERS
#endif
#ifndef EDQUOT
# define EDQUOT WSAEDQUOT
#endif
#ifndef ESTALE
# define ESTALE WSAESTALE
#endif
#ifndef EREMOTE
# define EREMOTE WSAEREMOTE
#endif
/* List of error structures. */
static socket_error_t socket_errno [] = {
/* 000 */ { 0, NULL, 0, NULL, NULL },
/* 001 */ { 0, NULL, 0, NULL, NULL },
/* 002 */ { 0, NULL, 0, NULL, NULL },
/* 003 */ { 0, NULL, 0, NULL, NULL },
/* 004 */ { WSAEINTR, "Interrupted function call", EINTR, NULL, "WSAEINTR" },
/* 005 */ { 0, NULL, 0, NULL, NULL },
/* 006 */ { 0, NULL, 0, NULL, NULL },
/* 007 */ { 0, NULL, 0, NULL, NULL },
/* 008 */ { 0, NULL, 0, NULL, NULL },
/* 009 */ { WSAEBADF, "Bad file number", EBADF, NULL, "WSAEBADF" },
/* 010 */ { 0, NULL, 0, NULL, NULL },
/* 011 */ { 0, NULL, 0, NULL, NULL },
/* 012 */ { 0, NULL, 0, NULL, NULL },
/* 013 */ { WSAEACCES, "Permission denied", EACCES, NULL, "WSAEACCES" },
/* 014 */ { WSAEFAULT, "Bad address", EFAULT, NULL, "WSAEFAULT" },
/* 015 */ { 0, NULL, 0, NULL, NULL },
/* 016 */ { 0, NULL, 0, NULL, NULL },
/* 017 */ { 0, NULL, 0, NULL, NULL },
/* 018 */ { 0, NULL, 0, NULL, NULL },
/* 019 */ { 0, NULL, 0, NULL, NULL },
/* 020 */ { 0, NULL, 0, NULL, NULL },
/* 021 */ { 0, NULL, 0, NULL, NULL },
/* 022 */ { WSAEINVAL, "Invalid argument", EINVAL, NULL, "WSAEINVAL" },
/* 023 */ { 0, NULL, 0, NULL, NULL },
/* 024 */ { WSAEMFILE, "Too many open files", EMFILE, NULL, "WSAEMFILE" },
/* 025 */ { 0, NULL, 0, NULL, NULL },
/* 026 */ { 0, NULL, 0, NULL, NULL },
/* 027 */ { 0, NULL, 0, NULL, NULL },
/* 028 */ { 0, NULL, 0, NULL, NULL },
/* 029 */ { 0, NULL, 0, NULL, NULL },
/* 030 */ { 0, NULL, 0, NULL, NULL },
/* 031 */ { 0, NULL, 0, NULL, NULL },
/* 032 */ { 0, NULL, 0, NULL, NULL },
/* 033 */ { 0, NULL, 0, NULL, NULL },
/* 034 */ { 0, NULL, 0, NULL, NULL },
/* 035 */ { WSAEWOULDBLOCK, "Resource temporarily unavailable",
EWOULDBLOCK, "EWOULDBLOCK", "WSAEWOULDBLOCK" },
/* 036 */ { WSAEINPROGRESS, "Operation now in progress",
EINPROGRESS, "EINPROGRESS", "WSAEINPROGRESS" },
/* 037 */ { WSAEALREADY, "Operation already in progress",
EALREADY, "EALREADY", "WSAEALREADY" },
/* 038 */ { WSAENOTSOCK, "Socket operation on non-socket",
ENOTSOCK, "ENOTSOCK", "WSAENOTSOCK"},
/* 039 */ { WSAEDESTADDRREQ, "Destination address required",
EDESTADDRREQ, "EDESTADDRREQ", "WSAEDESTADDRREQ" },
/* 040 */ { WSAEMSGSIZE, "Message too long",
EMSGSIZE, "EMSGSIZE", "WSAEMSGSIZE" },
/* 041 */ { WSAEPROTOTYPE, "Protocol wrong type for socket",
EPROTOTYPE, "EPROTOTYPE", "WSAEPROTOTYPE" },
/* 042 */ { WSAENOPROTOOPT, "Bad protocol option",
ENOPROTOOPT, "ENOPROTOOPT", "WSAENOPROTOOPT" },
/* 043 */ { WSAEPROTONOSUPPORT, "Protocol not supported",
EPROTONOSUPPORT, "EPROTONOSUPPORT", "WSAEPROTONOSUPPORT" },
/* 044 */ { WSAESOCKTNOSUPPORT, "Socket type not supported",
ESOCKTNOSUPPORT, "ESOCKTNOSUPPORT", "WSAESOCKTNOSUPPORT" },
/* 045 */ { WSAEOPNOTSUPP, "Operation not supported",
EOPNOTSUPP, "EOPNOTSUPP", "WSAEOPNOTSUPP" },
/* 046 */ { WSAEPFNOSUPPORT, "Protocol family not supported",
EPFNOSUPPORT, "EPFNOSUPPORT", "WSAEPFNOSUPPORT" },
/* 047 */ { WSAEAFNOSUPPORT,
"Address family not supported by protocol family",
EAFNOSUPPORT, "EAFNOSUPPORT", "WSAEAFNOSUPPORT" },
/* 048 */ { WSAEADDRINUSE, "Address already in use",
EADDRINUSE, "EADDRINUSE", "WSAEADDRINUSE" },
/* 049 */ { WSAEADDRNOTAVAIL, "Cannot assign requested address",
EADDRNOTAVAIL, "EADDRNOTAVAIL", "WSAEADDRNOTAVAIL" },
/* 050 */ { WSAENETDOWN, "Network is down",
ENETDOWN, "ENETDOWN", "WSAENETDOWN" },
/* 051 */ { WSAENETUNREACH, "Network is unreachable",
ENETUNREACH, "ENETUNREACH", "WSAENETUNREACH" },
/* 052 */ { WSAENETRESET, "Network dropped connection on reset",
ENETRESET, "ENETRESET", "WSAENETRESET" },
/* 053 */ { WSAECONNABORTED, "Software caused connection abort",
ECONNABORTED, "ECONNABORTED", "WSAECONNABORTED" },
/* 054 */ { WSAECONNRESET, "Connection reset by peer",
ECONNRESET, "ECONNRESET", "WSAECONNRESET" },
/* 055 */ { WSAENOBUFS, "No buffer space available",
ENOBUFS, "ENOBUFS", "WSAENOBUFS" },
/* 056 */ { WSAEISCONN, "Socket is already connected",
EISCONN, "EISCONN", "WSAEISCONN" },
/* 057 */ { WSAENOTCONN, "Socket is not connected",
ENOTCONN, "ENOTCONN", "WSAENOTCONN" },
/* 058 */ { WSAESHUTDOWN, "Cannot send after socket shutdown",
ESHUTDOWN, "ESHUTDOWN", "WSAESHUTDOWN" },
/* 059 */ { WSAETOOMANYREFS, "Too many references; can't splice",
ETOOMANYREFS, "ETOOMANYREFS", "WSAETOOMANYREFS" },
/* 060 */ { WSAETIMEDOUT, "Connection timed out",
ETIMEDOUT, "ETIMEDOUT", "WSAETIMEDOUT" },
/* 061 */ { WSAECONNREFUSED, "Connection refused",
ECONNREFUSED, "ECONNREFUSED", "WSAECONNREFUSED" },
/* 062 */ { WSAELOOP, "Too many levels of symbolic links",
ELOOP, "ELOOP", "WSAELOOP" },
/* 063 */ { WSAENAMETOOLONG, "File name too long",
ENAMETOOLONG, NULL, "WSAENAMETOOLONG" },
/* 064 */ { WSAEHOSTDOWN, "Host is down",
EHOSTDOWN, "EHOSTDOWN", "WSAEHOSTDOWN" },
/* 065 */ { WSAEHOSTUNREACH, "No route to host",
EHOSTUNREACH, "EHOSTUNREACH", "WSAEHOSTUNREACH" },
/* 066 */ { WSAENOTEMPTY, "Directory not empty",
ENOTEMPTY, NULL, "WSAENOTEMPTY" },
/* 067 */ { WSAEPROCLIM, "Too many processes",
EPROCLIM, "EPROCLIM", "WSAEPROCLIM" },
/* 068 */ { WSAEUSERS, "Too many users",
EUSERS, "EUSERS", "WSAEUSERS" },
/* 069 */ { WSAEDQUOT, "Disc quota exceeded",
EDQUOT, "EDQUOT", "WSAEDQUOT" },
/* 070 */ { WSAESTALE, "Stale NFS file handle",
ESTALE, "ESTALE", "WSAESTALE" },
/* 071 */ { WSAEREMOTE, "Too many levels of remote in path",
EREMOTE, "EREMOTE", "WSAEREMOTE" },
/* 072 */ { 0, NULL, 0, NULL, NULL },
/* 073 */ { 0, NULL, 0, NULL, NULL },
/* 074 */ { 0, NULL, 0, NULL, NULL },
/* 075 */ { 0, NULL, 0, NULL, NULL },
/* 076 */ { 0, NULL, 0, NULL, NULL },
/* 077 */ { 0, NULL, 0, NULL, NULL },
/* 078 */ { 0, NULL, 0, NULL, NULL },
/* 079 */ { 0, NULL, 0, NULL, NULL },
/* 080 */ { 0, NULL, 0, NULL, NULL },
/* 081 */ { 0, NULL, 0, NULL, NULL },
/* 082 */ { 0, NULL, 0, NULL, NULL },
/* 083 */ { 0, NULL, 0, NULL, NULL },
/* 084 */ { 0, NULL, 0, NULL, NULL },
/* 085 */ { 0, NULL, 0, NULL, NULL },
/* 086 */ { 0, NULL, 0, NULL, NULL },
/* 087 */ { 0, NULL, 0, NULL, NULL },
/* 088 */ { 0, NULL, 0, NULL, NULL },
/* 089 */ { 0, NULL, 0, NULL, NULL },
/* 090 */ { 0, NULL, 0, NULL, NULL },
/* 091 */ { WSASYSNOTREADY, "Network subsystem is unavailable",
0, NULL, "WSASYSNOTREADY" },
/* 092 */ { WSAVERNOTSUPPORTED, "WINSOCK.DLL version out of range",
0, NULL, "WSAVERNOTSUPPORTED" },
/* 093 */ { WSANOTINITIALISED, "Successful WSAStartup not yet performed",
0, NULL, "WSANOTINITIALISED" },
/* 094 */ { 0, NULL, 0, NULL, NULL },
/* 095 */ { 0, NULL, 0, NULL, NULL },
/* 096 */ { 0, NULL, 0, NULL, NULL },
/* 097 */ { 0, NULL, 0, NULL, NULL },
/* 098 */ { 0, NULL, 0, NULL, NULL },
/* 099 */ { 0, NULL, 0, NULL, NULL },
/* 100 */ { 0, NULL, 0, NULL, NULL },
/* 101 */ { WSAEDISCON, "Graceful shutdown in progress",
0, NULL, "WSAEDISCON" },
/* 102 */ { WSAENOMORE, "No more services",
0, NULL, "WSAENOMORE" },
/* 103 */ { WSAECANCELLED, "Service lookup cancelled",
0, NULL, "WSAECANCELLED" },
/* 104 */ { WSAEINVALIDPROCTABLE, "Invalid procedure call table",
0, NULL, "WSAEINVALIDPROCTABLE" },
/* 105 */ { WSAEINVALIDPROVIDER, "Invalid service provider",
0, NULL, "WSAEINVALIDPROVIDER" },
/* 106 */ { WSAEPROVIDERFAILEDINIT, "Service provider failure",
0, NULL, "WSAEPROVIDERFAILEDINIT" },
/* 107 */ { WSASYSCALLFAILURE, "System call failed",
0, NULL, "WSASYSCALLFAILURE" },
/* 108 */ { WSASERVICE_NOT_FOUND, "No such service",
0, NULL, "WSASERVICE_NOT_FOUND" },
/* 109 */ { WSATYPE_NOT_FOUND, "Class not found",
0, NULL, "WSATYPE_NOT_FOUND" },
/* 110 */ { WSA_E_NO_MORE, "No more services",
0, NULL, "WSA_E_NO_MORE" },
/* 111 */ { WSA_E_CANCELLED, "Service lookup cancelled",
0, NULL, "WSA_E_CANCELLED" },
/* 112 */ { WSAEREFUSED, "Database query refused",
0, NULL, "WSAEREFUSED" },
/* end */ { -1, NULL, -1, NULL, NULL }
};
/* Extended list of error structures. */
static socket_error_t socket_h_errno [] = {
/* 000 */ { 0, NULL, 0, NULL, NULL },
/* 001 */ { WSAHOST_NOT_FOUND, "Host not found",
HOST_NOT_FOUND, "HOST_NOT_FOUND", "WSAHOST_NOT_FOUND" },
/* 002 */ { WSATRY_AGAIN, "Non-authoritative host not found",
TRY_AGAIN, "TRY_AGAIN", "WSATRY_AGAIN" },
/* 003 */ { WSANO_RECOVERY, "This is a non-recoverable error",
NO_RECOVERY, "NO_RECOVERY", "WSANO_RECOVERY" },
/* 004 */ { WSANO_DATA, "Valid name, no data record of requested type",
NO_DATA, "NO_DATA", "WSANO_DATA" },
/* 005 */ { WSANO_ADDRESS, "No address, look for MX record",
NO_ADDRESS, "NO_ADDRESS", "WSANO_ADDRESS" },
/* end */ { -1, NULL, -1, NULL, NULL }
};
/* Returns the result of @code{WSAGetLastError()}. */
int
scm_i_socket_errno (void)
{
return WSAGetLastError ();
}
/* Returns a valid error message for Winsock-API error codes obtained via
@code{WSAGetLastError()} or NULL otherwise. */
char *
scm_i_socket_strerror (int error)
{
if (error >= WSABASEERR && error <= (WSABASEERR + 112))
return socket_errno[error - WSABASEERR].str;
else if (error >= (WSABASEERR + 1000) && error <= (WSABASEERR + 1005))
return socket_h_errno[error - (WSABASEERR + 1000)].str;
return NULL;
}
/* Define both the original and replacement error symbol is possible. Thus
the user is able to check symbolic errors after unsuccessful networking
function calls. */
static void
scm_socket_symbols_Win32 (socket_error_t * e)
{
while (e->error != -1)
{
if (e->error)
{
if (e->correct_str)
scm_c_define (e->correct_str, SCM_MAKINUM (e->error));
if (e->replace && e->replace_str)
scm_c_define (e->replace_str, SCM_MAKINUM (e->replace));
}
e++;
}
}
/* Initialize Winsock API under M$-Windows. */
void
scm_i_init_socket_Win32 (void)
{
scm_socket_symbols_Win32 (socket_errno);
scm_socket_symbols_Win32 (socket_h_errno);
}

56
libguile/win32-socket.h Normal file
View file

@ -0,0 +1,56 @@
/* classes: h_files */
#ifndef SCM_WIN32_SOCKET_H
#define SCM_WIN32_SOCKET_H
/* Copyright (C) 2001 Free Software Foundation, Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option)
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT 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
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA
*
* As a special exception, the Free Software Foundation gives permission
* for additional uses of the text contained in its release of GUILE.
*
* The exception is that, if you link the GUILE library with other files
* to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the GUILE library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the
* Free Software Foundation under the name GUILE. If you copy
* code from other Free Software Foundation releases into a copy of
* GUILE, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for GUILE, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice. */
#if HAVE_WINSOCK2_H
# include <winsock2.h>
#endif
int scm_i_socket_errno (void);
char * scm_i_socket_strerror (int error);
void scm_i_init_socket_Win32 (void);
#endif /* SCM_WIN32_SOCKET_H */

8
libguile/win32-uname.h
View file

@ -1,7 +1,7 @@
/* classes: h_files */ /* classes: h_files */
#ifndef SCM_UNAME_H #ifndef SCM_WIN32_UNAME_H
#define SCM_UNAME_H #define SCM_WIN32_UNAME_H
/* Copyright (C) 2001 Free Software Foundation, Inc. /* Copyright (C) 2001 Free Software Foundation, Inc.
* *
@ -70,6 +70,6 @@ struct utsname
char domainname[_UTSNAME_DOMAIN_LENGTH]; char domainname[_UTSNAME_DOMAIN_LENGTH];
}; };
int uname (struct utsname *uts); int uname (struct utsname * uts);
#endif /* SCM_UNAME_H */ #endif /* SCM_WIN32_UNAME_H */