kmx.io/cl-thot

diff --git a/thot-epoll.lisp b/thot-epoll.lisp
index c03f393..9c0e49b 100644
--- a/thot-epoll.lisp
+++ b/thot-epoll.lisp
@@ -167,31 +167,29 @@
 
 (defun acceptor-loop-epoll (listenfd &optional pipe)
   (declare (type (unsigned-byte 31) listenfd))
-  (labels ((acceptor-loop-epoll-fun ()
-             (epoll:with (epoll-fd)
-               (let ((epoll (make-instance 'epoll-infos :fd epoll-fd)))
-                 (epoll-add epoll (make-instance 'acceptor :fd listenfd))
-                 (when pipe
-                   (epoll-add epoll (make-instance 'control :fd pipe)))
-                 (loop
-                    (when *stop*
-                      (return))
-                    (epoll:wait (events fd epoll-fd)
-                      (let ((agent (get-agent epoll fd)))
-                        (unless agent (error "bad epoll fd ~S" fd))
-                        (cond ((not (= 0 (logand epoll:+err+ events)))
-                               (agent-error epoll agent))
-                              ((not (= 0 (logand epoll:+in+ events)))
-                               (agent-in epoll agent))
-                              ((not (= 0 (logand epoll:+out+ events)))
-                               (agent-out epoll agent))))))))))
-    #'acceptor-loop-epoll-fun))
+  (epoll:with (epoll-fd)
+    (let ((epoll (make-instance 'epoll-infos :fd epoll-fd)))
+      (epoll-add epoll (make-instance 'acceptor :fd listenfd))
+      (when pipe
+        (epoll-add epoll (make-instance 'control :fd pipe)))
+      (loop
+         (when *stop*
+           (return))
+         (epoll:wait (events fd epoll-fd)
+                     (let ((agent (get-agent epoll fd)))
+                       (unless agent (error "bad epoll fd ~S" fd))
+                       (cond ((not (= 0 (logand epoll:+err+ events)))
+                              (agent-error epoll agent))
+                             ((not (= 0 (logand epoll:+in+ events)))
+                              (agent-in epoll agent))
+                             ((not (= 0 (logand epoll:+out+ events)))
+                              (agent-out epoll agent)))))))))
+
+(defun maybe-configure-epoll ()
+  (when (cffi:foreign-symbol-pointer "epoll_create")
+    (setf *acceptor-loop* #'acceptor-loop-epoll)))
 
 (eval-when (:load-toplevel :execute)
-  (when (cffi:foreign-symbol-pointer "epoll_create")
-    (cond ((eq *acceptor-loop* 'acceptor-loop-simple)
-           (setq *acceptor-loop* 'acceptor-loop-epoll))
-          ((eq *acceptor-loop* 'acceptor-loop-threaded)
-           (setq *worker-thread-for-fd* 'acceptor-loop-epoll)))))
+  (maybe-configure-epoll))
 
 ;;(untrace socket:socket socket:bind socket:listen socket:accept unistd:close epoll:create epoll-add epoll-del acceptor-loop-epoll make-worker agent-in agent-out)
diff --git a/thot-threaded.lisp b/thot-threaded.lisp
index a2a4daa..b460cf0 100644
--- a/thot-threaded.lisp
+++ b/thot-threaded.lisp
@@ -5,8 +5,6 @@
 
 (in-package :thot)
 
-(defvar *worker-thread-for-fd*)
-
 (defparameter *init-threads* 8)
 
 (defun make-worker-threads (fd n pipe-in)
@@ -17,7 +15,7 @@
       (let ((thread-fd (unistd:dup fd)))
         (push thread-fd listen-fds)
         (push (bordeaux-threads:make-thread
-               (funcall *worker-thread-for-fd* thread-fd pipe-in)
+               (funcall *acceptor-loop* thread-fd pipe-in)
                :name "worker")
               threads)))
     (values threads listen-fds)))
@@ -43,18 +41,25 @@
          (unwind-protect (progn ,@body)
            (join-worker-threads ,threads ,listen-fds ,pipe-out))))))
 
-(defun acceptor-loop-threaded (fd)
-  (declare (type (unsigned-byte 31) fd))
+(defun main-loop-threaded (fd)
+  (declare (type unistd:file-descriptor fd))
   (when (debug-p :thot)
     (msg debug " " *acceptor-loop*))
   (set-nonblocking fd)
   (with-worker-threads (fd (1- (the fixnum *init-threads*)))
-    (funcall (funcall *worker-thread-for-fd* fd))))
+    (funcall *acceptor-loop* fd)))
+
+(defvar *disable-threads* nil)
+
+(defun threaded-p ()
+  (and bordeaux-threads:*supports-threads-p*
+       (not *disable-threads*)))
+
+(defun maybe-configure-threaded ()
+  (when (threaded-p)
+    (setf *main-loop* #'main-loop-threaded)))
 
 (eval-when (:load-toplevel :execute)
-  (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)))
+  (maybe-configure-threaded))
 
 ;(untrace start acceptor-loop-threaded request-loop read write set-nonblocking socket:socket socket:bind socket:listen socket:accept unistd:close unistd:select)
diff --git a/thot.lisp b/thot.lisp
index fcc7f09..2eb8cf8 100644
--- a/thot.lisp
+++ b/thot.lisp
@@ -550,9 +550,16 @@ The requested url "
               :keep-alive
               nil))))))
 
+(defvar *acceptor-loop*)
+(declaim (type function *acceptor-loop*))
+
+(defun main-loop (fd)
+  (funcall *acceptor-loop* fd))
+
 (defvar *stop* nil)
 
-(defvar *acceptor-loop*)
+(defvar *main-loop* #'main-loop)
+(declaim (type function *acceptor-loop*))
 
 (defvar *host*)
 
@@ -569,8 +576,8 @@ The requested url "
       (socket:bind-inet fd host port)
       (socket:listen fd 128)
       (when (debug-p :thot)
-        (msg debug *acceptor-loop*))
-      (funcall (funcall *acceptor-loop* fd)))))
+        (msg debug *main-loop*))
+      (funcall *main-loop* fd))))
 
 (defun set-nonblocking (fd)
   (let ((flags (the fixnum (fcntl:getfl fd))))