Here's a patch that finishes adding the interface to the other multiplexer backends. Now it should be possible to use all of them for simple readiness notification on a set of integer fds.
For example use, take a look at: http://github.com/vsedach/HTTP-DOHC Vladimir 2009/11/16 Vladimir Sedach <[email protected]>: > Here's a corrected patch for 0005 that supersedes the one in my > previous message. > > Vladimir > > 2009/11/16 Vladimir Sedach <[email protected]>: >> Hello, >> >> Here are some patches that make it easier to just use the multiplexer >> object without having to go through the provided event loop/timer >> machinery. This is done in three steps: make the monitor/harvest etc. >> methods on multiplexer accept just file descriptors as well as >> FD-ENTRYs (note that I've only done that for epoll in this set of >> patches, others to come!), export the handler methods, and add an >> optional flags parameter to the MONITOR-FD method (really useful for >> epoll, the other backends I'm not sure about). >> >> Let me know what you think. I'd like to get these patches (or at least >> the equivalent functionality of being able to use the multiplexer >> without having to make FD-ENTRYs) into IOlib as I'm about to release >> some software that uses it. >> >> Thanks, >> Vladimir >> >
From 902cf5d01bfda8087010a16d3ba607be62e5d0bc Mon Sep 17 00:00:00 2001 From: Vladimir Sedach <[email protected]> Date: Sat, 21 Nov 2009 06:00:24 -0500 Subject: [PATCH 6/6] Finished implemeting public FD-descriptor-only interface for other multiplexer backends. --- src/multiplex/backend-epoll.lisp | 16 +------ src/multiplex/backend-kqueue.lisp | 85 ++++++++++++++++++------------------- src/multiplex/backend-poll.lisp | 63 +++++++++++++--------------- src/multiplex/backend-select.lisp | 34 +++++++-------- src/multiplex/event-loop.lisp | 6 +- src/multiplex/fd-entry.lisp | 4 ++ src/multiplex/multiplexer.lisp | 15 ++++++- 7 files changed, 107 insertions(+), 116 deletions(-) diff --git a/src/multiplex/backend-epoll.lisp b/src/multiplex/backend-epoll.lisp index 39c9cf5..d3c0078 100644 --- a/src/multiplex/backend-epoll.lisp +++ b/src/multiplex/backend-epoll.lisp @@ -27,13 +27,6 @@ (if (member :epoll-oneshot flags) isys:epolloneshot 0) isys:epollpri)) ;; what to do about EPOLLPRI? -(defmethod monitor-fd ((mux epoll-multiplexer) (fd-entry fd-entry) &optional flags) - (declare (ignore flags)) - (monitor-fd mux - (fd-entry-fd fd-entry) - (list (when (fd-entry-read-handler fd-entry) :read) - (when (fd-entry-write-handler fd-entry) :write)))) - (defmacro with-epoll-event ((ev fd flags) &body body) `(with-foreign-object (,ev 'isys:epoll-event) (isys:%sys-bzero ,ev isys:size-of-epoll-event) @@ -54,9 +47,6 @@ (isys:eexist () (warn "FD ~A is already monitored." fd))))) -(defmethod update-fd ((mux epoll-multiplexer) (fd-entry fd-entry) flags edge-change) - (update-fd mux (fd-entry-fd fd-entry) flags edge-change)) - (defmethod update-fd ((mux epoll-multiplexer) (fd integer) flags edge-change) (declare (ignore edge-change)) (with-epoll-event (ev fd flags) @@ -67,10 +57,8 @@ (isys:enoent () (warn "FD ~A was not monitored, cannot update its status." fd))))) -(defmethod unmonitor-fd ((mux epoll-multiplexer) (fd-entry fd-entry)) - (unmonitor-fd mux (fd-entry-fd fd-entry))) - -(defmethod unmonitor-fd ((mux epoll-multiplexer) (fd integer)) +(defmethod unmonitor-fd ((mux epoll-multiplexer) (fd integer) &optional flags) + (declare (ignore flags)) (handler-case (isys:%sys-epoll-ctl (fd-of mux) isys:epoll-ctl-del diff --git a/src/multiplex/backend-kqueue.lisp b/src/multiplex/backend-kqueue.lisp index e54b71a..1afb3a4 100644 --- a/src/multiplex/backend-kqueue.lisp +++ b/src/multiplex/backend-kqueue.lisp @@ -19,68 +19,65 @@ (defmethod initialize-instance :after ((mux kqueue-multiplexer) &key) (setf (slot-value mux 'fd) (isys:%sys-kqueue))) -(defun do-kqueue-event-request (kqueue-fd fd-entry filter request-type) - (let ((fd (fd-entry-fd fd-entry))) - (with-foreign-object (kev 'isys:kevent) - (isys:%sys-bzero kev isys:size-of-kevent) - (isys:%sys-ev-set kev fd filter request-type 0 0 (null-pointer)) - (isys:%sys-kevent kqueue-fd - kev 1 - (null-pointer) 0 - (null-pointer))))) +(defun do-kqueue-event-request (kqueue-fd fd filter request-type) + (with-foreign-object (kev 'isys:kevent) + (isys:%sys-bzero kev isys:size-of-kevent) + (isys:%sys-ev-set kev fd filter request-type 0 0 (null-pointer)) + (isys:%sys-kevent kqueue-fd + kev + 1 + (null-pointer) + 0 + (null-pointer)))) -(defun calc-kqueue-monitor-filter (fd-entry) - (if (null (fd-entry-read-handler fd-entry)) +(defun calc-kqueue-flags (flags) + (if (member :write flags) isys:evfilt-write isys:evfilt-read)) -(defmethod monitor-fd ((mux kqueue-multiplexer) (fd-entry fd-entry) &optional flags) - (declare (ignore flags)) +(defmethod monitor-fd ((mux kqueue-multiplexer) (fd integer) &optional flags) (handler-case - (do-kqueue-event-request (fd-of mux) fd-entry - (calc-kqueue-monitor-filter fd-entry) + (do-kqueue-event-request (fd-of mux) + fd + (calc-kqueue-flags flags) isys:ev-add) (isys:ebadf () - (warn "FD ~A is invalid, cannot monitor it." (fd-entry-fd fd-entry))))) + (warn "FD ~A is invalid, cannot monitor it." fd)))) -(defun calc-kqueue-update-filter-and-flags (event-type edge-change) - (case event-type - (:read - (case edge-change - (:add (values isys:evfilt-read isys:ev-add)) - (:del (values isys:evfilt-read isys:ev-delete)))) - (:write - (case edge-change - (:add (values isys:evfilt-write isys:ev-add)) - (:del (values isys:evfilt-write isys:ev-delete)))))) +(defun calc-kqueue-update-filter-and-flags (flags edge-change) + (cond ((member :read flags) + (case edge-change + (:add (values isys:evfilt-read isys:ev-add)) + (:del (values isys:evfilt-read isys:ev-delete)))) + ((member :write flags) + (case edge-change + (:add (values isys:evfilt-write isys:ev-add)) + (:del (values isys:evfilt-write isys:ev-delete)))))) -(defmethod update-fd ((mux kqueue-multiplexer) fd-entry event-type edge-change) - (assert fd-entry (fd-entry) "Must supply an FD-ENTRY!") +(defmethod update-fd ((mux kqueue-multiplexer) (fd integer) flags edge-change) (handler-case - (multiple-value-call #'do-kqueue-event-request (fd-of mux) fd-entry - (calc-kqueue-update-filter-and-flags event-type edge-change)) + (multiple-value-call #'do-kqueue-event-request (fd-of mux) fd + (calc-kqueue-update-filter-and-flags + flags edge-change)) (isys:ebadf () - (warn "FD ~A is invalid, cannot update its status." - (fd-entry-fd fd-entry))) + (warn "FD ~A is invalid, cannot update its status." fd)) (isys:enoent () - (warn "FD ~A was not monitored, cannot update its status." - (fd-entry-fd fd-entry))))) + (warn "FD ~A was not monitored, cannot update its status." fd)))) -(defun calc-kqueue-unmonitor-filter (fd-entry) - (if (null (fd-entry-read-handler fd-entry)) - isys:evfilt-read - isys:evfilt-write)) +(defmethod unmonitor-fd ((mux kqueue-multiplexer) (fd-entry fd-entry) &optional flags) + (declare (ignore flags)) + (unmonitor-fd mux (fd-entry-fd fd-entry) (fd-entry-notify-flags fd-entry))) -(defmethod unmonitor-fd ((mux kqueue-multiplexer) fd-entry) +(defmethod unmonitor-fd ((mux kqueue-multiplexer) (fd integer) &optional flags) (handler-case - (do-kqueue-event-request (fd-of mux) fd-entry - (calc-kqueue-unmonitor-filter fd-entry) + (do-kqueue-event-request (fd-of mux) + fd + (calc-kqueue-flags flags) isys:ev-delete) (isys:ebadf () - (warn "FD ~A is invalid, cannot unmonitor it." (fd-entry-fd fd-entry))) + (warn "FD ~A is invalid, cannot unmonitor it." fd)) (isys:enoent () - (warn "FD ~A was not monitored, cannot unmonitor it." - (fd-entry-fd fd-entry))))) + (warn "FD ~A was not monitored, cannot unmonitor it." fd)))) (defmethod harvest-events ((mux kqueue-multiplexer) timeout) (with-foreign-objects ((events 'isys:kevent *kqueue-max-events*) diff --git a/src/multiplex/backend-poll.lisp b/src/multiplex/backend-poll.lisp index 6ca4d4c..7427e49 100644 --- a/src/multiplex/backend-poll.lisp +++ b/src/multiplex/backend-poll.lisp @@ -25,21 +25,23 @@ (foreign-free (fd-set-of mux)) (setf (fd-set-of mux) nil)) -(defvar *pollfd-table* (make-hash-table :test #'eql)) +(defvar *pollfd-table* (make-hash-table)) -(defun calc-pollfd-flags (readp writep) +(defun calc-pollfd-flags (flags) (let ((flags 0)) - (when readp (setf flags (logior nix:pollin nix:pollrdhup nix:pollpri))) - (when writep (setf flags (logior flags nix:pollout nix:pollhup))) - (values flags))) + (when (member :read flags) + (setf flags (logior nix:pollin nix:pollrdhup nix:pollpri))) + (when (member :write flags) + (setf flags (logior flags nix:pollout nix:pollhup))) + flags)) -(defun set-pollfd-entry (fd-set index fd readp writep) +(defun set-pollfd-entry (fd-set index fd flags) (with-foreign-slots ((nix::fd nix::events nix::revents) (mem-aref fd-set 'nix::pollfd index) nix::pollfd) (setf nix::fd fd nix::revents 0 - nix::events (calc-pollfd-flags readp writep)))) + nix::events (calc-pollfd-flags flags)))) (defun extend-pollfd-set (fd-set size) (let* ((new-size (+ size 5)) @@ -48,26 +50,18 @@ (foreign-free fd-set) (values new-fd-set new-size))) -(defmethod monitor-fd ((mux poll-multiplexer) (fd-entry fd-entry) &optional flags) - (let ((fd (fd-entry-fd fd-entry)) - (readp (fd-entry-read-handler fd-entry)) - (writep (fd-entry-write-handler fd-entry))) - (with-accessors ((fd-set fd-set-of) (size fd-set-size-of) - (count fd-count-of)) mux - (when (= count size) - (setf (values fd-set size) (extend-pollfd-set fd-set size))) - (set-pollfd-entry fd-set count fd readp writep) - (setf (gethash fd *pollfd-table*) count) - (incf count)))) - -(defmethod update-fd ((mux poll-multiplexer) fd-entry event-type edge-change) - (declare (ignore event-type edge-change)) - (let* ((fd (fd-entry-fd fd-entry)) - (pos (gethash fd *pollfd-table*)) - (readp (fd-entry-read-handler fd-entry)) - (writep (fd-entry-write-handler fd-entry))) - (with-accessors ((fd-set fd-set-of)) mux - (set-pollfd-entry fd-set pos fd readp writep)))) +(defmethod monitor-fd ((mux poll-multiplexer) (fd integer) &optional flags) + (with-accessors ((fd-set fd-set-of) (size fd-set-size-of) (count fd-count-of)) + mux + (when (= count size) + (setf (values fd-set size) (extend-pollfd-set fd-set size))) + (set-pollfd-entry fd-set count fd flags) + (setf (gethash fd *pollfd-table*) count) + (incf count))) + +(defmethod update-fd ((mux poll-multiplexer) (fd integer) flags edge-change) + (declare (ignore edge-change)) + (set-pollfd-entry (fd-set-of mux) (gethash fd *pollfd-table*) fd flags)) (defun shrink-pollfd-set (fd-set count size pos) (let* ((new-size (if (> 5 (- size count)) (- size 5) size)) @@ -79,14 +73,15 @@ (foreign-free fd-set) (values new-fd-set new-size))) -(defmethod unmonitor-fd ((mux poll-multiplexer) fd-entry) - (let* ((fd (fd-entry-fd fd-entry)) - (pos (gethash fd *pollfd-table*))) - (with-accessors ((fd-set fd-set-of) (size fd-set-size-of) - (count fd-count-of)) mux - (setf (values fd-set size) (shrink-pollfd-set fd-set (1- count) size pos)) - (remhash fd *pollfd-table*) - (decf count)))) +(defmethod unmonitor-fd ((mux poll-multiplexer) (fd integer) &optional flags) + (declare (ignore flags)) + (with-accessors ((fd-set fd-set-of) (size fd-set-size-of) (count fd-count-of)) + mux + (setf (values fd-set size) + (shrink-pollfd-set fd-set (1- count) size + (gethash fd *pollfd-table*))) + (remhash fd *pollfd-table*) + (decf count))) (defmethod harvest-events ((mux poll-multiplexer) timeout) (with-accessors ((fd-set fd-set-of) (size fd-set-size-of) diff --git a/src/multiplex/backend-select.lisp b/src/multiplex/backend-select.lisp index 4da03c0..35da5c2 100644 --- a/src/multiplex/backend-select.lisp +++ b/src/multiplex/backend-select.lisp @@ -41,19 +41,18 @@ ;; this means no fd <= end is set -1) -(defun recalc-fd-masks (mux fd read write) +(defun recalc-fd-masks (mux fd flags) (with-accessors ((rs read-fd-set-of) (ws write-fd-set-of) (es except-fd-set-of) (max-fd max-fd-of)) mux - (cond (read - (isys:%sys-fd-set fd rs) - (isys:%sys-fd-set fd es)) - (t - (isys:%sys-fd-clr fd rs) - (isys:%sys-fd-clr fd es))) - (if write + (if (member :read flags) + (progn (isys:%sys-fd-set fd rs) + (isys:%sys-fd-set fd es)) + (progn (isys:%sys-fd-clr fd rs) + (isys:%sys-fd-clr fd es))) + (if (member :write flags) (isys:%sys-fd-set fd ws) (isys:%sys-fd-clr fd ws)) (let ((end (max max-fd fd))) @@ -61,19 +60,16 @@ (find-max-fd ws end)))) t)) -(defmethod monitor-fd ((mux select-multiplexer) (fd-entry fd-entry) &optional flags) - (recalc-fd-masks mux (fd-entry-fd fd-entry) - (fd-entry-read-handler fd-entry) - (fd-entry-write-handler fd-entry))) +(defmethod monitor-fd ((mux select-multiplexer) (fd integer) &optional flags) + (recalc-fd-masks mux fd flags)) -(defmethod update-fd ((mux select-multiplexer) fd-entry event-type edge-change) - (declare (ignore event-type edge-change)) - (recalc-fd-masks mux (fd-entry-fd fd-entry) - (fd-entry-read-handler fd-entry) - (fd-entry-write-handler fd-entry))) +(defmethod update-fd ((mux select-multiplexer) (fd integer) flags edge-change) + (declare (ignore edge-change)) + (recalc-fd-masks mux fd flags)) -(defmethod unmonitor-fd ((mux select-multiplexer) fd-entry) - (recalc-fd-masks mux (fd-entry-fd fd-entry) nil nil)) +(defmethod unmonitor-fd ((mux select-multiplexer) (fd integer) &optional flags) + (declare (ignore flags)) + (recalc-fd-masks mux fd nil)) (defmethod harvest-events ((mux select-multiplexer) timeout) (with-accessors ((rs read-fd-set-of) diff --git a/src/multiplex/event-loop.lisp b/src/multiplex/event-loop.lisp index e28c988..c6c4c2a 100644 --- a/src/multiplex/event-loop.lisp +++ b/src/multiplex/event-loop.lisp @@ -145,7 +145,7 @@ within the extent of BODY. Closes VAR." (cond (current-fd-entry (%set-io-handler event-base fd event current-fd-entry timeout) - (update-fd (mux-of event-base) current-fd-entry event-type :add)) + (update-fd (mux-of event-base) current-fd-entry (list event-type) :add)) (t (let ((new-fd-entry (make-fd-entry fd))) (%set-io-handler event-base fd event new-fd-entry timeout) @@ -246,7 +246,7 @@ within the extent of BODY. Closes VAR." (%remove-fd-entry event-base fd) (unmonitor-fd (mux-of event-base) fd-entry)) (t - (update-fd (mux-of event-base) fd-entry event-type :del))))) + (update-fd (mux-of event-base) fd-entry (list event-type) :del))))) (defun %remove-fd-entry (event-base fd) (remhash fd (fds-of event-base))) @@ -327,7 +327,7 @@ within the extent of BODY. Closes VAR." (return (values (consp fd-events) dlist)))) (defun %handle-one-fd (event-base event now deletion-list) - (destructuring-bind (fd ev-types) event + (destructuring-bind (fd . ev-types) event (let* ((readp nil) (writep nil) (fd-entry (fd-entry-of event-base fd)) (errorp (and fd-entry (member :error ev-types)))) diff --git a/src/multiplex/fd-entry.lisp b/src/multiplex/fd-entry.lisp index 09ff0f3..12376e7 100644 --- a/src/multiplex/fd-entry.lisp +++ b/src/multiplex/fd-entry.lisp @@ -41,6 +41,10 @@ (:read (setf (fd-entry-read-handler fd-entry) event)) (:write (setf (fd-entry-write-handler fd-entry) event)))) +(defun fd-entry-notify-flags (fd-entry) + (list (when (fd-entry-read-handler fd-entry) :read) + (when (fd-entry-write-handler fd-entry) :write))) + (defun fd-entry-empty-p (fd-entry) (and (null (fd-entry-read-handler fd-entry)) (null (fd-entry-write-handler fd-entry)))) diff --git a/src/multiplex/multiplexer.lisp b/src/multiplex/multiplexer.lisp index 76d536d..19f587b 100644 --- a/src/multiplex/multiplexer.lisp +++ b/src/multiplex/multiplexer.lisp @@ -34,11 +34,11 @@ (:documentation "Add the descriptor reppresented by FD-ENTRY to multiplexer MUX. Must return NIL on failure, T otherwise.")) -(defgeneric update-fd (mux fd-entry event-type edge-change) +(defgeneric update-fd (mux fd-entry flags edge-change) (:documentation "Update the status of the descriptor reppresented by FD-ENTRY in multiplexer MUX. Must return NIL on failure, T otherwise.")) -(defgeneric unmonitor-fd (mux fd-entry) +(defgeneric unmonitor-fd (mux fd-entry &optional flags) (:documentation "Remove the descriptor reppresented by FD-ENTRY from multiplexer MUX. Must return NIL on failure, T otherwise.")) @@ -69,6 +69,17 @@ Returns a list of fd/result pairs which have one of these forms: (when (and (fd-limit-of mux) (> fd (fd-limit-of mux))) (error "Cannot add such a large FD: ~A" fd)))) +(defmethod monitor-fd ((mux multiplexer) (fd-entry fd-entry) &optional flags) + (declare (ignore flags)) + (monitor-fd mux (fd-entry-fd fd-entry) (fd-entry-notify-flags fd-entry))) + +(defmethod update-fd ((mux multiplexer) (fd-entry fd-entry) flags edge-change) + (declare (ignore flags)) + (update-fd mux (fd-entry-fd fd-entry) (fd-entry-notify-flags fd-entry) edge-change)) + +(defmethod unmonitor-fd ((mux multiplexer) (fd-entry fd-entry) &optional flags) + (unmonitor-fd mux (fd-entry-fd fd-entry) flags)) + (defmacro define-multiplexer (name priority superclasses slots &rest options) `(progn (defclass ,name ,superclasses ,slots ,@options) -- 1.6.3.3
_______________________________________________ IOLib-devel mailing list [email protected] http://common-lisp.net/cgi-bin/mailman/listinfo/iolib-devel
