Index: /trunk/ccl/level-1/l1-streams.lisp
===================================================================
--- /trunk/ccl/level-1/l1-streams.lisp	(revision 7808)
+++ /trunk/ccl/level-1/l1-streams.lisp	(revision 7809)
@@ -5370,5 +5370,4 @@
 (defun fd-stream-force-output (s ioblock count finish-p)
   (when (or (ioblock-dirty ioblock) finish-p)
-    (setf (ioblock-dirty ioblock) nil)
     (let* ((fd (ioblock-device ioblock))
 	   (io-buffer (ioblock-outbuf ioblock))
@@ -5378,21 +5377,23 @@
       (declare (fixnum octets))
       (declare (dynamic-extent buf))
-      (%setf-macptr buf (io-buffer-bufptr io-buffer))
-      (setf (io-buffer-idx io-buffer) 0
-	    (io-buffer-count io-buffer) 0)
-      (do* ()
-	   ((= octets 0)
-	    (when finish-p
-	      (case (%unix-fd-kind fd)
-		(:file (fd-fsync fd))))
-	    octets-to-write)
-	(let* ((written (with-eagain fd :output
-			  (fd-write fd buf octets))))
-	  (declare (fixnum written))
-	  (if (< written 0)
-	    (stream-io-error s (- written) "write"))
-	  (decf octets written)
-	  (unless (zerop octets)
-	    (%incf-ptr buf written)))))))
+      (without-interrupts
+       (setf (ioblock-dirty ioblock) nil)
+       (%setf-macptr buf (io-buffer-bufptr io-buffer))
+       (setf (io-buffer-idx io-buffer) 0
+             (io-buffer-count io-buffer) 0)
+       (do* ()
+            ((= octets 0)
+             (when finish-p
+               (case (%unix-fd-kind fd)
+                 (:file (fd-fsync fd))))
+             octets-to-write)
+         (let* ((written (with-eagain fd :output
+                                      (fd-write fd buf octets))))
+           (declare (fixnum written))
+           (if (< written 0)
+             (stream-io-error s (- written) "write"))
+           (decf octets written)
+           (unless (zerop octets)
+             (%incf-ptr buf written))))))))
 
 (defmethod stream-read-line ((s buffered-input-stream-mixin))