src/multiplex/backend-kqueue.lisp

   1 ;;;; -*- Mode: Lisp; indent-tabs-mode: nil -*-
   2 ;;;
   3 ;;; --- kqueue(2) multiplexer implementation.
   4 ;;;
   5
   6 (in-package :iolib/multiplex)
   7
   8 (defconstant +kqueue-priority+ 1)
   9
  10 (define-multiplexer kqueue-multiplexer +kqueue-priority+ (multiplexer)
  11   ())
  12
  13 (defmethod print-object ((mux kqueue-multiplexer) stream)
  14   (print-unreadable-object (mux stream :type nil :identity nil)
  15     (format stream "kqueue(2) multiplexer")))
  16
  17 (defvar *kqueue-max-events* 200)
  18
  19 (defmethod initialize-instance :after ((mux kqueue-multiplexer) &key)
  20   (setf (slot-value mux 'fd) (isys:kqueue)))
  21
  22 (defun do-kqueue-event-request (kqueue-fd fd-entry filter request-type)
  23   (let ((fd (fd-entry-fd fd-entry)))
  24     (with-foreign-object (kev 'isys:kevent)
  25       (isys:bzero kev (isys:sizeof 'isys:kevent))
  26       (isys:ev-set kev fd filter request-type 0 0 (null-pointer))
  27       (isys:kevent kqueue-fd
  28                         kev 1
  29                         (null-pointer) 0
  30                         (null-pointer)))))
  31
  32 (defun calc-kqueue-monitor-filter (fd-entry)
  33   (if (null (fd-entry-read-handler fd-entry))
  34       isys:evfilt-write
  35       isys:evfilt-read))
  36
  37 (defmethod monitor-fd ((mux kqueue-multiplexer) fd-entry)
  38   (assert fd-entry (fd-entry) "Must supply an FD-ENTRY!")
  39   (handler-case
  40       (do-kqueue-event-request (fd-of mux) fd-entry
  41                                (calc-kqueue-monitor-filter fd-entry)
  42                                isys:ev-add)
  43     (isys:ebadf ()
  44       (warn "FD ~A is invalid, cannot monitor it." (fd-entry-fd fd-entry)))))
  45
  46 (defun calc-kqueue-update-filter-and-flags (event-type edge-change)
  47   (case event-type
  48     (:read
  49      (case edge-change
  50        (:add (values isys:evfilt-read isys:ev-add))
  51        (:del (values isys:evfilt-read isys:ev-delete))))
  52     (:write
  53      (case edge-change
  54        (:add (values isys:evfilt-write isys:ev-add))
  55        (:del (values isys:evfilt-write isys:ev-delete))))))
  56
  57 (defmethod update-fd ((mux kqueue-multiplexer) fd-entry event-type edge-change)
  58   (assert fd-entry (fd-entry) "Must supply an FD-ENTRY!")
  59   (handler-case
  60       (multiple-value-call #'do-kqueue-event-request (fd-of mux) fd-entry
  61                            (calc-kqueue-update-filter-and-flags event-type edge-change))
  62     (isys:ebadf ()
  63       (warn "FD ~A is invalid, cannot update its status."
  64             (fd-entry-fd fd-entry)))
  65     (isys:enoent ()
  66       (warn "FD ~A was not monitored, cannot update its status."
  67             (fd-entry-fd fd-entry)))))
  68
  69 (defun calc-kqueue-unmonitor-filter (fd-entry)
  70   (if (null (fd-entry-read-handler fd-entry))
  71       isys:evfilt-read
  72       isys:evfilt-write))
  73
  74 (defmethod unmonitor-fd ((mux kqueue-multiplexer) fd-entry)
  75   (handler-case
  76       (do-kqueue-event-request (fd-of mux) fd-entry
  77                                (calc-kqueue-unmonitor-filter fd-entry)
  78                                isys:ev-delete)
  79     (isys:ebadf ()
  80       (warn "FD ~A is invalid, cannot unmonitor it." (fd-entry-fd fd-entry)))
  81     (isys:enoent ()
  82       (warn "FD ~A was not monitored, cannot unmonitor it."
  83             (fd-entry-fd fd-entry)))))
  84
  85 (defmethod harvest-events ((mux kqueue-multiplexer) timeout)
  86   (with-foreign-objects ((events 'isys:kevent *kqueue-max-events*)
  87                          (ts 'isys:timespec))
  88     (isys:bzero events (* *kqueue-max-events* (isys:sizeof 'isys:kevent)))
  89     (let (ready-fds)
  90       (isys:repeat-upon-condition-decreasing-timeout
  91           ((isys:eintr) tmp-timeout timeout)
  92         (when tmp-timeout
  93           (timeout->timespec tmp-timeout ts))
  94         (setf ready-fds
  95               (isys:kevent (fd-of mux) (null-pointer) 0
  96                                 events *kqueue-max-events*
  97                                 (if tmp-timeout ts (null-pointer)))))
  98       (macrolet ((kevent-slot (slot-name)
  99                    `(foreign-slot-value (mem-aref events 'isys:kevent i)
 100                                         'isys:kevent ',slot-name)))
 101         (loop for i below ready-fds
 102               for fd = (kevent-slot isys:ident)
 103               for flags = (kevent-slot isys:flags)
 104               for filter = (kevent-slot isys:filter)
 105               for data = (kevent-slot isys:data)
 106               for kqueue-event = (make-kqueue-event fd flags filter data)
 107               when kqueue-event collect kqueue-event)))))
 108
 109 ;;; TODO: do something with DATA
 110 (defun make-kqueue-event (fd flags filter data)
 111   (declare (ignore data))
 112   (let ((event ()))
 113     (switch (filter :test #'=)
 114       (isys:evfilt-write (push :write event))
 115       (isys:evfilt-read  (push :read event)))
 116     (flags-case flags
 117       ;; TODO: check what exactly EV_EOF means
 118       ;; (ev-eof   (pushnew :read event))
 119       (isys:ev-error (push :error event)))
 120     (when event
 121       (list fd event))))