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 'isys:epoll-event :count (fd-limit-of mux))))
  21
  22 (defmethod close :after ((mux epoll-multiplexer) &key abort)
  23   (declare (ignore abort))
  24   (with-slots (events) mux
  25     (when events
  26       (foreign-free events)
  27       (setf events nil))))
  28
  29 (defun calc-epoll-flags (fd-entry)
  30   (logior (if (fd-entry-read-handler fd-entry)
  31               isys:epollin
  32               0)
  33           (if (fd-entry-write-handler fd-entry)
  34               isys:epollout
  35               0)
  36           isys:epollpri))
  37
  38 (defmethod monitor-fd ((mux epoll-multiplexer) fd-entry)
  39   (assert fd-entry (fd-entry) "Must supply an FD-ENTRY!")
  40   (let ((flags (calc-epoll-flags fd-entry))
  41         (fd (fd-entry-fd fd-entry)))
  42     (with-foreign-object (ev 'isys:epoll-event)
  43       (isys:bzero ev (isys:sizeof 'isys:epoll-event))
  44       (setf (foreign-slot-value ev 'isys:epoll-event 'isys:events) flags)
  45       (setf (foreign-slot-value
  46              (foreign-slot-value ev 'isys:epoll-event 'isys:data)
  47              'isys:epoll-data 'isys:fd)
  48             fd)
  49       (handler-case
  50           (isys:epoll-ctl (fd-of mux) isys:epoll-ctl-add fd ev)
  51         (isys:ebadf ()
  52           (warn "FD ~A is invalid, cannot monitor it." fd))
  53         (isys:eexist ()
  54           (warn "FD ~A is already monitored." fd))))))
  55
  56 (defmethod update-fd ((mux epoll-multiplexer) fd-entry event-type edge-change)
  57   (declare (ignore event-type edge-change))
  58   (assert fd-entry (fd-entry) "Must supply an FD-ENTRY!")
  59   (let ((flags (calc-epoll-flags fd-entry))
  60         (fd (fd-entry-fd fd-entry)))
  61     (with-foreign-object (ev 'isys:epoll-event)
  62       (isys:bzero ev (isys:sizeof 'isys:epoll-event))
  63       (setf (foreign-slot-value ev 'isys:epoll-event 'isys:events) flags)
  64       (setf (foreign-slot-value
  65              (foreign-slot-value ev 'isys:epoll-event 'isys:data)
  66              'isys:epoll-data 'isys:fd)
  67             fd)
  68       (handler-case
  69           (isys:epoll-ctl (fd-of mux) isys:epoll-ctl-mod fd ev)
  70         (isys:ebadf ()
  71           (warn "FD ~A is invalid, cannot update its status." fd))
  72         (isys:enoent ()
  73           (warn "FD ~A was not monitored, cannot update its status." fd))))
  74     (values fd-entry)))
  75
  76 (defmethod unmonitor-fd ((mux epoll-multiplexer) fd-entry)
  77   (handler-case
  78       (isys:epoll-ctl (fd-of mux)
  79                            isys:epoll-ctl-del
  80                            (fd-entry-fd fd-entry)
  81                            (null-pointer))
  82     (isys:ebadf ()
  83       (warn "FD ~A is invalid, cannot unmonitor it." (fd-entry-fd fd-entry)))
  84     (isys:enoent ()
  85       (warn "FD ~A was not monitored, cannot unmonitor it."
  86             (fd-entry-fd fd-entry)))))
  87
  88 (defmethod harvest-events ((mux epoll-multiplexer) timeout)
  89   (with-accessors ((events event-set-of)
  90                    (fd-limit fd-limit-of))
  91       mux
  92     (isys:bzero events (* fd-limit (isys:sizeof 'isys:epoll-event)))
  93     (let (ready-fds)
  94       (isys:repeat-upon-condition-decreasing-timeout
  95           ((isys:eintr) tmp-timeout timeout)
  96         (setf ready-fds (isys:epoll-wait (fd-of mux) events fd-limit
  97                                          (timeout->milliseconds tmp-timeout))))
  98       (macrolet ((epoll-slot (slot-name)
  99                    `(foreign-slot-value (mem-aref events 'isys:epoll-event i)
 100                                         'isys:epoll-event ',slot-name)))
 101         (return*
 102          (loop :for i :below ready-fds
 103                :for fd := (foreign-slot-value (epoll-slot isys:data) 'isys:epoll-data 'isys:fd)
 104                :for event-mask := (epoll-slot isys:events)
 105                :for epoll-event := (make-epoll-event fd event-mask)
 106                :when epoll-event :collect epoll-event))))))
 107
 108 (defun make-epoll-event (fd mask)
 109   (let ((event ()))
 110     (flags-case mask
 111       ((isys:epollout isys:epollhup)
 112        (push :write event))
 113       ((isys:epollin isys:epollpri isys:epollhup)
 114        (push :read event))
 115       (isys:epollerr
 116        (push :error event)))
 117     (when event
 118       (list fd event))))