io-multiplex/kqueue.lisp

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