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 5a1fa68..5be78b7 100644 (file)
--- a/src/compiler/generic/vm-tran.lisp
+++ b/src/compiler/generic/vm-tran.lisp
@@ -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