1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Indent-tabs-mode: NIL -*-
3 ;;; kqueue.lisp --- kequeue multiplexer implementation.
5 ;;; Copyright (C) 2006-2007, Stelian Ionescu <sionescu@common-lisp.net>
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
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.
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)
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 (nix:bzero kev nix
::size-of-kevent
)
44 (nix:ev-set kev fd filter request-type
0 0 (null-pointer))
50 (defun calc-kqueue-monitor-filter (fd-entry)
51 (if (null (fd-entry-read-event fd-entry
))
55 (defmethod monitor-fd ((mux kqueue-multiplexer
) fd-entry
)
56 (assert fd-entry
(fd-entry) "Must supply an FD-ENTRY!")
58 (do-kqueue-event-request (fd-of mux
) fd-entry
59 (calc-kqueue-monitor-filter fd-entry
)
62 (warn "FD ~A is invalid, cannot monitor it." (fd-entry-fd fd-entry
)))))
64 (defun calc-kqueue-update-filter-and-flags (event-type edge-change
)
68 (:add
(values nix
:evfilt-read nix
:ev-add
))
69 (:del
(values nix
:evfilt-read nix
:ev-delete
))))
72 (:add
(values nix
:evfilt-write nix
:ev-add
))
73 (:del
(values nix
:evfilt-write nix
:ev-delete
))))))
75 (defmethod update-fd ((mux kqueue-multiplexer
) fd-entry event-type edge-change
)
76 (assert fd-entry
(fd-entry) "Must supply an FD-ENTRY!")
78 (multiple-value-call #'do-kqueue-event-request
(fd-of mux
) fd-entry
79 (calc-kqueue-update-filter-and-flags event-type edge-change
))
81 (warn "FD ~A is invalid, cannot update its status."
82 (fd-entry-fd fd-entry
)))
84 (warn "FD ~A was not monitored, cannot update its status."
85 (fd-entry-fd fd-entry
)))))
87 (defun calc-kqueue-unmonitor-filter (fd-entry)
88 (if (null (fd-entry-read-event fd-entry
))
92 (defmethod unmonitor-fd ((mux kqueue-multiplexer
) fd-entry
)
94 (do-kqueue-event-request (fd-of mux
) fd-entry
95 (calc-kqueue-unmonitor-filter fd-entry
)
98 (warn "FD ~A is invalid, cannot unmonitor it." (fd-entry-fd fd-entry
)))
100 (warn "FD ~A was not monitored, cannot unmonitor it."
101 (fd-entry-fd fd-entry
)))))
103 (defmethod harvest-events ((mux kqueue-multiplexer
) timeout
)
104 (with-foreign-objects ((events 'nix
::kevent
*kqueue-max-events
*)
106 (nix:bzero events
(* *kqueue-max-events
* nix
::size-of-kevent
))
108 (nix:repeat-upon-condition-decreasing-timeout
109 ((nix:eintr
) tmp-timeout timeout
)
111 (timeout->timespec tmp-timeout ts
))
113 (nix:kevent
(fd-of mux
) (null-pointer) 0
114 events
*kqueue-max-events
*
115 (if tmp-timeout ts
(null-pointer)))))
116 (macrolet ((kevent-slot (slot-name)
117 `(foreign-slot-value (mem-aref events
'nix
::kevent i
)
118 'nix
::kevent
',slot-name
)))
119 (loop for i below ready-fds
120 for fd
= (kevent-slot nix
::ident
)
121 for flags
= (kevent-slot nix
::flags
)
122 for filter
= (kevent-slot nix
::filter
)
123 for data
= (kevent-slot nix
::data
)
124 for kqueue-event
= (make-kqueue-event fd flags filter data
)
125 when kqueue-event collect kqueue-event
)))))
127 ;;; TODO: do something with DATA
128 (defun make-kqueue-event (fd flags filter data
)
129 (declare (ignore data
))
132 (#.nix
:evfilt-write
(push :write event
))
133 (#.nix
:evfilt-read
(push :read event
)))
135 ;; TODO: check what exactly EV_EOF means
136 ;; (nix:ev-eof (pushnew :read event))
137 (nix:ev-error
(push :error event
)))