0.8.3.27:

	Promising a vectorizing Lisp compiler since, oh, 2001...
	... hand-vectorize FILL on simple-base-strings.

diff --git a/NEWS b/NEWS
index 9e14331..927c90d 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -2022,6 +2022,8 @@ changes in sbcl-0.8.4 relative to sbcl-0.8.3:
   * optimization: compiler-internal data structure use has been
     reviewed, and changes have been made that should improve the
     performance of the compiler by about 20%.
+  * optimization: performance of FILL (and :INITIAL-ELEMENT) on
+    simple-base-strings and simple-bit-vectors is improved.
   * microoptimization: the compiler is better able to make use of the
     x86 LEA instruction for multiplication by constants.
   * bug fix: in some situations compiler did not report usage of

diff --git a/src/compiler/generic/vm-tran.lisp b/src/compiler/generic/vm-tran.lisp
index 3f17ce6..f6b32a1 100644 (file)
--- a/src/compiler/generic/vm-tran.lisp
+++ b/src/compiler/generic/vm-tran.lisp
@@ -341,13 +341,6 @@
                  (unless (= numx numy)
                    (return nil))))))))
 
-;;; FIXME: it is probably worth doing something like this for
-;;; SIMPLE-BASE-STRINGs too, if only so that (MAKE-STRING 100000
-;;; :INITIAL-ELEMENT #\Space) doesn't surprise the user with its
-;;; performance characteristics.  Getting it right is harder than with
-;;; bit-vectors, though, as one needs to be more careful with the loop
-;;; epilogue so as not to overwrite the convenient extra null byte
-;;; (for SB-ALIEN/C termination convention convenience).
 (deftransform fill ((sequence item) (simple-bit-vector bit) *
                    :policy (>= speed space))
   (let ((value (if (constant-continuation-p item)
@@ -372,6 +365,30 @@
             (declare (optimize (speed 3) (safety 0))
                      (type index index end-1))
             (setf (%raw-bits sequence index) value))))))
+
+(deftransform fill ((sequence item) (simple-base-string base-char) *
+                   :policy (>= speed space))
+  (let ((value (if (constant-continuation-p item)
+                  (let* ((char (continuation-value item))
+                         (code (sb!xc:char-code char)))
+                    (logior code (ash code 8) (ash code 16) (ash code 24)))
+                  `(let ((code (sb!xc:char-code item)))
+                    (logior code (ash code 8) (ash code 16) (ash code 24))))))
+    `(let ((length (length sequence))
+          (value ,value))
+      (multiple-value-bind (times rem)
+         (truncate length 4)
+       (do ((index sb!vm:vector-data-offset (1+ index))
+            (end (+ times sb!vm:vector-data-offset)))
+           ((= index end)
+            (let ((place (* times 4)))
+              (declare (fixnum place))
+              (dotimes (j rem)
+                (declare (index j))
+                (setf (schar sequence (the index (+ place j))) item))))
+         (declare (optimize (speed 3) (safety 0))
+                  (type index index))
+         (setf (%raw-bits sequence index) value))))))
 \f
 ;;;; %BYTE-BLT
 

diff --git a/version.lisp-expr b/version.lisp-expr
index b535fb3..a56b81e 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.8.3.26"
+"0.8.3.27"