From: Nathan Froyd <froydnj@cs.rice.edu>
Date: Thu, 9 Dec 2004 16:58:40 +0000 (+0000)
Subject: 0.8.17.28:
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=40318bbb37de12ad36ee34a664c86c870bc7dadf;p=sbcl.git

0.8.17.28:
	Oops.  Undo modular fixnum arithmetic changes from 0.8.17.24.
---

diff --git a/src/code/numbers.lisp b/src/code/numbers.lisp
index 0d6d868..330fcdd 100644
--- a/src/code/numbers.lisp
+++ b/src/code/numbers.lisp
@@ -1420,17 +1420,11 @@ the first."
 ;;; shifts.  See also the comment in (LOGAND OPTIMIZER) for more
 ;;; discussion of this hack.  -- CSR, 2003-10-09
 #!-alpha
-(progn
 (defun sb!vm::ash-left-mod32 (integer amount)
   (etypecase integer
     ((unsigned-byte 32) (ldb (byte 32 0) (ash integer amount)))
     (fixnum (ldb (byte 32 0) (ash (logand integer #xffffffff) amount)))
     (bignum (ldb (byte 32 0) (ash (logand integer #xffffffff) amount)))))
-(defun sb!vm::ash-left-mod29 (integer amount)
-  (etypecase integer
-    (fixnum (ldb (byte 29 0) (ash (logand integer #x1fffffff) amount)))
-    (bignum (ldb (byte 29 0) (ash (logand integer #x1fffffff) amount)))))
-) ; PROGN
 #!+alpha
 (defun sb!vm::ash-left-mod64 (integer amount)
   (etypecase integer
diff --git a/src/compiler/alpha/arith.lisp b/src/compiler/alpha/arith.lisp
index 971f228..e8c0586 100644
--- a/src/compiler/alpha/arith.lisp
+++ b/src/compiler/alpha/arith.lisp
@@ -411,26 +411,20 @@
     (sb!c::give-up-ir1-transform))
   '(%primitive fast-ash-left-mod64/unsigned=>unsigned integer count))
 
-(macrolet ((define-modular-backend (fun &optional constantp)
-             (collect ((forms))
-               (dolist (info '((29 fixnum) (32 unsigned)))
-                 (destructuring-bind (width regtype) info
-                   (let ((mfun-name (intern (format nil "~A-MOD~A" fun width)))
-                         (mvop (intern (format nil "FAST-~A-MOD~A/~A=>~A"
-                                               fun width regtype regtype)))
-                         (mcvop (intern (format nil "FAST-~A-MOD~A-C/~A=>~A"
-                                                fun width regtype regtype)))
-                         (vop (intern (format nil "FAST-~A/~A=>~A"
-                                              fun regtype regtype)))
-                         (cvop (intern (format nil "FAST-~A-C/~A=>~A"
-                                               fun regtype regtype))))
-                     (forms `(define-modular-fun ,mfun-name (x y) ,fun ,width))
-                     (forms `(define-vop (,mvop ,vop)
-                              (:translate ,mfun-name)))
-                     (when constantp
-                       (forms `(define-vop (,mcvop ,cvop)
-                                (:translate ,mfun-name)))))))
-               `(progn ,@(forms)))))
+(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))
+             (vop (symbolicate 'fast- fun '/unsigned=>unsigned))
+             (cvop (symbolicate 'fast- fun '-c/unsigned=>unsigned)))
+         `(progn
+            (define-modular-fun ,mfun-name (x y) ,fun 64)
+            (define-vop (,modvop ,vop)
+              (:translate ,mfun-name))
+            ,@(when constantp
+                `((define-vop (,modcvop ,cvop)
+                    (:translate ,mfun-name))))))))
   (define-modular-backend + t)
   (define-modular-backend - t)
   (define-modular-backend logxor t)
diff --git a/src/compiler/generic/vm-tran.lisp b/src/compiler/generic/vm-tran.lisp
index 87efca8..e47aec5 100644
--- a/src/compiler/generic/vm-tran.lisp
+++ b/src/compiler/generic/vm-tran.lisp
@@ -510,13 +510,6 @@
   ;; 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
-  ;;
-  ;; FIXME: I think we only want a single optimizer for ASH; this code
-  ;; currently defines two (the second one, AFAICS, overrides the first),
-  ;; but everything "works"--ASH with results of 29 bits or fewer use
-  ;; fixnum arithmetic.  -- njf, 2004-12-08
-  #!+#.(cl:if (cl:= 32 sb!vm:n-machine-word-bits) '(and) '(or))
-  (def sb!vm::ash-left-mod29 29)
   #!+#.(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-machine-word-bits) '(and) '(or))
diff --git a/src/compiler/hppa/arith.lisp b/src/compiler/hppa/arith.lisp
index cc1f8c4..78b3f53 100644
--- a/src/compiler/hppa/arith.lisp
+++ b/src/compiler/hppa/arith.lisp
@@ -580,34 +580,16 @@
   
 
 ;;;; modular functions
-
-(macrolet ((define-modular-backend (fun &optional constantp)
-             (collect ((forms))
-               (dolist (info '((29 fixnum) (32 unsigned)))
-                 (destructuring-bind (width regtype) info
-                   (let ((mfun-name (intern (format nil "~A-MOD~A" fun width)))
-                         (mvop (intern (format nil "FAST-~A-MOD~A/~A=>~A"
-                                               fun width regtype regtype)))
-                         (mcvop (intern (format nil "FAST-~A-MOD~A-C/~A=>~A"
-                                                fun width regtype regtype)))
-                         (vop (intern (format nil "FAST-~A/~A=>~A"
-                                              fun regtype regtype)))
-                         (cvop (intern (format nil "FAST-~A-C/~A=>~A"
-                                               fun regtype regtype))))
-                     (forms `(define-modular-fun ,mfun-name (x y) ,fun ,width))
-                     (forms `(define-vop (,mvop ,vop)
-                              (:translate ,mfun-name)))
-                     (when constantp
-                       (forms `(define-vop (,mcvop ,cvop)
-                                (:translate ,mfun-name)))))))
-               `(progn ,@(forms)))))
-  (define-modular-backend + t)
-  (define-modular-backend - t)
-  ;; FIXME: constant versions of these could be defined if anybody
-  ;; cared enough to implement them. -- CSR/NJF
-  (define-modular-backend logxor)
-  (define-modular-backend logandc1)
-  (define-modular-backend logandc2))
+(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-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)
@@ -633,6 +615,21 @@
   (:generator 1
     (inst uaddcm zero-tn x res)))
 
+(macrolet
+    ((define-modular-backend (fun)
+       (let ((mfun-name (symbolicate fun '-mod32))
+	     ;; FIXME: if anyone cares, add constant-arg vops.  --
+	     ;; CSR, 2003-09-16
+	     (modvop (symbolicate 'fast- fun '-mod32/unsigned=>unsigned))
+	     (vop (symbolicate 'fast- fun '/unsigned=>unsigned)))
+	 `(progn
+	    (define-modular-fun ,mfun-name (x y) ,fun 32)
+	    (define-vop (,modvop ,vop)
+	      (:translate ,mfun-name))))))
+  (define-modular-backend logxor)
+  (define-modular-backend logandc1)
+  (define-modular-backend logandc2))
+
 (define-source-transform logeqv (&rest args)
   (if (oddp (length args))
       `(logxor ,@args)
diff --git a/src/compiler/mips/arith.lisp b/src/compiler/mips/arith.lisp
index 6d73c2b..9ae3a64 100644
--- a/src/compiler/mips/arith.lisp
+++ b/src/compiler/mips/arith.lisp
@@ -667,30 +667,16 @@
        (inst sll r num amount)))))
 
 ;;;; Modular arithmetic
-
-(macrolet ((define-modular-backend (fun &optional constantp)
-             (collect ((forms))
-               (dolist (info '((29 fixnum) (32 unsigned)))
-                 (destructuring-bind (width regtype) info
-                   (let ((mfun-name (intern (format nil "~A-MOD~A" fun width)))
-                         (mvop (intern (format nil "FAST-~A-MOD~A/~A=>~A"
-                                               fun width regtype regtype)))
-                         (mcvop (intern (format nil "FAST-~A-MOD~A-C/~A=>~A"
-                                                fun width regtype regtype)))
-                         (vop (intern (format nil "FAST-~A/~A=>~A"
-                                              fun regtype regtype)))
-                         (cvop (intern (format nil "FAST-~A-C/~A=>~A"
-                                               fun regtype regtype))))
-                     (forms `(define-modular-fun ,mfun-name (x y) ,fun ,width))
-                     (forms `(define-vop (,mvop ,vop)
-                              (:translate ,mfun-name)))
-                     (when constantp
-                       (forms `(define-vop (,mcvop ,cvop)
-                                (:translate ,mfun-name)))))))
-               `(progn ,@(forms)))))
-  (define-modular-backend + t)
-  (define-modular-backend - t)
-  (define-modular-backend logxor t))
+(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-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)
@@ -716,6 +702,14 @@
   (:generator 1
     (inst nor r x zero-tn)))
 
+(define-modular-fun logxor-mod32 (x y) logxor 32)
+(define-vop (fast-logxor-mod32/unsigned=>unsigned
+             fast-logxor/unsigned=>unsigned)
+  (:translate logxor-mod32))
+(define-vop (fast-logxor-mod32-c/unsigned=>unsigned
+             fast-logxor-c/unsigned=>unsigned)
+  (:translate logxor-mod32))
+
 (define-modular-fun lognor-mod32 (x y) lognor 32)
 (define-vop (fast-lognor-mod32/unsigned=>unsigned
 	     fast-lognor/unsigned=>unsigned)
diff --git a/src/compiler/ppc/arith.lisp b/src/compiler/ppc/arith.lisp
index 8cb995c..369b0e8 100644
--- a/src/compiler/ppc/arith.lisp
+++ b/src/compiler/ppc/arith.lisp
@@ -135,90 +135,99 @@
   (:note "inline (signed-byte 32) arithmetic"))
 
 
-(macrolet ((define-var-binop (translate untagged-penalty op 
-                                        &optional arg-swap restore-fixnum-mask)
-               `(progn
-                 (define-vop (,(symbolicate "FAST-" translate "/FIXNUM=>FIXNUM")
-                              fast-fixnum-binop)
-                     ,@(when restore-fixnum-mask
-                             `((:temporary (:sc non-descriptor-reg) temp)))
-                     (:translate ,translate)
-                     (:generator 2
-                      ,(if arg-swap
-                           `(inst ,op ,(if restore-fixnum-mask 'temp 'r) y x)
-                           `(inst ,op ,(if restore-fixnum-mask 'temp 'r) x y))
-                      ;; FIXME: remind me what convention we used for 64bitizing
-                      ;; stuff?  -- CSR, 2003-08-27
-                      ,@(when restore-fixnum-mask
-                              `((inst clrrwi r temp (1- n-lowtag-bits))))))
-                 (define-vop (,(symbolicate "FAST-" translate "/SIGNED=>SIGNED")
-                              fast-signed-binop)
-                     (:translate ,translate)
-                   (:generator ,(1+ untagged-penalty)
-                    ,(if arg-swap
-                         `(inst ,op r y x)
-                         `(inst ,op r x y))))
-                 (define-vop (,(symbolicate "FAST-" translate "/UNSIGNED=>UNSIGNED")
-                              fast-unsigned-binop)
-                     (:translate ,translate)
-                   (:generator ,(1+ untagged-penalty)
-                    ,(if arg-swap
-                         `(inst ,op r y x)
-                         `(inst ,op r x y))))))
-           (define-const-binop (translate untagged-penalty op)
-               `(progn
+(eval-when (:compile-toplevel :load-toplevel :execute)
+
+(defmacro define-var-binop (translate untagged-penalty op 
+			    &optional arg-swap restore-fixnum-mask)
+  `(progn
+     (define-vop (,(symbolicate "FAST-" translate "/FIXNUM=>FIXNUM")
+		  fast-fixnum-binop)
+       ,@(when restore-fixnum-mask
+	   `((:temporary (:sc non-descriptor-reg) temp)))
+       (:translate ,translate)
+       (:generator 2
+	 ,(if arg-swap
+	     `(inst ,op ,(if restore-fixnum-mask 'temp 'r) y x)
+	     `(inst ,op ,(if restore-fixnum-mask 'temp 'r) x y))
+	 ;; FIXME: remind me what convention we used for 64bitizing
+	 ;; stuff?  -- CSR, 2003-08-27
+	 ,@(when restore-fixnum-mask
+	     `((inst clrrwi r temp (1- n-lowtag-bits))))))
+     (define-vop (,(symbolicate "FAST-" translate "/SIGNED=>SIGNED")
+		  fast-signed-binop)
+       (:translate ,translate)
+       (:generator ,(1+ untagged-penalty)
+         ,(if arg-swap
+	     `(inst ,op r y x)
+	     `(inst ,op r x y))))
+     (define-vop (,(symbolicate "FAST-" translate "/UNSIGNED=>UNSIGNED")
+		  fast-unsigned-binop)
+       (:translate ,translate)
+       (:generator ,(1+ untagged-penalty)
+	 ,(if arg-swap
+	     `(inst ,op r y x)
+	     `(inst ,op r x y))))))
+
+
+(defmacro define-const-binop (translate untagged-penalty op)
+  `(progn
      
-                 (define-vop (,(symbolicate 'fast- translate '-c/fixnum=>fixnum)
-                              fast-fixnum-binop-c)
-                     (:translate ,translate)
-                   (:generator 1
-                    (inst ,op r x (fixnumize y))))
-                 (define-vop (,(symbolicate 'fast- translate '-c/signed=>signed)
-                              fast-signed-binop-c)
-                     (:translate ,translate)
-                   (:generator ,untagged-penalty
-                    (inst ,op r x y)))
-                 (define-vop (,(symbolicate 'fast- translate '-c/unsigned=>unsigned)
-                              fast-unsigned-binop-c)
-                     (:translate ,translate)
-                   (:generator ,untagged-penalty
-                    (inst ,op r x y)))))
-           (defmacro define-const-logop (translate untagged-penalty op)
-             `(progn
+     (define-vop (,(symbolicate 'fast- translate '-c/fixnum=>fixnum)
+		  fast-fixnum-binop-c)
+       (:translate ,translate)
+       (:generator 1
+	 (inst ,op r x (fixnumize y))))
+     (define-vop (,(symbolicate 'fast- translate '-c/signed=>signed)
+		  fast-signed-binop-c)
+       (:translate ,translate)
+       (:generator ,untagged-penalty
+	 (inst ,op r x y)))
+     (define-vop (,(symbolicate 'fast- translate '-c/unsigned=>unsigned)
+		  fast-unsigned-binop-c)
+       (:translate ,translate)
+       (:generator ,untagged-penalty
+	 (inst ,op r x y)))))
+
+(defmacro define-const-logop (translate untagged-penalty op)
+  `(progn
      
-               (define-vop (,(symbolicate 'fast- translate '-c/fixnum=>fixnum)
-                            fast-fixnum-logop-c)
-                   (:translate ,translate)
-                 (:generator 1
-                  (inst ,op r x (fixnumize y))))
-               (define-vop (,(symbolicate 'fast- translate '-c/signed=>signed)
-                            fast-signed-logop-c)
-                   (:translate ,translate)
-                 (:generator ,untagged-penalty
-                  (inst ,op r x y)))
-               (define-vop (,(symbolicate 'fast- translate '-c/unsigned=>unsigned)
-                            fast-unsigned-logop-c)
-                   (:translate ,translate)
-                 (:generator ,untagged-penalty
-                  (inst ,op r x y))))))
-  (define-var-binop + 4 add)
-  (define-var-binop - 4 sub)
-  (define-var-binop logand 2 and)
-  (define-var-binop logandc1 2 andc t)
-  (define-var-binop logandc2 2 andc)
-  (define-var-binop logior 2 or)
-  (define-var-binop logorc1 2 orc t t)
-  (define-var-binop logorc2 2 orc nil t)
-  (define-var-binop logxor 2 xor)
-  (define-var-binop logeqv 2 eqv nil t)
-  (define-var-binop lognand 2 nand nil t)
-  (define-var-binop lognor 2 nor nil t)
-
-  (define-const-binop + 4 addi)
-  (define-const-binop - 4 subi)
-  (define-const-logop logand 2 andi.)
-  (define-const-logop logior 2 ori)
-  (define-const-logop logxor 2 xori))
+     (define-vop (,(symbolicate 'fast- translate '-c/fixnum=>fixnum)
+		  fast-fixnum-logop-c)
+       (:translate ,translate)
+       (:generator 1
+	 (inst ,op r x (fixnumize y))))
+     (define-vop (,(symbolicate 'fast- translate '-c/signed=>signed)
+		  fast-signed-logop-c)
+       (:translate ,translate)
+       (:generator ,untagged-penalty
+	 (inst ,op r x y)))
+     (define-vop (,(symbolicate 'fast- translate '-c/unsigned=>unsigned)
+		  fast-unsigned-logop-c)
+       (:translate ,translate)
+       (:generator ,untagged-penalty
+	 (inst ,op r x y)))))
+
+); eval-when
+
+(define-var-binop + 4 add)
+(define-var-binop - 4 sub)
+(define-var-binop logand 2 and)
+(define-var-binop logandc1 2 andc t)
+(define-var-binop logandc2 2 andc)
+(define-var-binop logior 2 or)
+(define-var-binop logorc1 2 orc t t)
+(define-var-binop logorc2 2 orc nil t)
+(define-var-binop logxor 2 xor)
+(define-var-binop logeqv 2 eqv nil t)
+(define-var-binop lognand 2 nand nil t)
+(define-var-binop lognor 2 nor nil t)
+
+(define-const-binop + 4 addi)
+(define-const-binop - 4 subi)
+(define-const-logop logand 2 andi.)
+(define-const-logop logior 2 ori)
+(define-const-logop logxor 2 xori)
+
 
 ;;; Special case fixnum + and - that trap on overflow.  Useful when we
 ;;; don't know that the output type is a fixnum.
@@ -474,26 +483,20 @@
     (sb!c::give-up-ir1-transform))
   '(%primitive fast-ash-left-mod32/unsigned=>unsigned integer count))
 
-(macrolet ((define-modular-backend (fun &optional constantp)
-             (collect ((forms))
-               (dolist (info '((29 fixnum) (32 unsigned)))
-                 (destructuring-bind (width regtype) info
-                   (let ((mfun-name (intern (format nil "~A-MOD~A" fun width)))
-                         (mvop (intern (format nil "FAST-~A-MOD~A/~A=>~A"
-                                               fun width regtype regtype)))
-                         (mcvop (intern (format nil "FAST-~A-MOD~A-C/~A=>~A"
-                                                fun width regtype regtype)))
-                         (vop (intern (format nil "FAST-~A/~A=>~A"
-                                              fun regtype regtype)))
-                         (cvop (intern (format nil "FAST-~A-C/~A=>~A"
-                                               fun regtype regtype))))
-                     (forms `(define-modular-fun ,mfun-name (x y) ,fun ,width))
-                     (forms `(define-vop (,mvop ,vop)
-                              (:translate ,mfun-name)))
-                     (when constantp
-                       (forms `(define-vop (,mcvop ,cvop)
-                                (:translate ,mfun-name)))))))
-               `(progn ,@(forms)))))
+(macrolet 
+    ((define-modular-backend (fun &optional constantp)
+       (let ((mfun-name (symbolicate fun '-mod32))
+	     (modvop (symbolicate 'fast- fun '-mod32/unsigned=>unsigned))
+	     (modcvop (symbolicate 'fast- fun 'mod32-c/unsigned=>unsigned))
+	     (vop (symbolicate 'fast- fun '/unsigned=>unsigned))
+	     (cvop (symbolicate 'fast- fun '-c/unsigned=>unsigned)))
+	 `(progn
+	    (define-modular-fun ,mfun-name (x y) ,fun 32)
+	    (define-vop (,modvop ,vop)
+	      (:translate ,mfun-name))
+	    ,@(when constantp
+		`((define-vop (,modcvop ,cvop)
+		    (:translate ,mfun-name))))))))
   (define-modular-backend + t)
   (define-modular-backend - t)
   (define-modular-backend * t)
diff --git a/src/compiler/sparc/arith.lisp b/src/compiler/sparc/arith.lisp
index 8e55634..1f40039 100644
--- a/src/compiler/sparc/arith.lisp
+++ b/src/compiler/sparc/arith.lisp
@@ -658,26 +658,20 @@
   (:generator 1
     (inst not res x)))
 
-(macrolet ((define-modular-backend (fun &optional constantp)
-             (collect ((forms))
-               (dolist (info '((29 fixnum) (32 unsigned)))
-                 (destructuring-bind (width regtype) info
-                   (let ((mfun-name (intern (format nil "~A-MOD~A" fun width)))
-                         (mvop (intern (format nil "FAST-~A-MOD~A/~A=>~A"
-                                               fun width regtype regtype)))
-                         (mcvop (intern (format nil "FAST-~A-MOD~A-C/~A=>~A"
-                                                fun width regtype regtype)))
-                         (vop (intern (format nil "FAST-~A/~A=>~A"
-                                              fun regtype regtype)))
-                         (cvop (intern (format nil "FAST-~A-C/~A=>~A"
-                                               fun regtype regtype))))
-                     (forms `(define-modular-fun ,mfun-name (x y) ,fun ,width))
-                     (forms `(define-vop (,mvop ,vop)
-                              (:translate ,mfun-name)))
-                     (when constantp
-                       (forms `(define-vop (,mcvop ,cvop)
-                                (:translate ,mfun-name)))))))
-               `(progn ,@(forms)))))
+(macrolet
+    ((define-modular-backend (fun &optional constantp)
+       (let ((mfun-name (symbolicate fun '-mod32))
+             (modvop (symbolicate 'fast- fun '-mod32/unsigned=>unsigned))
+             (modcvop (symbolicate 'fast- fun '-mod32-c/unsigned=>unsigned))
+             (vop (symbolicate 'fast- fun '/unsigned=>unsigned))
+             (cvop (symbolicate 'fast- fun '-c/unsigned=>unsigned)))
+         `(progn
+            (define-modular-fun ,mfun-name (x y) ,fun 32)
+            (define-vop (,modvop ,vop)
+              (:translate ,mfun-name))
+	    ,@(when constantp
+		`((define-vop (,modcvop ,cvop)
+		    (:translate ,mfun-name))))))))
   (define-modular-backend + t)
   (define-modular-backend - t)
   (define-modular-backend logxor t)
diff --git a/src/compiler/x86-64/arith.lisp b/src/compiler/x86-64/arith.lisp
index c0edde4..f549575 100644
--- a/src/compiler/x86-64/arith.lisp
+++ b/src/compiler/x86-64/arith.lisp
@@ -1234,34 +1234,21 @@
 
 ;;;; Modular functions
 
-(macrolet ((define-modular-backend (fun &optional constantp)
-             (collect ((forms))
-               (dolist (info '((60 fixnum) (64 unsigned)))
-                 (destructuring-bind (width regtype) info
-                   (let ((mfun-name (intern (format nil "~A-MOD~A" fun width)))
-                         (mvop (intern (format nil "FAST-~A-MOD~A/~A=>~A"
-                                               fun width regtype regtype)))
-                         (mcvop (intern (format nil "FAST-~A-MOD~A-C/~A=>~A"
-                                                fun width regtype regtype)))
-                         (vop (intern (format nil "FAST-~A/~A=>~A"
-                                              fun regtype regtype)))
-                         (cvop (intern (format nil "FAST-~A-C/~A=>~A"
-                                               fun regtype regtype))))
-                     (forms `(define-modular-fun ,mfun-name (x y) ,fun ,width))
-                     (forms `(define-vop (,mvop ,vop)
-                              (:translate ,mfun-name)))
-                     (when constantp
-                       (forms `(define-vop (,mcvop ,cvop)
-                                (:translate ,mfun-name)))))))
-               `(progn ,@(forms)))))
-  (define-modular-backend + t)
-  (define-modular-backend - t)
-  (define-modular-backend *)            ; FIXME: there exists a
-                                        ; FAST-*-C/FIXNUM=>FIXNUM VOP which
-                                        ; should be used for the MOD60 case,
-                                        ; but the MOD64 case cannot accept
-                                        ; immediate arguments.
-  (define-modular-backend logxor t))
+(define-modular-fun +-mod64 (x y) + 64)
+(define-vop (fast-+-mod64/unsigned=>unsigned fast-+/unsigned=>unsigned)
+  (:translate +-mod64))
+(define-vop (fast-+-mod64-c/unsigned=>unsigned fast-+-c/unsigned=>unsigned)
+  (:translate +-mod64))
+(define-modular-fun --mod64 (x y) - 64)
+(define-vop (fast---mod64/unsigned=>unsigned fast--/unsigned=>unsigned)
+  (:translate --mod64))
+(define-vop (fast---mod64-c/unsigned=>unsigned fast---c/unsigned=>unsigned)
+  (:translate --mod64))
+
+(define-modular-fun *-mod64 (x y) * 64)
+(define-vop (fast-*-mod64/unsigned=>unsigned fast-*/unsigned=>unsigned)
+  (:translate *-mod64))
+;;; (no -C variant as x86 MUL instruction doesn't take an immediate)
 
 (define-vop (fast-ash-left-mod64-c/unsigned=>unsigned
              fast-ash-c/unsigned=>unsigned)
@@ -1317,6 +1304,14 @@
     (move r x)
     (inst not r)))
 
+(define-modular-fun logxor-mod64 (x y) logxor 64)
+(define-vop (fast-logxor-mod64/unsigned=>unsigned
+             fast-logxor/unsigned=>unsigned)
+  (:translate logxor-mod64))
+(define-vop (fast-logxor-mod64-c/unsigned=>unsigned
+             fast-logxor-c/unsigned=>unsigned)
+  (:translate logxor-mod64))
+
 (define-source-transform logeqv (&rest args)
   (if (oddp (length args))
       `(logxor ,@args)
diff --git a/src/compiler/x86/arith.lisp b/src/compiler/x86/arith.lisp
index b45a958..ade7689 100644
--- a/src/compiler/x86/arith.lisp
+++ b/src/compiler/x86/arith.lisp
@@ -1192,104 +1192,64 @@
 
 ;;;; Modular functions
 
-(macrolet ((define-modular-backend (fun &optional constantp)
-             (collect ((forms))
-               (dolist (info '((29 fixnum) (32 unsigned)))
-                 (destructuring-bind (width regtype) info
-                   (let ((mfun-name (intern (format nil "~A-MOD~A" fun width)))
-                         (mvop (intern (format nil "FAST-~A-MOD~A/~A=>~A"
-                                               fun width regtype regtype)))
-                         (mcvop (intern (format nil "FAST-~A-MOD~A-C/~A=>~A"
-                                                fun width regtype regtype)))
-                         (vop (intern (format nil "FAST-~A/~A=>~A"
-                                              fun regtype regtype)))
-                         (cvop (intern (format nil "FAST-~A-C/~A=>~A"
-                                               fun regtype regtype))))
-                     (forms `(define-modular-fun ,mfun-name (x y) ,fun ,width))
-                     (forms `(define-vop (,mvop ,vop)
-                              (:translate ,mfun-name)))
-                     (when constantp
-                       (forms `(define-vop (,mcvop ,cvop)
-                                (:translate ,mfun-name)))))))
-               `(progn ,@(forms)))))
-  (define-modular-backend + t)
-  (define-modular-backend - t)
-  (define-modular-backend *)            ; FIXME: there exists a
-                                        ; FAST-*-C/FIXNUM=>FIXNUM VOP which
-                                        ; should be used for the MOD29 case,
-                                        ; but the MOD32 case cannot accept
-                                        ; immediate arguments.
-  (define-modular-backend logxor t))
-
-(macrolet ((define-modular-ash (width regtype)
-             (let ((mfun-name (intern (format nil "ASH-LEFT-MOD~A" width)))
-                   (modvop (intern (format nil "FAST-ASH-LEFT-MOD~A/~A=>~A"
-                                           width regtype regtype)))
-                   (modcvop (intern (format nil "FAST-ASH-LEFT-MOD~A-C/~A=>~A"
-                                            width regtype regtype)))
-                   (vop (intern (format nil "FAST-ASH-LEFT/~A=>~A"
-                                        regtype regtype)))
-                   (cvop (intern (format nil "FAST-ASH-C/~A=>~A"
-                                         regtype regtype))))
-               `(progn
-                 (define-vop (,modcvop ,cvop)
-                   (:translate ,mfun-name))
-                 (define-vop (,modvop ,vop))
-                 (deftransform ,mfun-name ((integer count)
-                                           ((unsigned-byte ,width) (unsigned-byte 5)))
-                   (when (sb!c::constant-lvar-p count)
-                     (sb!c::give-up-ir1-transform))
-                   '(%primitive ,modvop integer count))))))
-  (define-modular-ash 29 fixnum)
-  (define-modular-ash 32 unsigned))
+(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-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-modular-fun *-mod32 (x y) * 32)
+(define-vop (fast-*-mod32/unsigned=>unsigned fast-*/unsigned=>unsigned)
+  (:translate *-mod32))
+;;; (no -C variant as x86 MUL instruction doesn't take an immediate)
+
+(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))
 
 (in-package "SB!C")
 
 (defknown sb!vm::%lea-mod32 (integer integer (member 1 2 4 8) (signed-byte 32))
   (unsigned-byte 32)
   (foldable flushable movable))
-(defknown sb!vm::%lea-mod29 (integer integer (member 1 2 4 8) (signed-byte 29))
-  (unsigned-byte 29)
-  (foldable flushable movable))
+
 (define-modular-fun-optimizer %lea ((base index scale disp) :width width)
   (when (and (<= width 32)
 	     (constant-lvar-p scale)
 	     (constant-lvar-p disp))
     (cut-to-width base width)
     (cut-to-width index width)
-    (if (<= width 29)
-        'sb!vm::%lea-mod29
-        'sb!vm::%lea-mod32)))
+    'sb!vm::%lea-mod32))
 
 #+sb-xc-host
-(progn
-(defun sb!vm::%lea-mod29 (base index scale disp)
-  (ldb (byte 29 0) (%lea base index scale disp)))
 (defun sb!vm::%lea-mod32 (base index scale disp)
-  (ldb (byte 32 0) (%lea base index scale disp))))
+  (ldb (byte 32 0) (%lea base index scale disp)))
 #-sb-xc-host
-(progn
-(defun sb!vm::%lea-mod29 (base index scale disp)
-  (let ((base (logand base #x1fffffff))
-	(index (logand index #x1fffffff)))
-    ;; can't use modular version of %LEA, as we only have VOPs for
-    ;; constant SCALE and DISP.
-    (ldb (byte 29 0) (+ base (* index scale) disp))))
 (defun sb!vm::%lea-mod32 (base index scale disp)
   (let ((base (logand base #xffffffff))
 	(index (logand index #xffffffff)))
     ;; can't use modular version of %LEA, as we only have VOPs for
     ;; constant SCALE and DISP.
-    (ldb (byte 32 0) (+ base (* index scale) disp)))))
+    (ldb (byte 32 0) (+ base (* index scale) disp))))
 
 (in-package "SB!VM")
 
 (define-vop (%lea-mod32/unsigned=>unsigned
 	     %lea/unsigned=>unsigned)
   (:translate %lea-mod32))
-(define-vop (%lea-mod29/fixnum=>fixnum
-             %lea/fixnum=>fixnum)
-  (:translate %lea-mod29))
 
 ;;; logical operations
 (define-modular-fun lognot-mod32 (x) lognot 32)
@@ -1310,6 +1270,14 @@
     (move r x)
     (inst not r)))
 
+(define-modular-fun logxor-mod32 (x y) logxor 32)
+(define-vop (fast-logxor-mod32/unsigned=>unsigned
+             fast-logxor/unsigned=>unsigned)
+  (:translate logxor-mod32))
+(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)
@@ -1634,37 +1602,37 @@
 ;;; This is essentially a straight implementation of the algorithm in
 ;;; "Strength Reduction of Multiplications by Integer Constants",
 ;;; Youfeng Wu, ACM SIGPLAN Notices, Vol. 30, No.2, February 1995.
-(defun basic-decompose-multiplication (arg num n-bits condensed mask)
+(defun basic-decompose-multiplication (arg num n-bits condensed)
   (case (aref condensed 0)
     (0
      (let ((tmp (min 3 (aref condensed 1))))
        (decf (aref condensed 1) tmp)
-       `(logand ,mask (%lea ,arg
-                       ,(decompose-multiplication
-                         arg (ash (1- num) (- tmp)) (1- n-bits) (subseq condensed 1)
-                         mask)
-         ,(ash 1 tmp) 0))))
+       `(logand #xffffffff
+	 (%lea ,arg
+	       ,(decompose-multiplication
+		 arg (ash (1- num) (- tmp)) (1- n-bits) (subseq condensed 1))
+	       ,(ash 1 tmp) 0))))
     ((1 2 3)
      (let ((r0 (aref condensed 0)))
        (incf (aref condensed 1) r0)
-       `(logand ,mask (%lea ,(decompose-multiplication
-                              arg (- num (ash 1 r0)) (1- n-bits) (subseq condensed 1)
-                              mask)
-                       ,arg
-                       ,(ash 1 r0) 0))))
+       `(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)
-	 `(logand ,mask (ash ,(decompose-multiplication
-                               arg (ash num (- r0)) n-bits condensed mask)
-           ,r0))))))
+	 `(logand #xffffffff
+	   (ash ,(decompose-multiplication
+		  arg (ash num (- r0)) n-bits condensed)
+	        ,r0))))))
 
-(defun decompose-multiplication (arg num n-bits condensed mask)
-                                     
+(defun decompose-multiplication (arg num n-bits condensed)
   (cond
     ((= n-bits 0) 0)
     ((= num 1) arg)
     ((= n-bits 1)
-     `(logand ,mask (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))
@@ -1673,24 +1641,25 @@
 			     (ash (ldb (byte (- 32 (1+ j)) (1+ j)) num)
 				  (1+ j)))
 			  (ash 1 32)))
-             do (setq max (- (* 2 i) 3 j)
-                      end i))
+	       do (setq max (- (* 2 i) 3 j)
+			end i))
        (when (> max 0)
 	 (let ((j (reduce #'+ (subseq condensed 0 end))))
 	   (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)))))
-             `(logand ,mask (- ,(optimize-multiply arg n2 mask)
-                             ,(optimize-multiply arg n1 mask))))))))
+	   `(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) mask)))
-		       (logand ,mask (%lea ,x ,x (1- ,i) 0)))))))))
-    (t (basic-decompose-multiplication arg num n-bits condensed mask))))
+	     (return `(let ((,x ,(optimize-multiply arg (/ num i))))
+		       (logand #xffffffff
+			(%lea ,x ,x (1- ,i) 0)))))))))
+    (t (basic-decompose-multiplication arg num n-bits condensed))))
 	   
-(defun optimize-multiply (arg x mask)
+(defun optimize-multiply (arg x)
   (let* ((n-bits (logcount x))
 	 (condensed (make-array n-bits)))
     (let ((count 0) (bit 0))
@@ -1700,9 +1669,9 @@
 	       (setf count 1)
 	       (incf bit))
 	      (t (incf count)))))
-    (decompose-multiplication arg x n-bits condensed mask)))
+    (decompose-multiplication arg x n-bits condensed)))
 
-(defun *-transformer (y mask)
+(defun *-transformer (y)
   (cond
     ((= y (ash 1 (integer-length y)))
      ;; there's a generic transform for y = 2^k
@@ -1716,53 +1685,21 @@
     ;; FIXME: should make this more fine-grained.  If nothing else,
     ;; there should probably be a cutoff of about 9 instructions on
     ;; pentium-class machines.
-    (t (optimize-multiply 'x y mask))))
-
-;;; KLUDGE: due to the manner in which DEFTRANSFORM is implemented, it
-;;; is vitally important that the transform for (UNSIGNED-BYTE 29)
-;;; multiply come after the transform for (UNSIGNED-BYTE 32) multiply.
-;;; When attempting to transform a function application, the compiler
-;;; examines the relevant transforms for the function in the reverse
-;;; order in which they were defined and takes the first one which
-;;; succeeds.  If the (UNSIGNED-BYTE 32) transform were to come after
-;;; the (UNSIGNED-BYTE 29) transform, the (UNSIGNED-BYTE 32) transform
-;;; would be attempted first.  Since (UNSIGNED-BYTE 29) is subsumed by
-;;; (UNSIGNED-BYTE 32), and assuming the arguments and result are
-;;; (UNSIGNED-BYTE 29)s, the (UNSIGNED-BYTE 32) transform would succeed
-;;; and force (UNSIGNED-BYTE 32) arithmetic where (UNSIGNED-BYTE 29)
-;;; arithmetic would work perfectly well--introducing unnecessary
-;;; shifting and causing efficiency notes where the user might not
-;;; expect them to occur.  So we define the (UNSIGNED-BYTE 29) transform
-;;; *after* the (UNSIGNED-BYTE 32) transform in order to attempt the
-;;; (UNSIGNED-BYTE 29) transform *before* the (UNSIGNED-BYTE 32)
-;;; transform.  Yuck.   -- njf, 2004-12-07
+    (t (optimize-multiply 'x y))))
+
 (deftransform * ((x y)
 		 ((unsigned-byte 32) (constant-arg (unsigned-byte 32)))
 		 (unsigned-byte 32))
   "recode as leas, shifts and adds"
   (let ((y (lvar-value y)))
-    (*-transformer y #xffffffff)))
-
-(deftransform * ((x y)
-                 ((unsigned-byte 29) (constant-arg (unsigned-byte 29)))
-                 (unsigned-byte 29))
-  "recode as leas, shifts, and adds"
-  (let ((y (lvar-value y)))
-    (*-transformer y #x1fffffff)))
+    (*-transformer y)))
 
 (deftransform sb!vm::*-mod32
     ((x y) ((unsigned-byte 32) (constant-arg (unsigned-byte 32)))
      (unsigned-byte 32))
   "recode as leas, shifts and adds"
   (let ((y (lvar-value y)))
-    (*-transformer y #xffffffff)))
-
-(deftransform sb!vm::*-mod29
-    ((x y) ((unsigned-byte 29) (constant-arg (unsigned-byte 29)))
-     (unsigned-byte 29))
-  "recode as leas, shifts and adds"
-  (let ((y (lvar-value y)))
-    (*-transformer y #x1fffffff)))
+    (*-transformer y)))
 
 ;;; FIXME: we should also be able to write an optimizer or two to
 ;;; convert (+ (* x 2) 17), (- (* x 9) 5) to a %LEA.
diff --git a/version.lisp-expr b/version.lisp-expr
index 673838c..2c95b47 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.8.17.27"
+"0.8.17.28"