1 ;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp -*-
3 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4 ; Copyright (C) 2006,2007 by Stelian Ionescu ;
6 ; This program is free software; you can redistribute it and/or modify ;
7 ; it under the terms of the GNU General Public License as published by ;
8 ; the Free Software Foundation; either version 2 of the License, or ;
9 ; (at your option) any later version. ;
11 ; This program is distributed in the hope that it will be useful, ;
12 ; but WITHOUT ANY WARRANTY; without even the implied warranty of ;
13 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;
14 ; GNU General Public License for more details. ;
16 ; You should have received a copy of the GNU General Public License ;
17 ; along with this program; if not, write to the ;
18 ; Free Software Foundation, Inc., ;
19 ; 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA ;
20 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
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 (let ((kqueue-fd (et:kqueue
)))
41 (setf (slot-value mux
'fd
) kqueue-fd
)
42 (et:finalize-object-closing-fd mux kqueue-fd
)))
45 (defun do-kqueue-event-request (kqueue-fd fd-entry filter request-type
)
46 (let ((fd (fd-entry-fd fd-entry
)))
47 (with-foreign-object (kev 'et
:kevent
)
48 (et:memset kev
0 et
:size-of-kevent
)
49 (et:ev-set kev fd filter request-type
0 0 (null-pointer))
56 (defun calc-kqueue-monitor-filter (fd-entry)
57 (if (queue-empty-p (fd-entry-read-events fd-entry
))
62 (defmethod monitor-fd ((mux kqueue-multiplexer
) fd-entry
)
65 (do-kqueue-event-request (fd-of mux
) fd-entry
66 (calc-kqueue-monitor-filter fd-entry
)
68 (et:unix-error-badf
(err)
69 (declare (ignore err
))
70 (warn "FD ~A is invalid, cannot monitor it." (fd-entry-fd fd-entry
)))))
73 (defun calc-kqueue-update-filter-and-flags (edge-change)
75 (:read-add
(values et
:evfilt-read et
:ev-add
))
76 (:read-del
(values et
:evfilt-read et
:ev-delete
))
77 (:write-add
(values et
:evfilt-write et
:ev-add
))
78 (:write-del
(values et
:evfilt-write et
:ev-delete
))))
81 (defmethod update-fd ((mux kqueue-multiplexer
) fd-entry
)
84 (multiple-value-bind (filter change
)
85 (calc-kqueue-update-filter-and-flags (fd-entry-edge-change fd-entry
))
86 (do-kqueue-event-request (fd-of mux
) fd-entry filter change
))
87 (et:unix-error-badf
(err)
88 (declare (ignore err
))
89 (warn "FD ~A is invalid, cannot update its status." (fd-entry-fd fd-entry
)))
90 (et:unix-error-noent
(err)
91 (declare (ignore err
))
92 (warn "FD ~A was not monitored, cannot update its status." (fd-entry-fd fd-entry
)))))
95 (defun calc-kqueue-unmonitor-filter (fd-entry)
96 (if (queue-empty-p (fd-entry-read-events fd-entry
))
101 (defmethod unmonitor-fd ((mux kqueue-multiplexer
) fd-entry
)
103 (do-kqueue-event-request (fd-of mux
) fd-entry
104 (calc-kqueue-unmonitor-filter fd-entry
)
106 (et:unix-error-badf
(err)
107 (declare (ignore err
))
108 (warn "FD ~A is invalid, cannot unmonitor it." (fd-entry-fd fd-entry
)))
109 (et:unix-error-noent
(err)
110 (declare (ignore err
))
111 (warn "FD ~A was not monitored, cannot unmonitor it." (fd-entry-fd fd-entry
)))))
114 (defmethod harvest-events ((mux kqueue-multiplexer
) timeout
)
115 (with-foreign-objects ((events 'et
:kevent
*kqueue-max-events
*)
117 (et:memset events
0 (* *kqueue-max-events
* et
:size-of-kevent
))
119 (timeout->timespec timeout ts
))
121 (et:kevent
(fd-of mux
) (null-pointer) 0
122 events
*kqueue-max-events
* (if timeout ts
(null-pointer)))))
123 (macrolet ((kevent-slot (slot-name)
124 `(foreign-slot-value (mem-aref events
'et
:kevent i
)
125 'et
:kevent
',slot-name
)))
127 :for i
:below ready-fds
128 :for fd
:= (kevent-slot et
:ident
)
129 :for flags
:= (kevent-slot et
:flags
)
130 :for filter
:= (kevent-slot et
:filter
)
131 :for data
:= (kevent-slot et
:data
)
132 :for kqueue-event
:= (make-kqueue-event fd flags filter data
)
133 :when kqueue-event
:collect kqueue-event
)))))
136 (defun make-kqueue-event (fd flags filter data
)
139 (#.et
:evfilt-write
(push :write event
))
140 (#.et
:evfilt-read
(push :read event
)))
142 ;; TODO: check what exactly EV_EOF means
143 ;; (et:ev-eof (pushnew :read event))
144 (et:ev-error
(push :error event
)))