1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Indent-tabs-mode: NIL -*-
3 ;;; kqueue.lisp --- kequeue multiplexer implementation.
5 ;;; Copyright (C) 2006-2008, 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
) (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 'kevent
)
43 (bzero kev size-of-kevent
)
44 (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 evfilt-read ev-add
))
69 (:del
(values evfilt-read ev-delete
))))
72 (:add
(values evfilt-write ev-add
))
73 (:del
(values evfilt-write 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 'kevent
*kqueue-max-events
*)
106 (bzero events
(* *kqueue-max-events
* size-of-kevent
))
108 (nix:repeat-upon-condition-decreasing-timeout
109 ((nix:eintr
) tmp-timeout timeout
)
111 (timeout->timespec tmp-timeout ts
))
113 (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
'kevent i
) 'kevent
',slot-name
)))
118 (loop for i below ready-fds
119 for fd
= (kevent-slot ident
)
120 for flags
= (kevent-slot flags
)
121 for filter
= (kevent-slot filter
)
122 for data
= (kevent-slot data
)
123 for kqueue-event
= (make-kqueue-event fd flags filter data
)
124 when kqueue-event collect kqueue-event
)))))
126 ;;; TODO: do something with DATA
127 (defun make-kqueue-event (fd flags filter data
)
128 (declare (ignore data
))
130 (switch (filter :test
#'=)
131 (evfilt-write (push :write event
))
132 (evfilt-read (push :read event
)))
134 ;; TODO: check what exactly EV_EOF means
135 ;; (ev-eof (pushnew :read event))
136 (ev-error (push :error event
)))