- (let ((length (- tail head)))
- (multiple-value-bind (count errno)
- (sb!unix:unix-write (fd-stream-fd stream) (buffer-sap obuf)
- head length)
- (cond ((eql count length)
- ;; Complete write -- we can use the same buffer.
- (reset-buffer obuf))
- (count
- ;; Partial write -- update buffer status and queue.
- ;; Do not use INCF! Another thread might have moved
- ;; head...
- (setf (buffer-head obuf) (+ count head))
- (%queue-and-replace-output-buffer stream))
- #!-win32
- ((eql errno sb!unix:ewouldblock)
- ;; Blocking, queue.
- (%queue-and-replace-output-buffer stream))
- (t
- (simple-stream-perror "Couldn't write to ~s"
- stream errno)))))))))))
+ (loop
+ (let ((length (- tail head)))
+ (multiple-value-bind (count errno)
+ (sb!unix:unix-write (fd-stream-fd stream) (buffer-sap obuf)
+ head length)
+ (flet ((queue-or-wait ()
+ (if (fd-stream-serve-events stream)
+ (return (%queue-and-replace-output-buffer stream))
+ (or (wait-until-fd-usable (fd-stream-fd stream) :output
+ (fd-stream-timeout stream)
+ nil)
+ (signal-timeout 'io-timeout
+ :stream stream
+ :direction :output
+ :seconds (fd-stream-timeout stream))))))
+ (cond ((eql count length)
+ ;; Complete write -- we can use the same buffer.
+ (return (reset-buffer obuf)))
+ (count
+ ;; Partial write -- update buffer status and
+ ;; queue or wait.
+ (incf head count)
+ (setf (buffer-head obuf) head)
+ (queue-or-wait))
+ #!-win32
+ ((eql errno sb!unix:ewouldblock)
+ ;; Blocking, queue or wair.
+ (queue-or-wait))
+ (t
+ (simple-stream-perror "Couldn't write to ~s"
+ stream errno)))))))))))))