Index: spiffy.scm
===================================================================
--- spiffy.scm	(revision 22712)
+++ spiffy.scm	(working copy)
@@ -524,7 +524,11 @@
 (define (ssl-port->tcp-port p)
   (if (ssl-port? p) (##sys#slot p 11) (error "Expected an SSL port")))
 
-(define (accept-loop listener accept)
+(define (ssl-or-tcp-addresses p)
+  (tcp-addresses
+   (if (ssl-port? p) (ssl-port->tcp-port p) p)))
+
+(define (accept-loop listener accept #!optional (addresses ssl-or-tcp-addresses))
   (let ((thread-count (make-mutex/value 'thread-count 0))
         (thread-stopped! (make-condition-variable 'thread-stopped!))
         (exn-message (condition-property-accessor 'exn 'message "(no message)"))
@@ -539,10 +543,7 @@
       (handle-exceptions       ; Catch errors during TCP/SSL handshake
           e (debug! "Connection handshake error: ~S" (exn-message e))
           (let*-values (((in out)       (accept listener))
-                        ((local remote) (tcp-addresses
-                                         (if (ssl-port? in)
-                                             (ssl-port->tcp-port in)
-                                             in))))
+                        ((local remote) (addresses in)))
             (debug! "Incoming request from ~A" remote)
             (mutex-update! thread-count add1)
             (thread-start!
@@ -580,7 +581,8 @@
                       (ssl-keyfile (server-ssl-keyfile)) ; Deprecated
                       (bind-address (server-bind-address))
                       (listen tcp-listen)
-                      (accept tcp-accept))
+                      (accept tcp-accept)
+                      (addresses ssl-or-tcp-addresses))
   (when (or ssl-client-context ssl-pemfile ssl-keyfile)
     (error (conc "ssl-client-context, ssl-pemfile and ssl-keyfile are no "
                  "longer directly supported by start-server in order to make "
@@ -592,6 +594,6 @@
     ;; Make these parameters actual (start-server arg might override it)
     (parameterize ((server-port port)
                    (server-bind-address bind-address))
-      (accept-loop listener accept))))
+      (accept-loop listener accept addresses))))
 
 )