X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fmips%2Farith.lisp;h=70649f59628123f3dcd737035a0868abf82e68db;hb=3b7fca49cbf6c48605e7ebc1f57caa3255ca5cfd;hp=05a47b59999bef4ebe110bc3cf1179ba8cce37c7;hpb=4ae1b794a5d6a90794468cf8017f5307f2c30dfe;p=sbcl.git

diff --git a/src/compiler/mips/arith.lisp b/src/compiler/mips/arith.lisp
index 05a47b5..70649f5 100644
--- a/src/compiler/mips/arith.lisp
+++ b/src/compiler/mips/arith.lisp
@@ -1,24 +1,36 @@
-(in-package "SB!VM")
+;;;; the VM definition arithmetic VOPs for MIPS
 
+;;;; This software is part of the SBCL system. See the README file for
+;;;; more information.
+;;;;
+;;;; This software is derived from the CMU CL system, which was
+;;;; written at Carnegie Mellon University and released into the
+;;;; public domain. The software is in the public domain and is
+;;;; provided with absolutely no warranty. See the COPYING and CREDITS
+;;;; files for more information.
 
+(in-package "SB!VM")
 
 ;;;; Unary operations.
 
-(define-vop (fixnum-unop)
+(define-vop (fast-safe-arith-op)
+  (:policy :fast-safe)
+  (:effects)
+  (:affected))
+
+(define-vop (fixnum-unop fast-safe-arith-op)
   (:args (x :scs (any-reg)))
   (:results (res :scs (any-reg)))
   (:note "inline fixnum arithmetic")
   (:arg-types tagged-num)
-  (:result-types tagged-num)
-  (:policy :fast-safe))
+  (:result-types tagged-num))
 
