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))
+

