From 7373cfa4b0603ade14795c35a0b9352a3b4de88f Mon Sep 17 00:00:00 2001
From: Stas Boukarev <stassats@gmail.com>
Date: Sat, 5 Oct 2013 23:21:52 +0400
Subject: [PATCH] More compact code for flushing buffers on SBCL.

---
 io-sbcl-strings.lisp |  7 ++++---
 io-sbcl.lisp         | 17 +++++++++++------
 2 files changed, 15 insertions(+), 9 deletions(-)

diff --git a/io-sbcl-strings.lisp b/io-sbcl-strings.lisp
index 4d973d7..e0cdd9f 100644
--- a/io-sbcl-strings.lisp
+++ b/io-sbcl-strings.lisp
@@ -52,17 +52,18 @@
                           new-position))
                    (t
                     (flush-output-buffer stream
+                                         0
                                          (truly-the
                                           buffer-length
                                           (- new-position
                                              (output-stream-buffer-start
-                                              stream))))
-                    (setf (output-stream-buffer-position stream)
-                          (output-stream-buffer-start stream))))))))
+                                              stream))))))))))
   string)
 
 ;;; reading
 
+(declaim (ftype (function * (values * &optional))
+                 read-string-boundary))
 (defun read-string-boundary (length string stream
                              buffer-char-size memory-char-size)
   (declare (simple-string string)
diff --git a/io-sbcl.lisp b/io-sbcl.lisp
index e982866..ce63d2d 100644
--- a/io-sbcl.lisp
+++ b/io-sbcl.lisp
@@ -12,6 +12,10 @@
 
 (deftype word () 'sb-vm:word)
 
+(declaim (ftype (function * (values * &optional))
+                fill-input-buffer refill-input-buffer
+                flush-output-buffer))
+
 ;;; sap wrappers
 
 (defmacro define-sap-ref-wrapper (bits &key name signed)
@@ -172,7 +176,7 @@
    (input-stream-buffer-start stream)))
 
 (defun close-output-stream (stream)
-  (flush-output-buffer stream)
+  (flush-output-buffer stream 0)
   (sb-alien:alien-funcall
    (sb-alien:extern-alien "free"
                           (function (values) sb-alien:unsigned-long))
@@ -271,12 +275,15 @@
   (setf (n-signed-mem-ref n (advance-output-stream n stream)) value)
   t)
 
-(defun flush-output-buffer (stream &optional count)
+(defun flush-output-buffer (stream n &optional count)
   (unix-write (output-stream-fd stream)
               (output-stream-buffer-start stream)
               (or count
                   (- (output-stream-buffer-position stream)
-                     (output-stream-buffer-start stream)))))
+                     (output-stream-buffer-start stream))))
+  (setf (output-stream-buffer-position stream)
+        (truly-the word (+ n (output-stream-buffer-start stream))))
+  t)
 
 (declaim (inline advance-output-stream))
 (defun advance-output-stream (n stream)
@@ -287,9 +294,7 @@
          (new-sap (truly-the word (+ sap n))))
     (declare (word sap new-sap))
     (cond ((> new-sap (output-stream-buffer-end stream))
-           (flush-output-buffer stream)
-           (setf (output-stream-buffer-position stream)
-                 (truly-the word (+ n (output-stream-buffer-start stream))))
+           (flush-output-buffer stream n)
            (output-stream-buffer-start stream))
           (t
            (setf (output-stream-buffer-position stream)