-(define-vop (signed-unop)
+(define-vop (signed-unop fast-safe-arith-op)
   (:args (x :scs (signed-reg)))
   (:results (res :scs (signed-reg)))
   (:note "inline (signed-byte 32) arithmetic")
   (:arg-types signed-num)
-  (:result-types signed-num)
-  (:policy :fast-safe))
+  (:result-types signed-num))
 
 (define-vop (fast-negate/fixnum fixnum-unop)
   (:translate %negate)
@@ -32,55 +44,44 @@
 
 (define-vop (fast-lognot/fixnum fixnum-unop)
   (:temporary (:scs (any-reg) :type fixnum :to (:result 0))
-	      temp)
+              temp)
   (:translate lognot)
-  (:generator 2
+  (:generator 1
     (inst li temp (fixnumize -1))
     (inst xor res x temp)))
 
 (define-vop (fast-lognot/signed signed-unop)
   (:translate lognot)
-  (:generator 1
+  (:generator 2
     (inst nor res x zero-tn)))
-
-
 
 ;;;; Binary fixnum operations.
 
 ;;; Assume that any constant operand is the second arg...
 
-(define-vop (fast-fixnum-binop)
-  (:args (x :target r :scs (any-reg))
-	 (y :target r :scs (any-reg)))
+(define-vop (fast-fixnum-binop fast-safe-arith-op)
+  (:args (x :target r :scs (any-reg zero))
+         (y :target r :scs (any-reg zero)))
   (:arg-types tagged-num tagged-num)
   (:results (r :scs (any-reg)))
   (:result-types tagged-num)
-  (:note "inline fixnum arithmetic")
-  (:effects)
-  (:affected)
-  (:policy :fast-safe))
+  (:note "inline fixnum arithmetic"))
 
-(define-vop (fast-unsigned-binop)
-  (:args (x :target r :scs (unsigned-reg))
-	 (y :target r :scs (unsigned-reg)))
+(define-vop (fast-unsigned-binop fast-safe-arith-op)
+  (:args (x :target r :scs (unsigned-reg zero))
+         (y :target r :scs (unsigned-reg zero)))
   (:arg-types unsigned-num unsigned-num)
   (:results (r :scs (unsigned-reg)))
   (:result-types unsigned-num)
-  (:note "inline (unsigned-byte 32) arithmetic")
-  (:effects)
-  (:affected)
-  (:policy :fast-safe))
+  (:note "inline (unsigned-byte 32) arithmetic"))
 
-(define-vop (fast-signed-binop)
-  (:args (x :target r :scs (signed-reg))
-	 (y :target r :scs (signed-reg)))
+(define-vop (fast-signed-binop fast-safe-arith-op)
+  (:args (x :target r :scs (signed-reg zero))
+         (y :target r :scs (signed-reg zero)))
   (:arg-types signed-num signed-num)
   (:results (r :scs (signed-reg)))
   (:result-types signed-num)
-  (:note "inline (signed-byte 32) arithmetic")
-  (:effects)
-  (:affected)
-  (:policy :fast-safe))
+  (:note "inline (signed-byte 32) arithmetic"))
 
 (define-vop (fast-fixnum-c-binop fast-fixnum-binop)
   (:args (x :target r :scs (any-reg)))
@@ -98,60 +99,84 @@
   (:arg-types tagged-num (:constant integer)))
 
 (defmacro define-binop (translate cost untagged-cost op
-				  tagged-type untagged-type)
+                                  tagged-type untagged-type)
   `(progn
      (define-vop (,(symbolicate "FAST-" translate "/FIXNUM=>FIXNUM")
-		  fast-fixnum-binop)
+                  fast-fixnum-binop)
        (:args (x :target r :scs (any-reg))
-	      (y :target r :scs (any-reg)))
+              (y :target r :scs (any-reg)))
        (:translate ,translate)
        (:generator ,(1+ cost)
-	 (inst ,op r x y)))
+         (inst ,op r x y)))
      (define-vop (,(symbolicate "FAST-" translate "/SIGNED=>SIGNED")
-		  fast-signed-binop)
+                  fast-signed-binop)
        (:args (x :target r :scs (signed-reg))
-	      (y :target r :scs (signed-reg)))
+              (y :target r :scs (signed-reg)))
        (:translate ,translate)
        (:generator ,(1+ untagged-cost)
-	 (inst ,op r x y)))
+         (inst ,op r x y)))
      (define-vop (,(symbolicate "FAST-" translate "/UNSIGNED=>UNSIGNED")
-		  fast-unsigned-binop)
+                  fast-unsigned-binop)
        (:args (x :target r :scs (unsigned-reg))
-	      (y :target r :scs (unsigned-reg)))
+              (y :target r :scs (unsigned-reg)))
        (:translate ,translate)
        (:generator ,(1+ untagged-cost)
-	 (inst ,op r x y)))
+         (inst ,op r x y)))
      ,@(when tagged-type
-	 `((define-vop (,(symbolicate "FAST-" translate "-C/FIXNUM=>FIXNUM")
-			fast-fixnum-c-binop)
-		       (:arg-types tagged-num (:constant ,tagged-type))
-	     (:translate ,translate)
-	     (:generator ,cost
-			 (inst ,op r x (fixnumize y))))))
+         `((define-vop (,(symbolicate "FAST-" translate "-C/FIXNUM=>FIXNUM")
+                        fast-fixnum-c-binop)
+                       (:arg-types tagged-num (:constant ,tagged-type))
+             (:translate ,translate)
+             (:generator ,cost
+                         (inst ,op r x (fixnumize y))))))
      ,@(when untagged-type
-	 `((define-vop (,(symbolicate "FAST-" translate "-C/SIGNED=>SIGNED")
-			fast-signed-c-binop)
-		       (:arg-types signed-num (:constant ,untagged-type))
-	     (:translate ,translate)
-	     (:generator ,untagged-cost
-			 (inst ,op r x y)))
-	   (define-vop (,(symbolicate "FAST-" translate
-				      "-C/UNSIGNED=>UNSIGNED")
-			fast-unsigned-c-binop)
-		       (:arg-types unsigned-num (:constant ,untagged-type))
-	     (:translate ,translate)
-	     (:generator ,untagged-cost
-			 (inst ,op r x y)))))))
+         `((define-vop (,(symbolicate "FAST-" translate "-C/SIGNED=>SIGNED")
+                        fast-signed-c-binop)
+                       (:arg-types signed-num (:constant ,untagged-type))
+             (:translate ,translate)
+             (:generator ,untagged-cost
+                         (inst ,op r x y)))
+           (define-vop (,(symbolicate "FAST-" translate
+                                      "-C/UNSIGNED=>UNSIGNED")
+                        fast-unsigned-c-binop)
+                       (:arg-types unsigned-num (:constant ,untagged-type))
+             (:translate ,translate)
+             (:generator ,untagged-cost
+                         (inst ,op r x y)))))))
 
 (define-binop + 1 5 addu (signed-byte 14) (signed-byte 16))
 (define-binop - 1 5 subu
-  (integer #.(- (1- (ash 1 14))) #.(ash 1 14))
-  (integer #.(- (1- (ash 1 16))) #.(ash 1 16)))
+  (integer #.(- 1 (ash 1 13)) #.(ash 1 13))
+  (integer #.(- 1 (ash 1 15)) #.(ash 1 15)))
 (define-binop logior 1 3 or (unsigned-byte 14) (unsigned-byte 16))
-(define-binop lognor 1 3 nor nil nil)
 (define-binop logand 1 3 and (unsigned-byte 14) (unsigned-byte 16))
 (define-binop logxor 1 3 xor (unsigned-byte 14) (unsigned-byte 16))
 
+;;; No -C/ VOPs for LOGNOR because the NOR instruction doesn't take
+;;; immediate args.  -- CSR, 2003-09-11
+(define-vop (fast-lognor/fixnum=>fixnum fast-fixnum-binop)
+  (:translate lognor)
+  (:args (x :target r :scs (any-reg))
+         (y :target r :scs (any-reg)))
+  (:temporary (:sc non-descriptor-reg) temp)
+  (:generator 4
+    (inst nor temp x y)
+    (inst addu r temp (- fixnum-tag-mask))))
+
+(define-vop (fast-lognor/signed=>signed fast-signed-binop)
+  (:translate lognor)
+  (:args (x :target r :scs (signed-reg))
+         (y :target r :scs (signed-reg)))
+  (:generator 4
+    (inst nor r x y)))
+
+(define-vop (fast-lognor/unsigned=>unsigned fast-unsigned-binop)
+  (:translate lognor)
+  (:args (x :target r :scs (unsigned-reg))
+         (y :target r :scs (unsigned-reg)))
+  (:generator 4
+    (inst nor r x y)))
+
 ;;; Special case fixnum + and - that trap on overflow.  Useful when we don't
 ;;; know that the result is going to be a fixnum.
 #+nil
@@ -161,28 +186,28 @@
     (:result-types (:or signed-num unsigned-num))
     (:note nil)
     (:generator 4
-		(inst add r x y)))
+                (inst add r x y)))
 
   (define-vop (fast-+-c/fixnum fast-+-c/fixnum=>fixnum)
       (:results (r :scs (any-reg descriptor-reg)))
     (:result-types (:or signed-num unsigned-num))
     (:note nil)
     (:generator 3
-		(inst add r x (fixnumize y))))
+                (inst add r x (fixnumize y))))
 
   (define-vop (fast--/fixnum fast--/fixnum=>fixnum)
       (:results (r :scs (any-reg descriptor-reg)))
     (:result-types (:or signed-num unsigned-num))
     (:note nil)
     (:generator 4
-		(inst sub r x y)))
+                (inst sub r x y)))
 
   (define-vop (fast---c/fixnum fast---c/fixnum=>fixnum)
       (:results (r :scs (any-reg descriptor-reg)))
     (:result-types (:or signed-num unsigned-num))
     (:note nil)
     (:generator 3
-		(inst sub r x (fixnumize y))))
+                (inst sub r x (fixnumize y))))
 ) ; bogus trap-to-c-land +/-
 
 ;;; Shifting
@@ -190,7 +215,7 @@
 (define-vop (fast-ash/unsigned=>unsigned)
   (:note "inline ASH")
   (:args (number :scs (unsigned-reg) :to :save)
-	 (amount :scs (signed-reg)))
+         (amount :scs (signed-reg) :to :save))
   (:arg-types unsigned-num signed-num)
   (:results (result :scs (unsigned-reg)))
   (:result-types unsigned-num)
@@ -201,11 +226,11 @@
   (:generator 3
     (inst bgez amount positive)
     (inst subu ndesc zero-tn amount)
-    (inst slt temp ndesc 31)
-    (inst bne temp zero-tn done)
+    (inst slt temp ndesc 32)
+    (inst bne temp done)
     (inst srl result number ndesc)
     (inst b done)
-    (inst srl result number 31)
+    (move result zero-tn t)
 
     POSITIVE
     ;; The result-type assures us that this shift will not overflow.
@@ -216,7 +241,7 @@
 (define-vop (fast-ash/signed=>signed)
   (:note "inline ASH")
   (:args (number :scs (signed-reg) :to :save)
-	 (amount :scs (signed-reg)))
+         (amount :scs (signed-reg)))
   (:arg-types signed-num signed-num)
   (:results (result :scs (signed-reg)))
   (:result-types signed-num)
@@ -228,7 +253,7 @@
     (inst bgez amount positive)
     (inst subu ndesc zero-tn amount)
     (inst slt temp ndesc 31)
-    (inst bne temp zero-tn done)
+    (inst bne temp done)
     (inst sra result number ndesc)
     (inst b done)
     (inst sra result number 31)
@@ -250,15 +275,11 @@
   (:results (result :scs (unsigned-reg)))
   (:result-types unsigned-num)
   (:generator 1
-    (cond ((< count 0)
-	   ;; It is a right shift.
-	   (inst srl result number (min (- count) 31)))
-	  ((> count 0)
-	   ;; It is a left shift.
-	   (inst sll result number (min count 31)))
-	  (t
-	   ;; Count=0?  Shouldn't happen, but it's easy:
-	   (move result number)))))
+    (cond
+      ((< count -31) (move result zero-tn))
+      ((< count 0) (inst srl result number (min (- count) 31)))
+      ((> count 0) (inst sll result number (min count 31)))
+      (t (bug "identity ASH not transformed away")))))
 
 (define-vop (fast-ash-c/signed=>signed)
   (:policy :fast-safe)
@@ -270,15 +291,32 @@
   (:results (result :scs (signed-reg)))
   (:result-types signed-num)
   (:generator 1
-    (cond ((< count 0)
-	   ;; It is a right shift.
-	   (inst sra result number (min (- count) 31)))
-	  ((> count 0)
-	   ;; It is a left shift.
-	   (inst sll result number (min count 31)))
-	  (t
-	   ;; Count=0?  Shouldn't happen, but it's easy:
-	   (move result number)))))
+    (cond
+      ((< count 0) (inst sra result number (min (- count) 31)))
+      ((> count 0) (inst sll result number (min count 31)))
+      (t (bug "identity ASH not transformed away")))))
+
+(macrolet ((def (name sc-type type result-type cost)
+             `(define-vop (,name)
+                (:note "inline ASH")
+                (:translate ash)
+                (:args (number :scs (,sc-type))
+                       (amount :scs (signed-reg unsigned-reg immediate)))
+                (:arg-types ,type positive-fixnum)
+                (:results (result :scs (,result-type)))
+                (:result-types ,type)
+                (:policy :fast-safe)
+                (:generator ,cost
+                   (sc-case amount
+                     ((signed-reg unsigned-reg)
+                      (inst sll result number amount))
+                     (immediate
+                      (let ((amount (tn-value amount)))
+                        (aver (> amount 0))
+                        (inst sll result number amount))))))))
+  (def fast-ash-left/fixnum=>fixnum any-reg tagged-num any-reg 2)
+  (def fast-ash-left/signed=>signed signed-reg signed-num signed-reg 3)
+  (def fast-ash-left/unsigned=>unsigned unsigned-reg unsigned-num unsigned-reg 3))
 
 (define-vop (signed-byte-32-len)
   (:translate integer-length)
@@ -291,16 +329,16 @@
   (:temporary (:scs (non-descriptor-reg) :from (:argument 0)) shift)
   (:generator 30
     (let ((loop (gen-label))
-	  (test (gen-label)))
+          (test (gen-label)))
       (move shift arg)
       (inst bgez shift test)
-      (move res zero-tn)
+      (move res zero-tn t)
       (inst b test)
       (inst nor shift shift)
 
       (emit-label loop)
       (inst add res (fixnumize 1))
-      
+
       (emit-label test)
       (inst bne shift loop)
       (inst srl shift 1))))
