new bug in MT

[<don...@is...>]

(all bug reports related to MT go to -devel, right?)

This was an unpleasant surprise.  I've just made a small improvement
to my debug server.  The new code is below.  The difference is that
in addition to debugging an existing thread you can create a new one.
I find that in the new thread, if I enter (mt::list-threads) I get
a segfault!  The old threads don't do that.

I'm afraid I'm building up a backlog of bugs to be fixed when cvs
returns.  I think the current list includes, in addition to this one,
 performance change over last 10 years
 bug in loop? 

====
(defvar *debug-server-port* 1234)
(defun show-socket-addrs(socket) 
  (multiple-value-bind 
      (local-host local-port) 
      (socket:socket-stream-local socket) 
    (multiple-value-bind 
        (remote-host remote-port) 
        (socket:socket-stream-peer socket) 
      (format t "~&Connection: ~S:~D -- ~S:~D~%" 
              remote-host remote-port local-host local-port)))) 

(defun debug-server() 
  (let ((server (socket:socket-server *debug-server-port* 
                                      :interface "localhost"))) 
       (unwind-protect 
           (loop 
            (let ((socket (socket:socket-accept server :buffered nil))) 
              (show-socket-addrs socket) 
              (let ((tlist (loop for x in (mt:list-threads) as i from 1 
                             when (mt:thread-active-p x) collect (cons i x))) 
                    ans) 
                (print tlist socket) 
                (format socket 
                        "~&enter the number of a thread to interrupt debug ~ 
                         or something else that can be read in order to ~ 
                         create a new one: ") 
                (setf ans (or (cdr (assoc (read socket) tlist)) 
                              (mt:make-thread #'read :name "listener"))) 
                (mt:thread-interrupt 
                 ans 
                 :function 
                 (lambda nil 
                   (let ((*standard-input* socket) 
                         (*standard-output* socket) 
                         (*debug-io* socket) 
                         (*error-output* socket) 
                         (*trace-output* socket) 
                         (*query-io* socket)) 
                     (unwind-protect 
                         (break "debug") 
                       (close socket))))))))) 
         (socket:socket-server-close server))) 
 
(mt:make-thread #'debug-server :name "debug-server")
====
instructions:
run MT version of current cvs clisp
execute all above
telnet to localhost port 1234
This gives you a choice of breaking main thread or debug server or
creating a new listener, e.g., by typing 1, 2, or t