1 ;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp -*-
3 ;; Copyright (C) 2006, 2007 Stelian Ionescu
5 ;; This code is free software; you can redistribute it and/or
6 ;; modify it under the terms of the version 2.1 of
7 ;; the GNU Lesser General Public License as published by
8 ;; the Free Software Foundation, as clarified by the
9 ;; preamble found here:
10 ;; http://opensource.franz.com/preamble.html
12 ;; This program is distributed in the hope that it will be useful,
13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 ;; GNU General Public License for more details.
17 ;; You should have received a copy of the GNU Lesser General
18 ;; Public License along with this library; if not, write to the
19 ;; Free Software Foundation, Inc., 51 Franklin St, Fifth Floor,
20 ;; Boston, MA 02110-1301, USA
22 (in-package :io.multiplex
)
24 (defconstant +kqueue-priority
+ 1)
27 (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")))
36 (defvar *kqueue-max-events
* 200)
39 (defmethod initialize-instance :after
((mux kqueue-multiplexer
) &key
)
40 (setf (slot-value mux
'fd
) (et:kqueue
)))
43 (defun do-kqueue-event-request (kqueue-fd fd-entry filter request-type
)
44 (let ((fd (fd-entry-fd fd-entry
)))
45 (with-foreign-object (kev 'et
:kevent
)
46 (et:memset kev
0 et
:size-of-kevent
)
47 (et:ev-set kev fd filter request-type
0 0 (null-pointer))
54 (defun calc-kqueue-monitor-filter (fd-entry)
55 (if (queue-empty-p (fd-entry-read-events fd-entry
))
60 (defmethod monitor-fd ((mux kqueue-multiplexer
) fd-entry
)
63 (do-kqueue-event-request (fd-of mux
) fd-entry
64 (calc-kqueue-monitor-filter fd-entry
)
66 (et:unix-error-badf
(err)
67 (declare (ignore err
))
68 (warn "FD ~A is invalid, cannot monitor it." (fd-entry-fd fd-entry
)))))
71 (defun calc-kqueue-update-filter-and-flags (edge-change)
73 (:read-add
(values et
:evfilt-read et
:ev-add
))
74 (:read-del
(values et
:evfilt-read et
:ev-delete
))
75 (:write-add
(values et
:evfilt-write et
:ev-add
))
76 (:write-del
(values et
:evfilt-write et
:ev-delete
))))
79 (defmethod update-fd ((mux kqueue-multiplexer
) fd-entry
)
82 (multiple-value-bind (filter change
)
83 (calc-kqueue-update-filter-and-flags (fd-entry-edge-change fd-entry
))
84 (do-kqueue-event-request (fd-of mux
) fd-entry filter change
))
85 (et:unix-error-badf
(err)
86 (declare (ignore err
))
87 (warn "FD ~A is invalid, cannot update its status." (fd-entry-fd fd-entry
)))
88 (et:unix-error-noent
(err)
89 (declare (ignore err
))
90 (warn "FD ~A was not monitored, cannot update its status." (fd-entry-fd fd-entry
)))))
93 (defun calc-kqueue-unmonitor-filter (fd-entry)
94 (if (queue-empty-p (fd-entry-read-events fd-entry
))
99 (defmethod unmonitor-fd ((mux kqueue-multiplexer
) fd-entry
)
101 (do-kqueue-event-request (fd-of mux
) fd-entry
102 (calc-kqueue-unmonitor-filter fd-entry
)
104 (et:unix-error-badf
(err)
105 (declare (ignore err
))
106 (warn "FD ~A is invalid, cannot unmonitor it." (fd-entry-fd fd-entry
)))
107 (et:unix-error-noent
(err)
108 (declare (ignore err
))
109 (warn "FD ~A was not monitored, cannot unmonitor it." (fd-entry-fd fd-entry
)))))
112 (defmethod harvest-events ((mux kqueue-multiplexer
) timeout
)
113 (with-foreign-objects ((events 'et
:kevent
*kqueue-max-events
*)
115 (et:memset events
0 (* *kqueue-max-events
* et
:size-of-kevent
))
117 (repeat-decreasing-timeout ((et:unix-error-intr
)
120 (timeout->timespec tmp-timeout ts
))
122 (et:kevent
(fd-of mux
) (null-pointer) 0
123 events
*kqueue-max-events
*
124 (if tmp-timeout ts
(null-pointer)))))
125 (macrolet ((kevent-slot (slot-name)
126 `(foreign-slot-value (mem-aref events
'et
:kevent i
)
127 'et
:kevent
',slot-name
)))
129 :for i
:below ready-fds
130 :for fd
:= (kevent-slot et
:ident
)
131 :for flags
:= (kevent-slot et
:flags
)
132 :for filter
:= (kevent-slot et
:filter
)
133 :for data
:= (kevent-slot et
:data
)
134 :for kqueue-event
:= (make-kqueue-event fd flags filter data
)
135 :when kqueue-event
:collect kqueue-event
)))))
138 (defun make-kqueue-event (fd flags filter data
)
141 (#.et
:evfilt-write
(push :write event
))
142 (#.et
:evfilt-read
(push :read event
)))
144 ;; TODO: check what exactly EV_EOF means
145 ;; (et:ev-eof (pushnew :read event))
146 (et:ev-error
(push :error event
)))