0.9.6.8:

	More optimizations to OUTPUT-BYTES/FOO.

        * Rearrange the guts of the function to allow establishing the
          OUTPUT-NOTHING catch tag outside the inner loop.
	* Bounds check STRING once at the start of the function instead of
          once every iteration.
        * Declare some types.

diff --git a/NEWS b/NEWS
index 027bc54..a591e7b 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -1,6 +1,7 @@
 ;;;; -*- coding: utf-8; -*-
 changes in sbcl-0.9.7 relative to sbcl-0.9.6:
-  * optimization: performance improvements to READ-LINE
+  * optimization: performance improvements to IO on file streams of
+    :ELEMENT-TYPE CHARACTER
 
 changes in sbcl-0.9.6 relative to sbcl-0.9.5:
   * bug fix: add a workaround to SBCL looping infinitely at startup on

diff --git a/src/code/fd-stream.lisp b/src/code/fd-stream.lisp
index 3d6cb0f..8b54799 100644 (file)
--- a/src/code/fd-stream.lisp
+++ b/src/code/fd-stream.lisp
@@ -999,27 +999,34 @@
                      (> (fd-stream-ibuf-tail stream)
                         (fd-stream-ibuf-head stream)))
             (file-position stream (file-position stream)))
-          (when (< end start)
-            (error ":END before :START!"))
+          (unless (<= 0 start end (length string))
+            (signal-bounding-indices-bad-error string start end))
           (do ()
               ((= end start))
             (setf (fd-stream-obuf-tail stream)
                   (flet ((do-it (string)
-                           (do* ((len (fd-stream-obuf-length stream))
+                           (let ((len (fd-stream-obuf-length stream))
                                  (sap (fd-stream-obuf-sap stream))
                                  (tail (fd-stream-obuf-tail stream)))
-                                ((or (= start end) (< (- len tail) 4)) tail)
-                             ,(if output-restart
-                                  `(catch 'output-nothing
+                             (declare (type index tail)
+                                      ;; STRING bounds have already been checked.
+                                      (optimize (safety 0)))
+                             (loop
+                                (,@(if output-restart
+                                       `(catch 'output-nothing)
+                                       `(progn))
+                                   (do* ()
+                                        ((or (= start end) (< (- len tail) 4)))
                                      (let* ((byte (aref string start))
                                             (bits (char-code byte)))
                                        ,out-expr
-                                       (incf tail ,size)))
-                                  `(let* ((byte (aref string start))
-                                          (bits (char-code byte)))
-                                     ,out-expr
-                                     (incf tail ,size)))
-                             (incf start))))
+                                       (incf tail ,size)
+                                       (incf start)))
+                                   ;; Exited from the loop normally
+                                   (return-from do-it tail))
+                                ;; Exited via CATCH. Skip the current character
+                                ;; and try the inner loop again.
+                                (incf start)))))
                     (declare (inline do-it))
                     ;; Specialized versions for the common cases of
                     ;; SIMPLE-BASE-STRING and (SIMPLE-ARRAY CHARACTER)
@@ -1119,29 +1126,35 @@
                      (> (fd-stream-ibuf-tail stream)
                         (fd-stream-ibuf-head stream)))
             (file-position stream (file-position stream)))
-          (when (< end start)
-            (error ":END before :START!"))
+          (unless (<= 0 start end (length string))
+            (signal-bounding-indices-bad-error string start end))
           (do ()
               ((= end start))
             (setf (fd-stream-obuf-tail stream)
                   (flet ((do-it (string)
-                           (do* ((len (fd-stream-obuf-length stream))
+                           (let ((len (fd-stream-obuf-length stream))
                                  (sap (fd-stream-obuf-sap stream))
                                  (tail (fd-stream-obuf-tail stream)))
-                                ((or (= start end) (< (- len tail) 4)) tail)
-                             ,(if output-restart
-                                  `(catch 'output-nothing
+                             (declare (type index tail)
+                                      ;; STRING bounds have already been checked.
+                                      (optimize (safety 0)))
+                             (loop
+                                (,@(if output-restart
+                                       `(catch 'output-nothing)
+                                       `(progn))
+                                   (do* ()
+                                        ((or (= start end) (< (- len tail) 4)))
                                      (let* ((byte (aref string start))
                                             (bits (char-code byte))
                                             (size ,out-size-expr))
                                        ,out-expr
-                                       (incf tail size)))
-                                  `(let* ((byte (aref string start))
-                                          (bits (char-code byte))
-                                          (size ,out-size-expr))
-                                     ,out-expr
-                                     (incf tail size)))
-                             (incf start))))
+                                       (incf tail size)
+                                       (incf start)))
+                                   ;; Exited from the loop normally
+                                   (return-from do-it tail))
+                                ;; Exited via CATCH. Skip the current character
+                                ;; and try the inner loop again.
+                                (incf start)))))
                     (declare (inline do-it))
                     ;; Specialized versions for the common cases of
                     ;; SIMPLE-BASE-STRING and (SIMPLE-ARRAY CHARACTER)

diff --git a/version.lisp-expr b/version.lisp-expr
index 6ee9836..e5fb9fc 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.9.6.7"
+"0.9.6.8"