X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fgeneric%2Fvm-tran.lisp;h=3f17ce6023117a60b487f793185fab5687d45fab;hb=174feb792c8082846666e1218c58d5b0ab3b85b0;hp=8e82df78e76ba52276a72de5d5fd6a5c79800a67;hpb=bbd27eabe09922504493f71d5dea5fc4f4069810;p=sbcl.git

diff --git a/src/compiler/generic/vm-tran.lisp b/src/compiler/generic/vm-tran.lisp
index 8e82df7..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
 
@@ -391,6 +423,7 @@
 
 
 ;;;; 32-bit operations
+#!-x86 ; on X86 it is a modular function
 (deftransform lognot ((x) ((unsigned-byte 32)) *
                       :node node
                       :result result)
@@ -408,3 +441,6 @@
     (setf (node-derived-type node)
           (values-specifier-type '(values (unsigned-byte 32) &optional)))
     '(32bit-logical-not x)))
+
+(define-good-modular-fun logand)
+(define-good-modular-fun logior)