From: Christophe Rhodes <csr21@cam.ac.uk>
Date: Tue, 2 Sep 2003 12:33:23 +0000 (+0000)
Subject: 0.8.3.27:
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=a38728b21911d4f8d458dd3419dbf62dee44c89e;p=sbcl.git

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
--- 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
--- 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))))))
 
 ;;;; %BYTE-BLT
 
diff --git a/version.lisp-expr b/version.lisp-expr
index b535fb3..a56b81e 100644
--- 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"