X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fgeneric%2Fvm-tran.lisp;h=5be78b7d913eec00a1f1e3b4ca71062c6f512161;hb=75b52379bdc2269961af6a1308eca63610f38ac3;hp=47d2d8b8f5f3356affc6f273ea8dab23f8da8d8e;hpb=e4937e886890f3fcef391650a494f75cfc46c528;p=sbcl.git

diff --git a/src/compiler/generic/vm-tran.lisp b/src/compiler/generic/vm-tran.lisp
index 47d2d8b..5be78b7 100644
--- 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))