From d4e3d480732ff18fd53b4d772fd32e941adb7551 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Mon, 18 Aug 2003 11:30:17 +0000 Subject: [PATCH] 0.8.2.41: Slightly alleviate the bit-vector user's surprise ("mummy, why does initializing a bit-vector's elements to 1 take so long?") ... DEFTRANSFORM FILL for the easy case. --- src/compiler/generic/vm-tran.lisp | 32 ++++++++++++++++++++++++++++++++ version.lisp-expr | 2 +- 2 files changed, 33 insertions(+), 1 deletion(-) diff --git a/src/compiler/generic/vm-tran.lisp b/src/compiler/generic/vm-tran.lisp index bc21fbe..3f17ce6 100644 --- a/src/compiler/generic/vm-tran.lisp +++ b/src/compiler/generic/vm-tran.lisp @@ -340,6 +340,38 @@ (declare (type (unsigned-byte 32) numx numy)) (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) + (if (= (continuation-value item) 0) + 0 + #.(1- (ash 1 32))) + `(if (= item 0) 0 #.(1- (ash 1 32)))))) + `(let ((length (length sequence)) + (value ,value)) + (if (= length 0) + sequence + (do ((index sb!vm:vector-data-offset (1+ index)) + (end-1 (+ sb!vm:vector-data-offset + ;; bit-vectors of length 1-32 need precisely + ;; one (SETF %RAW-BITS), done here in the + ;; epilogue. - CSR, 2002-04-24 + (truncate (truly-the index (1- length)) + sb!vm:n-word-bits)))) + ((= index end-1) + (setf (%raw-bits sequence index) value) + sequence) + (declare (optimize (speed 3) (safety 0)) + (type index index end-1)) + (setf (%raw-bits sequence index) value)))))) ;;;; %BYTE-BLT diff --git a/version.lisp-expr b/version.lisp-expr index a8a0220..6ebf795 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.2.40" +"0.8.2.41" -- 1.7.10.4