Changeset 13101 for trunk/source/level-1/l1-processes.lisp

Timestamp:

Oct 27, 2009, 10:24:02 AM (11 years ago)

Author:

gb

Message:

In the primary PROCESS-EXIT-APPLICATION, don't assume that the lock on
CCL::*STDOUT* is free, even though we should be single-threaded at the
time this code is run. (SLIME may be using that stream to tellthe
user interesting things about the PROCESS-RESET condition it just
received on its control thread, and we may have had to kill that
thread since it wasn't responding to the PROCESS-RESET condition ...)

File:

• trunk/source/level-1/l1-processes.lisp (modified) (1 diff)

trunk/source/level-1/l1-processes.lisp

@@ -639 +639 @@
     (with-standard-abort-handling "Exit Lisp"
       (prepare-to-quit)
-      (fresh-line *stdout*)
-      (finish-output *stdout*))
+      ;; We may have abruptly terminated a thread
+      ;; which owned the output lock on *STDOUT*.
+      ;; Don't block waiting on that lock if so.
+      (let* ((s *stdout*)
+             (lock (ioblock-outbuf-lock (basic-stream-ioblock s)))
+             (locked (make-lock-acquisition)))
+        (declare (dynamic-extent locked))
+        (when (or (null lock) (%try-recursive-lock-object lock locked))
+          (unwind-protect
+               (progn
+                 (fresh-line s)
+                 (finish-output s)))
+          (when (lock-acquisition.status locked) (release-lock lock)))))
     (%set-toplevel thunk)
     (toplevel)))