From 96d429c5e734c1b48411bfc31a9e3b133033bc8b Mon Sep 17 00:00:00 2001
From: Stelian Ionescu <sionescu@common-lisp.net>
Date: Mon, 18 Jun 2007 01:46:05 +0200
Subject: [PATCH] Fixed %WRITE-N-BYTES and %FLUSH-OBUF. Signed-off-by: Stelian
 Ionescu <sionescu@common-lisp.net>

---
 io.streams/gray-stream-methods.lisp | 85 ++++++++++++++++++++-----------------
 1 file changed, 45 insertions(+), 40 deletions(-)

diff --git a/io.streams/gray-stream-methods.lisp b/io.streams/gray-stream-methods.lisp
index d006714..b02ac2c 100644
--- a/io.streams/gray-stream-methods.lisp
+++ b/io.streams/gray-stream-methods.lisp
@@ -181,50 +181,55 @@
 (defun %write-n-bytes (buf fd nbytes &optional timeout)
   (declare (type stream-buffer buf))
   (let ((bytes-written 0))
-    (flet ((write-once ()
-             (let ((num (handler-case
-                            (et:repeat-upon-eintr
-                              (et:write fd (inc-pointer buf bytes-written)
-                                        nbytes))
-                          (et:epipe ()
-                            (return-from %write-n-bytes (values nil :eof))))))
-               (unless (zerop num) (incf bytes-written num))))
-           (buffer-emptyp () (zerop nbytes)))
-      (let (num)
-        (if (buffer-emptyp) (values t nil)
-            (et:repeat-decreasing-timeout (timeout-var timeout)
-              (unless (setf num (write-once))
-                (when (member :error (iomux:wait-until-fd-ready fd :write))
-                  ;; FIXME signal something better -- maybe analyze the status
-                  (return-from %write-n-bytes (values nil :fail))))
-              (when (buffer-emptyp) (return-from %write-n-bytes (values t bytes-written)))
-              (when (zerop timeout-var) (return-from %write-n-bytes (values nil :timeout)))))))))
+    (labels ((write-once ()
+               (let ((num (handler-case
+                              (et:repeat-upon-condition-decreasing-timeout
+                                  ((et:eintr) timeout-var timeout)
+                                (prog1
+                                    (et:write fd (inc-pointer buf bytes-written) nbytes)
+                                  (when (and timeout-var (zerop timeout-var))
+                                    (return-from %write-n-bytes (values nil :timeout)))))
+                            (et:epipe ()
+                              (return-from %write-n-bytes (values nil :eof))))))
+                 (unless (zerop num) (incf bytes-written num))))
+             (write-or-return ()
+               (unless (write-once)
+                 (when (errorp)
+                   ;; FIXME signal something better -- maybe analyze the status
+                   (return-from %write-n-bytes (values nil :fail)))))
+             (buffer-emptyp () (= bytes-written nbytes))
+             (errorp () (member :error (iomux:wait-until-fd-ready fd :write))))
+      (loop :until (buffer-emptyp) :do (write-or-return)
+         :finally (return (values t bytes-written))))))
 
 (defun %flush-obuf (buf fd &optional timeout)
   (declare (type iobuf buf))
   (let ((bytes-written 0))
-    (flet ((write-once ()
-             (let ((num (handler-case
-                            (et:repeat-upon-eintr
-                              (et:write fd (iobuf-start-pointer buf)
-                                        (iobuf-length buf)))
-                          (et:epipe ()
-                            (return-from %flush-obuf (values nil :eof))))))
-               (unless (zerop num)
-                 (incf (iobuf-start buf) num)
-                 (incf bytes-written num))))
-           (buffer-emptyp ()
-             (when (iobuf-empty-p buf)
-               (iobuf-reset buf) t)))
-      (let (num)
-        (if (buffer-emptyp) (values t nil)
-            (et:repeat-decreasing-timeout (timeout-var timeout)
-              (unless (setf num (write-once))
-                (when (member :error (iomux:wait-until-fd-ready fd :write))
-                  ;; FIXME signal something better -- maybe analyze the status
-                  (return-from %flush-obuf (values nil :fail))))
-              (when (buffer-emptyp) (return-from %flush-obuf (values t bytes-written)))
-              (when (zerop timeout-var) (return-from %flush-obuf (values nil :timeout)))))))))
+    (labels ((write-once ()
+               (let ((num (handler-case
+                              (et:repeat-upon-condition-decreasing-timeout
+                                  ((et:eintr) timeout-var timeout)
+                                (prog1
+                                    (et:write fd (iobuf-start-pointer buf)
+                                              (iobuf-length buf))
+                                  (when (and timeout-var (zerop timeout-var))
+                                    (return-from %flush-obuf (values nil :timeout)))))
+                            (et:epipe ()
+                              (return-from %flush-obuf (values nil :eof))))))
+                 (unless (zerop num)
+                   (incf (iobuf-start buf) num)
+                   (incf bytes-written num))))
+             (write-or-return ()
+               (unless (write-once)
+                 (when (errorp)
+                   ;; FIXME signal something better -- maybe analyze the status
+                   (return-from %flush-obuf (values nil :fail)))))
+             (buffer-emptyp ()
+               (when (iobuf-empty-p buf)
+                 (iobuf-reset buf) t))
+             (errorp () (member :error (iomux:wait-until-fd-ready fd :write))))
+      (loop :until (buffer-emptyp) :do (write-or-return)
+         :finally (return (values t bytes-written))))))
 
 ;; TODO: add timeout support
 (defun %flush-obuf-if-needed (stream)
-- 
2.11.4.GIT