1 ;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp -*-
3 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4 ; Copyright (C) 2006 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 ;; (declaim (optimize (speed 2) (safety 2) (space 1) (debug 2)))
23 (declaim (optimize (speed 0) (safety 2) (space 0) (debug 2)))
25 (in-package :io.multiplex
)
32 (:constructor make-handler
(fd read-func write-func except-func
))
34 (fd 0 :type et
:select-file-descriptor
)
35 (read-func nil
:type
(or function null
))
36 (write-func nil
:type
(or function null
))
37 (except-func nil
:type
(or function null
)))
39 (defclass multiplex-interface
()
40 ((fd-handlers :initform
(make-hash-table :test
'eql
) :reader fd-handlers
)
41 (fd-set-size :initform
0)))
43 (defmethod initialize-instance :after
((interface multiplex-interface
)
45 (setf (slot-value interface
'fd-set-size
) size
))
47 (defgeneric fd-handler
(multiplex-interface fd
)
48 (:method
((interface multiplex-interface
) fd
)
49 (gethash fd
(fd-handlers interface
))))
51 (defgeneric monitor-fd
(multiplex-interface handler
)
52 (:method-combination progn
:most-specific-last
))
54 (defgeneric modify-fd
(multiplex-interface fd
55 &key read-handler write-handler except-handler
)
56 (:method-combination progn
:most-specific-last
))
58 (defgeneric add-fd-handlers
(multiplex-interface fd
59 &key read-handler write-handler except-handler
)
60 (:method-combination progn
:most-specific-last
))
62 (defgeneric unmonitor-fd
(multiplex-interface handler
)
63 (:method-combination progn
:most-specific-first
))
65 (defgeneric remove-fd-handlers
(multiplex-interface fd
66 &key read write except all
)
67 (:method-combination progn
:most-specific-first
))
69 (defgeneric serve-fd-events
(multiplex-interface &key
))
71 (defgeneric close-multiplex-interface
(multiplex-interface)
72 (:method
((interface multiplex-interface
))
75 (eval-when (:compile-toplevel
:load-toplevel
:execute
)
76 (defvar *multiplex-available-interfaces
* nil
)
77 (defvar *multiplex-best-interface
* nil
))
79 (defmacro define-iomux-interface
(name priority
)
80 `(pushnew (cons ,priority
',name
)
81 *multiplex-available-interfaces
*))
85 (with-foreign-object (stat 'et
:stat
)
87 (progn (et:stat fd stat
) t
)
88 (et:unix-error-badf
(err)
89 (declare (ignore err
))
92 (defun finalize-object-closing-fd (object fd
)
93 (finalize object
#'(lambda () (et:close fd
))))
101 (defmethod monitor-fd progn
((interface multiplex-interface
) handler
)
102 (setf (gethash (handler-fd handler
) (fd-handlers interface
))
106 (defmethod modify-fd progn
((interface multiplex-interface
) fd
107 &key read-handler write-handler except-handler
)
108 (let ((handler (fd-handler interface fd
)))
109 (setf (handler-read-func handler
) read-handler
)
110 (setf (handler-write-func handler
) write-handler
)
111 (setf (handler-except-func handler
) except-handler
))
114 (defmethod add-fd-handlers progn
((interface multiplex-interface
) fd
115 &key read-handler write-handler except-handler
)
116 (assert (or read-handler write-handler except-handler
))
118 (let ((current-handler (fd-handler interface fd
)))
121 (modify-fd interface fd
122 :read-handler
(or read-handler
123 (handler-read-func current-handler
))
124 :write-handler
(or write-handler
125 (handler-except-func current-handler
))
126 :except-handler
(or except-handler
127 (handler-except-func current-handler
))))
129 (setf current-handler
(make-handler fd read-handler write-handler except-handler
))
130 (monitor-fd interface current-handler
))))
133 (defmethod unmonitor-fd progn
((interface multiplex-interface
) handler
)
134 (remhash (handler-fd handler
) (fd-handlers interface
))
137 (defmethod remove-fd-handlers progn
((interface multiplex-interface
) fd
138 &key read write except all
)
140 (assert (or read write except
)))
142 (let ((current-handler (fd-handler interface fd
)))
143 (when current-handler
145 (unmonitor-fd interface current-handler
)
147 (when read
(setf (handler-read-func current-handler
) nil
))
148 (when write
(setf (handler-write-func current-handler
) nil
))
149 (when except
(setf (handler-except-func current-handler
) nil
))
150 (if (or (handler-read-func current-handler
)
151 (handler-write-func current-handler
)
152 (handler-except-func current-handler
))
153 (modify-fd interface fd
154 :read-handler
(handler-read-func current-handler
)
155 :write-handler
(handler-except-func current-handler
)
156 :except-handler
(handler-except-func current-handler
))
157 (unmonitor-fd interface current-handler
))))))
160 ;; if there are handlers installed save them and restore them at the end
161 ;; (defmacro with-fd-handlers ((fd &key read-handler write-handler except-handler) &body body)
162 ;; (let ((tmp-handler (gensym)))
163 ;; `(let ((,tmp-handler (gethash ,fd fd-handlers)))
166 ;; (when ,tmp-handler
167 ;; (remove-fd-handlers ,fd :all t))
168 ;; (add-fd-handlers ,fd :read-handler ,read-handler
169 ;; :write-handler ,write-handler
170 ;; :except-handler ,except-handler)
173 ;; (setf (gethash ,fd fd-handlers) ,tmp-handler)
174 ;; (remove-fd-handlers ,fd :all t))))))