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

diff --git a/src/compiler/generic/vm-tran.lisp b/src/compiler/generic/vm-tran.lisp
index aa21616..5be78b7 100644
--- a/src/compiler/generic/vm-tran.lisp
+++ b/src/compiler/generic/vm-tran.lisp
@@ -359,7 +359,7 @@
 					       (:big-endian
 						'(- sb!vm:n-word-bits extra))))
 				  (%raw-bits sequence index))))
-               (declare (type (mod #.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...
@@ -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))