1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Indent-tabs-mode: NIL -*-
3 ;;; epoll.lisp --- epoll()-based multiplexer implementation.
5 ;;; Copyright (C) 2006-2007, 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 +epoll-priority
+ 1)
28 (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")))
35 (defconstant +epoll-default-size-hint
+ 25)
36 (defvar *epoll-max-events
* 200)
38 (defmethod initialize-instance :after
((mux epoll-multiplexer
)
39 &key
(size +epoll-default-size-hint
+))
40 (setf (slot-value mux
'fd
) (nix:epoll-create size
)))
42 (defun calc-epoll-flags (fd-entry)
43 (logior (if (not (queue-empty-p (fd-entry-read-events fd-entry
)))
45 (if (not (queue-empty-p (fd-entry-write-events fd-entry
)))
49 (defmethod monitor-fd ((mux epoll-multiplexer
) fd-entry
)
51 (let ((flags (calc-epoll-flags fd-entry
))
52 (fd (fd-entry-fd fd-entry
)))
53 (with-foreign-object (ev 'nix
::epoll-event
)
54 (nix:bzero ev nix
::size-of-epoll-event
)
55 (setf (foreign-slot-value ev
'nix
::epoll-event
'nix
::events
)
57 (setf (foreign-slot-value
58 (foreign-slot-value ev
'nix
::epoll-event
'nix
::data
)
59 'nix
::epoll-data
'nix
::fd
)
62 (nix:epoll-ctl
(fd-of mux
) nix
:epoll-ctl-add fd ev
)
64 (warn "FD ~A is invalid, cannot monitor it." fd
))
66 (warn "FD ~A is already monitored." fd
))))))
68 (defmethod update-fd ((mux epoll-multiplexer
) fd-entry
)
70 (let ((flags (calc-epoll-flags fd-entry
))
71 (fd (fd-entry-fd fd-entry
)))
72 (with-foreign-object (ev 'nix
::epoll-event
)
73 (nix:bzero ev nix
::size-of-epoll-event
)
74 (setf (foreign-slot-value ev
'nix
::epoll-event
'nix
::events
)
76 (setf (foreign-slot-value
77 (foreign-slot-value ev
'nix
::epoll-event
'nix
::data
)
78 'nix
::epoll-data
'nix
::fd
)
81 (nix:epoll-ctl
(fd-of mux
) nix
::epoll-ctl-mod fd ev
)
83 (warn "FD ~A is invalid, cannot update its status." fd
))
85 (warn "FD ~A was not monitored, cannot update its status." fd
))))
88 (defmethod unmonitor-fd ((mux epoll-multiplexer
) fd-entry
)
90 (nix:epoll-ctl
(fd-of mux
)
92 (fd-entry-fd fd-entry
)
95 (warn "FD ~A is invalid, cannot unmonitor it." (fd-entry-fd fd-entry
)))
97 (warn "FD ~A was not monitored, cannot unmonitor it."
98 (fd-entry-fd fd-entry
)))))
100 (defmethod harvest-events ((mux epoll-multiplexer
) timeout
)
101 (with-foreign-object (events 'nix
::epoll-event
*epoll-max-events
*)
102 (nix:bzero events
(* *epoll-max-events
* nix
::size-of-epoll-event
))
104 (nix:repeat-upon-condition-decreasing-timeout
105 ((nix:eintr
) tmp-timeout timeout
)
106 (setf ready-fds
(nix:epoll-wait
(fd-of mux
) events
*epoll-max-events
*
107 (timeout->milisec tmp-timeout
))))
108 (macrolet ((epoll-slot (slot-name)
109 `(foreign-slot-value (mem-aref events
'nix
::epoll-event i
)
110 'nix
::epoll-event
',slot-name
)))
111 (return-from harvest-events
112 (loop for i below ready-fds
113 for fd
= (foreign-slot-value (epoll-slot nix
::data
)
114 'nix
::epoll-data
'nix
::fd
)
115 for event-mask
= (epoll-slot nix
::events
)
116 for epoll-event
= (make-epoll-event fd event-mask
)
117 when epoll-event collect epoll-event
))))))
119 (defun make-epoll-event (fd mask
)
122 ((nix::epollout nix
::epollhup
)
124 ((nix::epollin nix
::epollpri nix
::epollhup
)
127 (push :error event
)))