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 +epoll-priority
+ 1)
27 (define-multiplexer epoll-multiplexer
+epoll-priority
+ (multiplexer)
31 (defmethod print-object ((mux epoll-multiplexer
) stream
)
32 (print-unreadable-object (mux stream
:type nil
:identity nil
)
33 (format stream
"epoll(4) multiplexer")))
36 (defconstant +epoll-default-size-hint
+ 25)
37 (defvar *epoll-max-events
* 200)
40 (defmethod initialize-instance :after
((mux epoll-multiplexer
)
41 &key
(size +epoll-default-size-hint
+))
42 (let ((epoll-fd (et:epoll-create size
)))
43 (setf (slot-value mux
'fd
) epoll-fd
)
44 (et:finalize-object-closing-fd mux epoll-fd
)))
47 (defun calc-epoll-flags (fd-entry)
48 (logior (if (not (queue-empty-p (fd-entry-read-events fd-entry
))) et
:epollin
0)
49 (if (not (queue-empty-p (fd-entry-write-events fd-entry
))) et
:epollout
0)
53 (defmethod monitor-fd ((mux epoll-multiplexer
) fd-entry
)
55 (let ((flags (calc-epoll-flags fd-entry
))
56 (fd (fd-entry-fd fd-entry
)))
57 (with-foreign-object (ev 'et
:epoll-event
)
58 (et:memset ev
0 et
:size-of-epoll-event
)
59 (setf (foreign-slot-value ev
'et
:epoll-event
'et
:events
) flags
)
60 (setf (foreign-slot-value (foreign-slot-value ev
'et
:epoll-event
'et
:data
)
61 'et
:epoll-data
'et
:fd
)
64 (et:epoll-ctl
(fd-of mux
) et
:epoll-ctl-add fd ev
)
65 (et:unix-error-badf
(err)
66 (declare (ignore err
))
67 (warn "FD ~A is invalid, cannot monitor it." fd
)
68 (return-from monitor-fd nil
))
69 (et:unix-error-exist
(err)
70 (declare (ignore err
))
71 (warn "FD ~A is already monitored." fd
)
72 (return-from monitor-fd nil
))))
76 (defmethod update-fd ((mux epoll-multiplexer
) fd-entry
)
78 (let ((flags (calc-epoll-flags fd-entry
))
79 (fd (fd-entry-fd fd-entry
)))
80 (with-foreign-object (ev 'et
:epoll-event
)
81 (et:memset ev
0 et
:size-of-epoll-event
)
82 (setf (foreign-slot-value ev
'et
:epoll-event
'et
:events
) flags
)
83 (setf (foreign-slot-value (foreign-slot-value ev
'et
:epoll-event
'et
:data
)
84 'et
:epoll-data
'et
:fd
)
87 (et:epoll-ctl
(fd-of mux
) et
:epoll-ctl-mod fd ev
)
88 (et:unix-error-badf
(err)
89 (declare (ignore err
))
90 (warn "FD ~A is invalid, cannot update its status." fd
)
91 (return-from update-fd nil
))
92 (et:unix-error-noent
(err)
93 (declare (ignore err
))
94 (warn "FD ~A was not monitored, cannot update its status." fd
)
95 (return-from update-fd nil
))))
99 (defmethod unmonitor-fd ((mux epoll-multiplexer
) fd-entry
)
102 (et:epoll-ctl
(fd-of mux
)
104 (fd-entry-fd fd-entry
)
107 (et:unix-error-badf
(err)
108 (declare (ignore err
))
109 (warn "FD ~A is invalid, cannot unmonitor it." (fd-entry-fd fd-entry
)))
110 (et:unix-error-noent
(err)
111 (declare (ignore err
))
112 (warn "FD ~A was not monitored, cannot unmonitor it." (fd-entry-fd fd-entry
)))))
115 (defmethod harvest-events ((mux epoll-multiplexer
) timeout
)
116 (let ((milisec-timeout (timeout->milisec timeout
)))
117 (with-foreign-object (events 'et
:epoll-event
*epoll-max-events
*)
118 (et:memset events
0 (* *epoll-max-events
* et
:size-of-epoll-event
))
120 (et:epoll-wait
(fd-of mux
) events
121 *epoll-max-events
* milisec-timeout
)))
122 (macrolet ((epoll-slot (slot-name)
123 `(foreign-slot-value (mem-aref events
'et
:epoll-event i
)
124 'et
:epoll-event
',slot-name
)))
125 (return-from harvest-events
127 :for i
:below ready-fds
128 :for fd
:= (foreign-slot-value (epoll-slot et
:data
) 'et
:epoll-data
'et
:fd
)
129 :for event-mask
:= (epoll-slot et
:events
)
130 :for epoll-event
:= (make-epoll-event fd event-mask
)
131 :when epoll-event
:collect epoll-event
)))))))
134 (defun make-epoll-event (fd mask
)
137 ((et:epollout et
:epollhup
)
139 ((et:epollin et
:epollpri et
:epollhup
)
142 (push :error event
)))
147 (defun timeout->milisec
(timeout)
149 (multiple-value-bind (sec usec
) (decode-timeout timeout
)
151 (truncate usec
1000)))