io-multiplex/epoll.lisp

   1 ;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp -*-
   2
   3 ;;   Copyright (C) 2006, 2007 Stelian Ionescu
   4 ;;
   5 ;;   This code is free software; you can redistribute it and/or
   6 ;;   modify it under the terms of the version 2.1 of
   7 ;;   the GNU Lesser General Public License as published by
   8 ;;   the Free Software Foundation, as clarified by the
   9 ;;   preamble found here:
  10 ;;       http://opensource.franz.com/preamble.html
  11 ;;
  12 ;;   This program is distributed in the hope that it will be useful,
  13 ;;   but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;;   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;;   GNU General Public License for more details.
  16 ;;
  17 ;;   You should have received a copy of the GNU Lesser General
  18 ;;   Public License along with this library; if not, write to the
  19 ;;   Free Software Foundation, Inc., 51 Franklin St, Fifth Floor,
  20 ;;   Boston, MA 02110-1301, USA
  21
  22 (in-package :io.multiplex)
  23
  24 (defconstant +epoll-priority+ 1)
  25
  26
  27 (define-multiplexer epoll-multiplexer +epoll-priority+ (multiplexer)
  28   ())
  29
  30
  31 (defmethod print-object ((mux epoll-multiplexer) stream)
  32   (print-unreadable-object (mux stream :type nil :identity nil)
  33     (format stream "epoll(4) multiplexer")))
  34
  35
  36 (defconstant +epoll-default-size-hint+ 25)
  37 (defvar *epoll-max-events* 200)
  38
  39
  40 (defmethod initialize-instance :after ((mux epoll-multiplexer)
  41                                        &key (size +epoll-default-size-hint+))
  42   (setf (slot-value mux 'fd) (et:epoll-create size)))
  43
  44
  45 (defun calc-epoll-flags (fd-entry)
  46   (logior (if (not (queue-empty-p (fd-entry-read-events fd-entry))) et:epollin 0)
  47           (if (not (queue-empty-p (fd-entry-write-events fd-entry))) et:epollout 0)
  48           et:epollpri))
  49
  50
  51 (defmethod monitor-fd ((mux epoll-multiplexer) fd-entry)
  52   (assert fd-entry)
  53   (let ((flags (calc-epoll-flags fd-entry))
  54         (fd (fd-entry-fd fd-entry)))
  55     (with-foreign-object (ev 'et:epoll-event)
  56       (et:memset ev 0 et:size-of-epoll-event)
  57       (setf (foreign-slot-value ev 'et:epoll-event 'et:events) flags)
  58       (setf (foreign-slot-value (foreign-slot-value ev 'et:epoll-event 'et:data)
  59                                 'et:epoll-data 'et:fd)
  60             fd)
  61       (handler-case
  62           (et:epoll-ctl (fd-of mux) et:epoll-ctl-add fd ev)
  63         (et:ebadf ()
  64           (warn "FD ~A is invalid, cannot monitor it." fd))
  65         (et:eexist ()
  66           (warn "FD ~A is already monitored." fd))))))
  67
  68
  69 (defmethod update-fd ((mux epoll-multiplexer) fd-entry)
  70   (assert fd-entry)
  71   (let ((flags (calc-epoll-flags fd-entry))
  72         (fd (fd-entry-fd fd-entry)))
  73     (with-foreign-object (ev 'et:epoll-event)
  74       (et:memset ev 0 et:size-of-epoll-event)
  75       (setf (foreign-slot-value ev 'et:epoll-event 'et:events) flags)
  76       (setf (foreign-slot-value (foreign-slot-value ev 'et:epoll-event 'et:data)
  77                                 'et:epoll-data 'et:fd)
  78             fd)
  79       (handler-case
  80           (et:epoll-ctl (fd-of mux) et:epoll-ctl-mod fd ev)
  81         (et:ebadf ()
  82           (warn "FD ~A is invalid, cannot update its status." fd))
  83         (et:enoent ()
  84           (warn "FD ~A was not monitored, cannot update its status." fd))))
  85     (values fd-entry)))
  86
  87
  88 (defmethod unmonitor-fd ((mux epoll-multiplexer) fd-entry)
  89   (handler-case
  90       (et:epoll-ctl (fd-of mux)
  91                     et:epoll-ctl-del
  92                     (fd-entry-fd fd-entry)
  93                     (null-pointer))
  94     (et:ebadf ()
  95       (warn "FD ~A is invalid, cannot unmonitor it." (fd-entry-fd fd-entry)))
  96     (et:enoent ()
  97       (warn "FD ~A was not monitored, cannot unmonitor it." (fd-entry-fd fd-entry)))))
  98
  99
 100 (defmethod harvest-events ((mux epoll-multiplexer) timeout)
 101   (with-foreign-object (events 'et:epoll-event *epoll-max-events*)
 102     (et:memset events 0 (* *epoll-max-events* et:size-of-epoll-event))
 103     (let (ready-fds)
 104       (et:repeat-upon-condition-decreasing-timeout ((et:eintr)
 105                                                     tmp-timeout timeout)
 106         (setf ready-fds
 107               (et:epoll-wait (fd-of mux) events
 108                              *epoll-max-events*
 109                              (timeout->milisec tmp-timeout))))
 110       (macrolet ((epoll-slot (slot-name)
 111                    `(foreign-slot-value (mem-aref events 'et:epoll-event i)
 112                                         'et:epoll-event ',slot-name)))
 113         (return-from harvest-events
 114           (loop
 115              :for i :below ready-fds
 116              :for fd := (foreign-slot-value (epoll-slot et:data) 'et:epoll-data 'et:fd)
 117              :for event-mask := (epoll-slot et:events)
 118              :for epoll-event := (make-epoll-event fd event-mask)
 119              :when epoll-event :collect epoll-event))))))
 120
 121
 122 (defun make-epoll-event (fd mask)
 123   (let ((event ()))
 124     (flags-case mask
 125       ((et:epollout et:epollhup)
 126        (push :write event))
 127       ((et:epollin et:epollpri et:epollhup)
 128        (push :read event))
 129       (et:epollerr
 130        (push :error event)))
 131     (when event
 132       (list fd event))))