src/multiplex/backend-epoll.lisp

   1 ;;;; -*- Mode: Lisp; indent-tabs-mode: nil -*-
   2 ;;;
   3 ;;; --- epoll(2) multiplexer implementation.
   4 ;;;
   5
   6 (in-package :iolib/multiplex)
   7
   8 (defconstant +epoll-priority+ 1)
   9
  10 (define-multiplexer epoll-multiplexer +epoll-priority+ (multiplexer)
  11   ((events :reader event-set-of)))
  12
  13 (defmethod print-object ((mux epoll-multiplexer) stream)
  14   (print-unreadable-object (mux stream :type nil :identity nil)
  15     (format stream "epoll(4) multiplexer")))
  16
  17 (defmethod initialize-instance :after ((mux epoll-multiplexer) &key (size 25))
  18   (setf (slot-value mux 'fd) (isys:epoll-create size))
  19   (setf (slot-value mux 'events)
  20         (foreign-alloc '(:struct isys:epoll-event)
  21                        :count (fd-limit-of mux))))
  22
  23 (defmethod close :after ((mux epoll-multiplexer) &key abort)
  24   (declare (ignore abort))
  25   (with-slots (events) mux
  26     (when events
  27       (foreign-free events)
  28       (setf events nil))))
  29
  30 (defun calc-epoll-flags (fd-entry)
  31   (logior (if (fd-entry-read-handler fd-entry)
  32               isys:epollin
  33               0)
  34           (if (fd-entry-write-handler fd-entry)
  35               isys:epollout
  36               0)
  37           isys:epollpri))
  38
  39 (defmethod monitor-fd ((mux epoll-multiplexer) fd-entry)
  40   (assert fd-entry (fd-entry) "Must supply an FD-ENTRY!")
  41   (let ((flags (calc-epoll-flags fd-entry))
  42         (fd (fd-entry-fd fd-entry)))
  43     (with-foreign-object (ev '(:struct isys:epoll-event))
  44       (isys:bzero ev (isys:sizeof '(:struct isys:epoll-event)))
  45       (setf (foreign-slot-value ev '(:struct isys:epoll-event) 'isys:events)
  46             flags)
  47       (setf (foreign-slot-value
  48              (foreign-slot-value ev '(:struct isys:epoll-event) 'isys:data)
  49              '(:union isys:epoll-data) 'isys:fd)
  50             fd)
  51       (handler-case
  52           (isys:epoll-ctl (fd-of mux) isys:epoll-ctl-add fd ev)
  53         (isys:ebadf ()
  54           (warn "FD ~A is invalid, cannot monitor it." fd))
  55         (isys:eexist ()
  56           (warn "FD ~A is already monitored." fd))))))
  57
  58 (defmethod update-fd ((mux epoll-multiplexer) fd-entry event-type edge-change)
  59   (declare (ignore event-type edge-change))
  60   (assert fd-entry (fd-entry) "Must supply an FD-ENTRY!")
  61   (let ((flags (calc-epoll-flags fd-entry))
  62         (fd (fd-entry-fd fd-entry)))
  63     (with-foreign-object (ev '(:struct isys:epoll-event))
  64       (isys:bzero ev (isys:sizeof '(:struct isys:epoll-event)))
  65       (setf (foreign-slot-value ev '(:struct isys:epoll-event) 'isys:events)
  66             flags)
  67       (setf (foreign-slot-value
  68              (foreign-slot-value ev '(:struct isys:epoll-event) 'isys:data)
  69              '(:union isys:epoll-data) 'isys:fd)
  70             fd)
  71       (handler-case
  72           (isys:epoll-ctl (fd-of mux) isys:epoll-ctl-mod fd ev)
  73         (isys:ebadf ()
  74           (warn "FD ~A is invalid, cannot update its status." fd))
  75         (isys:enoent ()
  76           (warn "FD ~A was not monitored, cannot update its status." fd))))
  77     (values fd-entry)))
  78
  79 (defmethod unmonitor-fd ((mux epoll-multiplexer) fd-entry)
  80   (handler-case
  81       (isys:epoll-ctl (fd-of mux)
  82                            isys:epoll-ctl-del
  83                            (fd-entry-fd fd-entry)
  84                            (null-pointer))
  85     (isys:ebadf ()
  86       (warn "FD ~A is invalid, cannot unmonitor it." (fd-entry-fd fd-entry)))
  87     (isys:enoent ()
  88       (warn "FD ~A was not monitored, cannot unmonitor it."
  89             (fd-entry-fd fd-entry)))))
  90
  91 (defmethod harvest-events ((mux epoll-multiplexer) timeout)
  92   (with-accessors ((events event-set-of)
  93                    (fd-limit fd-limit-of))
  94       mux
  95     (isys:bzero events (* fd-limit (isys:sizeof '(:struct isys:epoll-event))))
  96     (let (ready-fds)
  97       (isys:repeat-upon-condition-decreasing-timeout
  98           ((isys:eintr) tmp-timeout timeout)
  99         (setf ready-fds (isys:epoll-wait (fd-of mux) events fd-limit
 100                                          (timeout->milliseconds tmp-timeout))))
 101       (macrolet ((epoll-slot (slot-name)
 102                    `(foreign-slot-value
 103                      ;; FIXME: tests fail when wrapping this bare reference
 104                      ;; in a :STRUCT.
 105                      (mem-aref events 'isys:epoll-event i)
 106                      '(:struct isys:epoll-event) ',slot-name)))
 107         (return*
 108          (loop :for i :below ready-fds
 109                :for fd := (foreign-slot-value (epoll-slot isys:data)
 110                                               '(:union isys:epoll-data) 'isys:fd)
 111                :for event-mask := (epoll-slot isys:events)
 112                :for epoll-event := (make-epoll-event fd event-mask)
 113                :when epoll-event :collect epoll-event))))))
 114
 115 (defun make-epoll-event (fd mask)
 116   (let ((event ()))
 117     (flags-case mask
 118       ((isys:epollout isys:epollhup)
 119        (push :write event))
 120       ((isys:epollin isys:epollpri isys:epollhup)
 121        (push :read event))
 122       (isys:epollerr
 123        (push :error event)))
 124     (when event
 125       (list fd event))))