@@ -314,7 +352,7 @@
   (:results (res :scs (unsigned-reg)))
   (:result-types positive-fixnum)
   (:temporary (:scs (non-descriptor-reg) :from (:argument 0) :to (:result 0)
-		    :target res) num)
+                    :target res) num)
   (:temporary (:scs (non-descriptor-reg)) mask temp)
   (:generator 30
     (inst li mask #x55555555)
@@ -350,7 +388,7 @@
   (:temporary (:scs (non-descriptor-reg)) temp)
   (:translate *)
   (:generator 4
-    (inst sra temp y 2)
+    (inst sra temp y n-fixnum-tag-bits)
     (inst mult x temp)
     (inst mflo r)))
 
@@ -371,30 +409,30 @@
 (define-vop (fast-truncate/fixnum fast-fixnum-binop)
   (:translate truncate)
   (:results (q :scs (any-reg))
-	    (r :scs (any-reg)))
+            (r :scs (any-reg)))
   (:result-types tagged-num tagged-num)
   (:temporary (:scs (non-descriptor-reg) :to :eval) temp)
   (:vop-var vop)
   (:save-p :compute-only)
   (:generator 11
     (let ((zero (generate-error-code vop division-by-zero-error x y)))
-      (inst beq y zero-tn zero))
+      (inst beq y zero))
     (inst nop)
     (inst div x y)
     (inst mflo temp)
-    (inst sll q temp 2)
+    (inst sll q temp n-fixnum-tag-bits)
     (inst mfhi r)))
 
 (define-vop (fast-truncate/unsigned fast-unsigned-binop)
   (:translate truncate)
   (:results (q :scs (unsigned-reg))
-	    (r :scs (unsigned-reg)))
+            (r :scs (unsigned-reg)))
   (:result-types unsigned-num unsigned-num)
   (:vop-var vop)
   (:save-p :compute-only)
   (:generator 12
     (let ((zero (generate-error-code vop division-by-zero-error x y)))
-      (inst beq y zero-tn zero))
+      (inst beq y zero))
     (inst nop)
     (inst divu x y)
     (inst mflo q)
