mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

DRAFT Add partial `scm_fcntl' support for MinGW.

Browse source 
* libguile/filesys.c (_mingw_debug_p)[__MINGW32__: New function.
(scm_fcntl)[__MINGW32__]: Add support creating non-blocking sockets.
This commit is contained in:
Rutger van Beusekom 2019-11-06 14:56:57 +01:00 • committed by Michael Gran
parent 2b86a3b1cb
commit 12ad1a9ad2
1 changed files with 82 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

83
libguile/filesys.c
View file

@ -1124,7 +1124,88 @@ SCM_DEFINE (scm_fcntl, "fcntl", 2, 1, 0,
return scm_from_int (rv); return scm_from_int (rv);
} }
#undef FUNC_NAME #undef FUNC_NAME
#endif /* HAVE_FCNTL */
#else /* !HAVE_FCNTL */
/* XXX gnulib sets these all to 0 which disallows a partial or stub
implementation. */
#undef F_DUPFD
#define F_DUPFD 0
#undef F_GETFD
#define F_GETFD 1
#undef F_SETFD
#define F_SETFD 2
#undef F_GETFL
#define F_GETFL 3
#undef F_SETFL
#define F_SETFL 4
#undef O_NONBLOCK
#define O_NONBLOCK 04000
#undef O_ASNC
#define O_ASYNC 020000
#undef O_SYNC
#define O_SYNC 04010000
#undef O_NDELAY
#define O_NDELAY O_NONBLOCK
int
_mingw_debug_p ()
{
static int debug = -1;
if (debug == -1)
{
char *p = getenv ("MINGW_DEBUG");
debug = p ? strcmp (p, "0") : 0;
}
return debug;
}
SCM_DEFINE (scm_fcntl, "fcntl", 2, 1, 0,
(SCM object, SCM cmd, SCM value),
"Limited fctnl support for mingw:\n"
"OBJECT: socket\n"
"CMD = F_SETFL,\n"
"VALUE = (logior O_NONBLOCK (fcntl OBJECT F_GETFL)).")
#define FUNC_NAME s_scm_fcntl
{
static int stub = 0;
int c_cmd = scm_to_int (cmd);
switch (c_cmd)
{
case F_GETFL:
break;
case F_SETFL:
{
int c_value = scm_to_int (value);
u_long non_blocking = (c_value & O_NONBLOCK) ? 1 : 0;
object = SCM_COERCE_OUTPORT (object);
SOCKET fd = _get_osfhandle (SCM_FPORT_FDES (object));
if (SOCKET_ERROR == ioctlsocket (fd, FIONBIO, &non_blocking))
SCM_SYSERROR;
break;
}
default:
{
if (_mingw_debug_p () && !stub)
fputs ("stub: fcntl", stderr);
stub = 1;
}
}
return scm_from_int (0);
}
#undef FUNC_NAME
#endif /* !HAVE_FCNTL */
SCM_DEFINE (scm_fsync, "fsync", 1, 0, 0, SCM_DEFINE (scm_fsync, "fsync", 1, 0, 0,
(SCM object), (SCM object),