Added bordeaux-thread path to help debugging.

Pascal J. Bourguignon [2021-05-23 08:01]
Added bordeaux-thread path to help debugging.
Filename
clext/telnet/bt-ccl-debug.lisp
clext/telnet/bt-ccl-debug.org
clext/telnet/bt-patch.lisp
clext/telnet/com.informatimago.clext.telnet.repl.asd
clext/telnet/com.informatimago.clext.telnet.repl.test.asd
clext/telnet/debug.lisp
clext/telnet/packages.lisp
diff --git a/clext/telnet/bt-ccl-debug.lisp b/clext/telnet/bt-ccl-debug.lisp
new file mode 100644
index 0000000..9cefbb2
--- /dev/null
+++ b/clext/telnet/bt-ccl-debug.lisp
@@ -0,0 +1,212 @@
+
+(in-package "COM.INFORMATIMAGO.BORDEAUX-THREAD.PATCH")
+
+(defvar *names*  (make-hash-table :weak :key :test 'eq))
+
+(defun make-condition-variable (&key name)
+  (let ((semaphore (ccl:make-semaphore)))
+    (setf (gethash semaphore *names*) name)
+    semaphore))
+
+(defmethod print-object :around ((semaphore ccl:semaphore) stream)
+  (let ((name (gethash semaphore *names*)))
+    (if name
+        (print-unreadable-object (semaphore stream :identity t :type  t)
+          (format stream ":NAME ~S" name))
+        (call-next-method))))
+
+
+(defvar *status* (make-hash-table :weak :key :test 'eq))
+
+(defun caller () (third (ccl:backtrace-as-list)))
+(defmacro with-lock-held ((place) &body body)
+  (let ((vlock (gensym)))
+    `(let ((,vlock ,place))
+       (ccl:with-lock-grabbed (,vlock)
+         (push (list :locking (caller) (bt:current-thread)) (gethash ,vlock *status* '()))
+         (unwind-protect
+              (progn ,@body)
+           (pop (gethash ,vlock *status* '())))))))
+
+(defmethod print-object :around ((lock ccl::recursive-lock) stream)
+  (let ((status (gethash lock *status*)))
+    (if status
+        (print-unreadable-object (lock stream :identity t :type  t)
+          (format stream "~S :status ~S" (ccl:lock-name lock) status))
+        (call-next-method))))
+
+
+#-(and)
+(ignore
+
+ bt:make-condition-variable
+ (com.informatimago.common-lisp.cesarum.utility:hash-table-entries *names*)
+
+ (map nil 'print (com.informatimago.common-lisp.cesarum.utility:hash-table-entries *status*))
+
+ (#<recursive-lock "down-layer" [ptr @ #x605080] #x3020028D45FD>)
+ (#<recursive-lock "Telnet REPL Server Lock" [ptr @ #x10D880] #x30200279729D>)
+ (#<recursive-lock "telnet-stream" :status ((:locking
+                                             (funcall "#<STANDARD-METHOD COM.INFORMATIMAGO.CLEXT.TELNET.STREAM::INPUT-BUFFER-FETCH-OCTET (COM.INFORMATIMAGO.CLEXT.TELNET.STREAM:TELNET-STREAM T)>" "#<TELNET-STREAM  #x3020028D75CD>" "NIL")
+                                             #<process Telnet REPL Client #1(21) [semaphore wait] #x3020028D192D>)
+                                            (:locking
+                                             (com.informatimago.clext.telnet.stream::%stream-read-char "#<TELNET-STREAM #x3020028D75CD>" "NIL")
+                                             #<process Telnet REPL Client #1(21) [semaphore wait] #x3020028D192D>)) #x3020028D74BD>
+                   (:locking
+                    (funcall "#<STANDARD-METHOD COM.INFORMATIMAGO.CLEXT.TELNET.STREAM::INPUT-BUFFER-FETCH-OCTET (COM.INFORMATIMAGO.CLEXT.TELNET.STREAM:TELNET-STREAM T)>" "#<TELNET-STREAM #x3020028D75CD>" "NIL")
+                    #<process Telnet REPL Client #1(21) [semaphore wait] #x3020028D192D>)
+                   (:locking
+                    (com.informatimago.clext.telnet.stream::%stream-read-char "#<TELNET-STREAM #x3020028D75CD>" "NIL")
+                    #<process Telnet REPL Client #1(21) [semaphore wait] #x3020028D192D>)) nil
+ )
+
+#|
+
+# -*- mode:org -*-
+* Debugging a dead-lock in a program using =bordeaux-threads= in =ccl=.
+
+We have a program with three threads:
+
+#+BEGIN_EXAMPLE
+cl-user> (list-threads)
+ 1) #<process Telnet REPL Client #1 DOWN LAYER(22) [semaphore wait] #x302002A4903D>
+ 2) #<process Telnet REPL Client #1(21) [semaphore wait] #x302002A469FD>
+ 3) #<process Telnet REPL Server(20) [Active] #x30200291EB5D>
+ 4) …
+#+END_EXAMPLE
+
+The server thread listens to connections and forks client threads for
+accepted connections.
+
+The client thread forks a down layer thread that loops reading bytes
+from the client socket, and forwarding them up the protocol layers, up
+to a buffer in a =TELNET-STREAM= Gray stream.
+
+The client thread then goes on into a REPL loop using the
+=TELNET-STREAM= Gray stream as =*TERMINAL-IO*=.  Writing back to
+=*TERMINAL-IO*= goes down to the client socket in this client thread.
+
+Unfortunately, when sending a byte to the upper layer, the down layer
+thread hangs waiting for the stream-lock.  Who has locked this stream?
+
+Neither =ccl= nor =bordeaux-threads= are very helpful in debugging that…
+
+** Recording the thread and function that holds an lock
+
+What we'd want, is to know what thread are holding a lock.  So we will
+implement a macro shadowing  =BT:WITH-LOCK-HELD=, to record that
+information into a weak hash-table.  Happily, =ccl= has native weak
+hash-tables so we don't have to use
+=com.informatimago.clext.closer-weak=.
+
+#+BEGIN_CODE lisp
+#+(and ccl debug-condition-variables)
+(defpackage "COM.INFORMATIMAGO.BORDEAUX-THREAD.PATCH"
+  (:use "COMMON-LISP" "BORDEAUX-THREADS")
+  (:shadow "MAKE-CONDITION-VARIABLE" "WITH-LOCK-HELD")
+  (:export "MAKE-CONDITION-VARIABLE" "WITH-LOCK-HELD")
+  (:documentation "Implements MAKE-CONDITION-VARIABLE on ccl to print the name,
+and WITH-LOCK-HELD to record the locking thread."))
+
+(defpackage "COM.INFORMATIMAGO.CLEXT.TELNET.STREAM"
+  (:use "COMMON-LISP" "BORDEAUX-THREADS"  …)
+  #+(and ccl debug-condition-variables)
+  (:shadowing-import-from "COM.INFORMATIMAGO.BORDEAUX-THREAD.PATCH"
+                          "MAKE-CONDITION-VARIABLE" "WITH-LOCK-HELD")
+  (:export "TELNET-STREAM" …))
+
+(defpackage "COM.INFORMATIMAGO.CLEXT.TELNET.REPL"
+  (:use "COMMON-LISP" "BORDEAUX-THREADS"  …)
+  #+(and ccl debug-condition-variables)
+  (:shadowing-import-from "COM.INFORMATIMAGO.BORDEAUX-THREAD.PATCH"
+                          "MAKE-CONDITION-VARIABLE" "WITH-LOCK-HELD")
+  (:export "START-REPL-SERVER" …))
+#+END_CODE
+
+
+In addition to recording the current thread, we also get the name of
+the caller function from =ccl:backtrace-as-list=.
+
+We use a =PRINT-OBJECT :AROUND= method to print the locking threads
+when it's available
+
+#+BEGIN_CODE lisp
+(in-package "COM.INFORMATIMAGO.BORDEAUX-THREAD.PATCH")
+
+(defvar *status* (make-hash-table :weak :key :test 'eq))
+
+(defun caller () (third (ccl:backtrace-as-list)))
+
+(defmacro with-lock-held ((place) &body body)
+  (let ((vlock (gensym)))
+    `(let ((,vlock ,place))
+       (ccl:with-lock-grabbed (,vlock)
+         (push (list :locking (caller) (bt:current-thread)) (gethash ,vlock *status* '()))
+         (unwind-protect
+              (progn ,@body)
+           (pop (gethash ,vlock *status* '())))))))
+
+(defmethod print-object :around ((lock ccl::recursive-lock) stream)
+  (let ((status (gethash lock *status*)))
+    (if status
+        (print-unreadable-object (lock stream :identity t :type  t)
+          (format stream "~S :status ~S" (ccl:lock-name lock) status))
+        (call-next-method))))
+#+END_CODE
+
+Then when the dead-lock occurs, we can have a look at the status of
+the various locks, and notice immediately our culprit stream lock that
+is held by not once but TWICE by the same thread!  =ccl= only has
+recursive locks, and =bt:with-lock-held= uses the native locking
+mechanism, which is a recursive lock.  But now, it is clear what
+functions are involved in this double locking and the solution will be
+obvious: split =input-buffer-fetch-octet= into an inner function that
+assumes the lock is already held, and use this in %stream-read-char.
+Problem solved.
+
+#+BEGIN_EXAMPLE
+ (map nil 'print (com.informatimago.common-lisp.cesarum.utility:hash-table-entries *status*))
+
+ (#<recursive-lock "down-layer" [ptr @ #x605080] #x3020028D45FD>)
+ (#<recursive-lock "Telnet REPL Server Lock" [ptr @ #x10D880] #x30200279729D>)
+ (#<recursive-lock "telnet-stream" :status ((:locking
+                                             (funcall "#<STANDARD-METHOD COM.INFORMATIMAGO.CLEXT.TELNET.STREAM::INPUT-BUFFER-FETCH-OCTET (COM.INFORMATIMAGO.CLEXT.TELNET.STREAM:TELNET-STREAM T)>" "#<TELNET-STREAM  #x3020028D75CD>" "NIL")
+                                             #<process Telnet REPL Client #1(21) [semaphore wait] #x3020028D192D>)
+                                            (:locking
+                                             (com.informatimago.clext.telnet.stream::%stream-read-char "#<TELNET-STREAM #x3020028D75CD>" "NIL")
+                                             #<process Telnet REPL Client #1(21) [semaphore wait] #x3020028D192D>)) #x3020028D74BD>
+                   (:locking
+                    (funcall "#<STANDARD-METHOD COM.INFORMATIMAGO.CLEXT.TELNET.STREAM::INPUT-BUFFER-FETCH-OCTET (COM.INFORMATIMAGO.CLEXT.TELNET.STREAM:TELNET-STREAM T)>" "#<TELNET-STREAM #x3020028D75CD>" "NIL")
+                    #<process Telnet REPL Client #1(21) [semaphore wait] #x3020028D192D>)
+                   (:locking
+                    (com.informatimago.clext.telnet.stream::%stream-read-char "#<TELNET-STREAM #x3020028D75CD>" "NIL")
+                    #<process Telnet REPL Client #1(21) [semaphore wait] #x3020028D192D>)) nil
+#+END_EXAMPLE
+
+** Naming Condition Variables
+
+In addition, =ccl= condition-variables are not named;
+=bordeaux-threads= ignores the name parameter.  So we shadow
+=make-condition-variable= and record the name of the condition
+variables in a weak hash-table, and add a =print-object :around=
+method to print this name when available.  This is very convenient
+when *inspecting* threads, to see on what condition variable they're
+actually waiting.
+
+#+BEGIN_CODE lisp
+(in-package "COM.INFORMATIMAGO.BORDEAUX-THREAD.PATCH")
+(defvar *names*  (make-hash-table :weak :key :test 'eq))
+
+(defun make-condition-variable (&key name)
+  (let ((semaphore (ccl:make-semaphore)))
+    (setf (gethash semaphore *names*) name)
+    semaphore))
+
+(defmethod print-object :around ((semaphore ccl:semaphore) stream)
+  (let ((name (gethash semaphore *names*)))
+    (if name
+        (print-unreadable-object (semaphore stream :identity t :type  t)
+          (format stream ":NAME ~S" name))
+        (call-next-method))))
+#+END_CODE
+
diff --git a/clext/telnet/bt-ccl-debug.org b/clext/telnet/bt-ccl-debug.org
new file mode 100644
index 0000000..ad9ab14
--- /dev/null
+++ b/clext/telnet/bt-ccl-debug.org
@@ -0,0 +1,148 @@
+# -*- mode:org -*-
+* Debugging a dead-lock in a program using =bordeaux-threads= in =ccl=.
+
+We have a program with three threads:
+
+#+BEGIN_EXAMPLE
+cl-user> (list-threads)
+ 1) #<process Telnet REPL Client #1 DOWN LAYER(22) [semaphore wait] #x302002A4903D>
+ 2) #<process Telnet REPL Client #1(21) [semaphore wait] #x302002A469FD>
+ 3) #<process Telnet REPL Server(20) [Active] #x30200291EB5D>
+ 4) …
+#+END_EXAMPLE
+
+The server thread listens to connections and forks client threads for
+accepted connections.
+
+The client thread forks a down layer thread that loops reading bytes
+from the client socket, and forwarding them up the protocol layers, up
+to a buffer in a =TELNET-STREAM= Gray stream.
+
+The client thread then goes on into a REPL loop using the
+=TELNET-STREAM= Gray stream as =*TERMINAL-IO*=.  Writing back to
+=*TERMINAL-IO*= goes down to the client socket in this client thread.
+
+Unfortunately, when sending a byte to the upper layer, the down layer
+thread hangs waiting for the stream-lock.  Who has locked this stream?
+
+Neither =ccl= nor =bordeaux-threads= are very helpful in debugging that…
+
+** Recording the thread and function that holds an lock
+
+What we'd want, is to know what threads are holding a lock.  So we will
+implement a macro shadowing  =BT:WITH-LOCK-HELD=, to record that
+information into a weak hash-table.  Happily, =ccl= has native weak
+hash-tables so we don't have to use
+=com.informatimago.clext.closer-weak=.
+
+#+BEGIN_CODE lisp
+#+(and ccl debug-condition-variables)
+(defpackage "COM.INFORMATIMAGO.BORDEAUX-THREAD.PATCH"
+  (:use "COMMON-LISP" "BORDEAUX-THREADS")
+  (:shadow "MAKE-CONDITION-VARIABLE" "WITH-LOCK-HELD")
+  (:export "MAKE-CONDITION-VARIABLE" "WITH-LOCK-HELD")
+  (:documentation "Implements MAKE-CONDITION-VARIABLE on ccl to print the name,
+and WITH-LOCK-HELD to record the locking thread."))
+
+(defpackage "COM.INFORMATIMAGO.CLEXT.TELNET.STREAM"
+  (:use "COMMON-LISP" "BORDEAUX-THREADS"  …)
+  #+(and ccl debug-condition-variables)
+  (:shadowing-import-from "COM.INFORMATIMAGO.BORDEAUX-THREAD.PATCH"
+                          "MAKE-CONDITION-VARIABLE" "WITH-LOCK-HELD")
+  (:export "TELNET-STREAM" …))
+
+(defpackage "COM.INFORMATIMAGO.CLEXT.TELNET.REPL"
+  (:use "COMMON-LISP" "BORDEAUX-THREADS"  …)
+  #+(and ccl debug-condition-variables)
+  (:shadowing-import-from "COM.INFORMATIMAGO.BORDEAUX-THREAD.PATCH"
+                          "MAKE-CONDITION-VARIABLE" "WITH-LOCK-HELD")
+  (:export "START-REPL-SERVER" …))
+#+END_CODE
+
+
+In addition to recording the current thread, we also get the name of
+the caller function from =ccl:backtrace-as-list=.
+
+We use a =PRINT-OBJECT :AROUND= method to print the locking threads
+when it's available
+
+#+BEGIN_CODE lisp
+(in-package "COM.INFORMATIMAGO.BORDEAUX-THREAD.PATCH")
+
+(defvar *status* (make-hash-table :weak :key :test 'eq))
+
+(defun caller () (third (ccl:backtrace-as-list)))
+
+(defmacro with-lock-held ((place) &body body)
+  (let ((vlock (gensym)))
+    `(let ((,vlock ,place))
+       (ccl:with-lock-grabbed (,vlock)
+         (push (list :locking (caller) (bt:current-thread)) (gethash ,vlock *status* '()))
+         (unwind-protect
+              (progn ,@body)
+           (pop (gethash ,vlock *status* '())))))))
+
+(defmethod print-object :around ((lock ccl::recursive-lock) stream)
+  (let ((status (gethash lock *status*)))
+    (if status
+        (print-unreadable-object (lock stream :identity t :type  t)
+          (format stream "~S :status ~S" (ccl:lock-name lock) status))
+        (call-next-method))))
+#+END_CODE
+
+Then when the dead-lock occurs, we can have a look at the status of
+the various locks, and notice immediately our culprit stream lock that
+is held by not once but TWICE by the same thread!  =ccl= only has
+recursive locks, and =bt:with-lock-held= uses the native locking
+mechanism, which is a recursive lock.  But now, it is clear what
+functions are involved in this double locking and the solution will be
+obvious: split =input-buffer-fetch-octet= into an inner function that
+assumes the lock is already held, and use this in %stream-read-char.
+Problem solved.
+
+#+BEGIN_EXAMPLE
+ (map nil 'print (com.informatimago.common-lisp.cesarum.utility:hash-table-entries *status*))
+
+ (#<recursive-lock "down-layer" [ptr @ #x605080] #x3020028D45FD>)
+ (#<recursive-lock "Telnet REPL Server Lock" [ptr @ #x10D880] #x30200279729D>)
+ (#<recursive-lock "telnet-stream" :status ((:locking
+                                             (funcall "#<STANDARD-METHOD COM.INFORMATIMAGO.CLEXT.TELNET.STREAM::INPUT-BUFFER-FETCH-OCTET (COM.INFORMATIMAGO.CLEXT.TELNET.STREAM:TELNET-STREAM T)>" "#<TELNET-STREAM  #x3020028D75CD>" "NIL")
+                                             #<process Telnet REPL Client #1(21) [semaphore wait] #x3020028D192D>)
+                                            (:locking
+                                             (com.informatimago.clext.telnet.stream::%stream-read-char "#<TELNET-STREAM #x3020028D75CD>" "NIL")
+                                             #<process Telnet REPL Client #1(21) [semaphore wait] #x3020028D192D>)) #x3020028D74BD>
+                   (:locking
+                    (funcall "#<STANDARD-METHOD COM.INFORMATIMAGO.CLEXT.TELNET.STREAM::INPUT-BUFFER-FETCH-OCTET (COM.INFORMATIMAGO.CLEXT.TELNET.STREAM:TELNET-STREAM T)>" "#<TELNET-STREAM #x3020028D75CD>" "NIL")
+                    #<process Telnet REPL Client #1(21) [semaphore wait] #x3020028D192D>)
+                   (:locking
+                    (com.informatimago.clext.telnet.stream::%stream-read-char "#<TELNET-STREAM #x3020028D75CD>" "NIL")
+                    #<process Telnet REPL Client #1(21) [semaphore wait] #x3020028D192D>)) nil
+#+END_EXAMPLE
+
+** Naming Condition Variables
+
+In addition, =ccl= condition-variables are not named;
+=bordeaux-threads= ignores the name parameter.  So we shadow
+=make-condition-variable= and record the name of the condition
+variables in a weak hash-table, and add a =print-object :around=
+method to print this name when available.  This is very convenient
+when *inspecting* threads, to see on what condition variable they're
+actually waiting.
+
+#+BEGIN_CODE lisp
+(in-package "COM.INFORMATIMAGO.BORDEAUX-THREAD.PATCH")
+(defvar *names*  (make-hash-table :weak :key :test 'eq))
+
+(defun make-condition-variable (&key name)
+  (let ((semaphore (ccl:make-semaphore)))
+    (setf (gethash semaphore *names*) name)
+    semaphore))
+
+(defmethod print-object :around ((semaphore ccl:semaphore) stream)
+  (let ((name (gethash semaphore *names*)))
+    (if name
+        (print-unreadable-object (semaphore stream :identity t :type  t)
+          (format stream ":NAME ~S" name))
+        (call-next-method))))
+#+END_CODE
+
diff --git a/clext/telnet/bt-patch.lisp b/clext/telnet/bt-patch.lisp
new file mode 100644
index 0000000..a14c65d
--- /dev/null
+++ b/clext/telnet/bt-patch.lisp
@@ -0,0 +1,194 @@
+
+(in-package "COM.INFORMATIMAGO.BORDEAUX-THREAD.PATCH")
+
+(defvar *names*  (make-hash-table :weak :key :test 'eq))
+
+(defun make-condition-variable (&key name)
+  (let ((semaphore (ccl:make-semaphore)))
+    (setf (gethash semaphore *names*) name)
+    semaphore))
+
+(defmethod print-object :around ((semaphore ccl:semaphore) stream)
+  (let ((name (gethash semaphore *names*)))
+    (if name
+        (print-unreadable-object (semaphore stream :identity t :type  t)
+          (format stream ":NAME ~S" name))
+        (call-next-method))))
+
+
+(defvar *status* (make-hash-table :weak :key :test 'eq))
+
+(defun caller () (third (ccl:backtrace-as-list)))
+(defmacro with-lock-held ((place) &body body)
+  (let ((vlock (gensym)))
+    `(let ((,vlock ,place))
+       (ccl:with-lock-grabbed (,vlock)
+         (push (list :locking (caller) (bt:current-thread)) (gethash ,vlock *status* '()))
+         (unwind-protect
+              (progn ,@body)
+           (pop (gethash ,vlock *status* '())))))))
+
+(defmethod print-object :around ((lock ccl::recursive-lock) stream)
+  (let ((status (gethash lock *status*)))
+    (if status
+        (print-unreadable-object (lock stream :identity t :type  t)
+          (format stream "~S :status ~S" (ccl:lock-name lock) status))
+        (call-next-method))))
+
+
+#-(and)
+(ignore
+
+ bt:make-condition-variable
+ (com.informatimago.common-lisp.cesarum.utility:hash-table-entries *names*)
+
+ (map nil 'print (com.informatimago.common-lisp.cesarum.utility:hash-table-entries *status*))
+
+ (#<recursive-lock "down-layer" [ptr @ #x605080] #x3020028D45FD>)
+ (#<recursive-lock "Telnet REPL Server Lock" [ptr @ #x10D880] #x30200279729D>)
+ (#<recursive-lock "telnet-stream" :status ((:locking
+                                             (funcall "#<STANDARD-METHOD COM.INFORMATIMAGO.CLEXT.TELNET.STREAM::INPUT-BUFFER-FETCH-OCTET (COM.INFORMATIMAGO.CLEXT.TELNET.STREAM:TELNET-STREAM T)>" "#<TELNET-STREAM  #x3020028D75CD>" "NIL")
+                                             #<process Telnet REPL Client #1(21) [semaphore wait] #x3020028D192D>)
+                                            (:locking
+                                             (com.informatimago.clext.telnet.stream::%stream-read-char "#<TELNET-STREAM #x3020028D75CD>" "NIL")
+                                             #<process Telnet REPL Client #1(21) [semaphore wait] #x3020028D192D>)) #x3020028D74BD>
+                   (:locking
+                    (funcall "#<STANDARD-METHOD COM.INFORMATIMAGO.CLEXT.TELNET.STREAM::INPUT-BUFFER-FETCH-OCTET (COM.INFORMATIMAGO.CLEXT.TELNET.STREAM:TELNET-STREAM T)>" "#<TELNET-STREAM #x3020028D75CD>" "NIL")
+                    #<process Telnet REPL Client #1(21) [semaphore wait] #x3020028D192D>)
+                   (:locking
+                    (com.informatimago.clext.telnet.stream::%stream-read-char "#<TELNET-STREAM #x3020028D75CD>" "NIL")
+                    #<process Telnet REPL Client #1(21) [semaphore wait] #x3020028D192D>)) nil
+ )
+
+#|
+
+# -*- mode:org -*-
+* Debugging a dead-lock in a program using =bordeaux-threads= in =ccl=.
+
+We have a program with three threads:
+
+#+BEGIN_EXAMPLE
+cl-user> (list-threads)
+ 1) #<process Telnet REPL Client #1 DOWN LAYER(22) [semaphore wait] #x302002A4903D>
+ 2) #<process Telnet REPL Client #1(21) [semaphore wait] #x302002A469FD>
+ 3) #<process Telnet REPL Server(20) [Active] #x30200291EB5D>
+ 4) …
+#+END_EXAMPLE
+
+The server thread listens to connections and forks client threads for
+accepted connections.
+
+The client thread forks a down layer thread that loops reading bytes
+from the client socket, and forwarding them up the protocol layers, up
+to a buffer in a =TELNET-STREAM= Gray stream.
+
+The client thread then goes on into a REPL loop using the
+=TELNET-STREAM= Gray stream as =*TERMINAL-IO*=.  Writing back to
+=*TERMINAL-IO*= goes down to the client socket in this client thread.
+
+Unfortunately, when sending a byte to the upper layer, the down layer
+thread hangs waiting for the stream-lock.  Who has locked this stream?
+
+Neither =ccl= nor =bordeaux-threads= are very helpful in debugging that…
+
+What we'd want, is to know what thread are holding a lock.  So we will
+implement a macro shadowing  =BT:WITH-LOCK-HELD=, to record that
+information into a weak hash-table.  Happily, =ccl= has native weak
+hash-tables so we don't have to use
+=com.informatimago.clext.closer-weak=.
+
+#+BEGIN_CODE lisp
+#+(and ccl debug-condition-variables)
+(defpackage "COM.INFORMATIMAGO.BORDEAUX-THREAD.PATCH"
+  (:use "COMMON-LISP" "BORDEAUX-THREADS")
+  (:shadow "MAKE-CONDITION-VARIABLE" "WITH-LOCK-HELD")
+  (:export "MAKE-CONDITION-VARIABLE" "WITH-LOCK-HELD")
+  (:documentation "Implements MAKE-CONDITION-VARIABLE on ccl to print the name,
+and WITH-LOCK-HELD to record the locking thread."))
+
+(defpackage "COM.INFORMATIMAGO.CLEXT.TELNET.STREAM"
+  (:use "COMMON-LISP" "BORDEAUX-THREADS"  …)
+  #+(and ccl debug-condition-variables)
+  (:shadowing-import-from "COM.INFORMATIMAGO.BORDEAUX-THREAD.PATCH"
+                          "MAKE-CONDITION-VARIABLE" "WITH-LOCK-HELD")
+  (:export "TELNET-STREAM" …))
+
+(defpackage "COM.INFORMATIMAGO.CLEXT.TELNET.REPL"
+  (:use "COMMON-LISP" "BORDEAUX-THREADS"  …)
+  #+(and ccl debug-condition-variables)
+  (:shadowing-import-from "COM.INFORMATIMAGO.BORDEAUX-THREAD.PATCH"
+                          "MAKE-CONDITION-VARIABLE" "WITH-LOCK-HELD")
+  (:export "START-REPL-SERVER" …))
+#+END_CODE
+
+
+
+#+BEGIN_CODE lisp
+(in-package "COM.INFORMATIMAGO.BORDEAUX-THREAD.PATCH")
+
+(defvar *status* (make-hash-table :weak :key :test 'eq))
+
+(defun caller () (third (ccl:backtrace-as-list)))
+
+(defmacro with-lock-held ((place) &body body)
+  (let ((vlock (gensym)))
+    `(let ((,vlock ,place))
+       (ccl:with-lock-grabbed (,vlock)
+         (push (list :locking (caller) (bt:current-thread)) (gethash ,vlock *status* '()))
+         (unwind-protect
+              (progn ,@body)
+           (pop (gethash ,vlock *status* '())))))))
+
+(defmethod print-object :around ((lock ccl::recursive-lock) stream)
+  (let ((status (gethash lock *status*)))
+    (if status
+        (print-unreadable-object (lock stream :identity t :type  t)
+          (format stream "~S :status ~S" (ccl:lock-name lock) status))
+        (call-next-method))))
+#+END_CODE
+
+#+BEGIN_EXAMPLE
+ (map nil 'print (com.informatimago.common-lisp.cesarum.utility:hash-table-entries *status*))
+
+ (#<recursive-lock "down-layer" [ptr @ #x605080] #x3020028D45FD>)
+ (#<recursive-lock "Telnet REPL Server Lock" [ptr @ #x10D880] #x30200279729D>)
+ (#<recursive-lock "telnet-stream" :status ((:locking
+                                             (funcall "#<STANDARD-METHOD COM.INFORMATIMAGO.CLEXT.TELNET.STREAM::INPUT-BUFFER-FETCH-OCTET (COM.INFORMATIMAGO.CLEXT.TELNET.STREAM:TELNET-STREAM T)>" "#<TELNET-STREAM  #x3020028D75CD>" "NIL")
+                                             #<process Telnet REPL Client #1(21) [semaphore wait] #x3020028D192D>)
+                                            (:locking
+                                             (com.informatimago.clext.telnet.stream::%stream-read-char "#<TELNET-STREAM #x3020028D75CD>" "NIL")
+                                             #<process Telnet REPL Client #1(21) [semaphore wait] #x3020028D192D>)) #x3020028D74BD>
+                   (:locking
+                    (funcall "#<STANDARD-METHOD COM.INFORMATIMAGO.CLEXT.TELNET.STREAM::INPUT-BUFFER-FETCH-OCTET (COM.INFORMATIMAGO.CLEXT.TELNET.STREAM:TELNET-STREAM T)>" "#<TELNET-STREAM #x3020028D75CD>" "NIL")
+                    #<process Telnet REPL Client #1(21) [semaphore wait] #x3020028D192D>)
+                   (:locking
+                    (com.informatimago.clext.telnet.stream::%stream-read-char "#<TELNET-STREAM #x3020028D75CD>" "NIL")
+                    #<process Telnet REPL Client #1(21) [semaphore wait] #x3020028D192D>)) nil
+#+END_EXAMPLE
+
+
+
+
+ccl condition-variables are not named;
+bordeaux-threads ignores the name parameter.
+So we shadow make-condition-variable and record the name
+of the condition variables in a
+
+#+BEGIN_CODE lisp
+(in-package "COM.INFORMATIMAGO.BORDEAUX-THREAD.PATCH")
+(defvar *names*  (make-hash-table :weak :key :test 'eq))
+
+(defun make-condition-variable (&key name)
+  (let ((semaphore (ccl:make-semaphore)))
+    (setf (gethash semaphore *names*) name)
+    semaphore))
+
+(defmethod print-object :around ((semaphore ccl:semaphore) stream)
+  (let ((name (gethash semaphore *names*)))
+    (if name
+        (print-unreadable-object (semaphore stream :identity t :type  t)
+          (format stream ":NAME ~S" name))
+        (call-next-method))))
+#+END_CODE
+
+|#
diff --git a/clext/telnet/com.informatimago.clext.telnet.repl.asd b/clext/telnet/com.informatimago.clext.telnet.repl.asd
index f6757c9..241b859 100644
--- a/clext/telnet/com.informatimago.clext.telnet.repl.asd
+++ b/clext/telnet/com.informatimago.clext.telnet.repl.asd
@@ -44,7 +44,7 @@ This system implements a Telnet REPL Server.
   :maintainer "Pascal J. Bourguignon <pjb@informatimago.com>"
   :licence "AGPL3"
   ;; component attributes:
-  :version "1.0.0"
+  :version "1.0.1"
   :properties ((#:author-email                   . "pjb@informatimago.com")
                (#:date                           . "Spring 2021")
                ((#:albert #:output-dir)          . "/tmp/documentation/com.informatimago.clext.telnet.repl/")
@@ -60,12 +60,24 @@ This system implements a Telnet REPL Server.
                "usocket"
                "bordeaux-threads"
                "trivial-gray-streams")
-  :components ((:file "packages"        :depends-on ())
-               (:file "telnet-stream"   :depends-on ("packages"))
-               (:file "babel-extension" :depends-on ("packages"))
-               (:file "telnet-repl"     :depends-on ("packages" "telnet-stream" "babel-extension")))
+  :components ((:file "packages"
+                :depends-on ())
+               #+(and ccl debug-condition-variables)
+               (:file "bt-patch"
+                :depends-on ("packages"))
+               (:file "telnet-stream"
+                :depends-on ("packages"
+                             #+(and ccl debug-condition-variables) "bt-patch"))
+               (:file "babel-extension"
+                :depends-on ("packages"))
+               (:file "telnet-repl"
+                :depends-on ("packages"
+                             "babel-extension"
+                             "telnet-stream"
+                             #+(and ccl debug-condition-variables) "bt-patch")))
   ;; #+adsf3 :in-order-to #+adsf3 ((asdf:test-op (asdf:test-op "com.informatimago.clext.telnet.repl.test")))
   )


+
 ;;;; THE END ;;;;
diff --git a/clext/telnet/com.informatimago.clext.telnet.repl.test.asd b/clext/telnet/com.informatimago.clext.telnet.repl.test.asd
new file mode 100644
index 0000000..fa2b6a2
--- /dev/null
+++ b/clext/telnet/com.informatimago.clext.telnet.repl.test.asd
@@ -0,0 +1,79 @@
+;;;; -*- mode:lisp;coding:utf-8 -*-
+;;;;**************************************************************************
+;;;;FILE:               com.informatimago.clext.telnet.asd
+;;;;LANGUAGE:           Common-Lisp
+;;;;SYSTEM:             Common-Lisp
+;;;;USER-INTERFACE:     NONE
+;;;;DESCRIPTION
+;;;;
+;;;;    ASD file to load the Telnet REPL server.
+;;;;
+;;;;AUTHORS
+;;;;    <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
+;;;;MODIFICATIONS
+;;;;    2021-05-13 <PJB> Created this .asd file.
+;;;;BUGS
+;;;;LEGAL
+;;;;    AGPL3
+;;;;
+;;;;    Copyright Pascal J. Bourguignon 2021 - 2021
+;;;;
+;;;;    This program is free software: you can redistribute it and/or modify
+;;;;    it under the terms of the GNU Affero General Public License as published by
+;;;;    the Free Software Foundation, either version 3 of the License, or
+;;;;    (at your option) any later version.
+;;;;
+;;;;    This program is distributed in the hope that it will be useful,
+;;;;    but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;;    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;;;    GNU Affero General Public License for more details.
+;;;;
+;;;;    You should have received a copy of the GNU Affero General Public License
+;;;;    along with this program.  If not, see http://www.gnu.org/licenses/
+;;;;**************************************************************************
+
+(asdf:defsystem "com.informatimago.clext.telnet.repl.test"
+  ;; system attributes:
+  :description "Tests the Telnet REPL Server."
+  :long-description "
+
+This system tests the Telnet REPL Server.
+
+"
+  :author     "Pascal J. Bourguignon <pjb@informatimago.com>"
+  :maintainer "Pascal J. Bourguignon <pjb@informatimago.com>"
+  :licence "AGPL3"
+  ;; component attributes:
+  :version "1.0.0"
+  :properties ((#:author-email                   . "pjb@informatimago.com")
+               (#:date                           . "Spring 2021")
+               ((#:albert #:output-dir)          . "/tmp/documentation/com.informatimago.clext.telnet.repl.test/")
+               ((#:albert #:formats)             . ("docbook"))
+               ((#:albert #:docbook #:template)  . "book")
+               ((#:albert #:docbook #:bgcolor)   . "white")
+               ((#:albert #:docbook #:textcolor) . "black"))
+  #+asdf-unicode :encoding #+asdf-unicode :utf-8
+  :depends-on ("babel"
+               "usocket"
+               "bordeaux-threads"
+               "trivial-gray-streams"
+               "com.informatimago.common-lisp.cesarum"
+               "com.informatimago.common-lisp.interactive"
+               "com.informatimago.common-lisp.telnet"
+               "com.informatimago.clext.telnet.repl")
+  :components ((:file "packages"        :depends-on ())
+
+               (:file "telnet-stream"   :depends-on ("packages"))
+               (:file "babel-extension" :depends-on ("packages"))
+               (:file "telnet-repl"     :depends-on ("packages"
+                                                     "telnet-stream"
+                                                     "babel-extension"))
+
+               (:file "babel-extension-test" :depends-on ("packages" "babel-extension"))
+               (:file "test-stub-nvt"        :depends-on ("packages"))
+               (:file "telnet-stream-test"   :depends-on ("packages"
+                                                          "telnet-stream"
+                                                          "test-stub-nvt"))))
+
+
+;;;; THE END ;;;;
diff --git a/clext/telnet/debug.lisp b/clext/telnet/debug.lisp
new file mode 100644
index 0000000..850c2dc
--- /dev/null
+++ b/clext/telnet/debug.lisp
@@ -0,0 +1 @@
+(bt:interrupt-thread (second (bt:all-threads)) (function break))
diff --git a/clext/telnet/packages.lisp b/clext/telnet/packages.lisp
index d0894f6..d7642c1 100644
--- a/clext/telnet/packages.lisp
+++ b/clext/telnet/packages.lisp
@@ -5,9 +5,9 @@
 ;;;;SYSTEM:             Common-Lisp
 ;;;;USER-INTERFACE:     NONE
 ;;;;DESCRIPTION
-;;;;
+;;;;
 ;;;;    The package definitions of the telnet REPL server.
-;;;;
+;;;;
 ;;;;AUTHORS
 ;;;;    <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
 ;;;;MODIFICATIONS
@@ -15,19 +15,19 @@
 ;;;;BUGS
 ;;;;LEGAL
 ;;;;    AGPL3
-;;;;
+;;;;
 ;;;;    Copyright Pascal J. Bourguignon 2021 - 2021
-;;;;
+;;;;
 ;;;;    This program is free software: you can redistribute it and/or modify
 ;;;;    it under the terms of the GNU Affero General Public License as published by
 ;;;;    the Free Software Foundation, either version 3 of the License, or
 ;;;;    (at your option) any later version.
-;;;;
+;;;;
 ;;;;    This program is distributed in the hope that it will be useful,
 ;;;;    but WITHOUT ANY WARRANTY; without even the implied warranty of
 ;;;;    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 ;;;;    GNU Affero General Public License for more details.
-;;;;
+;;;;
 ;;;;    You should have received a copy of the GNU Affero General Public License
 ;;;;    along with this program.  If not, see <http://www.gnu.org/licenses/>.
 ;;;;**************************************************************************
@@ -38,11 +38,16 @@
   (:export "DECODE-CHARACTER"
            "REPLACE-OCTETS-BY-STRING"))

-(defpackage "COM.INFORMATIMAGO.CLEXT.BABEL-EXTENSION.TEST"
-  (:use "COMMON-LISP"
-        "COM.INFORMATIMAGO.CLEXT.BABEL-EXTENSION"
-        "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.SIMPLE-TEST")
-  (:export "TEST/ALL"))
+
+;; (push :debug-condition-variables *features*)
+
+#+(and ccl debug-condition-variables)
+(defpackage "COM.INFORMATIMAGO.BORDEAUX-THREAD.PATCH"
+  (:use "COMMON-LISP" "BORDEAUX-THREADS")
+  (:shadow "MAKE-CONDITION-VARIABLE" "WITH-LOCK-HELD")
+  (:export "MAKE-CONDITION-VARIABLE" "WITH-LOCK-HELD")
+  (:documentation "Implements bt:make-condition-variable on ccl to print the name."))
+

 (defpackage "COM.INFORMATIMAGO.CLEXT.TELNET.STREAM"
   (:use "COMMON-LISP"
@@ -55,8 +60,13 @@
         "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.STRING"
         "COM.INFORMATIMAGO.CLEXT.CHARACTER-SETS"
         "COM.INFORMATIMAGO.CLEXT.BABEL-EXTENSION")
+  #+(and ccl debug-condition-variables)
+  (:shadowing-import-from "COM.INFORMATIMAGO.BORDEAUX-THREAD.PATCH"
+                          "MAKE-CONDITION-VARIABLE" "WITH-LOCK-HELD")
   (:export "WITH-TELNET-ON-STREAM"
-           "TELNET-STREAM"))
+           "TELNET-STREAM"
+           "NAME" "CLIENT" "STOP-CLOSURE"
+           "*LOG-OUTPUT*"))

 (defpackage "COM.INFORMATIMAGO.CLEXT.TELNET.REPL"
   (:use "COMMON-LISP"
@@ -68,6 +78,9 @@
         ;; "com.informatimago.common-lisp.cesarum"
         "COM.INFORMATIMAGO.COMMON-LISP.INTERACTIVE.INTERACTIVE"
         "COM.INFORMATIMAGO.CLEXT.TELNET.STREAM")
+  #+(and ccl debug-condition-variables)
+  (:shadowing-import-from "COM.INFORMATIMAGO.BORDEAUX-THREAD.PATCH"
+                          "MAKE-CONDITION-VARIABLE" "WITH-LOCK-HELD")
   (:export "REPL-SERVER"
            "REPL-SERVER-THREAD"
            "REPL-SERVER-PORT"
@@ -76,4 +89,7 @@
            "REPL-SERVER-CLIENT-THREADS"
            "START-REPL-SERVER" "STOP-REPL-SERVER"))

+
+
+
 ;;;; THE END ;;;;
ViewGit