@@ -403,13 +441,13 @@
 (define-vop (fast-truncate/signed fast-signed-binop)
   (:translate truncate)
   (:results (q :scs (signed-reg))
-	    (r :scs (signed-reg)))
+            (r :scs (signed-reg)))
   (:result-types signed-num signed-num)
   (:vop-var vop)
   (:save-p :compute-only)
   (:generator 12
     (let ((zero (generate-error-code vop division-by-zero-error x y)))
-      (inst beq y zero-tn zero))
+      (inst beq y zero))
     (inst nop)
     (inst div x y)
     (inst mflo q)
@@ -429,7 +467,7 @@
 
 (define-vop (fast-conditional/fixnum fast-conditional)
   (:args (x :scs (any-reg))
-	 (y :scs (any-reg)))
+         (y :scs (any-reg)))
   (:arg-types tagged-num tagged-num)
   (:note "inline fixnum comparison"))
 
@@ -440,7 +478,7 @@
 
 (define-vop (fast-conditional/signed fast-conditional)
   (:args (x :scs (signed-reg))
-	 (y :scs (signed-reg)))
+         (y :scs (signed-reg)))
   (:arg-types signed-num signed-num)
   (:note "inline (signed-byte 32) comparison"))
 
@@ -451,72 +489,72 @@
 
 (define-vop (fast-conditional/unsigned fast-conditional)
   (:args (x :scs (unsigned-reg))
-	 (y :scs (unsigned-reg)))
+         (y :scs (unsigned-reg)))
   (:arg-types unsigned-num unsigned-num)
   (:note "inline (unsigned-byte 32) comparison"))
 
 (define-vop (fast-conditional-c/unsigned fast-conditional/unsigned)
   (:args (x :scs (unsigned-reg)))
   (:arg-types unsigned-num (:constant (and (signed-byte-with-a-bite-out 16 1)
-					   unsigned-byte)))
+                                           unsigned-byte)))
   (:info target not-p y))
 
 
 (defmacro define-conditional-vop (translate &rest generator)
   `(progn
      ,@(mapcar #'(lambda (suffix cost signed)
-		   (unless (and (member suffix '(/fixnum -c/fixnum))
-				(eq translate 'eql))
-		     `(define-vop (,(intern (format nil "~:@(FAST-IF-~A~A~)"
-						    translate suffix))
-				   ,(intern
-				     (format nil "~:@(FAST-CONDITIONAL~A~)"
-					     suffix)))
-			(:translate ,translate)
-			(:generator ,cost
-			  (let* ((signed ,signed)
-				 (-c/fixnum ,(eq suffix '-c/fixnum))
-				 (y (if -c/fixnum (fixnumize y) y)))
-			    (declare (ignorable signed -c/fixnum y))
-			    ,@generator)))))
-	       '(/fixnum -c/fixnum /signed -c/signed /unsigned -c/unsigned)
-	       '(3 2 5 4 5 4)
-	       '(t t t t nil nil))))
+                   (unless (and (member suffix '(/fixnum -c/fixnum))
+                                (eq translate 'eql))
+                     `(define-vop (,(intern (format nil "~:@(FAST-IF-~A~A~)"
+                                                    translate suffix))
+                                   ,(intern
+                                     (format nil "~:@(FAST-CONDITIONAL~A~)"
+                                             suffix)))
+                        (:translate ,translate)
+                        (:generator ,cost
+                          (let* ((signed ,signed)
+                                 (-c/fixnum ,(eq suffix '-c/fixnum))
+                                 (y (if -c/fixnum (fixnumize y) y)))
+                            (declare (ignorable signed -c/fixnum y))
+                            ,@generator)))))
+               '(/fixnum -c/fixnum /signed -c/signed /unsigned -c/unsigned)
+               '(3 2 5 4 5 4)
+               '(t t t t nil nil))))
 
 (define-conditional-vop <
   (cond ((and signed (eql y 0))
-	 (if not-p
-	     (inst bgez x target)
-	     (inst bltz x target)))
-	(t
-	 (if signed
-	     (inst slt temp x y)
-	     (inst sltu temp x y))
-	 (if not-p
-	     (inst beq temp zero-tn target)
-	     (inst bne temp zero-tn target))))
+         (if not-p
+             (inst bgez x target)
+             (inst bltz x target)))
+        (t
+         (if signed
+             (inst slt temp x y)
+             (inst sltu temp x y))
+         (if not-p
+             (inst beq temp target)
+             (inst bne temp target))))
   (inst nop))
 
 (define-conditional-vop >
   (cond ((and signed (eql y 0))
-	 (if not-p
-	     (inst blez x target)
-	     (inst bgtz x target)))
-	((integerp y)
-	 (let ((y (+ y (if -c/fixnum (fixnumize 1) 1))))
-	   (if signed
-	       (inst slt temp x y)
-	       (inst sltu temp x y))
-	   (if not-p
-	       (inst bne temp zero-tn target)
-	       (inst beq temp zero-tn target))))
-	(t
-	 (if signed
-	     (inst slt temp y x)
-	     (inst sltu temp y x))
-	 (if not-p
-	     (inst beq temp zero-tn target)
-	     (inst bne temp zero-tn target))))
+         (if not-p
+             (inst blez x target)
+             (inst bgtz x target)))
+        ((integerp y)
+         (let ((y (+ y (if -c/fixnum (fixnumize 1) 1))))
+           (if signed
+               (inst slt temp x y)
+               (inst sltu temp x y))
+           (if not-p
+               (inst bne temp target)
+               (inst beq temp target))))
+        (t
+         (if signed
+             (inst slt temp y x)
+             (inst sltu temp y x))
+         (if not-p
+             (inst beq temp target)
+             (inst bne temp target))))
   (inst nop))
 
 ;;; EQL/FIXNUM is funny because the first arg can be of any type, not just a
@@ -540,20 +578,20 @@
 ;;;
 (define-vop (fast-eql/fixnum fast-conditional)
   (:args (x :scs (any-reg))
-	 (y :scs (any-reg)))
+         (y :scs (any-reg)))
   (:arg-types tagged-num tagged-num)
   (:note "inline fixnum comparison")
   (:translate eql)
   (:ignore temp)
   (:generator 3
     (if not-p
-	(inst bne x y target)
-	(inst beq x y target))
+        (inst bne x y target)
+        (inst beq x y target))
     (inst nop)))
 ;;;
 (define-vop (generic-eql/fixnum fast-eql/fixnum)
   (:args (x :scs (any-reg descriptor-reg))
-	 (y :scs (any-reg)))
+         (y :scs (any-reg)))
   (:arg-types * tagged-num)
   (:variant-cost 7))
 
@@ -564,102 +602,26 @@
   (:translate eql)
   (:generator 2
     (let ((y (cond ((eql y 0) zero-tn)
-		   (t
-		    (inst li temp (fixnumize y))
-		    temp))))
+                   (t
+                    (inst li temp (fixnumize y))
+                    temp))))
       (if not-p
-	  (inst bne x y target)
-	  (inst beq x y target))
+          (inst bne x y target)
+          (inst beq x y target))
       (inst nop))))
 ;;;
 (define-vop (generic-eql-c/fixnum fast-eql-c/fixnum)
   (:args (x :scs (any-reg descriptor-reg)))
   (:arg-types * (:constant (signed-byte 14)))
   (:variant-cost 6))
-  
+
 
 ;;;; 32-bit logical operations
 
-(define-vop (merge-bits)
-  (:translate merge-bits)
-  (:args (shift :scs (signed-reg unsigned-reg))
-	 (prev :scs (unsigned-reg))
-	 (next :scs (unsigned-reg)))
-  (:arg-types tagged-num unsigned-num unsigned-num)
-  (:temporary (:scs (unsigned-reg) :to (:result 0)) temp)
-  (:temporary (:scs (unsigned-reg) :to (:result 0) :target result) res)
-  (:results (result :scs (unsigned-reg)))
-  (:result-types unsigned-num)
-  (:policy :fast-safe)
-  (:generator 4
-    (let ((done (gen-label)))
-      (inst beq shift done)
-      (inst srl res next shift)
-      (inst subu temp zero-tn shift)
-      (inst sll temp prev temp)
-      (inst or res res temp)
-      (emit-label done)
-      (move result res))))
-
-
-(define-vop (32bit-logical)
-  (:args (x :scs (unsigned-reg))
-	 (y :scs (unsigned-reg)))
-  (:arg-types unsigned-num unsigned-num)
-  (:results (r :scs (unsigned-reg)))
-  (:result-types unsigned-num)
-  (:policy :fast-safe))
-
-(define-vop (32bit-logical-not 32bit-logical)
-  (:translate 32bit-logical-not)
-  (:args (x :scs (unsigned-reg)))
-  (:arg-types unsigned-num)
-  (:generator 1
-    (inst nor r x zero-tn)))
-
-(define-vop (32bit-logical-and 32bit-logical)
-  (:translate 32bit-logical-and)
-  (:generator 1
-    (inst and r x y)))
-
-(deftransform 32bit-logical-nand ((x y) (* *))
-  '(32bit-logical-not (32bit-logical-and x y)))
-
-(define-vop (32bit-logical-or 32bit-logical)
-  (:translate 32bit-logical-or)
-  (:generator 1
-    (inst or r x y)))
-
-(define-vop (32bit-logical-nor 32bit-logical)
-  (:translate 32bit-logical-nor)
-  (:generator 1
-    (inst nor r x y)))
-
-(define-vop (32bit-logical-xor 32bit-logical)
-  (:translate 32bit-logical-xor)
-  (:generator 1
-    (inst xor r x y)))
-
-(deftransform 32bit-logical-eqv ((x y) (* *))
-  '(32bit-logical-not (32bit-logical-xor x y)))
-
-(deftransform 32bit-logical-andc1 ((x y) (* *))
-  '(32bit-logical-and (32bit-logical-not x) y))
-
-(deftransform 32bit-logical-andc2 ((x y) (* *))
-  '(32bit-logical-and x (32bit-logical-not y)))
-
-(deftransform 32bit-logical-orc1 ((x y) (* *))
-  '(32bit-logical-or (32bit-logical-not x) y))
-
-(deftransform 32bit-logical-orc2 ((x y) (* *))
-  '(32bit-logical-or x (32bit-logical-not y)))
-
-
 (define-vop (shift-towards-someplace)
   (:policy :fast-safe)
   (:args (num :scs (unsigned-reg))
-	 (amount :scs (signed-reg)))
+         (amount :scs (signed-reg)))
   (:arg-types unsigned-num tagged-num)
   (:results (r :scs (unsigned-reg)))
   (:result-types unsigned-num))
@@ -683,27 +645,80 @@
        (inst srl r num amount))
       (:little-endian
        (inst sll r num amount)))))
-
-
 
+;;;; Modular arithmetic
+(define-modular-fun +-mod32 (x y) + :untagged nil 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-modular-fun --mod32 (x y) - :untagged nil 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))
+
+(define-vop (fast-ash-left-mod32/unsigned=>unsigned
+             fast-ash-left/unsigned=>unsigned))
+(deftransform ash-left-mod32 ((integer count)
+                              ((unsigned-byte 32) (unsigned-byte 5)))
+  (when (sb!c::constant-lvar-p count)
+    (sb!c::give-up-ir1-transform))
+  '(%primitive fast-ash-left-mod32/unsigned=>unsigned integer count))
+
+;;; logical operations
+(define-modular-fun lognot-mod32 (x) lognot :untagged nil 32)
+(define-vop (lognot-mod32/unsigned=>unsigned)
+  (:translate lognot-mod32)
+  (:args (x :scs (unsigned-reg)))
+  (:arg-types unsigned-num)
+  (:results (r :scs (unsigned-reg)))
+  (:result-types unsigned-num)
+  (:policy :fast-safe)
+  (:generator 1
+    (inst nor r x zero-tn)))
+
+(define-modular-fun lognor-mod32 (x y) lognor :untagged nil 32)
+(define-vop (fast-lognor-mod32/unsigned=>unsigned
+             fast-lognor/unsigned=>unsigned)
+  (:translate lognor-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 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)
@@ -711,25 +726,25 @@
   (:info target not-p)
   (:generator 2
     (if not-p
-	(inst bltz digit target)
-	(inst bgez digit target))
+        (inst bltz digit target)
+        (inst bgez digit target))
     (inst nop)))
 
 (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))
-	 (b :scs (unsigned-reg))
-	 (c :scs (any-reg)))
+         (b :scs (unsigned-reg))
+         (c :scs (any-reg)))
   (:arg-types unsigned-num unsigned-num positive-fixnum)
   (:temporary (:scs (unsigned-reg) :to (:result 0) :target result) res)
   (:results (result :scs (unsigned-reg))
-	    (carry :scs (unsigned-reg) :from :eval))
+            (carry :scs (unsigned-reg) :from :eval))
   (:result-types unsigned-num positive-fixnum)
   (:temporary (:scs (non-descriptor-reg)) temp)
   (:generator 5
     (let ((carry-in (gen-label))
-	  (done (gen-label)))
+          (done (gen-label)))
       (inst bne c carry-in)
       (inst addu res a b)
 
@@ -746,19 +761,19 @@
       (move result res))))
 
 (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))
-	 (b :scs (unsigned-reg))
-	 (c :scs (any-reg)))
+         (b :scs (unsigned-reg))
+         (c :scs (any-reg)))
   (:arg-types unsigned-num unsigned-num positive-fixnum)
   (:temporary (:scs (unsigned-reg) :to (:result 0) :target result) res)
   (:results (result :scs (unsigned-reg))
-	    (borrow :scs (unsigned-reg) :from :eval))
+            (borrow :scs (unsigned-reg) :from :eval))
   (:result-types unsigned-num positive-fixnum)
   (:generator 4
     (let ((no-borrow-in (gen-label))
-	  (done (gen-label)))
+          (done (gen-label)))
 
       (inst bne c no-borrow-in)
       (inst subu res a b)
@@ -775,15 +790,15 @@
       (move result res))))
 
 (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))
-	 (y :scs (unsigned-reg))
-	 (carry-in :scs (unsigned-reg) :to :save))
+         (y :scs (unsigned-reg))
+         (carry-in :scs (unsigned-reg) :to :save))
   (:arg-types unsigned-num unsigned-num unsigned-num)
   (:temporary (:scs (unsigned-reg) :from (:argument 1)) temp)
   (:results (hi :scs (unsigned-reg))
-	    (lo :scs (unsigned-reg)))
+            (lo :scs (unsigned-reg)))
   (:result-types unsigned-num unsigned-num)
   (:generator 6
     (inst multu x y)
@@ -794,16 +809,16 @@
     (inst addu hi temp)))
 
 (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))
-	 (y :scs (unsigned-reg))
-	 (prev :scs (unsigned-reg))
-	 (carry-in :scs (unsigned-reg) :to :save))
+         (y :scs (unsigned-reg))
+         (prev :scs (unsigned-reg))
+         (carry-in :scs (unsigned-reg) :to :save))
   (:arg-types unsigned-num unsigned-num unsigned-num unsigned-num)
   (:temporary (:scs (unsigned-reg) :from (:argument 2)) temp)
   (:results (hi :scs (unsigned-reg))
-	    (lo :scs (unsigned-reg)))
+            (lo :scs (unsigned-reg)))
   (:result-types unsigned-num unsigned-num)
   (:generator 9
     (inst multu x y)
@@ -817,73 +832,66 @@
     (inst addu hi temp)))
 
 (define-vop (bignum-mult)
-  (:translate sb!bignum::%multiply)
+  (:translate sb!bignum:%multiply)
   (:policy :fast-safe)
   (:args (x :scs (unsigned-reg))
-	 (y :scs (unsigned-reg)))
+         (y :scs (unsigned-reg)))
   (:arg-types unsigned-num unsigned-num)
   (:results (hi :scs (unsigned-reg))
-	    (lo :scs (unsigned-reg)))
+            (lo :scs (unsigned-reg)))
   (:result-types unsigned-num unsigned-num)
   (:generator 3
     (inst multu x y)
     (inst mflo lo)
     (inst mfhi hi)))
 
-(define-vop (bignum-lognot)
-  (:translate sb!bignum::%lognot)
-  (:policy :fast-safe)
-  (:args (x :scs (unsigned-reg)))
-  (:arg-types unsigned-num)
-  (:results (r :scs (unsigned-reg)))
-  (:result-types unsigned-num)
-  (:generator 1
-    (inst nor r x zero-tn)))
+(define-vop (bignum-lognot lognot-mod32/unsigned=>unsigned)
+  (: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)))
   (:arg-types tagged-num)
   (:results (digit :scs (unsigned-reg)))
   (:result-types unsigned-num)
   (:generator 1
-    (inst sra digit fixnum 2)))
+    (inst sra digit fixnum n-fixnum-tag-bits)))
 
 (define-vop (bignum-floor)
-  (:translate sb!bignum::%floor)
+  (:translate sb!bignum:%floor)
   (:policy :fast-safe)
   (:args (num-high :scs (unsigned-reg) :target rem)
-	 (num-low :scs (unsigned-reg) :target rem-low)
-	 (denom :scs (unsigned-reg) :to (:eval 1)))
+         (num-low :scs (unsigned-reg) :target rem-low)
+         (denom :scs (unsigned-reg) :to (:eval 1)))
   (:arg-types unsigned-num unsigned-num unsigned-num)
   (:temporary (:scs (unsigned-reg) :from (:argument 1)) rem-low)
   (:temporary (:scs (unsigned-reg) :from (:eval 0)) temp)
   (:results (quo :scs (unsigned-reg) :from (:eval 0))
-	    (rem :scs (unsigned-reg) :from (:argument 0)))
+            (rem :scs (unsigned-reg) :from (:argument 0)))
   (:result-types unsigned-num unsigned-num)
   (:generator 325 ; number of inst assuming targeting works.
     (move rem num-high)
     (move rem-low num-low)
     (flet ((maybe-subtract (&optional (guess temp))
-	     (inst subu temp guess 1)
-	     (inst and temp denom)
-	     (inst subu rem temp)))
+             (inst subu temp guess 1)
+             (inst and temp denom)
+             (inst subu rem temp)))
       (inst sltu quo rem denom)
       (maybe-subtract quo)
       (dotimes (i 32)
-	(inst sll rem 1)
-	(inst srl temp rem-low 31)
-	(inst or rem temp)
-	(inst sll rem-low 1)
-	(inst sltu temp rem denom)
-	(inst sll quo 1)
-	(inst or quo temp)
-	(maybe-subtract)))
+        (inst sll rem 1)
+        (inst srl temp rem-low 31)
+        (inst or rem temp)
+        (inst sll rem-low 1)
+        (inst sltu temp rem denom)
+        (inst sll quo 1)
+        (inst or quo temp)
+        (maybe-subtract)))
     (inst nor quo zero-tn)))
 
 (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) :target res))
   (:arg-types unsigned-num)
@@ -892,16 +900,16 @@
   (:generator 1
     (sc-case res
       (any-reg
-       (inst sll res digit 2))
+       (inst sll res digit n-fixnum-tag-bits))
       (signed-reg
        (move res digit)))))
 
 
 (define-vop (digit-ashr)
-  (:translate sb!bignum::%ashr)
+  (:translate sb!bignum:%ashr)
   (:policy :fast-safe)
   (:args (digit :scs (unsigned-reg))
-	 (count :scs (unsigned-reg)))
+         (count :scs (unsigned-reg)))
   (:arg-types unsigned-num positive-fixnum)
   (:results (result :scs (unsigned-reg)))
   (:result-types unsigned-num)
@@ -909,12 +917,12 @@
     (inst sra result digit count)))
 
 (define-vop (digit-lshr digit-ashr)
-  (:translate sb!bignum::%digit-logical-shift-right)
+  (:translate sb!bignum:%digit-logical-shift-right)
   (:generator 1
     (inst srl result digit count)))
 
 (define-vop (digit-ashl digit-ashr)
-  (:translate sb!bignum::%ashl)
+  (:translate sb!bignum:%ashl)
   (:generator 1
     (inst sll result digit count)))
 
@@ -923,19 +931,19 @@
 
 (define-static-fun two-arg-gcd (x y) :translate gcd)
 (define-static-fun two-arg-lcm (x y) :translate lcm)
-		  
+
 (define-static-fun two-arg-+ (x y) :translate +)
 (define-static-fun two-arg-- (x y) :translate -)
 (define-static-fun two-arg-* (x y) :translate *)
 (define-static-fun two-arg-/ (x y) :translate /)
-		  
+
 (define-static-fun two-arg-< (x y) :translate <)
 (define-static-fun two-arg-<= (x y) :translate <=)
 (define-static-fun two-arg-> (x y) :translate >)
 (define-static-fun two-arg->= (x y) :translate >=)
 (define-static-fun two-arg-= (x y) :translate =)
 (define-static-fun two-arg-/= (x y) :translate /=)
-		  
+
 (define-static-fun %negate (x) :translate %negate)
 
 (define-static-fun two-arg-and (x y) :translate logand)