Author: psmith Date: Tue Oct 10 01:55:24 2006 New Revision: 10
Modified: branches/home/psmith/stress-mods/event-notification.asd branches/home/psmith/stress-mods/src/async-fd.lisp branches/home/psmith/stress-mods/src/async-socket.lisp branches/home/psmith/stress-mods/src/epoll.lisp branches/home/psmith/stress-mods/src/event-notification.lisp branches/home/psmith/stress-mods/src/nio-httpd.lisp branches/home/psmith/stress-mods/src/nio-server.lisp Log:
Moved to event driven SM: Server socket in level triggered mode - (TODO: why does this improve performance?) Put accepted connections fd's in nonblocking, RW notification and left as ET (as suggested in 'man epoll') Increased accept backlog to 1k (TODO: put on config) Included code review suggestions from Risto
Modified: branches/home/psmith/stress-mods/event-notification.asd ============================================================================== --- branches/home/psmith/stress-mods/event-notification.asd (original) +++ branches/home/psmith/stress-mods/event-notification.asd Tue Oct 10 01:55:24 2006 @@ -8,7 +8,8 @@ (:file "src/kqueue-cffi" :depends-on ("src/event-notification")) (:file "src/epoll-cffi" :depends-on ("src/event-notification")) (:file "src/kqueue" :depends-on ("src/event-notification" "src/kqueue-cffi")) - (:file "src/epoll" :depends-on ("src/event-notification" "src/epoll-cffi"))) + (:file "src/errno") + (:file "src/epoll" :depends-on ("src/event-notification" "src/epoll-cffi" "src/errno")))
:depends-on (:cffi))
Modified: branches/home/psmith/stress-mods/src/async-fd.lisp ============================================================================== --- branches/home/psmith/stress-mods/src/async-fd.lisp (original) +++ branches/home/psmith/stress-mods/src/async-fd.lisp Tue Oct 10 01:55:24 2006 @@ -105,6 +105,7 @@
(defun close-fd (unix-fd) "Close UNIX-FD." +#+nio-debug (format t "close-fd ~A~%" unix-fd) (%close unix-fd))
@@ -145,15 +146,20 @@ (define-condition read-error (error) ())
(defun read-more (async-fd) +#+nio-debug (format t "read-more called with ~A~%" async-fd) "Read more data from ASYNC-FD." (with-slots (foreign-read-buffer foreign-read-buffer-size) async-fd (with-slots (read-fd lisp-read-buffer lisp-read-buffer-write-ptr) async-fd - +#+nio-debug (format t "read-more - calling read()~%") +#+nio-debug (force-output t) (let ((new-bytes (%read read-fd foreign-read-buffer foreign-read-buffer-size))) - +#+nio-debug (format t "read-more : Read ~A bytes~%" new-bytes) +#+nio-debug (force-output t) (cond - ((< new-bytes 0) - (error 'read-error)) + ((< new-bytes 0) + (progn + (format t "read-error - Errno: ~A~%" (sb-alien:get-errno)) + (error 'read-error)))
((= new-bytes 0) nil);;(throw 'end-of-file nil)) @@ -168,6 +174,8 @@ (mem-aref foreign-read-buffer :uint8 i))) (incf lisp-read-buffer-write-ptr new-bytes) +#+nio-debug (format t "read-more prior to callback") +#+nio-debug (force-output t) ;; call callback (with-slots (accept-filter read-callback) async-fd (if accept-filter @@ -182,8 +190,8 @@ (defun close-async-fd (async-fd) "Close ASYNC-FD's fd after everything has been written from write-queue." (with-slots (write-queue read-fd write-fd foreign-read-buffer) async-fd +#+nio-debug (format t "close-asyn-fd called with :read-fd ~A :write-fd ~A~%" read-fd write-fd) (cond - ;; if write-queue is emtpy, close now ((null write-queue) (close-fd read-fd) @@ -197,6 +205,7 @@
(defun write-more (async-fd) "Write data from ASYNC-FD's write-queue." +#+nio-debug (format t "write-more called with ~A~%" async-fd) (with-slots (write-fd write-queue) async-fd
;; loop for packets in queue @@ -234,7 +243,7 @@
(defun async-write-seq (async-fd seq &optional (start 0) (end (length seq))) "Queue from SEQ between START and END to write-queue." - +#+nio-debug (format t "async-write-seq - called ~A~%" async-fd) (assert (and (numberp start) (not (null seq))))
;; enqueue sequence @@ -243,7 +252,8 @@ (setf write-queue (append write-queue (list entry)))))
;; start writing - (write-more async-fd)) +; (write-more async-fd) +)
@@ -258,13 +268,15 @@ (defun add-async-fd (event-queue async-fd mode) (ecase mode (:read (add-fd event-queue (slot-value async-fd 'read-fd) :read)) - (:write (add-fd event-queue (slot-value async-fd 'write-fd) :write)))) + (:write (add-fd event-queue (slot-value async-fd 'write-fd) :write)) + (:read-write (add-fd event-queue (slot-value async-fd 'write-fd) :read-write))))
(defun remove-async-fd (event-queue async-fd mode) (ecase mode (:read (remove-fd event-queue (slot-value async-fd 'read-fd) :read)) - (:write (remove-fd event-queue (slot-value async-fd 'write-fd) :write)))) + (:write (remove-fd event-queue (slot-value async-fd 'write-fd) :write)) + (:read-write (remove-fd event-queue (slot-value async-fd 'write-fd) :read-write))))
(defun async-fd-read-fd (async-fd)
Modified: branches/home/psmith/stress-mods/src/async-socket.lisp ============================================================================== --- branches/home/psmith/stress-mods/src/async-socket.lisp (original) +++ branches/home/psmith/stress-mods/src/async-socket.lisp Tue Oct 10 01:55:24 2006 @@ -82,8 +82,8 @@ (sockaddr :pointer) (socklen :pointer))
- -(defun start-listen (socket-fd &optional (backlog 7)) +;;TODO put backlog on config +(defun start-listen (socket-fd &optional (backlog 1000)) (%listen socket-fd backlog))
Modified: branches/home/psmith/stress-mods/src/epoll.lisp ============================================================================== --- branches/home/psmith/stress-mods/src/epoll.lisp (original) +++ branches/home/psmith/stress-mods/src/epoll.lisp Tue Oct 10 01:55:24 2006 @@ -29,23 +29,38 @@ #+linux (progn
- (defun make-event-queue () - (%epoll-create 10)) + (defconstant +epoll-size+ 1000)
+ (defun make-event-queue () + (%epoll-create +epoll-size+))
- (defun add-fd (event-queue fd mode &key (trigger :edge)) - (with-foreign-object (ev 'epoll-event) - (memzero ev +epoll-event-size+) + (defun read-event-p (event) + (not (eql (logand event +epoll-in+) 0)))
- (setf (foreign-slot-value ev 'epoll-event 'fd) fd - (foreign-slot-value ev 'epoll-event 'events) - (logior (if (eql :read mode) +epoll-in+ 0) - (if (eql :write mode) +epoll-out+ 0) - (if (eql trigger :edge) +epoll-et+))) + (defun write-event-p (event) + (not (eql (logand event +epoll-out+) 0)))
- (%epoll-ctl event-queue +epoll-ctl-add+ fd ev)))
+ (defun add-fd (event-queue fd mode &key (trigger :edge)) + (with-foreign-object (ev 'epoll-event) + (memzero ev +epoll-event-size+) + (let ((actual-mode (logior (if (eql :read mode) +epoll-in+ 0) + (if (eql :write mode) +epoll-out+ 0) + (if (eql :read-write mode) (logior +epoll-in+ +epoll-out+) 0) + (if (eql trigger :edge) +epoll-et+ 0)))) + #+nio-debug (format t "Add-fd called with :fd ~A :event-queue ~A :mode ~A :trigger ~A :actual-mode ~A~%" fd event-queue mode trigger actual-mode) + + (setf (foreign-slot-value ev 'epoll-event 'fd) fd + (foreign-slot-value ev 'epoll-event 'events) + actual-mode)) + + (if (eql (%epoll-ctl event-queue +epoll-ctl-add+ fd ev) -1) + (progn + (format t "add-fd (epoll_ctl) error occurred: ~A~%" (get-errno)) + ;; (error 'poll-error) + )))) + (defun remove-fd (event-queue fd mode) (with-foreign-object (ev 'epoll-event) (memzero ev +epoll-event-size+) @@ -58,21 +73,26 @@ (define-condition poll-error (error) ())
(defun poll-events (event-queue) - (with-foreign-object (events 'epoll-event 10) - (memzero events (* +epoll-event-size+ 10)) - (loop for res = (%epoll-wait event-queue events 10 -1) +#+nio-debug (format t "poll-events called with :event-queue ~A~%" event-queue) + (with-foreign-object (events 'epoll-event +epoll-size+) + (memzero events (* +epoll-event-size+ +epoll-size+)) + (loop for res = (%epoll-wait event-queue events +epoll-size+ -1) + do - (case res - (-1 (error 'poll-error)) - (0 nil) - (t - (let ((idents nil)) - (loop for i from 0 below res do - (push (foreign-slot-value - (mem-aref events 'epoll-event i) - 'epoll-event 'fd) - idents)) - (return idents))))))) - - - ) + (progn +#+nio-debug (format t "poll-events - dealing with ~A~%" res) + (case res + (-1 (error 'poll-error)) + (0 nil) + (t + (let ((idents nil)) + (loop for i from 0 below res do + (push (cons (foreign-slot-value + (mem-aref events 'epoll-event i) + 'epoll-event 'fd) + (foreign-slot-value + (mem-aref events 'epoll-event i) + 'epoll-event 'events)) + idents)) + (return idents)))))))) +)
Modified: branches/home/psmith/stress-mods/src/event-notification.lisp ============================================================================== --- branches/home/psmith/stress-mods/src/event-notification.lisp (original) +++ branches/home/psmith/stress-mods/src/event-notification.lisp Tue Oct 10 01:55:24 2006 @@ -26,4 +26,4 @@ |# (defpackage :event-notification (:use :cl :cffi) (:export - make-event-queue add-fd remove-fd poll-events poll-error)) \ No newline at end of file + make-event-queue add-fd remove-fd poll-events poll-error read-event-p write-event-p)) \ No newline at end of file
Modified: branches/home/psmith/stress-mods/src/nio-httpd.lisp ============================================================================== --- branches/home/psmith/stress-mods/src/nio-httpd.lisp (original) +++ branches/home/psmith/stress-mods/src/nio-httpd.lisp Tue Oct 10 01:55:24 2006 @@ -94,6 +94,7 @@
(defun serve-content (client status content-type content) +#+nio-debug (format t "serve-content :client ~A~%" client) (let ((status-line (make-status-line status)) (content-type (concatenate 'vector
Modified: branches/home/psmith/stress-mods/src/nio-server.lisp ============================================================================== --- branches/home/psmith/stress-mods/src/nio-server.lisp (original) +++ branches/home/psmith/stress-mods/src/nio-server.lisp Tue Oct 10 01:55:24 2006 @@ -59,7 +59,8 @@ (format t "~&Starting server on ~S port ~S.. (socket fd is ~D)~%" host port sock)
(start-listen sock) - (add-fd event-queue sock :read) + + (add-fd event-queue sock :read :trigger :level) (format t "waiting for events..~%") (force-output)
@@ -69,38 +70,39 @@ (format t "Poll-error, exiting..~%") (throw 'poll-error-exit nil))))
- (loop for unix-fds = (poll-events event-queue) do + (loop for unix-epoll-events = (poll-events event-queue) do
- (loop for fd in unix-fds do - + (loop for (fd . event) in unix-epoll-events do (cond ;; new connection ((= fd sock) (let ((async-fd (socket-accept fd))) - +#+nio-debug (format t "start-server - New conn: ~A~%" async-fd) (cond ((null async-fd) (format t "Accept failed.~%"))
;; accept connection ? - ((funcall accept-connection async-fd) + ((set-fd-nonblocking (async-fd-read-fd async-fd)) + (funcall accept-connection async-fd) (setf (gethash (async-fd-read-fd async-fd) client-hash) async-fd) (set-accept-filter async-fd accept-filter) (set-read-callback async-fd connection-handler) - (add-async-fd event-queue async-fd :read) - (add-async-fd event-queue async-fd :write) + (add-async-fd event-queue async-fd :read-write) +; (add-async-fd event-queue async-fd :write) )
;; no accept, close (t + (format t "start-server - accept-connection closed~%") (close-async-fd async-fd)))))
;; socket i/o available (t (let ((async-fd (gethash fd client-hash))) - +#+nio-debug (format t "IO event ~A on ~A~%" event async-fd) (unless (null async-fd) (catch 'error-exit (handler-bind ((read-error #'(lambda (x) @@ -112,9 +114,9 @@ (force-close-async-fd async-fd) (throw 'error-exit nil))))
- (read-more async-fd)))) + (when (read-event-p event) (read-more async-fd)) + (when (write-event-p event) (write-more async-fd))))) )) - ))))) - + ))))) (ignore-errors (close-fd sock))))