Merge branch 'poll-multiplexer'
[iolib.git] / io-multiplex / kqueue.lisp
blobae357df553b74ed220023204926d7244a60f63b8
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
24 (in-package :io.multiplex)
26 (defconstant +kqueue-priority+ 1)
28 (define-multiplexer kqueue-multiplexer +kqueue-priority+ (multiplexer)
29 ())
31 (defmethod print-object ((mux kqueue-multiplexer) stream)
32 (print-unreadable-object (mux stream :type nil :identity nil)
33 (format stream "kqueue(2) multiplexer")))
35 (defvar *kqueue-max-events* 200)
37 (defmethod initialize-instance :after ((mux kqueue-multiplexer) &key)
38 (setf (slot-value mux 'fd) (nix:kqueue)))
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 (cl-posix-ffi:memset kev 0 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)))))
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))
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)))))
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))))
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)))))
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))
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)))))
100 (defmethod harvest-events ((mux kqueue-multiplexer) timeout)
101 (with-foreign-objects ((events 'nix::kevent *kqueue-max-events*)
102 (ts 'nix::timespec))
103 (cl-posix-ffi:memset events 0 (* *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)))))
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))))