Changeset 13139

Timestamp:

Oct 30, 2009, 3:17:14 PM (15 years ago)

Author:

gz

Message:

Merge r13101 (fix for abrupt exit)

File:

• branches/working-0711/ccl/level-1/l1-processes.lisp (modified) (1 diff)

branches/working-0711/ccl/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)))