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 (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 (timeout->timespec timeout ts
))
119 (et:kevent
(fd-of mux
) (null-pointer) 0
120 events
*kqueue-max-events
* (if timeout ts
(null-pointer)))))
121 (macrolet ((kevent-slot (slot-name)
122 `(foreign-slot-value (mem-aref events
'et
:kevent i
)
123 'et
:kevent
',slot-name
)))
125 :for i
:below ready-fds
126 :for fd
:= (kevent-slot et
:ident
)
127 :for flags
:= (kevent-slot et
:flags
)
128 :for filter
:= (kevent-slot et
:filter
)
129 :for data
:= (kevent-slot et
:data
)
130 :for kqueue-event
:= (make-kqueue-event fd flags filter data
)
131 :when kqueue-event
:collect kqueue-event
)))))
134 (defun make-kqueue-event (fd flags filter data
)
137 (#.et
:evfilt-write
(push :write event
))
138 (#.et
:evfilt-read
(push :read event
)))
140 ;; TODO: check what exactly EV_EOF means
141 ;; (et:ev-eof (pushnew :read event))
142 (et:ev-error
(push :error event
)))