X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86%2Farith.lisp;h=36b869d71e2bcfd0a114f4c51ad413c651c3ca52;hb=d131dfb49a3e6522d2358d14252f3f52cfcd202a;hp=38c3d9c27cd2280fa12c4a4bb42ab1a3346bc7f3;hpb=bf6ceefcdda0bed3f4fb2964176a4149e11b0b10;p=sbcl.git

diff --git a/src/compiler/x86/arith.lisp b/src/compiler/x86/arith.lisp
index 38c3d9c..36b869d 100644
--- a/src/compiler/x86/arith.lisp
+++ b/src/compiler/x86/arith.lisp
@@ -683,11 +683,15 @@
 	   (inst lea result (make-ea :dword :index number :scale 8)))
 	  (t
 	   (move result number)
-	   (cond ((plusp amount) (inst shl result amount))
-		 ((< amount -31) (inst xor result result))
-		 (t (inst shr result (- amount))))))))
-
-(define-vop (fast-ash-left/signed)
+	   (cond ((< -32 amount 32)
+                  ;; this code is used both in ASH and ASH-MOD32, so
+                  ;; be careful
+                  (if (plusp amount)
+                      (inst shl result amount)
+                      (inst shr result (- amount))))
+		 (t (inst xor result result)))))))
+
+(define-vop (fast-ash-left/signed=>signed)
   (:translate ash)
   (:args (number :scs (signed-reg) :target result
 		 :load-if (not (and (sc-is number signed-stack)
@@ -708,7 +712,7 @@
     (move ecx amount)
     (inst shl result :cl)))
 
-(define-vop (fast-ash-left/unsigned)
+(define-vop (fast-ash-left/unsigned=>unsigned)
   (:translate ash)
   (:args (number :scs (unsigned-reg) :target result
 		 :load-if (not (and (sc-is number unsigned-stack)
@@ -1142,6 +1146,15 @@
   (:translate +-mod32))
 (define-vop (fast-+-mod32-c/unsigned=>unsigned fast-+-c/unsigned=>unsigned)
   (:translate +-mod32))
+(define-modular-fun --mod32 (x y) - 32)
+(define-vop (fast---mod32/unsigned=>unsigned fast--/unsigned=>unsigned)
+  (:translate --mod32))
+(define-vop (fast---mod32-c/unsigned=>unsigned fast---c/unsigned=>unsigned)
+  (:translate --mod32))
+
+(define-vop (fast-ash-left-mod32-c/unsigned=>unsigned
+             fast-ash-c/unsigned=>unsigned)
+  (:translate ash-left-mod32))
 
 ;;; logical operations
 (define-modular-fun lognot-mod32 (x) lognot 32)
@@ -1498,12 +1511,12 @@
   (foldable flushable))
 
 (defoptimizer (%lea derive-type) ((base index scale disp))
-  (when (and (constant-continuation-p scale)
-	     (constant-continuation-p disp))
-    (let ((scale (continuation-value scale))
-	  (disp (continuation-value disp))
-	  (base-type (continuation-type base))
-	  (index-type (continuation-type index)))
+  (when (and (constant-lvar-p scale)
+	     (constant-lvar-p disp))
+    (let ((scale (lvar-value scale))
+	  (disp (lvar-value disp))
+	  (base-type (lvar-type base))
+	  (index-type (lvar-type index)))
       (when (and (numeric-type-p base-type)
 		 (numeric-type-p index-type))
 	(let ((base-lo (numeric-type-low base-type))
@@ -1577,7 +1590,7 @@
     (0
      (let ((tmp (min 3 (aref condensed 1))))
        (decf (aref condensed 1) tmp)
-       `(truly-the (unsigned-byte 32)
+       `(logand #xffffffff
 	 (%lea ,arg
 	       ,(decompose-multiplication
 		 arg (ash (1- num) (- tmp)) (1- n-bits) (subseq condensed 1))
@@ -1585,14 +1598,14 @@
     ((1 2 3)
      (let ((r0 (aref condensed 0)))
        (incf (aref condensed 1) r0)
-       `(truly-the (unsigned-byte 32)
+       `(logand #xffffffff
 	 (%lea ,(decompose-multiplication
 		 arg (- num (ash 1 r0)) (1- n-bits) (subseq condensed 1))
 	       ,arg
 	       ,(ash 1 r0) 0))))
     (t (let ((r0 (aref condensed 0)))
 	 (setf (aref condensed 0) 0)
-	 `(truly-the (unsigned-byte 32)
+	 `(logand #xffffffff
 	   (ash ,(decompose-multiplication
 		  arg (ash num (- r0)) n-bits condensed)
 	        ,r0))))))
@@ -1602,7 +1615,7 @@
     ((= n-bits 0) 0)
     ((= num 1) arg)
     ((= n-bits 1)
-     `(truly-the (unsigned-byte 32) (ash ,arg ,(1- (integer-length num)))))
+     `(logand #xffffffff (ash ,arg ,(1- (integer-length num)))))
     ((let ((max 0) (end 0))
        (loop for i from 2 to (length condensed)
 	     for j = (reduce #'+ (subseq condensed 0 i))
@@ -1618,14 +1631,14 @@
 	   (let ((n2 (+ (ash 1 (1+ j))
 			(ash (ldb (byte (- 32 (1+ j)) (1+ j)) num) (1+ j))))
 		 (n1 (1+ (ldb (byte (1+ j) 0) (lognot num)))))
-	   `(truly-the (unsigned-byte 32)
+	   `(logand #xffffffff
 	     (- ,(optimize-multiply arg n2) ,(optimize-multiply arg n1))))))))
     ((dolist (i '(9 5 3))
        (when (integerp (/ num i))
 	 (when (< (logcount (/ num i)) (logcount num))
 	   (let ((x (gensym)))
 	     (return `(let ((,x ,(optimize-multiply arg (/ num i))))
-		       (truly-the (unsigned-byte 32)
+		       (logand #xffffffff
 			(%lea ,x ,x (1- ,i) 0)))))))))
     (t (basic-decompose-multiplication arg num n-bits condensed))))
 	   
@@ -1645,7 +1658,7 @@
 		 ((unsigned-byte 32) (constant-arg (unsigned-byte 32)))
 		 (unsigned-byte 32))
   "recode as leas, shifts and adds"
-  (let ((y (continuation-value y)))
+  (let ((y (lvar-value y)))
     (cond
       ((= y (ash 1 (integer-length y)))
        ;; there's a generic transform for y = 2^k