X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86%2Farith.lisp;h=33cf26a407a1a28b2d29dfcaadd8689f89d97daf;hb=c3699db2053ff3b5ac6a98d4431c3789496002d8;hp=39377cdf49d903439b8bf3e38332c6452063328e;hpb=57e21c4b62e8c1a1ee7ef59ed2abb0c864fb06bc;p=sbcl.git

diff --git a/src/compiler/x86/arith.lisp b/src/compiler/x86/arith.lisp
index 39377cd..33cf26a 100644
--- a/src/compiler/x86/arith.lisp
+++ b/src/compiler/x86/arith.lisp
@@ -1,4 +1,4 @@
-;;;; the VM definition arithmetic VOPs for the x86
+;;;; the VM definition of arithmetic VOPs for the x86
 
 ;;;; This software is part of the SBCL system. See the README file for
 ;;;; more information.
@@ -184,7 +184,6 @@
   (define-binop logior 2 or)
   (define-binop logxor 2 xor))
 
-
 ;;; Special handling of add on the x86; can use lea to avoid a
 ;;; register load, otherwise it uses add.
 (define-vop (fast-+/fixnum=>fixnum fast-safe-arith-op)
@@ -684,11 +683,17 @@
 	   (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 (if (sc-is result unsigned-reg)
+                        (inst xor result result)
+                        (inst mov result 0))))))))
+
+(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)
@@ -709,7 +714,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)
@@ -1143,6 +1148,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)
@@ -1170,25 +1184,42 @@
 (define-vop (fast-logxor-mod32-c/unsigned=>unsigned
              fast-logxor-c/unsigned=>unsigned)
   (:translate logxor-mod32))
