[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 03/23: add (ice-9 epoll)
From: |
Andy Wingo |
Subject: |
[Guile-commits] 03/23: add (ice-9 epoll) |
Date: |
Thu, 24 Mar 2016 14:26:02 +0000 |
wingo pushed a commit to branch wip-ethreads
in repository guile.
commit f2446e79ab0b40720aca507d866d893a8211fd6c
Author: Andy Wingo <address@hidden>
Date: Thu Mar 15 12:16:22 2012 +0100
add (ice-9 epoll)
* configure.ac: Add checks for sys/epoll.h, epoll_create, and
epoll_create1.
* libguile/poll.c (scm_primitive_epoll_create, scm_primitive_epoll_ctl)
(scm_primitive_epoll_wait): New primitives for (ice-9 epoll).
Registered via a scm_init_epoll extension.
* module/Makefile.am: Add ice-9/epoll.scm.
* module/ice-9/epoll.scm: New file.
---
configure.ac | 4 +-
libguile/poll.c | 149 ++++++++++++++++++++++++++++++++++++++++++++++++
module/Makefile.am | 1 +
module/ice-9/epoll.scm | 112 ++++++++++++++++++++++++++++++++++++
4 files changed, 265 insertions(+), 1 deletions(-)
diff --git a/configure.ac b/configure.ac
index 0eb2368..5ff96e0 100644
--- a/configure.ac
+++ b/configure.ac
@@ -664,7 +664,7 @@ AC_CHECK_HEADERS([complex.h fenv.h io.h libc.h limits.h
memory.h process.h strin
sys/dir.h sys/ioctl.h sys/select.h \
sys/time.h sys/timeb.h sys/times.h sys/stdtypes.h sys/types.h \
sys/utime.h time.h unistd.h utime.h pwd.h grp.h sys/utsname.h \
-direct.h machine/fpu.h sched.h sys/sendfile.h])
+direct.h machine/fpu.h sched.h sys/epoll.h sys/sendfile.h])
# "complex double" is new in C99, and "complex" is only a keyword if
# <complex.h> is included
@@ -739,6 +739,7 @@ AC_CHECK_HEADERS([assert.h crt_externs.h])
# for gcc to provide the "complex double" type but the system to not
# have functions like cexp and clog
# clog10 - not in mingw (though others like clog and csqrt are)
+# epoll_create, epoll_create1: glibc/Linux API
# fesetround - available in C99, but not older systems
# ftruncate - posix, but probably not older systems (current mingw
# has it as an inline for chsize)
@@ -757,6 +758,7 @@ AC_CHECK_HEADERS([assert.h crt_externs.h])
# sendfile - non-POSIX, found in glibc
#
AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 ctermid
\
+ epoll_create epoll_create1 \
fesetround ftime ftruncate fchown fchmod getcwd geteuid getsid \
gettimeofday gmtime_r ioctl lstat mkdir mknod nice \
readdir_r readdir64_r readlink rename rmdir setegid seteuid \
diff --git a/libguile/poll.c b/libguile/poll.c
index 9ea846b..234ff82 100644
--- a/libguile/poll.c
+++ b/libguile/poll.c
@@ -27,6 +27,11 @@
#include <poll.h>
+#ifdef HAVE_SYS_EPOLL_H
+#include <sys/epoll.h>
+#define HAVE_EPOLL
+#endif
+
#include "libguile/_scm.h"
#include "libguile/bytevectors.h"
#include "libguile/numbers.h"
@@ -174,6 +179,110 @@ scm_primitive_poll (SCM pollfds, SCM nfds, SCM ports, SCM
timeout)
+/* {EPoll}
+ */
+
+/* EPoll is a newer Linux interface designed for sets of file
+ descriptors that are mostly in a dormant state. These primitives
+ wrap the epoll interface on a very low level.
+
+ This is a low-level interface. See the `(ice-9 epoll)' module for a more
+ usable wrapper. Note that this low-level interface deals in file
+ descriptors, not ports, in order to allow higher-level code to handle
+ the interaction with the garbage collector. */
+#ifdef HAVE_EPOLL
+static SCM
+scm_primitive_epoll_create (SCM cloexec_p)
+#define FUNC_NAME "epoll-create"
+{
+ int fd;
+
+#ifdef HAVE_EPOLL_CREATE1
+ fd = epoll_create1 (scm_is_true (cloexec_p) ? EPOLL_CLOEXEC : 0);
+ if (fd < 0)
+ SCM_SYSERROR;
+#else
+ fd = epoll_create (16);
+ if (fd < 0)
+ SCM_SYSERROR;
+ if (scm_is_true (cloexec_p))
+ fcntl (fd, F_SETFD, FD_CLOEXEC, 1);
+#endif
+
+ return scm_from_int (fd);
+}
+#undef FUNC_NAME
+
+/* This epoll wrapper always places the fd itself as the "data" of the
+ events structure. */
+static SCM
+scm_primitive_epoll_ctl (SCM epfd, SCM op, SCM fd, SCM events)
+#define FUNC_NAME "primitive-epoll-ctl"
+{
+ int c_epfd, c_op, c_fd;
+ struct epoll_event ev = { 0, };
+
+ c_epfd = scm_to_int (epfd);
+ c_op = scm_to_int (op);
+ c_fd = scm_to_int (fd);
+
+ if (SCM_UNBNDP (events))
+ {
+ if (c_op == EPOLL_CTL_DEL)
+ /* Events do not matter in this case. */
+ ev.events = 0;
+ else
+ SCM_MISC_ERROR ("missing events arg", SCM_EOL);
+ }
+ else
+ ev.events = scm_to_uint32 (events);
+
+ ev.data.fd = c_fd;
+
+ if (epoll_ctl (c_epfd, c_op, c_fd, &ev))
+ SCM_SYSERROR;
+
+ return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+/* Wait on the files whose descriptors were registered on EPFD, and
+ write the resulting events in EVENTSV, a bytevector. Returns the
+ number of struct epoll_event values that were written to EVENTSV,
+ which may be zero if no files triggered wakeups within TIMEOUT
+ milliseconds. */
+static SCM
+scm_primitive_epoll_wait (SCM epfd, SCM eventsv, SCM timeout)
+#define FUNC_NAME "primitive-epoll-wait"
+{
+ int c_epfd, maxevents, rv, c_timeout;
+ struct epoll_event *events;
+
+ c_epfd = scm_to_int (epfd);
+
+ SCM_VALIDATE_BYTEVECTOR (SCM_ARG2, eventsv);
+ if (SCM_UNLIKELY (SCM_BYTEVECTOR_LENGTH (eventsv) % sizeof (*events)))
+ SCM_OUT_OF_RANGE (SCM_ARG2, eventsv);
+
+ events = (struct epoll_event *) SCM_BYTEVECTOR_CONTENTS (eventsv);
+ maxevents = SCM_BYTEVECTOR_LENGTH (eventsv) / sizeof (*events);
+ c_timeout = SCM_UNBNDP (timeout) ? -1 : scm_to_int (timeout);
+
+ SCM_SYSCALL (rv = epoll_wait (c_epfd, events, maxevents, c_timeout));
+
+ if (rv == -1)
+ SCM_SYSERROR;
+
+ return scm_from_int (rv);
+}
+#undef FUNC_NAME
+
+#endif /* HAVE_EPOLL */
+
+
+
+
+/* Low-level helpers for (ice-9 poll). */
static void
scm_init_poll (void)
{
@@ -204,6 +313,41 @@ scm_init_poll (void)
}
+/* Low-level helpers for (ice-9 epoll). */
+static void
+scm_init_epoll (void)
+{
+#ifdef HAVE_EPOLL
+ scm_c_define_gsubr ("primitive-epoll-create", 1, 0, 0,
+ scm_primitive_epoll_create);
+ scm_c_define_gsubr ("primitive-epoll-ctl", 3, 1, 0,
+ scm_primitive_epoll_ctl);
+ scm_c_define_gsubr ("primitive-epoll-wait", 3, 1, 0,
+ scm_primitive_epoll_wait);
+ scm_c_define ("%sizeof-struct-epoll-event",
+ scm_from_size_t (sizeof (struct epoll_event)));
+ scm_c_define ("%offsetof-struct-epoll-event-fd",
+ scm_from_size_t (offsetof (struct epoll_event, data.fd)));
+ scm_c_define ("EPOLLIN", scm_from_int (EPOLLIN));
+ scm_c_define ("EPOLLOUT", scm_from_int (EPOLLOUT));
+#ifdef EPOLLRDHUP
+ scm_c_define ("EPOLLRDHUP", scm_from_int (EPOLLRDHUP));
+#endif
+ scm_c_define ("EPOLLPRI", scm_from_int (EPOLLPRI));
+ scm_c_define ("EPOLLERR", scm_from_int (EPOLLERR));
+ scm_c_define ("EPOLLHUP", scm_from_int (EPOLLHUP));
+ scm_c_define ("EPOLLET", scm_from_int (EPOLLET));
+#ifdef EPOLLONESHOT
+ scm_c_define ("EPOLLONESHOT", scm_from_int (EPOLLONESHOT));
+#endif
+ scm_c_define ("EPOLL_CTL_ADD", scm_from_int (EPOLL_CTL_ADD));
+ scm_c_define ("EPOLL_CTL_MOD", scm_from_int (EPOLL_CTL_MOD));
+ scm_c_define ("EPOLL_CTL_DEL", scm_from_int (EPOLL_CTL_DEL));
+#else
+ scm_misc_error ("%init-epoll", "`epoll' unavailable on this platform",
SCM_EOL);
+#endif
+}
+
void
scm_register_poll (void)
{
@@ -211,6 +355,11 @@ scm_register_poll (void)
"scm_init_poll",
(scm_t_extension_init_func) scm_init_poll,
NULL);
+
+ scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION,
+ "scm_init_epoll",
+ (scm_t_extension_init_func) scm_init_epoll,
+ NULL);
}
/*
diff --git a/module/Makefile.am b/module/Makefile.am
index f44a7a6..76734e6 100644
--- a/module/Makefile.am
+++ b/module/Makefile.am
@@ -56,6 +56,7 @@ SOURCES = \
ice-9/debug.scm \
ice-9/deprecated.scm \
ice-9/documentation.scm \
+ ice-9/epoll.scm \
ice-9/eports.scm \
ice-9/eval-string.scm \
ice-9/eval.scm \
diff --git a/module/ice-9/epoll.scm b/module/ice-9/epoll.scm
new file mode 100644
index 0000000..e10c5ff
--- /dev/null
+++ b/module/ice-9/epoll.scm
@@ -0,0 +1,112 @@
+;; epoll
+
+;;;; Copyright (C) 2016 Free Software Foundation, Inc.
+;;;;
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;;
+;;;; This library 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
+;;;; Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301
USA
+;;;;
+
+(define-module (ice-9 epoll)
+ #:use-module (srfi srfi-9)
+ #:use-module (srfi srfi-9 gnu)
+ #:use-module (rnrs bytevectors)
+ #:export (epoll-create
+ epoll-destroy
+ epoll?
+ epoll-add!
+ epoll-modify!
+ epoll-remove!
+ epoll
+
+ EPOLLIN EPOLLOUT EPOLLPRO EPOLLERR EPOLLHUP EPOLLET))
+
+(eval-when (eval load compile)
+ (load-extension (string-append "libguile-" (effective-version))
+ "scm_init_epoll"))
+
+(if (defined? 'EPOLLRDHUP)
+ (export EPOLLRDHUP))
+(if (defined? 'EPOLLONESHOT)
+ (export EPOLLONESHOT))
+
+(define-record-type <epoll>
+ (make-epoll fd eventsv)
+ epoll?
+ (fd epoll-fd set-epoll-fd!)
+ (eventsv epoll-eventsv set-epoll-eventsv!))
+
+(define-syntax events-offset
+ (lambda (x)
+ (syntax-case x ()
+ ((_ n)
+ #`(* n #,%sizeof-struct-epoll-event)))))
+
+(define-syntax fd-offset
+ (lambda (x)
+ (syntax-case x ()
+ ((_ n)
+ #`(+ (* n #,%sizeof-struct-epoll-event)
+ #,%offsetof-struct-epoll-event-fd)))))
+
+(define epoll-guardian (make-guardian))
+(define (pump-epoll-guardian)
+ (let ((epoll (epoll-guardian)))
+ (when epoll
+ (epoll-destroy epoll)
+ (pump-epoll-guardian))))
+(add-hook! after-gc-hook pump-epoll-guardian)
+
+(define* (epoll-create #:key (close-on-exec? #t))
+ (let ((epoll (make-epoll (primitive-epoll-create close-on-exec?) #f)))
+ (epoll-guardian epoll)
+ epoll))
+
+(define (epoll-destroy epoll)
+ (when (epoll-fd epoll)
+ (close-fdes (epoll-fd epoll))
+ (set-epoll-fd! epoll #f)))
+
+(define (epoll-add! epoll fd events)
+ (primitive-epoll-ctl (epoll-fd epoll) EPOLL_CTL_ADD fd events))
+
+(define* (epoll-modify! epoll fd events)
+ (primitive-epoll-ctl (epoll-fd epoll) EPOLL_CTL_MOD fd events))
+
+(define (epoll-remove! epoll fd)
+ (primitive-epoll-ctl (epoll-fd epoll) EPOLL_CTL_DEL fd))
+
+(define (epoll-default-folder fd events seed)
+ (acons fd events seed))
+
+(define (ensure-epoll-eventsv epoll maxevents)
+ (let ((prev (epoll-eventsv epoll)))
+ (if (and prev
+ (or (not maxevents)
+ (= (events-offset maxevents) (bytevector-length prev))))
+ prev
+ (let ((v (make-bytevector (events-offset (or maxevents 8)))))
+ (set-epoll-eventsv! epoll v)
+ v))))
+
+(define* (epoll epoll #:optional maxevents (timeout -1)
+ #:key (folder epoll-default-folder) (seed '()))
+ (let* ((eventsv (ensure-epoll-eventsv epoll maxevents))
+ (n (primitive-epoll-wait (epoll-fd epoll) eventsv timeout)))
+ (let lp ((seed seed) (i 0))
+ (if (< i n)
+ (lp (folder (bytevector-s32-native-ref eventsv (fd-offset i))
+ (bytevector-u32-native-ref eventsv (events-offset i))
+ seed)
+ (1+ i))
+ seed))))
- [Guile-commits] 08/23: add #:limit to get-bytevector-delimited, (continued)
- [Guile-commits] 08/23: add #:limit to get-bytevector-delimited, Andy Wingo, 2016/03/24
- [Guile-commits] 11/23: socket: TCP_CORK, TCP_NODELAY, Andy Wingo, 2016/03/24
- [Guile-commits] 23/23: virtualize read/write/close operations in <eport>, Andy Wingo, 2016/03/24
- [Guile-commits] 15/23: (web server ethreads): more use of latin1 accessors, Andy Wingo, 2016/03/24
- [Guile-commits] 01/23: add (ice-9 nio), Andy Wingo, 2016/03/24
- [Guile-commits] 20/23: eports: nonblocking connect-eport, Andy Wingo, 2016/03/24
- [Guile-commits] 14/23: refactoring to (web server ethreads) read-http-line, Andy Wingo, 2016/03/24
- [Guile-commits] 02/23: add (ice-9 eports), Andy Wingo, 2016/03/24
- [Guile-commits] 17/23: getsockopt: allow raw file descriptors, Andy Wingo, 2016/03/24
- [Guile-commits] 16/23: eports: add put-utf8-char, put-utf8-string, Andy Wingo, 2016/03/24
- [Guile-commits] 03/23: add (ice-9 epoll),
Andy Wingo <=
- [Guile-commits] 21/23: eports tweak, Andy Wingo, 2016/03/24
- [Guile-commits] 07/23: add (web server ethreads), Andy Wingo, 2016/03/24
- [Guile-commits] 22/23: add examples/ethreads/memcached-{client, server}, Andy Wingo, 2016/03/24