From 8271fa9874b14a00e505c3d130b1ca546ad2b9d4 Mon Sep 17 00:00:00 2001 From: Stelian Ionescu Date: Wed, 17 Jan 2007 02:23:35 +0100 Subject: [PATCH] Overhaul of the I/O multiplexers. --- io-multiplex/common.lisp | 395 ++++++++++++++++++++++++------------------- io-multiplex/defpackage.lisp | 18 +- io-multiplex/detect.lisp | 6 +- io-multiplex/epoll.lisp | 110 ++++++------ io-multiplex/select.lisp | 94 ++++++---- 5 files changed, 360 insertions(+), 263 deletions(-) rewrite io-multiplex/common.lisp (68%) diff --git a/io-multiplex/common.lisp b/io-multiplex/common.lisp dissimilarity index 68% index 435c86c..4c80f54 100644 --- a/io-multiplex/common.lisp +++ b/io-multiplex/common.lisp @@ -1,174 +1,221 @@ -;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp -*- - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; Copyright (C) 2006 by Stelian Ionescu ; -; ; -; This program is free software; you can redistribute it and/or modify ; -; it under the terms of the GNU General Public License as published by ; -; the Free Software Foundation; either version 2 of the License, or ; -; (at your option) any later version. ; -; ; -; This program is distributed in the hope that it will be useful, ; -; but WITHOUT ANY WARRANTY; without even the implied warranty of ; -; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ; -; GNU General Public License for more details. ; -; ; -; You should have received a copy of the GNU General Public License ; -; along with this program; if not, write to the ; -; Free Software Foundation, Inc., ; -; 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA ; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -;; (declaim (optimize (speed 2) (safety 2) (space 1) (debug 2))) -(declaim (optimize (speed 0) (safety 2) (space 0) (debug 2))) - -(in-package :io.multiplex) - -;;; -;;; Class definitions -;;; - -(defstruct (handler - (:constructor make-handler (fd read-func write-func except-func)) - (:copier nil)) - (fd 0 :type et:select-file-descriptor) - (read-func nil :type (or function null)) - (write-func nil :type (or function null)) - (except-func nil :type (or function null))) - -(defclass multiplex-interface () - ((fd-handlers :initform (make-hash-table :test 'eql) :reader fd-handlers) - (fd-set-size :initform 0))) - -(defmethod initialize-instance :after ((interface multiplex-interface) - &key size) - (setf (slot-value interface 'fd-set-size) size)) - -(defgeneric fd-handler (multiplex-interface fd) - (:method ((interface multiplex-interface) fd) - (gethash fd (fd-handlers interface)))) - -(defgeneric monitor-fd (multiplex-interface handler) - (:method-combination progn :most-specific-last)) - -(defgeneric modify-fd (multiplex-interface fd - &key read-handler write-handler except-handler) - (:method-combination progn :most-specific-last)) - -(defgeneric add-fd-handlers (multiplex-interface fd - &key read-handler write-handler except-handler) - (:method-combination progn :most-specific-last)) - -(defgeneric unmonitor-fd (multiplex-interface handler) - (:method-combination progn :most-specific-first)) - -(defgeneric remove-fd-handlers (multiplex-interface fd - &key read write except all) - (:method-combination progn :most-specific-first)) - -(defgeneric serve-fd-events (multiplex-interface &key)) - -(defgeneric close-multiplex-interface (multiplex-interface) - (:method ((interface multiplex-interface)) - t)) - -(eval-when (:compile-toplevel :load-toplevel :execute) - (defvar *multiplex-available-interfaces* nil) - (defvar *multiplex-best-interface* nil)) - -(defmacro define-iomux-interface (name priority) - `(pushnew (cons ,priority ',name) - *multiplex-available-interfaces*)) - -;; small utility -(defun fd-open-p (fd) - (with-foreign-object (stat 'et:stat) - (handler-case - (progn (et:stat fd stat) t) - (et:unix-error-badf (err) - (declare (ignore err)) - nil)))) - -(defun finalize-object-closing-fd (object fd) - (finalize object #'(lambda () (et:close fd)))) - - - -;;; -;;; Base methods -;;; - -(defmethod monitor-fd progn ((interface multiplex-interface) handler) - (setf (gethash (handler-fd handler) (fd-handlers interface)) - handler) - (values interface)) - -(defmethod modify-fd progn ((interface multiplex-interface) fd - &key read-handler write-handler except-handler) - (let ((handler (fd-handler interface fd))) - (setf (handler-read-func handler) read-handler) - (setf (handler-write-func handler) write-handler) - (setf (handler-except-func handler) except-handler)) - (values interface)) - -(defmethod add-fd-handlers progn ((interface multiplex-interface) fd - &key read-handler write-handler except-handler) - (assert (or read-handler write-handler except-handler)) - - (let ((current-handler (fd-handler interface fd))) - (if current-handler - (progn - (modify-fd interface fd - :read-handler (or read-handler - (handler-read-func current-handler)) - :write-handler (or write-handler - (handler-except-func current-handler)) - :except-handler (or except-handler - (handler-except-func current-handler)))) - (progn - (setf current-handler (make-handler fd read-handler write-handler except-handler)) - (monitor-fd interface current-handler)))) - (values interface)) - -(defmethod unmonitor-fd progn ((interface multiplex-interface) handler) - (remhash (handler-fd handler) (fd-handlers interface)) - (values interface)) - -(defmethod remove-fd-handlers progn ((interface multiplex-interface) fd - &key read write except all) - (unless all - (assert (or read write except))) - - (let ((current-handler (fd-handler interface fd))) - (when current-handler - (if all - (unmonitor-fd interface current-handler) - (progn - (when read (setf (handler-read-func current-handler) nil)) - (when write (setf (handler-write-func current-handler) nil)) - (when except (setf (handler-except-func current-handler) nil)) - (if (or (handler-read-func current-handler) - (handler-write-func current-handler) - (handler-except-func current-handler)) - (modify-fd interface fd - :read-handler (handler-read-func current-handler) - :write-handler (handler-except-func current-handler) - :except-handler (handler-except-func current-handler)) - (unmonitor-fd interface current-handler)))))) - (values interface)) - -;; if there are handlers installed save them and restore them at the end -;; (defmacro with-fd-handlers ((fd &key read-handler write-handler except-handler) &body body) -;; (let ((tmp-handler (gensym))) -;; `(let ((,tmp-handler (gethash ,fd fd-handlers))) -;; (unwind-protect -;; (progn -;; (when ,tmp-handler -;; (remove-fd-handlers ,fd :all t)) -;; (add-fd-handlers ,fd :read-handler ,read-handler -;; :write-handler ,write-handler -;; :except-handler ,except-handler) -;; ,@body) -;; (if ,tmp-handler -;; (setf (gethash ,fd fd-handlers) ,tmp-handler) -;; (remove-fd-handlers ,fd :all t)))))) +;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp -*- + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; Copyright (C) 2006,2007 by Stelian Ionescu ; +; ; +; This program is free software; you can redistribute it and/or modify ; +; it under the terms of the GNU General Public License as published by ; +; the Free Software Foundation; either version 2 of the License, or ; +; (at your option) any later version. ; +; ; +; This program is distributed in the hope that it will be useful, ; +; but WITHOUT ANY WARRANTY; without even the implied warranty of ; +; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ; +; GNU General Public License for more details. ; +; ; +; You should have received a copy of the GNU General Public License ; +; along with this program; if not, write to the ; +; Free Software Foundation, Inc., ; +; 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA ; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; (declaim (optimize (speed 2) (safety 2) (space 1) (debug 2))) +(declaim (optimize (speed 0) (safety 2) (space 0) (debug 2))) + +(in-package :io.multiplex) + +;;;; +;;;; Type definitions +;;;; + +(deftype event-type () + '(member :read :write :except :error)) + +;;; +;;; FD Entry +;;; +(defstruct (fd-entry + (:constructor make-fd-entry (fd read-handlers write-handlers + except-handlers error-handlers)) + (:copier nil)) + (fd 0 :type et:select-file-descriptor) + (read-handlers nil :type list) + (write-handlers nil :type list) + (except-handlers nil :type list) + (error-handlers nil :type list)) + +(defun fd-entry-handler-list (fd-entry event-type) + (check-type fd-entry fd-entry) + (check-type event-type event-type) + (case event-type + (:read (fd-entry-read-handlers fd-entry)) + (:write (fd-entry-write-handlers fd-entry)) + (:except (fd-entry-except-handlers fd-entry)) + (:error (fd-entry-error-handlers fd-entry)))) + +(defun (setf fd-entry-handler-list) (handler-list fd-entry event-type) + (check-type fd-entry fd-entry) + (check-type event-type event-type) + (case event-type + (:read (setf (fd-entry-read-handlers fd-entry) handler-list)) + (:write (setf (fd-entry-write-handlers fd-entry) handler-list)) + (:except (setf (fd-entry-except-handlers fd-entry) handler-list)) + (:error (setf (fd-entry-error-handlers fd-entry) handler-list)))) + +(defun fd-entry-empty-p (fd-entry) + (not (or (fd-entry-read-handlers fd-entry) + (fd-entry-write-handlers fd-entry) + (fd-entry-except-handlers fd-entry) + (fd-entry-error-handlers fd-entry)))) + +;;; +;;; Handler +;;; +(defstruct (handler + (:constructor make-handler (event-type function)) + (:copier nil)) + (event-type nil :type (or null event-type)) + (function nil :type (or null function))) + +;;; +;;; Multiplexer +;;; +(defclass multiplexer () + ((fd-entries :initform (make-hash-table :test 'eql) :reader fd-entries) + (fd-set-size :initform 0))) + +(defmethod initialize-instance :after ((mux multiplexer) + &key size) + (setf (slot-value mux 'fd-set-size) size)) + +(defgeneric fd-entry (mux fd) + (:method ((mux multiplexer) fd) + (gethash fd (fd-entries mux)))) + +(defgeneric monitor-fd (mux fd-entry) + (:method-combination progn :most-specific-last)) + +(defgeneric update-fd (mux fd-entry) + (:method-combination progn :most-specific-last) + (:method progn ((mux multiplexer) fd-entry) + t)) + +(defgeneric add-fd-handler (mux fd event-type function) + (:method-combination progn :most-specific-last)) + +(defgeneric unmonitor-fd (mux fd) + (:method-combination progn :most-specific-first)) + +(defgeneric remove-fd-handler (mux fd handler) + (:method-combination progn :most-specific-first)) + +(defgeneric serve-fd-events (mux &key timeout)) + +(defgeneric close-multiplexer (mux) + (:method ((mux multiplexer)) + t)) + +(eval-when (:compile-toplevel :load-toplevel :execute) + (defvar *available-multiplexers* nil) + (defvar *best-multiplexer* nil)) + +(defmacro define-multiplexer (name priority superclasses slots &rest options) + `(progn + (defclass ,name ,superclasses ,slots ,@options) + (pushnew (cons ,priority ',name) + *available-multiplexers*))) + +(defun fd-open-p (fd) + (with-foreign-object (stat 'et:stat) + (handler-case + (progn (et:stat fd stat) t) + (et:unix-error-badf (err) + (declare (ignore err)) + nil)))) + +(defun finalize-object-closing-fd (object fd) + (finalize object #'(lambda () (et:close fd)))) + + + +;;;; +;;;; Base methods +;;;; + +(defmethod monitor-fd progn ((mux multiplexer) fd-entry) + (let ((fd (fd-entry-fd fd-entry))) + (setf (gethash fd (fd-entries mux)) fd-entry) + (values fd))) + +(defmethod add-fd-handler progn ((mux multiplexer) + fd event-type function) + (check-type event-type event-type) + + (let ((current-entry (fd-entry mux fd)) + (handler (make-handler event-type function))) + (if current-entry + (push handler (fd-entry-handler-list current-entry event-type)) + (progn + (setf current-entry (make-fd-entry fd nil nil nil nil)) + (push handler (fd-entry-handler-list current-entry event-type)) + (monitor-fd mux current-entry))) + (values handler))) + +(defmethod unmonitor-fd progn ((mux multiplexer) fd) + (remhash fd (fd-entries mux)) + (values fd)) + +(defmethod remove-fd-handler progn ((mux multiplexer) + fd handler) + (check-type (handler-event-type handler) event-type) + + (let ((event-type (handler-event-type handler)) + (current-entry (fd-entry mux fd))) + (when current-entry + (setf (fd-entry-handler-list current-entry event-type) + (delete handler (fd-entry-handler-list current-entry event-type) :test 'eq)) + (when (fd-entry-empty-p current-entry) + (unmonitor-fd mux fd)))) + (values mux)) + +;; if there are handlers installed save them and restore them at the end +(defmacro with-fd-handler ((mux fd event-type function) + &body body) + (let ((handler (gensym "HANDLER-"))) + `(let (,handler) + (unwind-protect + (progn + (setf ,handler (add-fd-handler ,mux ,fd ,event-type ,function)) + ,@body) + (when ,handler + (remove-fd-handler ,mux ,fd ,handler)))))) + + +;;;; +;;;; Other utilities +;;;; + +;;; Break a real timeout into seconds and microseconds. +(defun decode-timeout (timeout) + (typecase timeout + (integer (values timeout 0)) + (null (values 0 0)) + (real + (multiple-value-bind (q r) (truncate (coerce timeout 'single-float)) + (declare (type unsigned-byte q) (single-float r)) + (values q (the (values unsigned-byte t) (truncate (* r 1f6)))))) + (t + (error "Timeout is not a real number or NIL: ~S" timeout)))) + +(defun wait-until-fd-usable (mux fd event-type &optional timeout) + (let (status) + (flet ((callback (fd type) + (cond ((member type '(:error :except)) + (setf status :except)) + ((eql type event-type) + (setf status :ok))))) + (with-fd-handler (mux fd event-type #'callback) + (loop + (serve-fd-events mux :timeout timeout) + (when status + (return-from wait-until-fd-usable status))))))) diff --git a/io-multiplex/defpackage.lisp b/io-multiplex/defpackage.lisp index d6863ac..f1185c9 100644 --- a/io-multiplex/defpackage.lisp +++ b/io-multiplex/defpackage.lisp @@ -1,7 +1,7 @@ ;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp -*- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; Copyright (C) 2006 by Stelian Ionescu ; +; Copyright (C) 2006,2007 by Stelian Ionescu ; ; ; ; This program is free software; you can redistribute it and/or modify ; ; it under the terms of the GNU General Public License as published by ; @@ -27,16 +27,16 @@ (:export ;; classes #:handler - #:multiplex-interface - #:select-multiplex-interface - #:epoll-multiplex-interface + #:multiplexer + #:select-multiplexer + #:epoll-multiplexer ;; available interface - #:*multiplex-available-interfaces* - #:*multiplex-best-interface* + #:*available-multiplexers* + #:*best-multiplexer* - #:add-fd-handlers #:remove-fd-handlers - #:modify-fd #:serve-fd-events - #:close-multiplex-interface + #:add-fd-handler #:remove-fd-handler + #:unmonitor-fd #:serve-fd-events + #:close-multiplexer #:finalize-object-closing-fd)) diff --git a/io-multiplex/detect.lisp b/io-multiplex/detect.lisp index 45b4be8..680062c 100644 --- a/io-multiplex/detect.lisp +++ b/io-multiplex/detect.lisp @@ -1,7 +1,7 @@ ;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp -*- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; Copyright (C) 2006 by Stelian Ionescu ; +; Copyright (C) 2006,2007 by Stelian Ionescu ; ; ; ; This program is free software; you can redistribute it and/or modify ; ; it under the terms of the GNU General Public License as published by ; @@ -25,5 +25,5 @@ (in-package :io.multiplex) ;;; TODO: do real detecting here -(setf *multiplex-best-interface* - (cdar (sort *multiplex-available-interfaces* #'< :key #'car))) +(setf *best-multiplexer* + (cdar (sort *available-multiplexers* #'< :key #'car))) diff --git a/io-multiplex/epoll.lisp b/io-multiplex/epoll.lisp index 995ba96..ea9cacb 100644 --- a/io-multiplex/epoll.lisp +++ b/io-multiplex/epoll.lisp @@ -1,7 +1,7 @@ ;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp -*- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; Copyright (C) 2006 by Stelian Ionescu ; +; Copyright (C) 2006,2007 by Stelian Ionescu ; ; ; ; This program is free software; you can redistribute it and/or modify ; ; it under the terms of the GNU General Public License as published by ; @@ -24,78 +24,92 @@ (in-package :io.multiplex) -(defclass epoll-multiplex-interface (multiplex-interface) - ((epoll-fd :reader epoll-fd))) - (defconstant +epoll-priority+ 1) -(define-iomux-interface epoll-multiplex-interface +epoll-priority+) +(define-multiplexer epoll-multiplexer +epoll-priority+ + (multiplexer) + ((epoll-fd :reader epoll-fd))) (defconstant +epoll-default-size-hint+ 25) (eval-when (:compile-toplevel :load-toplevel :execute) (defvar *epoll-max-events* 200)) -(defmethod initialize-instance :after ((interface epoll-multiplex-interface) +(defmethod initialize-instance :after ((mux epoll-multiplexer) &key (size +epoll-default-size-hint+)) (let ((epoll-fd (et:epoll-create size))) - (setf (slot-value interface 'epoll-fd) epoll-fd) - (finalize-object-closing-fd interface epoll-fd))) + (setf (slot-value mux 'epoll-fd) epoll-fd) + (finalize-object-closing-fd mux epoll-fd))) + +(defun calc-epoll-flags (fd-entry) + (logior (if (fd-entry-read-handlers fd-entry) et:epollin 0) + (if (fd-entry-write-handlers fd-entry) et:epollout 0) + (if (fd-entry-except-handlers fd-entry) et:epollpri 0))) -(defmethod monitor-fd progn ((interface epoll-multiplex-interface) handler) - (let ((flags (logior (if (handler-read-func handler) et:epollin 0) - (if (handler-write-func handler) et:epollout 0) - (if (handler-except-func handler) et:epollpri 0))) - (fd (handler-fd handler))) +(defmethod monitor-fd progn ((mux epoll-multiplexer) fd-entry) + (assert fd-entry) + (let ((flags (calc-epoll-flags fd-entry)) + (fd (fd-entry-fd fd-entry))) (with-foreign-object (ev 'et:epoll-event) (et:memset ev 0 #.(foreign-type-size 'et:epoll-event)) (setf (foreign-slot-value ev 'et:epoll-event 'et:events) flags) (setf (foreign-slot-value (foreign-slot-value ev 'et:epoll-event 'et:data) 'et:epoll-data 'et:fd) fd) - (et:epoll-ctl (epoll-fd interface) et:epoll-ctl-add fd ev)) - (values interface))) + (et:epoll-ctl (epoll-fd mux) et:epoll-ctl-add fd ev)) + (values fd))) -(defmethod modify-fd progn ((interface epoll-multiplex-interface) fd - &key read-handler write-handler except-handler) - (let ((flags (logior (if read-handler et:epollin 0) - (if write-handler et:epollout 0) - (if except-handler et:epollpri 0)))) +(defmethod update-fd progn ((mux epoll-multiplexer) fd-entry) + (assert fd-entry) + (let ((flags (calc-epoll-flags fd-entry)) + (fd (fd-entry-fd fd-entry))) (with-foreign-object (ev 'et:epoll-event) (et:memset ev 0 #.(foreign-type-size 'et:epoll-event)) (setf (foreign-slot-value ev 'et:epoll-event 'et:events) flags) (setf (foreign-slot-value (foreign-slot-value ev 'et:epoll-event 'et:data) 'et:epoll-data 'et:fd) fd) - (et:epoll-ctl (epoll-fd interface) et:epoll-ctl-mod fd ev)) - (values interface))) + (et:epoll-ctl (epoll-fd mux) et:epoll-ctl-mod fd ev)) + (values fd-entry))) -(defmethod unmonitor-fd progn ((interface epoll-multiplex-interface) handler) - (et:epoll-ctl (epoll-fd interface) +(defmethod unmonitor-fd progn ((mux epoll-multiplexer) fd) + (et:epoll-ctl (epoll-fd mux) et:epoll-ctl-del - (handler-fd handler) + fd (null-pointer)) - (values interface)) + (values fd)) -(defun epoll-serve-single-fd (handler events) - (let ((except-func (handler-except-func handler)) - (read-func (handler-read-func handler)) - (write-func (handler-write-func handler)) - (fd (handler-fd handler))) - (when (and except-func (plusp (logand et:epollerr events))) - (funcall except-func fd :error)) - (when (and except-func (plusp (logand et:epollpri events))) - (funcall except-func fd :except)) - (when (and read-func (plusp (logand et:epollin events))) - (funcall read-func fd :read)) - (when (and write-func (plusp (logand et:epollout events))) - (funcall write-func fd :write)))) +(defun epoll-serve-single-fd (fd-entry events) + (assert fd-entry) + (let ((error-handlers (handler-error-handlers fd-entry)) + (except-handlers (handler-except-handlers fd-entry)) + (read-handlers (handler-read-handlers fd-entry)) + (write-handlers (handler-write-handlers fd-entry)) + (fd (fd-entry-fd fd-entry))) + (when (and error-handlers (logtest et:epollerr events)) + (dolist (error-handler error-handlers) + (funcall (handler-function error-handler) fd :error))) + (when (and except-handlers (logtest et:epollpri events)) + (dolist (except-handler (fd-entry-except-handlers fd-entry)) + (funcall (handler-function except-handler) fd :except))) + (when (and read-handlers (logtest et:epollin events)) + (dolist (read-handler (fd-entry-read-handlers fd-entry)) + (funcall (handler-function read-handler) fd :read))) + (when (and write-handlers (logtest et:epollout events)) + (dolist (write-handler (fd-entry-write-handlers fd-entry)) + (funcall (handler-function write-handler) fd :write))))) -(defmethod serve-fd-events ((interface epoll-multiplex-interface) &key) +(defmethod serve-fd-events ((mux epoll-multiplexer) + &key timeout) (with-foreign-object (events 'et:epoll-event #.*epoll-max-events*) (et:memset events 0 #.(* *epoll-max-events* (foreign-type-size 'et:epoll-event))) + (if timeout + (multiple-value-bind + (to-sec to-usec) (decode-timeout timeout) + (setf timeout (+ to-sec (* to-usec 1000)))) + (setf timeout -1)) (let ((ready-fds - (et:epoll-wait (epoll-fd interface) events - #.*epoll-max-events* -1))) + (et:epoll-wait (epoll-fd mux) events + #.*epoll-max-events* timeout))) (loop :for i :below ready-fds :for fd := (foreign-slot-value (foreign-slot-value (mem-aref events 'et:epoll-event i) @@ -103,10 +117,10 @@ 'et:epoll-data 'et:fd) :for event-mask := (foreign-slot-value (mem-aref events 'et:epoll-event i) 'et:epoll-event 'et:events) - :do (epoll-serve-single-fd (fd-handler interface fd) - event-mask)))) - (values interface)) + :do (epoll-serve-single-fd (fd-entry mux fd) + event-mask)) + (return-from serve-fd-events ready-fds)))) -(defmethod close-multiplex-interface ((interface epoll-multiplex-interface)) - (cancel-finalization interface) - (et:close (epoll-fd interface))) +(defmethod close-multiplexer ((mux epoll-multiplexer)) + (cancel-finalization mux) + (et:close (epoll-fd mux))) diff --git a/io-multiplex/select.lisp b/io-multiplex/select.lisp index b2e3944..f448b76 100644 --- a/io-multiplex/select.lisp +++ b/io-multiplex/select.lisp @@ -1,7 +1,7 @@ ;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp -*- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; Copyright (C) 2006 by Stelian Ionescu ; +; Copyright (C) 2006,2007 by Stelian Ionescu ; ; ; ; This program is free software; you can redistribute it and/or modify ; ; it under the terms of the GNU General Public License as published by ; @@ -24,11 +24,10 @@ (in-package :io.multiplex) -(defclass select-multiplex-interface (multiplex-interface) ()) - (defconstant +select-priority+ 3) -(define-iomux-interface select-multiplex-interface +select-priority+) +(define-multiplexer select-multiplexer +select-priority+ + (multiplexer) ()) (defun select-setup-masks (select-iface read-fds write-fds except-fds) (declare (type et:foreign-pointer @@ -39,57 +38,94 @@ (et:fd-zero except-fds) (let ((max-fd 0)) - (with-hash-table-iterator (next-item (fd-handlers select-iface)) - (multiple-value-bind (item-p fd handler) (next-item) + (with-hash-table-iterator (next-item (fd-entries select-iface)) + (multiple-value-bind (item-p fd fd-entry) (next-item) (when item-p (when (> fd max-fd) (setf max-fd fd)) - (when (handler-read-func handler) + (when (fd-entry-read-handlers fd-entry) (et:fd-set fd read-fds)) - (when (handler-write-func handler) + (when (fd-entry-write-handlers fd-entry) (et:fd-set fd write-fds)) - (when (handler-except-func handler) + (when (fd-entry-except-handlers fd-entry) (et:fd-set fd except-fds))))) max-fd)) -(defmethod serve-fd-events ((interface select-multiplex-interface) &key) +(defun handle-select-fd-errors (select-iface) + (let ((current-entries (fd-entries select-iface)) + invalid-fd-entries) + (with-hash-table-iterator (next-item current-entries) + (multiple-value-bind (item-p fd fd-entry) (next-item) + (when (and item-p (not (fd-open-p fd))) + (push fd-entry invalid-fd-entries)))) + (dolist (fd-entry invalid-fd-entries) + (let ((fd (fd-entry-fd fd-entry)) + (error-handlers (fd-entry-error-handlers fd-entry))) + (if error-handlers + (dolist (error-handler error-handlers) + (funcall (handler-function error-handler) fd :error)) + (remhash fd current-entries)))))) + +(defmethod serve-fd-events ((mux select-multiplexer) + &key timeout) (with-foreign-objects ((read-fds 'et:fd-set) (write-fds 'et:fd-set) (except-fds 'et:fd-set)) (let ((max-fd (select-setup-masks - interface + mux read-fds write-fds - except-fds))) + except-fds)) + (count 0)) - (with-slots (fd-handlers) interface + ;; this means there are no valid fds to serve + ;; but with no fds active select() blocks forever(at least on Linux) + (when (zerop max-fd) + (return-from serve-fd-events 0)) + + (with-accessors ((fd-entries fd-entries)) mux (tagbody :start (handler-case - (et:select (1+ max-fd) - read-fds - write-fds - except-fds - (null-pointer)) + (with-foreign-object (to 'et:timeval) + (when timeout + (progn + (et:memset to 0 #.(foreign-type-size 'et:timeval)) + (multiple-value-bind + (to-sec to-usec) (decode-timeout timeout) + (setf (foreign-slot-value to 'et:timeval 'et:tv-sec) to-sec) + (setf (foreign-slot-value to 'et:timeval 'et:tv-usec) to-usec)))) + (et:select (1+ max-fd) + read-fds + write-fds + except-fds + (if timeout to (null-pointer)))) (et:unix-error-intr (err) (declare (ignore err)) - (go :start)))) + (go :start)) + (et:unix-error-badf (err) + (declare (ignore err)) + (handle-select-fd-errors mux)))) - (with-hash-table-iterator (next-item fd-handlers) - (multiple-value-bind (item-p fd handler) (next-item) + (with-hash-table-iterator (next-item fd-entries) + (multiple-value-bind (item-p fd fd-entry) (next-item) (when item-p (if (fd-open-p fd) (progn + (incf count) (when (and (et:fd-isset fd except-fds) - (handler-except-func handler)) - (funcall (handler-except-func handler) fd :except)) + (fd-entry-except-handlers fd-entry)) + (dolist (except-handler (fd-entry-except-handlers fd-entry)) + (funcall (handler-function except-handler) fd :except))) (when (and (et:fd-isset fd read-fds) - (handler-read-func handler)) - (funcall (handler-read-func handler) fd :read)) + (fd-entry-read-handlers fd-entry)) + (dolist (read-handler (fd-entry-read-handlers fd-entry)) + (funcall (handler-function read-handler) fd :read))) (when (and (et:fd-isset fd write-fds) - (handler-write-func handler)) - (funcall (handler-write-func handler) fd :write))) + (fd-entry-write-handlers fd-entry)) + (dolist (write-handler (fd-entry-write-handlers fd-entry)) + (funcall (handler-function write-handler) fd :write)))) ;; TODO: add better error handling - (error "Handler for bad fd is present: ~A " fd)))))))) - (values interface)) + (error "Handler for bad fd is present: ~A " fd))))) + (return-from serve-fd-events count))))) -- 2.11.4.GIT