+
+(define-source-transform logeqv (&rest args)
+  (if (oddp (length args))
+      `(logxor ,@args)
+      `(lognot (logxor ,@args))))
+(define-source-transform logandc1 (x y)
+  `(logand (lognot ,x) ,y))
+(define-source-transform logandc2 (x y)
+  `(logand ,x (lognot ,y)))
+(define-source-transform logorc1 (x y)
+  `(logior (lognot ,x) ,y))
+(define-source-transform logorc2 (x y)
+  `(logior ,x (lognot ,y)))
+(define-source-transform lognor (x y)
+  `(lognot (logior ,x ,y)))
+(define-source-transform lognand (x y)
+  `(lognot (logand ,x ,y)))
 
 ;;;; bignum stuff
 
 (define-vop (bignum-length get-header-data)
-  (:translate sb!bignum::%bignum-length)
+  (:translate sb!bignum:%bignum-length)
   (:policy :fast-safe))
 
 (define-vop (bignum-set-length set-header-data)
-  (:translate sb!bignum::%bignum-set-length)
+  (:translate sb!bignum:%bignum-set-length)
   (:policy :fast-safe))
 
 (define-full-reffer bignum-ref * bignum-digits-offset other-pointer-lowtag
-  (unsigned-reg) unsigned-num sb!bignum::%bignum-ref)
+  (unsigned-reg) unsigned-num sb!bignum:%bignum-ref)
 
 (define-full-setter bignum-set * bignum-digits-offset other-pointer-lowtag
-  (unsigned-reg) unsigned-num sb!bignum::%bignum-set)
+  (unsigned-reg) unsigned-num sb!bignum:%bignum-set)
 
 (define-vop (digit-0-or-plus)
-  (:translate sb!bignum::%digit-0-or-plusp)
+  (:translate sb!bignum:%digit-0-or-plusp)
   (:policy :fast-safe)
   (:args (digit :scs (unsigned-reg)))
   (:arg-types unsigned-num)
@@ -1204,7 +1235,7 @@
 ;;; 4. This is easy to deal with and may save a fixnum-word
 ;;; conversion.
 (define-vop (add-w/carry)
-  (:translate sb!bignum::%add-with-carry)
+  (:translate sb!bignum:%add-with-carry)
   (:policy :fast-safe)
   (:args (a :scs (unsigned-reg) :target result)
 	 (b :scs (unsigned-reg unsigned-stack) :to :eval)
@@ -1225,7 +1256,7 @@
 ;;; Note: the borrow is the oppostite of the x86 convention - 1 for no
 ;;; borrow and 0 for a borrow.
 (define-vop (sub-w/borrow)
-  (:translate sb!bignum::%subtract-with-borrow)
+  (:translate sb!bignum:%subtract-with-borrow)
   (:policy :fast-safe)
   (:args (a :scs (unsigned-reg) :to :eval :target result)
 	 (b :scs (unsigned-reg unsigned-stack) :to :result)
@@ -1244,7 +1275,7 @@
 
 
 (define-vop (bignum-mult-and-add-3-arg)
-  (:translate sb!bignum::%multiply-and-add)
+  (:translate sb!bignum:%multiply-and-add)
   (:policy :fast-safe)
   (:args (x :scs (unsigned-reg) :target eax)
 	 (y :scs (unsigned-reg unsigned-stack))
@@ -1266,7 +1297,7 @@
     (move lo eax)))
 
 (define-vop (bignum-mult-and-add-4-arg)
-  (:translate sb!bignum::%multiply-and-add)
+  (:translate sb!bignum:%multiply-and-add)
   (:policy :fast-safe)
   (:args (x :scs (unsigned-reg) :target eax)
 	 (y :scs (unsigned-reg unsigned-stack))
@@ -1292,7 +1323,7 @@
 
 
 (define-vop (bignum-mult)
-  (:translate sb!bignum::%multiply)
+  (:translate sb!bignum:%multiply)
   (:policy :fast-safe)
   (:args (x :scs (unsigned-reg) :target eax)
 	 (y :scs (unsigned-reg unsigned-stack)))
@@ -1311,10 +1342,10 @@
     (move lo eax)))
 
 (define-vop (bignum-lognot lognot-mod32/unsigned=>unsigned)
-  (:translate sb!bignum::%lognot))
+  (:translate sb!bignum:%lognot))
 
 (define-vop (fixnum-to-digit)
-  (:translate sb!bignum::%fixnum-to-digit)
+  (:translate sb!bignum:%fixnum-to-digit)
   (:policy :fast-safe)
   (:args (fixnum :scs (any-reg control-stack) :target digit))
   (:arg-types tagged-num)
@@ -1328,7 +1359,7 @@
     (inst sar digit 2)))
 
 (define-vop (bignum-floor)
-  (:translate sb!bignum::%floor)
+  (:translate sb!bignum:%floor)
   (:policy :fast-safe)
   (:args (div-high :scs (unsigned-reg) :target edx)
 	 (div-low :scs (unsigned-reg) :target eax)
@@ -1349,7 +1380,7 @@
     (move rem edx)))
 
 (define-vop (signify-digit)
-  (:translate sb!bignum::%fixnum-digit-with-correct-sign)
+  (:translate sb!bignum:%fixnum-digit-with-correct-sign)
   (:policy :fast-safe)
   (:args (digit :scs (unsigned-reg unsigned-stack) :target res))
   (:arg-types unsigned-num)
@@ -1364,7 +1395,7 @@
       (inst shl res 2))))
 
 (define-vop (digit-ashr)
-  (:translate sb!bignum::%ashr)
+  (:translate sb!bignum:%ashr)
   (:policy :fast-safe)
   (:args (digit :scs (unsigned-reg unsigned-stack) :target result)
 	 (count :scs (unsigned-reg) :target ecx))
@@ -1380,14 +1411,14 @@
     (inst sar result :cl)))
 
 (define-vop (digit-lshr digit-ashr)
-  (:translate sb!bignum::%digit-logical-shift-right)
+  (:translate sb!bignum:%digit-logical-shift-right)
   (:generator 1
     (move result digit)
     (move ecx count)
     (inst shr result :cl)))
 
 (define-vop (digit-ashl digit-ashr)
-  (:translate sb!bignum::%ashl)
+  (:translate sb!bignum:%ashl)
   (:generator 1
     (move result digit)
     (move ecx count)
@@ -1561,7 +1592,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))
@@ -1569,14 +1600,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))))))
@@ -1586,7 +1617,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))
@@ -1602,14 +1633,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))))