summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2010-12-06 19:27:22 +0100
committerAndy Wingo <wingo@pobox.com>2010-12-06 19:27:22 +0100
commite9634465e365e74b3dc3edeae98a98ece1530f82 (patch)
tree67a8769b67fc3bcc7f638cbd0e7758d801ba614d
parenta9a206554062cf55220dd33d9256ccb431cc888e (diff)
downloadguile-e9634465e365e74b3dc3edeae98a98ece1530f82.tar.gz
ice-9 poll handles buffered io too
* libguile/poll.c (scm_primitive_poll): Account for buffered I/O. * module/ice-9/poll.scm (poll): Adapt to call primitive-poll with the port vector too.
-rw-r--r--libguile/poll.c80
-rw-r--r--module/ice-9/poll.scm1
2 files changed, 77 insertions, 4 deletions
diff --git a/libguile/poll.c b/libguile/poll.c
index 0304448fa..e4d430c52 100644
--- a/libguile/poll.c
+++ b/libguile/poll.c
@@ -61,17 +61,28 @@
The pollfds bytevector is modified directly, setting the returned events in
the final two bytes (the revents member).
+ Since Scheme ports can buffer input or output in userspace, a Scheme
+ poll interface needs to take that into account as well. The `ports'
+ argument, a vector big enough for `nfds' elements, is given for this
+ purpose. If a pollfd entry has a corresponding open port, that port
+ is scanned for available input or output before dropping into the
+ poll. If any port has buffered I/O available, the poll syscall is
+ still issued, but with a timeout of 0 milliseconds, and a full port
+ scan occurs after the poll returns.
+
If timeout is given and is non-negative, the poll will return after that
number of milliseconds if no fd became active.
*/
#ifdef HAVE_POLL
static SCM
-scm_primitive_poll (SCM pollfds, SCM nfds, SCM timeout)
+scm_primitive_poll (SCM pollfds, SCM nfds, SCM ports, SCM timeout)
#define FUNC_NAME "primitive-poll"
{
- int rv;
+ int rv = 0;
+ nfds_t i;
nfds_t c_nfds;
int c_timeout;
+ int have_buffered_io = 0;
struct pollfd *fds;
SCM_VALIDATE_BYTEVECTOR (SCM_ARG1, pollfds);
@@ -80,15 +91,76 @@ scm_primitive_poll (SCM pollfds, SCM nfds, SCM timeout)
if (SCM_UNLIKELY (SCM_BYTEVECTOR_LENGTH (pollfds)
< c_nfds * sizeof(struct pollfd)))
- SCM_OUT_OF_RANGE (SCM_ARG1, nfds);
+ SCM_OUT_OF_RANGE (SCM_ARG2, nfds);
+ SCM_VALIDATE_VECTOR (SCM_ARG3, ports);
+ if (SCM_UNLIKELY (SCM_SIMPLE_VECTOR_LENGTH (ports) < c_nfds))
+ SCM_OUT_OF_RANGE (SCM_ARG3, ports);
+
fds = (struct pollfd*)SCM_BYTEVECTOR_CONTENTS (pollfds);
+ for (i = 0; i < c_nfds; i++)
+ {
+ SCM port = SCM_SIMPLE_VECTOR_REF (ports, i);
+ short int revents = 0;
+
+ if (SCM_PORTP (port))
+ {
+ if (SCM_CLOSEDP (port))
+ revents |= POLLERR;
+ else
+ {
+ scm_t_port *pt = SCM_PTAB_ENTRY (port);
+
+ if (pt->read_pos < pt->read_end)
+ /* Buffered input waiting to be read. */
+ revents |= POLLIN;
+ if (pt->write_pos < pt->write_end)
+ /* Buffered output possible. */
+ revents |= POLLOUT;
+ }
+ }
+
+ if (revents & fds[i].events)
+ {
+ have_buffered_io = 1;
+ c_timeout = 0;
+ break;
+ }
+ }
+
SCM_SYSCALL (rv = poll (fds, c_nfds, c_timeout));
if (rv == -1)
SCM_SYSERROR;
+ if (have_buffered_io)
+ for (i = 0; i < c_nfds; i++)
+ {
+ SCM port = SCM_SIMPLE_VECTOR_REF (ports, i);
+ short int revents = 0;
+
+ if (SCM_PORTP (port))
+ {
+ if (SCM_CLOSEDP (port))
+ revents |= POLLERR;
+ else
+ {
+ scm_t_port *pt = SCM_PTAB_ENTRY (port);
+
+ if (pt->read_pos < pt->read_end)
+ /* Buffered input waiting to be read. */
+ revents |= POLLIN;
+ if (pt->write_pos < pt->write_end)
+ /* Buffered output possible. */
+ revents |= POLLOUT;
+ }
+ }
+
+ if ((fds[i].revents = revents & fds[i].events))
+ rv++;
+ }
+
return scm_from_int (rv);
}
#undef FUNC_NAME
@@ -101,7 +173,7 @@ static void
scm_init_poll (void)
{
#if HAVE_POLL
- scm_c_define_gsubr ("primitive-poll", 3, 0, 0, scm_primitive_poll);
+ scm_c_define_gsubr ("primitive-poll", 4, 0, 0, scm_primitive_poll);
#else
scm_misc_error ("%init-poll", "`poll' unavailable on this platform", SCM_EOL);
#endif
diff --git a/module/ice-9/poll.scm b/module/ice-9/poll.scm
index e506e2ac4..26b264b8e 100644
--- a/module/ice-9/poll.scm
+++ b/module/ice-9/poll.scm
@@ -172,4 +172,5 @@
(define* (poll poll-set #:optional (timeout -1))
(primitive-poll (pset-pollfds poll-set)
(poll-set-nfds poll-set)
+ (pset-ports poll-set)
timeout))