[nio-cvs] r10 - in branches/home/psmith/stress-mods: . src
psmith at common-lisp.net
psmith at common-lisp.net
Tue Oct 10 05:55:24 UTC 2006
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))))
More information about the Nio-cvs
mailing list