[Openmcl-cvs-notifications] r14833 - /trunk/source/level-1/l1-streams.lisp

[gb at clozure.com]

Author: gb
Date: Tue Jun 21 04:17:23 2011
New Revision: 14833

Log:
Writing octet sequences to vector output streams grows the buffer, so
account for that in %IOBLOCK-BINARY-STREAM-WRITE-VECTOR.

Fixes ticket:870 in the trunk.

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

Modified: trunk/source/level-1/l1-streams.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-streams.lisp (original)
+++ trunk/source/level-1/l1-streams.lisp Tue Jun 21 04:17:23 2011
@@ -5229,13 +5229,12 @@
 ;;; matches the sequence's element-type isn't affected.
 (defun %ioblock-binary-stream-write-vector (ioblock vector start end)
   (declare (fixnum start end))
+  (declare (optimize (safety 3)))
   (let* ((out (ioblock-outbuf ioblock))
-         (buf (io-buffer-buffer out))
          (written 0)
-         (limit (io-buffer-limit out))
          (total (- end start))
-         (buftype (typecode buf)))
-    (declare (fixnum buftype written total limit))
+         (buftype (typecode (io-buffer-buffer out))))
+    (declare (fixnum buftype written total))
     (if (not (=3D (the fixnum (typecode vector)) buftype))
       (if (typep vector 'string)
         (funcall (ioblock-write-simple-string-function ioblock)
@@ -5258,8 +5257,10 @@
         (setf (ioblock-dirty ioblock) t)
         (let* ((index (io-buffer-idx out))
                (count (io-buffer-count out))
+               (limit (io-buffer-limit out))
+               (buf (io-buffer-buffer out))
                (avail (- limit index)))
-          (declare (fixnum index avail count))
+          (declare (fixnum index avail count limit))
           (cond
             ((=3D (setq written avail) 0)
              (%ioblock-force-output ioblock nil))