Commit 78efbf617927cdd42307c1fbc399e8c7476718c7
2017-06-26T12:34:23
Merge worker-thread into acceptor-loop-simple. Make *listen-fds* local to with-worker-threads. Init *worker-thread-for-fd* to acceptor-loop-single.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100
diff --git a/thot-threaded.lisp b/thot-threaded.lisp
index 99bcaf3..a13b90b 100644
--- a/thot-threaded.lisp
+++ b/thot-threaded.lisp
@@ -1,60 +1,46 @@
(in-package :thot)
-(defvar *listen-fds*)
-
-(defun worker-thread (fd &optional dup)
- (let ((listen-fd (if dup (unistd:dup fd) fd)))
- (when dup
- (pushnew listen-fd *listen-fds*))
- (labels ((worker-thread-fd ()
- ;;(format t "~&WORKER THREAD~%")
- (unwind-protect
- (loop
- (when *stop*
- (return))
- (ignore-errors
- (unistd:with-selected (`(,listen-fd) () () 1)
- (readable writable errors)
- (when readable
- (socket:with-accept (clientfd) listen-fd
- (with-stream (stream (babel-io-stream
- (fd-io-stream clientfd)))
- (request-loop stream)))))))
- (when dup
- (unistd:close listen-fd)))))
- #'worker-thread-fd)))
+(defvar *worker-thread-for-fd*)
(defparameter *init-threads* 8)
(defun make-worker-threads (fd n)
- (let ((threads ()))
+ (let ((threads ())
+ (listen-fds ()))
(dotimes (i n)
- (push (bordeaux-threads:make-thread
- (worker-thread fd t)
- :name "worker")
- threads))
- threads))
-
-(defun join-worker-threads (threads)
+ (let ((thread-fd (unistd:dup fd)))
+ (push thread-fd listen-fds)
+ (push (bordeaux-threads:make-thread
+ (funcall *worker-thread-for-fd* thread-fd)
+ :name "worker")
+ threads)))
+ (values threads listen-fds)))
+
+(defun join-worker-threads (threads listen-fds)
(setq *stop* t)
+ (dolist (fd listen-fds)
+ (unistd:close fd))
(dolist (thread threads)
(bordeaux-threads:join-thread thread)))
(defmacro with-worker-threads ((fd count) &body body)
- (let ((threads (gensym "THREADS-")))
- `(let* ((*listen-fds* ())
- (,threads (make-worker-threads ,fd ,count)))
+ (let ((threads (gensym "THREADS-"))
+ (listen-fds (gensym "LISTEN-FDS-")))
+ `(multiple-value-bind (,threads ,listen-fds)
+ (make-worker-threads ,fd ,count)
(unwind-protect (progn ,@body)
- (join-worker-threads ,threads)))))
+ (join-worker-threads ,threads ,listen-fds)))))
(defun acceptor-loop-threaded (fd)
(declare (type (unsigned-byte 31) fd))
(set-nonblocking fd)
(with-worker-threads (fd (1- *init-threads*))
- (funcall (worker-thread fd))))
+ (funcall (funcall *worker-thread-for-fd* fd))))
(when bordeaux-threads:*supports-threads-p*
+ (unless (boundp '*worker-thread-for-fd*)
+ (setq *worker-thread-for-fd* *acceptor-loop*))
(setq *acceptor-loop* 'acceptor-loop-threaded))
(untrace start acceptor-loop-threaded request-loop read write
diff --git a/thot.lisp b/thot.lisp
index bcfecc0..4512e28 100644
--- a/thot.lisp
+++ b/thot.lisp
@@ -404,7 +404,7 @@ The requested url ~S was not found on this server."
0)
(socket:bind-inet fd host port)
(socket:listen fd 128)
- (funcall *acceptor-loop* fd))))
+ (funcall (funcall *acceptor-loop* fd)))))
(defun set-nonblocking (fd)
(let ((flags (fcntl:getfl fd)))