io.multiplex/backend-epoll.lisp

   1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; indent-tabs-mode: nil -*-
   2 ;;;
   3 ;;; --- epoll(2) multiplexer implementation.
   4 ;;;
   5
   6 (in-package :io.multiplex)
   7
   8 (defconstant +epoll-priority+ 1)
   9
  10 (define-multiplexer epoll-multiplexer +epoll-priority+ (multiplexer)
  11   ())
  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 (defconstant +epoll-default-size-hint+ 25)
  18 (defconstant +epoll-max-events+ 1024)
  19
  20 (defmethod initialize-instance :after ((mux epoll-multiplexer)
  21                                        &key (size +epoll-default-size-hint+))
  22   (setf (slot-value mux 'fd) (isys:%sys-epoll-create size)))
  23
  24 (defun calc-epoll-flags (fd-entry)
  25   (logior (if (fd-entry-read-handler fd-entry)
  26               isys:epollin
  27               0)
  28           (if (fd-entry-write-handler fd-entry)
  29               isys:epollout
  30               0)
  31           isys:epollpri))
  32
  33 (defmethod monitor-fd ((mux epoll-multiplexer) fd-entry)
  34   (assert fd-entry (fd-entry) "Must supply an FD-ENTRY!")
  35   (let ((flags (calc-epoll-flags fd-entry))
  36         (fd (fd-entry-fd fd-entry)))
  37     (with-foreign-object (ev 'isys:epoll-event)
  38       (isys:%sys-bzero ev isys:size-of-epoll-event)
  39       (setf (foreign-slot-value ev 'isys:epoll-event 'isys:events) flags)
  40       (setf (foreign-slot-value
  41              (foreign-slot-value ev 'isys:epoll-event 'isys:data)
  42              'isys:epoll-data 'isys:fd)
  43             fd)
  44       (handler-case
  45           (isys:%sys-epoll-ctl (fd-of mux) isys:epoll-ctl-add fd ev)
  46         (isys:ebadf ()
  47           (warn "FD ~A is invalid, cannot monitor it." fd))
  48         (isys:eexist ()
  49           (warn "FD ~A is already monitored." fd))))))
  50
  51 (defmethod update-fd ((mux epoll-multiplexer) fd-entry event-type edge-change)
  52   (declare (ignore event-type edge-change))
  53   (assert fd-entry (fd-entry) "Must supply an FD-ENTRY!")
  54   (let ((flags (calc-epoll-flags fd-entry))
  55         (fd (fd-entry-fd fd-entry)))
  56     (with-foreign-object (ev 'isys:epoll-event)
  57       (isys:%sys-bzero ev isys:size-of-epoll-event)
  58       (setf (foreign-slot-value ev 'isys:epoll-event 'isys:events) flags)
  59       (setf (foreign-slot-value
  60              (foreign-slot-value ev 'isys:epoll-event 'isys:data)
  61              'isys:epoll-data 'isys:fd)
  62             fd)
  63       (handler-case
  64           (isys:%sys-epoll-ctl (fd-of mux) isys:epoll-ctl-mod fd ev)
  65         (isys:ebadf ()
  66           (warn "FD ~A is invalid, cannot update its status." fd))
  67         (isys:enoent ()
  68           (warn "FD ~A was not monitored, cannot update its status." fd))))
  69     (values fd-entry)))
  70
  71 (defmethod unmonitor-fd ((mux epoll-multiplexer) fd-entry)
  72   (handler-case
  73       (isys:%sys-epoll-ctl (fd-of mux)
  74                            isys:epoll-ctl-del
  75                            (fd-entry-fd fd-entry)
  76                            (null-pointer))
  77     (isys:ebadf ()
  78       (warn "FD ~A is invalid, cannot unmonitor it." (fd-entry-fd fd-entry)))
  79     (isys:enoent ()
  80       (warn "FD ~A was not monitored, cannot unmonitor it."
  81             (fd-entry-fd fd-entry)))))
  82
  83 (defmethod harvest-events ((mux epoll-multiplexer) timeout)
  84   (with-foreign-object (events 'isys:epoll-event +epoll-max-events+)
  85     (isys:%sys-bzero events (* +epoll-max-events+ isys:size-of-epoll-event))
  86     (let (ready-fds)
  87       (isys:repeat-upon-condition-decreasing-timeout
  88           ((isys:eintr) tmp-timeout timeout)
  89         (setf ready-fds (isys:%sys-epoll-wait (fd-of mux) events +epoll-max-events+
  90                                               (timeout->milisec tmp-timeout))))
  91       (macrolet ((epoll-slot (slot-name)
  92                    `(foreign-slot-value (mem-aref events 'isys:epoll-event i)
  93                                         'isys:epoll-event ',slot-name)))
  94         (return*
  95          (loop :for i :below ready-fds
  96                :for fd := (foreign-slot-value (epoll-slot isys:data) 'isys:epoll-data 'isys:fd)
  97                :for event-mask := (epoll-slot isys:events)
  98                :for epoll-event := (make-epoll-event fd event-mask)
  99                :when epoll-event :collect epoll-event))))))
 100
 101 (defun make-epoll-event (fd mask)
 102   (let ((event ()))
 103     (flags-case mask
 104       ((isys:epollout isys:epollhup)
 105        (push :write event))
 106       ((isys:epollin isys:epollpri isys:epollhup)
 107        (push :read event))
 108       (isys:epollerr
 109        (push :error event)))
 110     (when event
 111       (list fd event))))