1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Indent-tabs-mode: NIL -*-
3 ;;; multiplexer.lisp --- Base class for multiplexers.
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 (defvar *available-multiplexers
* nil
27 "An alist of (PRIORITY . MULTIPLEXER). Smaller values mean higher priority.")
29 (defvar *default-multiplexer
* nil
30 "The default multiplexer for the current OS.")
32 (defun get-fd-limit ()
33 "Return the maximum number of FDs available for the current process."
34 (let ((fd-limit (nix:getrlimit nix
:rlimit-nofile
)))
35 (unless (eql fd-limit nix
:rlim-infinity
)
38 (defclass multiplexer
()
40 (fd-limit :initform
(get-fd-limit)
43 (closedp :accessor multiplexer-closedp
45 (:documentation
"Base class for I/O multiplexers."))
47 (defgeneric close-multiplexer
(mux)
48 (:method-combination progn
:most-specific-last
)
49 (:documentation
"Close multiplexer MUX, calling close() on the multiplexer's FD if bound."))
51 (defgeneric monitor-fd
(mux fd-entry
)
52 (:documentation
"Add the descriptor reppresented by FD-ENTRY to multiplexer MUX.
53 Must return NIL on failure, T otherwise."))
55 (defgeneric update-fd
(mux fd-entry event-type edge-change
)
56 (:documentation
"Update the status of the descriptor reppresented by FD-ENTRY in multiplexer MUX.
57 Must return NIL on failure, T otherwise."))
59 (defgeneric unmonitor-fd
(mux fd-entry
)
60 (:documentation
"Remove the descriptor reppresented by FD-ENTRY from multiplexer MUX.
61 Must return NIL on failure, T otherwise."))
63 (defgeneric harvest-events
(mux timeout
)
64 (:documentation
"Wait for events on multiplexer MUX for a maximum time of TIMEOUT seconds.
65 Returns a list of fd/result pairs which have one of these forms:
71 (defmethod close-multiplexer :around
((mux multiplexer
))
72 (unless (multiplexer-closedp mux
)
74 (setf (multiplexer-closedp mux
) t
)))
76 (defmethod close-multiplexer progn
((mux multiplexer
))
77 (when (and (slot-boundp mux
'fd
) (not (null (fd-of mux
))))
78 (nix:close
(fd-of mux
))
79 (setf (slot-value mux
'fd
) nil
))
82 (defmethod monitor-fd :around
((mux multiplexer
) fd-entry
)
83 (if (ignore-and-print-errors (call-next-method))
85 (warn "FD monitoring failed for FD ~A."
86 (fd-entry-fd fd-entry
))))
88 (defmethod update-fd :around
((mux multiplexer
) fd-entry event-type edge-change
)
89 (declare (ignore event-type edge-change
))
90 (if (ignore-and-print-errors (call-next-method))
92 (warn "FD status update failed for FD ~A."
93 (fd-entry-fd fd-entry
))))
95 (defmethod unmonitor-fd :around
((mux multiplexer
) fd-entry
)
96 (if (ignore-and-print-errors (call-next-method))
98 (warn "FD unmonitoring failed for FD ~A."
99 (fd-entry-fd fd-entry
))))
101 (defmacro define-multiplexer
(name priority superclasses slots
&rest options
)
103 (defclass ,name
,superclasses
,slots
,@options
)
104 (pushnew (cons ,priority
',name
) *available-multiplexers
*