1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Indent-tabs-mode: NIL -*-
3 ;;; epoll.lisp --- epoll()-based multiplexer implementation.
5 ;;; Copyright (C) 2006-2008, 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
) (epoll-create size
)))
42 (defun calc-epoll-flags (fd-entry)
43 (logior (if (fd-entry-read-event fd-entry
)
45 (if (fd-entry-write-event fd-entry
)
49 (defmethod monitor-fd ((mux epoll-multiplexer
) fd-entry
)
50 (assert fd-entry
(fd-entry) "Must supply an FD-ENTRY!")
51 (let ((flags (calc-epoll-flags fd-entry
))
52 (fd (fd-entry-fd fd-entry
)))
53 (with-foreign-object (ev 'epoll-event
)
54 (bzero ev size-of-epoll-event
)
55 (setf (foreign-slot-value ev
'epoll-event
'events
) flags
)
56 (setf (foreign-slot-value
57 (foreign-slot-value ev
'epoll-event
'data
) 'epoll-data
'fd
)
60 (epoll-ctl (fd-of mux
) epoll-ctl-add fd ev
)
62 (warn "FD ~A is invalid, cannot monitor it." fd
))
64 (warn "FD ~A is already monitored." fd
))))))
66 (defmethod update-fd ((mux epoll-multiplexer
) fd-entry event-type edge-change
)
67 (declare (ignore event-type edge-change
))
68 (assert fd-entry
(fd-entry) "Must supply an FD-ENTRY!")
69 (let ((flags (calc-epoll-flags fd-entry
))
70 (fd (fd-entry-fd fd-entry
)))
71 (with-foreign-object (ev 'epoll-event
)
72 (bzero ev size-of-epoll-event
)
73 (setf (foreign-slot-value ev
'epoll-event
'events
) flags
)
74 (setf (foreign-slot-value
75 (foreign-slot-value ev
'epoll-event
'data
) 'epoll-data
'fd
)
78 (epoll-ctl (fd-of mux
) epoll-ctl-mod fd ev
)
80 (warn "FD ~A is invalid, cannot update its status." fd
))
82 (warn "FD ~A was not monitored, cannot update its status." fd
))))
85 (defmethod unmonitor-fd ((mux epoll-multiplexer
) fd-entry
)
87 (epoll-ctl (fd-of mux
)
89 (fd-entry-fd fd-entry
)
92 (warn "FD ~A is invalid, cannot unmonitor it." (fd-entry-fd fd-entry
)))
94 (warn "FD ~A was not monitored, cannot unmonitor it."
95 (fd-entry-fd fd-entry
)))))
97 (defmethod harvest-events ((mux epoll-multiplexer
) timeout
)
98 (with-foreign-object (events 'epoll-event
*epoll-max-events
*)
99 (bzero events
(* *epoll-max-events
* size-of-epoll-event
))
101 (nix:repeat-upon-condition-decreasing-timeout
102 ((nix:eintr
) tmp-timeout timeout
)
103 (setf ready-fds
(epoll-wait (fd-of mux
) events
*epoll-max-events
*
104 (timeout->milisec tmp-timeout
))))
105 (macrolet ((epoll-slot (slot-name)
106 `(foreign-slot-value (mem-aref events
'epoll-event i
)
107 'epoll-event
',slot-name
)))
108 (return-from harvest-events
109 (loop :for i
:below ready-fds
110 :for fd
:= (foreign-slot-value (epoll-slot data
) 'epoll-data
'fd
)
111 :for event-mask
:= (epoll-slot events
)
112 :for epoll-event
:= (make-epoll-event fd event-mask
)
113 :when epoll-event
:collect epoll-event
))))))
115 (defun make-epoll-event (fd mask
)
120 ((epollin epollpri epollhup
)
123 (push :error event
)))