Edi Weitz wrote:
Edi Weitz wrote:
LispWorks/Hunchentoot doesn't use KMRCL, so that's the plan for SBCL and the other Lisps as well.
I had a feeling this was on your agenda as well.
OK, here's a quick hack which tries to be a version of Hunchentoot which works with SBCL (see below for other Lisps):
Fantastic :) Thanks Edi.
I have this setup, and I'm running through some tests now.
Here's one quick observation:
After killing the workers, STOP-SERVER tries to PROCESS-KILL the main listener. The main listener though, as returned in the object from START-SERVER, is actually a socket, not a thread.
This is the case because START-UP-SERVER in port-sbcl.lisp returns a socket when START-SERVER is expecting a thread.
The attached patch remedies this, as also takes care of closing the socket when the thread dies.
Cheers,
-- Travis
diff -rN -u old-tbnl/port-sbcl.lisp new-tbnl/port-sbcl.lisp --- old-tbnl/port-sbcl.lisp 2006-10-01 13:10:23.000000000 -0400 +++ new-tbnl/port-sbcl.lisp 2006-10-01 13:10:23.000000000 -0400 @@ -84,20 +84,23 @@ (funcall announce nil condition) (setq done condition) (return-from open-socket-and-accept)))) - (let ((socket (make-instance 'sb-bsd-sockets:inet-socket + (let ((socket (make-instance 'sb-bsd-sockets:inet-socket :type :stream :protocol :tcp))) - (setf (sb-bsd-sockets:sockopt-reuse-address socket) t) - (sb-bsd-sockets:socket-bind socket (resolve-hostname address) service) - (sb-bsd-sockets:socket-listen socket 5) - (funcall announce socket) - (setq done socket) - (loop (funcall function (sb-bsd-sockets:socket-accept socket))))))) - (process-run-function process-name #'open-socket-and-accept) - (loop until done do (sleep .1)) - (typecase done - (sb-bsd-sockets:inet-socket done) - (t (values nil done)))))) + (unwind-protect + (progn + (setf (sb-bsd-sockets:sockopt-reuse-address socket) t) + (sb-bsd-sockets:socket-bind socket (resolve-hostname address) service) + (sb-bsd-sockets:socket-listen socket 5) + (funcall announce socket) + (setq done socket) + (loop (funcall function (sb-bsd-sockets:socket-accept socket)))) + (sb-bsd-sockets:socket-close socket)))))) + (let ((listener-thread (process-run-function process-name #'open-socket-and-accept))) + (loop until done do (sleep .1)) + (typecase done + (sb-bsd-sockets:inet-socket listener-thread) + (t (values nil done)))))))
(defun make-socket-stream (socket read-timeout write-timeout) (declare (ignore write-timeout)) @@ -106,4 +109,5 @@ :output t :element-type '(unsigned-byte 8) :timeout read-timeout - :buffering :full)) \ No newline at end of file + :buffering :full)) +