X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Falpha%2Farith.lisp;h=c6c85520d7d42dd77714f8c8d12a48acae98c777;hb=f8893c7c658bf9d9e0757c63e47af2fdea810f04;hp=7f2a0bd87423c56bc91401bbe135d3b5fe7c38cb;hpb=dd357f3be290498fb7ef172696d986337f517a93;p=sbcl.git

diff --git a/src/compiler/alpha/arith.lisp b/src/compiler/alpha/arith.lisp
index 7f2a0bd..c6c8552 100644
--- a/src/compiler/alpha/arith.lisp
+++ b/src/compiler/alpha/arith.lisp
@@ -196,7 +196,7 @@
   (:translate ash)
   (:policy :fast-safe)
   (:temporary (:sc non-descriptor-reg) ndesc)
-  (:temporary (:sc non-descriptor-reg :to :eval) temp)
+  (:temporary (:sc non-descriptor-reg) temp)
   (:generator 3
     (inst bge amount positive)
     (inst subq zero-tn amount ndesc)
@@ -223,7 +223,7 @@
   (:translate ash)
   (:policy :fast-safe)
   (:temporary (:sc non-descriptor-reg) ndesc)
-  (:temporary (:sc non-descriptor-reg :to :eval) temp)
+  (:temporary (:sc non-descriptor-reg) temp)
   (:generator 3
     (inst bge amount positive)
     (inst subq zero-tn amount ndesc)
@@ -249,8 +249,8 @@
   (:result-types signed-num)
   (:generator 1
     (cond
-      ((< count 0) (inst sra number (- count) result))
-      ((> count 0) (inst sll number count result))
+      ((< count 0) (inst sra number (min 63 (- count)) result))
+      ((> count 0) (inst sll number (min 63 count) result))
       (t (bug "identity ASH not transformed away")))))
 
 (define-vop (fast-ash-c/unsigned=>unsigned)
@@ -266,7 +266,7 @@
     (cond
       ((< count -63) (move zero-tn result))
       ((< count 0) (inst sra number (- count) result))
-      ((> count 0) (inst sll number count result))
+      ((> count 0) (inst sll number (min 63 count) result))
       (t (bug "identity ASH not transformed away")))))
 
 (define-vop (signed-byte-64-len)
@@ -364,11 +364,15 @@
   (:generator 1
     (inst not x res)))
 
+(define-vop (fast-ash-left-mod64-c/unsigned=>unsigned
+	     fast-ash-c/unsigned=>unsigned)
+  (:translate ash-left-mod64))
+
 (macrolet
     ((define-modular-backend (fun &optional constantp)
        (let ((mfun-name (symbolicate fun '-mod64))
              (modvop (symbolicate 'fast- fun '-mod64/unsigned=>unsigned))
-             (modcvop (symbolicate 'fast- fun 'mod64-c/unsigned=>unsigned))
+             (modcvop (symbolicate 'fast- fun '-mod64-c/unsigned=>unsigned))
              (vop (symbolicate 'fast- fun '/unsigned=>unsigned))
              (cvop (symbolicate 'fast- fun '-c/unsigned=>unsigned)))
          `(progn
@@ -379,6 +383,7 @@
                 `((define-vop (,modcvop ,cvop)
                     (:translate ,mfun-name))))))))
   (define-modular-backend + t)
+  (define-modular-backend - t)
   (define-modular-backend logxor t)
   (define-modular-backend logeqv t)
   (define-modular-backend logandc1)