0.8.14.5: Join the foreign legion!

[sbcl.git] / src / compiler / generic / vm-tran.lisp

diff --git a/src/compiler/generic/vm-tran.lisp b/src/compiler/generic/vm-tran.lisp
index 47d2d8b..5be78b7 100644 (file)
--- a/src/compiler/generic/vm-tran.lisp
+++ b/src/compiler/generic/vm-tran.lisp
@@ -329,7 +329,7 @@
                                     (:big-endian
                                      '(- sb!vm:n-word-bits extra))))
                             (%raw-bits y i))))
-                     (declare (type (integer 0 #.(1- sb!vm:n-word-bits))
+                     (declare (type (mod #.sb!vm:n-word-bits)
                                      extra)
                               (type sb!vm:word mask numx numy))
                      (= numx numy)))
@@ -340,7 +340,7 @@
                  (unless (= numx numy)
                    (return nil))))))))
 
-(deftransform count ((sequence item) (simple-bit-vector bit) *
+(deftransform count ((item sequence) (bit simple-bit-vector) *
                      :policy (>= speed space))
   `(let ((length (length sequence)))
     (if (zerop length)
@@ -359,7 +359,7 @@
                                               (:big-endian
                                                '(- sb!vm:n-word-bits extra))))
                                  (%raw-bits sequence index))))
-               (declare (type (mod #.(1- sb!vm:n-word-bits)) extra))
+               (declare (type (mod #.sb!vm:n-word-bits) extra))
                (declare (type sb!vm:word mask bits))
                ;; could consider LOGNOT for the zero case instead of
                ;; doing the subtraction...
@@ -411,10 +411,10 @@
                   (let* ((char (lvar-value item))
                          (code (sb!xc:char-code char))
                           (accum 0))
-                     (dotimes (i sb!vm:n-word-bytes)
+                     (dotimes (i sb!vm:n-word-bytes accum)
                        (setf accum (logior accum (ash code (* 8 i))))))
                   `(let ((code (sb!xc:char-code item)))
-                     (logior ,@(loop for i from 0 upto sb!vm:n-word-bytes
+                     (logior ,@(loop for i from 0 below sb!vm:n-word-bytes
                                      collect `(ash code ,(* 8 i))))))))
     `(let ((length (length sequence))
           (value ,value))
@@ -490,17 +490,23 @@
     ((def (name width)
         `(progn
            (defknown ,name (integer (integer 0)) (unsigned-byte ,width)
-                     (foldable flushable movable))
+                     (foldable flushable movable))        
            (define-modular-fun-optimizer ash ((integer count) :width width)
              (when (and (<= width ,width)
-                        (constant-lvar-p count) ;?
-                        (plusp (lvar-value count)))
+                        (or (and (constant-lvar-p count)
+                                 (plusp (lvar-value count)))
+                            (csubtypep (lvar-type count)
+                                       (specifier-type '(and unsigned-byte
+                                                         fixnum)))))
                (cut-to-width integer width)
                ',name))
            (setf (gethash ',name *modular-versions*) `(ash ,',width)))))
-  #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or))
+  ;; This should really be dependent on SB!VM:N-WORD-BITS, but since we
+  ;; don't have a true Alpha64 port yet, we'll have to stick to
+  ;; SB!VM:N-MACHINE-WORD-BITS for the time being.  --njf, 2004-08-14
+  #!+#.(cl:if (cl:= 32 sb!vm:n-machine-word-bits) '(and) '(or))
   (def sb!vm::ash-left-mod32 32)
-  #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
+  #!+#.(cl:if (cl:= 64 sb!vm:n-machine-word-bits) '(and) '(or))
   (def sb!vm::ash-left-mod64 64))
 
 \f