[Openmcl-cvs-notifications] r13636 - /trunk/source/level-1/l1-processes.lisp

[rme at clozure.com]

Author: rme
Date: Sat Apr 17 22:47:10 2010
New Revision: 13636

Log:
Flush ccl::*stderr* on quit.  Patch from Stas Boukarev.
(see ticket:652)

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

Modified: trunk/source/level-1/l1-processes.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/level-1/l1-processes.lisp (original)
+++ trunk/source/level-1/l1-processes.lisp Sat Apr 17 22:47:10 2010
@@ -638,19 +638,23 @@
   (when (eq process *initial-process*)
     (with-standard-abort-handling "Exit Lisp"
       (prepare-to-quit)
-      ;; 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)))))
+      ;; We may have abruptly terminated a thread which owned the
+      ;; output lock on a stream we want to flush.  Don't block
+      ;; waiting on the lock if so.
+      (flet ((flush-stream (s)
+	       (let* ((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)))))))
+	(flush-stream *stdout*)
+	(flush-stream *stderr*)))
     (%set-toplevel thunk)
     (toplevel)))
 =