| 
     
      
      
      From: <don...@is...> - 2011-03-06 01:39:23
      
     
   | 
Code is below.  (It's similar to what I've sent before.)
I build from current source, run, load the file below.
Next, go to another shell and telnet to localhost port 1234.
The response is something like this:
 telnet localhost 1234
 Trying 127.0.0.1...
 Connected to localhost.
 Escape character is '^]'.
 ((1 . #<THREAD "debugger-2011-3-5 16:56:59">) (2 . #<THREAD "debug-server">)
 (3 . #<THREAD "main thread">)) 
 enter the number of a thread to interrupt/debug: 
If I enter 1 then things seem to work.
I've recently noticed that if I enter anything else then bad things
happen.  For instance,
 2
 ** - Continuable Error
 debug
 If you continue (by typing 'continue'): Return from BREAK loop
 Break 1 [1]> 
up to this point everything is as expected.  However, I then type
() followed by enter and get
 Connection closed by foreign host.
The original clisp image is not doing so well either.
In one case, while trying to get a response I saw this:
 *** - Internal error: statement in file "../src/stream.d", line 9789
 has been reached!!
If I enter 3 (debug the main thread):
 debug
 If you continue (by typing 'continue'): Connection closed by foreign host.
and in this case the original lisp shows:
 *** - PRINC: The value of *ERROR-OUTPUT* was not an appropriate stream:
      #<CLOSED IO INPUT-BUFFERED SOCKET-STREAM CHARACTER 127.0.0.1:1234>. It
      has been changed to #<IO SYNONYM-STREAM *TERMINAL-IO*>.
followed by a lot of these
 *** - WRITE-CHAR on
      #<CLOSED IO INPUT-BUFFERED SOCKET-STREAM CHARACTER 127.0.0.1:1234> is
      illegal
followed by
 *** - Segmentation fault (core dumped)
It occurs to me that the write-char's may be attempted outputs from new
debugger levels and that I may be running out of stack.
Something similar happens if I try to debug another debug thread.
In any case, I hope others with better understanding of the code can
reproduce this and debug it.
I'm pretty confident on the reproducing side, since this happens on both
of my test machines.
====
(defun serve-one-debugger(socket)
  (let ((tlist (loop for x in (mt:list-threads) with i = 0
		 when (mt:thread-active-p x) collect (cons (incf i) x)))
	ans)
    (print tlist socket)
    (format socket
	    "~&enter the number of a thread to interrupt/debug: ")
    (setf ans (or (cdr (assoc (read socket) tlist))
		  ;; try to put in package ap5?
		  (mt:current-thread)))
    (unwind-protect
	(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))
	     (break "debug"))))
      (close socket))))
(defun show-ut (&optional (ut (get-universal-time))) 
  (multiple-value-bind 
   (s m h d mo y) (decode-universal-time ut) 
   (format nil "~d-~d-~d ~2,'0d:~2,'0d:~2,'0d" y mo d h m s)))
(defun new-debugger-name()
  (format nil "debugger-~a" (show-ut)))
(defun debug-server()
  (let ((server (socket:socket-server *debug-server-port*
				      :interface "localhost")))
       (unwind-protect
	   (loop
	    (let ((socket (socket:socket-accept server ;; :buffered nil
                                                )))
	      (mt:make-thread #'(lambda ()(serve-one-debugger socket))
			      :name (new-debugger-name))))
	 (socket:socket-server-close server))))
(setf *debug-server-port* 1234)
(mt:make-thread #'debug-server :name "debug-server")
 |