X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fbignum.lisp;h=054e6dfd17b56e6b77c5d4f31ea528c528358896;hb=18dc0069cd514c976042766ab9a785c970fe1603;hp=c07fc192847b4b01754a2b4d357869d7312b59d4;hpb=1a1f1815159e714a635e92e9f0f2f7845e64fc91;p=sbcl.git

diff --git a/src/code/bignum.lisp b/src/code/bignum.lisp
index c07fc19..054e6df 100644
--- a/src/code/bignum.lisp
+++ b/src/code/bignum.lisp
@@ -20,7 +20,7 @@
 ;;;       bignum-ashift-right bignum-ashift-left bignum-gcd
 ;;;       bignum-to-float bignum-integer-length
 ;;;       bignum-logical-and bignum-logical-ior bignum-logical-xor
-;;;       bignum-logical-not bignum-load-byte bignum-deposit-byte
+;;;       bignum-logical-not bignum-load-byte
 ;;;       bignum-truncate bignum-plus-p bignum-compare make-small-bignum
 ;;;       bignum-logbitp bignum-logcount
 ;;;   These symbols define the interface to the compiler:
@@ -28,7 +28,7 @@
 ;;;       %bignum-length %bignum-set-length %bignum-ref %bignum-set
 ;;;       %digit-0-or-plusp %add-with-carry %subtract-with-borrow
 ;;;       %multiply-and-add %multiply %lognot %logand %logior %logxor
-;;;       %fixnum-to-digit %floor %fixnum-digit-with-correct-sign %ashl
+;;;       %fixnum-to-digit %bigfloor %fixnum-digit-with-correct-sign %ashl
 ;;;       %ashr %digit-logical-shift-right))
 
 ;;; The following interfaces will either be assembler routines or code
@@ -67,7 +67,7 @@
 ;;;    LDB
 ;;;       %FIXNUM-TO-DIGIT
 ;;;    TRUNCATE
-;;;       %FLOOR
+;;;       %BIGFLOOR
 ;;;
 ;;; Note: The floating routines know about the float representation.
 ;;;
@@ -194,7 +194,7 @@
   (%lognot digit))
 
 ;;; Each of these does the digit-size unsigned op.
-#!-sb-fluid (declaim (inline %logand %logior %logxor))
+(declaim (inline %logand %logior %logxor))
 (defun %logand (a b)
   (declare (type bignum-element-type a b))
   (logand a b))
@@ -216,13 +216,13 @@
 ;;; dividing the first two as a 2*digit-size integer by the third.
 ;;;
 ;;; Do weird LET and SETQ stuff to bamboozle the compiler into allowing
-;;; the %FLOOR transform to expand into pseudo-assembler for which the
+;;; the %BIGFLOOR transform to expand into pseudo-assembler for which the
 ;;; compiler can later correctly allocate registers.
-(defun %floor (a b c)
+(defun %bigfloor (a b c)
   (let ((a a) (b b) (c c))
     (declare (type bignum-element-type a b c))
     (setq a a b b c c)
-    (%floor a b c)))
+    (%bigfloor a b c)))
 
 ;;; Convert the digit to a regular integer assuming that the digit is signed.
 (defun %fixnum-digit-with-correct-sign (digit)
@@ -270,7 +270,7 @@
 
 ;;; These take two digit-size quantities and compare or contrast them
 ;;; without wasting time with incorrect type checking.
-#!-sb-fluid (declaim (inline %digit-compare %digit-greater))
+(declaim (inline %digit-compare %digit-greater))
 (defun %digit-compare (x y)
   (= x y))
 (defun %digit-greater (x y)
@@ -339,14 +339,7 @@
 ;;; function to call that fixes up the result returning any useful values, such
 ;;; as the result. This macro may evaluate its arguments more than once.
 (sb!xc:defmacro subtract-bignum-loop (a len-a b len-b res len-res return-fun)
-  (let ((borrow (gensym))
-        (a-digit (gensym))
-        (a-sign (gensym))
-        (b-digit (gensym))
-        (b-sign (gensym))
-        (i (gensym))
-        (v (gensym))
-        (k (gensym)))
+  (with-unique-names (borrow a-digit a-sign b-digit b-sign i v k)
     `(let* ((,borrow 1)
             (,a-sign (%sign-digit ,a ,len-a))
             (,b-sign (%sign-digit ,b ,len-b)))
@@ -482,31 +475,30 @@
                                 from-end)
   (sb!int:once-only ((n-dest dest)
                      (n-src src))
-    (let ((n-start1 (gensym))
-          (n-end1 (gensym))
-          (n-start2 (gensym))
-          (n-end2 (gensym))
-          (i1 (gensym))
-          (i2 (gensym))
-          (end1 (or end1 `(%bignum-length ,n-dest)))
-          (end2 (or end2 `(%bignum-length ,n-src))))
-      (if from-end
-          `(let ((,n-start1 ,start1)
-                 (,n-start2 ,start2))
-             (do ((,i1 (1- ,end1) (1- ,i1))
-                  (,i2 (1- ,end2) (1- ,i2)))
-                 ((or (< ,i1 ,n-start1) (< ,i2 ,n-start2)))
-               (declare (fixnum ,i1 ,i2))
-               (%bignum-set ,n-dest ,i1
-                            (%bignum-ref ,n-src ,i2))))
-          `(let ((,n-end1 ,end1)
-                 (,n-end2 ,end2))
-             (do ((,i1 ,start1 (1+ ,i1))
-                  (,i2 ,start2 (1+ ,i2)))
-                 ((or (>= ,i1 ,n-end1) (>= ,i2 ,n-end2)))
-               (declare (type bignum-index ,i1 ,i2))
-               (%bignum-set ,n-dest ,i1
-                            (%bignum-ref ,n-src ,i2))))))))
+    (with-unique-names (n-start1 n-end1 n-start2 n-end2 i1 i2)
+      (let ((end1 (or end1 `(%bignum-length ,n-dest)))
+            (end2 (or end2 `(%bignum-length ,n-src))))
+        (if from-end
+            `(let ((,n-start1 ,start1)
+                   (,n-start2 ,start2))
+              (do ((,i1 (1- ,end1) (1- ,i1))
+                   (,i2 (1- ,end2) (1- ,i2)))
+                  ((or (< ,i1 ,n-start1) (< ,i2 ,n-start2)))
+                (declare (fixnum ,i1 ,i2))
+                (%bignum-set ,n-dest ,i1 (%bignum-ref ,n-src ,i2))))
+            (if (eql start1 start2)
+                `(let ((,n-end1 (min ,end1 ,end2)))
+                  (do ((,i1 ,start1 (1+ ,i1)))
+                      ((>= ,i1 ,n-end1))
+                    (declare (type bignum-index ,i1))
+                    (%bignum-set ,n-dest ,i1 (%bignum-ref ,n-src ,i1))))
+                `(let ((,n-end1 ,end1)
+                       (,n-end2 ,end2))
+                  (do ((,i1 ,start1 (1+ ,i1))
+                       (,i2 ,start2 (1+ ,i2)))
+                      ((or (>= ,i1 ,n-end1) (>= ,i2 ,n-end2)))
+                    (declare (type bignum-index ,i1 ,i2))
+                    (%bignum-set ,n-dest ,i1 (%bignum-ref ,n-src ,i2))))))))))
 
 (sb!xc:defmacro with-bignum-buffers (specs &body body)
   #!+sb-doc
@@ -543,7 +535,7 @@
 ;;; it, we pay a heavy price in BIGNUM-GCD when compiled by the
 ;;; cross-compiler. -- CSR, 2004-07-19
 (declaim (ftype (sfunction (bignum-type bignum-index bignum-type bignum-index)
-                           sb!vm::positive-fixnum)
+                           (and unsigned-byte fixnum))
                 bignum-factors-of-two))
 (defun bignum-factors-of-two (a len-a b len-b)
   (declare (type bignum-index len-a len-b) (type bignum-type a b))
@@ -605,7 +597,7 @@
     (declare (type (unsigned-byte #.sb!vm:n-word-bits) ud vd umask imask m))
     (dotimes (i digit-size)
       (setf umask (logior umask imask))
-      (unless (zerop (logand ud umask))
+      (when (logtest ud umask)
         (setf ud (modularly (- ud vd)))
         (setf m (modularly (logior m imask))))
       (setf imask (modularly (ash imask 1)))
@@ -634,7 +626,7 @@
     (declare (type (unsigned-byte #.(integer-length #.sb!vm:n-word-bits)) d)
              (type (unsigned-byte #.sb!vm:n-word-bits) n))
     (gcd-assert (>= d 0))
-    (unless (zerop (logand (%bignum-ref u 0) n))
+    (when (logtest (%bignum-ref u 0) n)
       (let ((tmp1-len
              (multiply-bignum-buffer-and-smallnum-to-buffer v v-len
                                                             (logand n (bmod u
@@ -785,6 +777,7 @@
         (setf u-len (make-gcd-bignum-odd u u-len))
         (rotatef u v)
         (rotatef u-len v-len))
+      (bignum-abs-buffer u u-len)
       (setf u (copy-bignum u u-len))
       (let ((n (bignum-mod-gcd v1 u)))
         (ash (bignum-mod-gcd u1 (if (fixnump n)
@@ -901,13 +894,9 @@
 
 ;;; This negates bignum-len digits of bignum, storing the resulting digits into
 ;;; result (possibly EQ to bignum) and returning whatever end-carry there is.
-(sb!xc:defmacro bignum-negate-loop (bignum
-                                    bignum-len
-                                    &optional (result nil resultp))
-  (let ((carry (gensym))
-        (end (gensym))
-        (value (gensym))
-        (last (gensym)))
+(sb!xc:defmacro bignum-negate-loop
+    (bignum bignum-len &optional (result nil resultp))
+  (with-unique-names (carry end value last)
     `(let* (,@(if (not resultp) `(,last))
             (,carry
              (multiple-value-bind (,value ,carry)
@@ -989,15 +978,14 @@
           (res-len-1 (1- res-len))
           ,@(if result `((,result (%allocate-bignum res-len)))))
      (declare (type bignum-index res-len res-len-1))
-     (do ((i ,start-digit i+1)
-          (i+1 (1+ ,start-digit) (1+ i+1))
+     (do ((i ,start-digit (1+ i))
           (j 0 (1+ j)))
          ,termination
-       (declare (type bignum-index i i+1 j))
+       (declare (type bignum-index i j))
        (setf (%bignum-ref ,(if result result source) j)
              (%logior (%digit-logical-shift-right (%bignum-ref ,source i)
                                                   ,start-pos)
-                      (%ashl (%bignum-ref ,source i+1)
+                      (%ashl (%bignum-ref ,source (1+ i))
                              high-bits-in-first-digit))))))
 
 ) ; EVAL-WHEN
@@ -1123,8 +1111,7 @@
          (res-len-1 (1- res-len))
          (res (or res (%allocate-bignum res-len))))
     (declare (type bignum-index res-len res-len-1))
-    (do ((i 0 i+1)
-         (i+1 1 (1+ i+1))
+    (do ((i 0 (1+ i))
          (j (1+ digits) (1+ j)))
         ((= j res-len-1)
          (setf (%bignum-ref res digits)
@@ -1134,11 +1121,11 @@
          (if resp
              (%normalize-bignum-buffer res res-len)
              (%normalize-bignum res res-len)))
-      (declare (type bignum-index i i+1 j))
+      (declare (type bignum-index i j))
       (setf (%bignum-ref res j)
             (%logior (%digit-logical-shift-right (%bignum-ref bignum i)
                                                  remaining-bits)
-                     (%ashl (%bignum-ref bignum i+1) n-bits))))))
+                     (%ashl (%bignum-ref bignum (1+ i)) n-bits))))))
 
 ;;;; relational operators
 
@@ -1277,7 +1264,7 @@
 
     (cond
      ;; Round down if round bit is 0.
-     ((zerop (logand round-bit low))
+     ((not (logtest round-bit low))
       (float-from-bits shifted len))
      ;; If only round bit is set, then round to even.
      ((and (= low round-bit)
@@ -1315,8 +1302,7 @@
         (floor index digit-size)
       (if (>= word-index len)
           (not (bignum-plus-p bignum))
-          (not (zerop (logand (%bignum-ref bignum word-index)
-                              (ash 1 bit-index))))))))
+          (logbitp bit-index (%bignum-ref bignum word-index))))))
 
 (defun bignum-logcount (bignum)
   (declare (type bignum-type bignum))
@@ -1475,463 +1461,9 @@
     (setf (%bignum-ref res i) (%logxor sign (%bignum-ref b i))))
   (%normalize-bignum res len-b))
 
-;;;; LDB (load byte)
-
-#|
-FOR NOW WE DON'T USE LDB OR DPB. WE USE SHIFTS AND MASKS IN NUMBERS.LISP WHICH
-IS LESS EFFICIENT BUT EASIER TO MAINTAIN. BILL SAYS THIS CODE CERTAINLY WORKS!
-
-(defconstant maximum-fixnum-bits (- sb!vm:n-word-bits sb!vm:n-lowtag-bits))
-
-(defun bignum-load-byte (byte bignum)
-  (declare (type bignum-type bignum))
-  (let ((byte-len (byte-size byte))
-        (byte-pos (byte-position byte)))
-    (if (< byte-len maximum-fixnum-bits)
-        (bignum-ldb-fixnum-res bignum byte-len byte-pos)
-        (bignum-ldb-bignum-res bignum byte-len byte-pos))))
-
-;;; This returns a fixnum result of loading a byte from a bignum. In order, we
-;;; check for the following conditions:
-;;;    Insufficient bignum digits to start loading a byte --
-;;;       Return 0 or byte-len 1's depending on sign of bignum.
-;;;    One bignum digit containing the whole byte spec --
-;;;       Grab 'em, shift 'em, and mask out what we don't want.
-;;;    Insufficient bignum digits to cover crossing a digit boundary --
-;;;       Grab the available bits in the last digit, and or in whatever
-;;;       virtual sign bits we need to return a full byte spec.
-;;;    Else (we cross a digit boundary with all bits available) --
-;;;       Make a couple masks, grab what we want, shift it around, and
-;;;       LOGIOR it all together.
-;;; Because (< maximum-fixnum-bits digit-size) and
-;;;      (< byte-len maximum-fixnum-bits),
-;;; we only cross one digit boundary if any.
-(defun bignum-ldb-fixnum-res (bignum byte-len byte-pos)
-  (multiple-value-bind (skipped-digits pos) (truncate byte-pos digit-size)
-    (let ((bignum-len (%bignum-length bignum))
-          (s-digits+1 (1+ skipped-digits)))
-      (declare (type bignum-index bignum-len s-digits+1))
-      (if (>= skipped-digits bignum-len)
-          (if (%bignum-0-or-plusp bignum bignum-len)
-              0
-              (%make-ones byte-len))
-          (let ((end (+ pos byte-len)))
-            (cond ((<= end digit-size)
-                   (logand (ash (%bignum-ref bignum skipped-digits) (- pos))
-                           ;; Must LOGAND after shift here.
-                           (%make-ones byte-len)))
-                  ((>= s-digits+1 bignum-len)
-                   (let* ((available-bits (- digit-size pos))
-                          (res (logand (ash (%bignum-ref bignum skipped-digits)
-                                            (- pos))
-                                       ;; LOGAND should be unnecessary here
-                                       ;; with a logical right shift or a
-                                       ;; correct digit-sized one.
-                                       (%make-ones available-bits))))
-                     (if (%bignum-0-or-plusp bignum bignum-len)
-                         res
-                         (logior (%ashl (%make-ones (- end digit-size))
-                                        available-bits)
-                                 res))))
-                  (t
-                   (let* ((high-bits-in-first-digit (- digit-size pos))
-                          (high-mask (%make-ones high-bits-in-first-digit))
-                          (low-bits-in-next-digit (- end digit-size))
-                          (low-mask (%make-ones low-bits-in-next-digit)))
-                     (declare (type bignum-element-type high-mask low-mask))
-                     (logior (%ashl (logand (%bignum-ref bignum s-digits+1)
-                                            low-mask)
-                                    high-bits-in-first-digit)
-                             (logand (ash (%bignum-ref bignum skipped-digits)
-                                          (- pos))
-                                     ;; LOGAND should be unnecessary here with
-                                     ;; a logical right shift or a correct
-                                     ;; digit-sized one.
-                                     high-mask))))))))))
-
-;;; This returns a bignum result of loading a byte from a bignum. In order, we
-;;; check for the following conditions:
-;;;    Insufficient bignum digits to start loading a byte --
-;;;    Byte-pos starting on a digit boundary --
-;;;    Byte spec contained in one bignum digit --
-;;;       Grab the bits we want and stick them in a single digit result.
-;;;       Since we know byte-pos is non-zero here, we know our single digit
-;;;       will have a zero high sign bit.
-;;;    Else (unaligned multiple digits) --
-;;;       This is like doing a shift right combined with either masking
-;;;       out unwanted high bits from bignum or filling in virtual sign
-;;;       bits if bignum had insufficient bits. We use SHIFT-RIGHT-ALIGNED
-;;;       and reference lots of local variables this macro establishes.
-(defun bignum-ldb-bignum-res (bignum byte-len byte-pos)
-  (multiple-value-bind (skipped-digits pos) (truncate byte-pos digit-size)
-    (let ((bignum-len (%bignum-length bignum)))
-      (declare (type bignum-index bignum-len))
-      (cond
-       ((>= skipped-digits bignum-len)
-        (make-bignum-virtual-ldb-bits bignum bignum-len byte-len))
-       ((zerop pos)
-        (make-aligned-ldb-bignum bignum bignum-len byte-len skipped-digits))
-       ((< (+ pos byte-len) digit-size)
-        (let ((res (%allocate-bignum 1)))
-          (setf (%bignum-ref res 0)
-                (logand (%ashr (%bignum-ref bignum skipped-digits) pos)
-                        (%make-ones byte-len)))
-          res))
-       (t
-        (make-unaligned-ldb-bignum bignum bignum-len
-                                   byte-len skipped-digits pos))))))
-
-;;; This returns bits from bignum that don't physically exist. These are
-;;; all zero or one depending on the sign of the bignum.
-(defun make-bignum-virtual-ldb-bits (bignum bignum-len byte-len)
-  (if (%bignum-0-or-plusp bignum bignum-len)
-      0
-      (multiple-value-bind (res-len-1 extra) (truncate byte-len digit-size)
-        (declare (type bignum-index res-len-1))
-        (let* ((res-len (1+ res-len-1))
-               (res (%allocate-bignum res-len)))
-          (declare (type bignum-index res-len))
-          (do ((j 0 (1+ j)))
-              ((= j res-len-1)
-               (setf (%bignum-ref res j) (%make-ones extra))
-               (%normalize-bignum res res-len))
-            (declare (type bignum-index j))
-            (setf (%bignum-ref res j) all-ones-digit))))))
-
-;;; Since we are picking up aligned digits, we just copy the whole digits
-;;; we want and fill in extra bits. We might have a byte-len that extends
-;;; off the end of the bignum, so we may have to fill in extra 1's if the
-;;; bignum is negative.
-(defun make-aligned-ldb-bignum (bignum bignum-len byte-len skipped-digits)
-  (multiple-value-bind (res-len-1 extra) (truncate byte-len digit-size)
-    (declare (type bignum-index res-len-1))
-    (let* ((res-len (1+ res-len-1))
-           (res (%allocate-bignum res-len)))
-      (declare (type bignum-index res-len))
-      (do ((i skipped-digits (1+ i))
-           (j 0 (1+ j)))
-          ((or (= j res-len-1) (= i bignum-len))
-           (cond ((< i bignum-len)
-                  (setf (%bignum-ref res j)
-                        (logand (%bignum-ref bignum i)
-                                (the bignum-element-type (%make-ones extra)))))
-                 ((%bignum-0-or-plusp bignum bignum-len))
-                 (t
-                  (do ((j j (1+ j)))
-                      ((= j res-len-1)
-                       (setf (%bignum-ref res j) (%make-ones extra)))
-                    (setf (%bignum-ref res j) all-ones-digit))))
-           (%normalize-bignum res res-len))
-      (declare (type bignum-index i j))
-      (setf (%bignum-ref res j) (%bignum-ref bignum i))))))
-
-;;; This grabs unaligned bignum bits from bignum assuming byte-len causes at
-;;; least one digit boundary crossing. We use SHIFT-RIGHT-UNALIGNED referencing
-;;; lots of local variables established by it.
-(defun make-unaligned-ldb-bignum (bignum
-                                  bignum-len
-                                  byte-len
-                                  skipped-digits
-                                  pos)
-  (multiple-value-bind (res-len-1 extra) (truncate byte-len digit-size)
-    (shift-right-unaligned
-     bignum skipped-digits pos (1+ res-len-1)
-     ((or (= j res-len-1) (= i+1 bignum-len))
-      (cond ((= j res-len-1)
-             (cond
-              ((< extra high-bits-in-first-digit)
-               (setf (%bignum-ref res j)
-                     (logand (ash (%bignum-ref bignum i) minus-start-pos)
-                             ;; Must LOGAND after shift here.
-                             (%make-ones extra))))
-              (t
-               (setf (%bignum-ref res j)
-                     (logand (ash (%bignum-ref bignum i) minus-start-pos)
-                             ;; LOGAND should be unnecessary here with a logical
-                             ;; right shift or a correct digit-sized one.
-                             high-mask))
-               (when (%bignum-0-or-plusp bignum bignum-len)
-                 (setf (%bignum-ref res j)
-                       (logior (%bignum-ref res j)
-                               (%ashl (%make-ones
-                                       (- extra high-bits-in-first-digit))
-                                      high-bits-in-first-digit)))))))
-            (t
-             (setf (%bignum-ref res j)
-                   (logand (ash (%bignum-ref bignum i) minus-start-pos)
-                           ;; LOGAND should be unnecessary here with a logical
-                           ;; right shift or a correct digit-sized one.
-                           high-mask))
-             (unless (%bignum-0-or-plusp bignum bignum-len)
-               ;; Fill in upper half of this result digit with 1's.
-               (setf (%bignum-ref res j)
-                     (logior (%bignum-ref res j)
-                             (%ashl low-mask high-bits-in-first-digit)))
-               ;; Fill in any extra 1's we need to be byte-len long.
-               (do ((j (1+ j) (1+ j)))
-                   ((>= j res-len-1)
-                    (setf (%bignum-ref res j) (%make-ones extra)))
-                 (setf (%bignum-ref res j) all-ones-digit)))))
-      (%normalize-bignum res res-len))
-     res)))
-
-;;;; DPB (deposit byte)
-
-(defun bignum-deposit-byte (new-byte byte-spec bignum)
-  (declare (type bignum-type bignum))
-  (let* ((byte-len (byte-size byte-spec))
-         (byte-pos (byte-position byte-spec))
-         (bignum-len (%bignum-length bignum))
-         (bignum-plusp (%bignum-0-or-plusp bignum bignum-len))
-         (byte-end (+ byte-pos byte-len))
-         (res-len (1+ (max (ceiling byte-end digit-size) bignum-len)))
-         (res (%allocate-bignum res-len)))
-    (declare (type bignum-index bignum-len res-len))
-    ;; Fill in an extra sign digit in case we set what would otherwise be the
-    ;; last digit's last bit. Normalize at the end in case this was
-    ;; unnecessary.
-    (unless bignum-plusp
-      (setf (%bignum-ref res (1- res-len)) all-ones-digit))
-    (multiple-value-bind (end-digit end-bits) (truncate byte-end digit-size)
-      (declare (type bignum-index end-digit))
-      ;; Fill in bits from bignum up to byte-pos.
-      (multiple-value-bind (pos-digit pos-bits) (truncate byte-pos digit-size)
-        (declare (type bignum-index pos-digit))
-        (do ((i 0 (1+ i))
-             (end (min pos-digit bignum-len)))
-            ((= i end)
-             (cond ((< i bignum-len)
-                    (unless (zerop pos-bits)
-                      (setf (%bignum-ref res i)
-                            (logand (%bignum-ref bignum i)
-                                    (%make-ones pos-bits)))))
-                   (bignum-plusp)
-                   (t
-                    (do ((i i (1+ i)))
-                        ((= i pos-digit)
-                         (unless (zerop pos-bits)
-                           (setf (%bignum-ref res i) (%make-ones pos-bits))))
-                      (setf (%bignum-ref res i) all-ones-digit)))))
-          (setf (%bignum-ref res i) (%bignum-ref bignum i)))
-        ;; Fill in bits from new-byte.
-        (if (typep new-byte 'fixnum)
-            (deposit-fixnum-bits new-byte byte-len pos-digit pos-bits
-                                 end-digit end-bits res)
-            (deposit-bignum-bits new-byte byte-len pos-digit pos-bits
-                                 end-digit end-bits res)))
-      ;; Fill in remaining bits from bignum after byte-spec.
-      (when (< end-digit bignum-len)
-        (setf (%bignum-ref res end-digit)
-              (logior (logand (%bignum-ref bignum end-digit)
-                              (%ashl (%make-ones (- digit-size end-bits))
-                                     end-bits))
-                      ;; DEPOSIT-FIXNUM-BITS and DEPOSIT-BIGNUM-BITS only store
-                      ;; bits from new-byte into res's end-digit element, so
-                      ;; we don't need to mask out unwanted high bits.
-                      (%bignum-ref res end-digit)))
-        (do ((i (1+ end-digit) (1+ i)))
-            ((= i bignum-len))
-          (setf (%bignum-ref res i) (%bignum-ref bignum i)))))
-    (%normalize-bignum res res-len)))
-
-;;; This starts at result's pos-digit skipping pos-bits, and it stores bits
-;;; from new-byte, a fixnum, into result. It effectively stores byte-len
-;;; number of bits, but never stores past end-digit and end-bits in result.
-;;; The first branch fires when all the bits we want from new-byte are present;
-;;; if byte-len crosses from the current result digit into the next, the last
-;;; argument to DEPOSIT-FIXNUM-DIGIT is a mask for those bits. The second
-;;; branch handles the need to grab more bits than the fixnum new-byte has, but
-;;; new-byte is positive; therefore, any virtual bits are zero. The mask for
-;;; bits that don't fit in the current result digit is simply the remaining
-;;; bits in the bignum digit containing new-byte; we don't care if we store
-;;; some extra in the next result digit since they will be zeros. The last
-;;; branch handles the need to grab more bits than the fixnum new-byte has, but
-;;; new-byte is negative; therefore, any virtual bits must be explicitly filled
-;;; in as ones. We call DEPOSIT-FIXNUM-DIGIT to grab what bits actually exist
-;;; and to fill in the current result digit.
-(defun deposit-fixnum-bits (new-byte byte-len pos-digit pos-bits
-                            end-digit end-bits result)
-  (declare (type bignum-index pos-digit end-digit))
-  (let ((other-bits (- digit-size pos-bits))
-        (new-byte-digit (%fixnum-to-digit new-byte)))
-    (declare (type bignum-element-type new-byte-digit))
-    (cond ((< byte-len maximum-fixnum-bits)
-           (deposit-fixnum-digit new-byte-digit byte-len pos-digit pos-bits
-                                 other-bits result
-                                 (- byte-len other-bits)))
-          ((or (plusp new-byte) (zerop new-byte))
-           (deposit-fixnum-digit new-byte-digit byte-len pos-digit pos-bits
-                                 other-bits result pos-bits))
-          (t
-           (multiple-value-bind (digit bits)
-               (deposit-fixnum-digit new-byte-digit byte-len pos-digit pos-bits
-                                     other-bits result
-                                     (if (< (- byte-len other-bits) digit-size)
-                                         (- byte-len other-bits)
-                                         digit-size))
-             (declare (type bignum-index digit))
-             (cond ((< digit end-digit)
-                    (setf (%bignum-ref result digit)
-                          (logior (%bignum-ref result digit)
-                                  (%ashl (%make-ones (- digit-size bits)) bits)))
-                    (do ((i (1+ digit) (1+ i)))
-                        ((= i end-digit)
-                         (setf (%bignum-ref result i) (%make-ones end-bits)))
-                      (setf (%bignum-ref result i) all-ones-digit)))
-                   ((> digit end-digit))
-                   ((< bits end-bits)
-                    (setf (%bignum-ref result digit)
-                          (logior (%bignum-ref result digit)
-                                  (%ashl (%make-ones (- end-bits bits))
-                                         bits))))))))))
-
-;;; This fills in the current result digit from new-byte-digit. The first case
-;;; handles everything we want fitting in the current digit, and other-bits is
-;;; the number of bits remaining to be filled in result's current digit. This
-;;; number is digit-size minus pos-bits. The second branch handles filling in
-;;; result's current digit, and it shoves the unused bits of new-byte-digit
-;;; into the next result digit. This is correct regardless of new-byte-digit's
-;;; sign. It returns the new current result digit and how many bits already
-;;; filled in the result digit.
-(defun deposit-fixnum-digit (new-byte-digit byte-len pos-digit pos-bits
-                             other-bits result next-digit-bits-needed)
-  (declare (type bignum-index pos-digit)
-           (type bignum-element-type new-byte-digit next-digit-mask))
-  (cond ((<= byte-len other-bits)
-         ;; Bits from new-byte fit in the current result digit.
-         (setf (%bignum-ref result pos-digit)
-               (logior (%bignum-ref result pos-digit)
-                       (%ashl (logand new-byte-digit (%make-ones byte-len))
-                              pos-bits)))
-         (if (= byte-len other-bits)
-             (values (1+ pos-digit) 0)
-             (values pos-digit (+ byte-len pos-bits))))
-        (t
-         ;; Some of new-byte's bits go in current result digit.
-         (setf (%bignum-ref result pos-digit)
-               (logior (%bignum-ref result pos-digit)
-                       (%ashl (logand new-byte-digit (%make-ones other-bits))
-                              pos-bits)))
-         (let ((pos-digit+1 (1+ pos-digit)))
-           ;; The rest of new-byte's bits go in the next result digit.
-           (setf (%bignum-ref result pos-digit+1)
-                 (logand (ash new-byte-digit (- other-bits))
-                         ;; Must LOGAND after shift here.
-                         (%make-ones next-digit-bits-needed)))
-           (if (= next-digit-bits-needed digit-size)
-               (values (1+ pos-digit+1) 0)
-               (values pos-digit+1 next-digit-bits-needed))))))
-
-;;; This starts at result's pos-digit skipping pos-bits, and it stores bits
-;;; from new-byte, a bignum, into result. It effectively stores byte-len
-;;; number of bits, but never stores past end-digit and end-bits in result.
-;;; When handling a starting bit unaligned with a digit boundary, we check
-;;; in the second branch for the byte spec fitting into the pos-digit element
-;;; after after pos-bits; DEPOSIT-UNALIGNED-BIGNUM-BITS expects at least one
-;;; digit boundary crossing.
-(defun deposit-bignum-bits (bignum-byte byte-len pos-digit pos-bits
-                            end-digit end-bits result)
-  (declare (type bignum-index pos-digit end-digit))
-  (cond ((zerop pos-bits)
-         (deposit-aligned-bignum-bits bignum-byte pos-digit end-digit end-bits
-                                      result))
-        ((or (= end-digit pos-digit)
-             (and (= end-digit (1+ pos-digit))
-                  (zerop end-bits)))
-         (setf (%bignum-ref result pos-digit)
-               (logior (%bignum-ref result pos-digit)
-                       (%ashl (logand (%bignum-ref bignum-byte 0)
-                                      (%make-ones byte-len))
-                              pos-bits))))
-        (t (deposit-unaligned-bignum-bits bignum-byte pos-digit pos-bits
-                                          end-digit end-bits result))))
-
-;;; This deposits bits from bignum-byte into result starting at pos-digit and
-;;; the zero'th bit. It effectively only stores bits to end-bits in the
-;;; end-digit element of result. The loop termination code takes care of
-;;; picking up the last digit's bits or filling in virtual negative sign bits.
-(defun deposit-aligned-bignum-bits (bignum-byte pos-digit end-digit end-bits
-                                    result)
-  (declare (type bignum-index pos-digit end-digit))
-  (let* ((bignum-len (%bignum-length bignum-byte))
-         (bignum-plusp (%bignum-0-or-plusp bignum-byte bignum-len)))
-    (declare (type bignum-index bignum-len))
-    (do ((i 0 (1+ i ))
-         (j pos-digit (1+ j)))
-        ((or (= j end-digit) (= i bignum-len))
-         (cond ((= j end-digit)
-                (cond ((< i bignum-len)
-                       (setf (%bignum-ref result j)
-                             (logand (%bignum-ref bignum-byte i)
-                                     (%make-ones end-bits))))
-                      (bignum-plusp)
-                      (t
-                       (setf (%bignum-ref result j) (%make-ones end-bits)))))
-               (bignum-plusp)
-               (t
-                (do ((j j (1+ j)))
-                    ((= j end-digit)
-                     (setf (%bignum-ref result j) (%make-ones end-bits)))
-                  (setf (%bignum-ref result j) all-ones-digit)))))
-      (setf (%bignum-ref result j) (%bignum-ref bignum-byte i)))))
-
-;;; This assumes at least one digit crossing.
-(defun deposit-unaligned-bignum-bits (bignum-byte pos-digit pos-bits
-                                      end-digit end-bits result)
-  (declare (type bignum-index pos-digit end-digit))
-  (let* ((bignum-len (%bignum-length bignum-byte))
-         (bignum-plusp (%bignum-0-or-plusp bignum-byte bignum-len))
-         (low-mask (%make-ones pos-bits))
-         (bits-past-pos-bits (- digit-size pos-bits))
-         (high-mask (%make-ones bits-past-pos-bits))
-         (minus-high-bits (- bits-past-pos-bits)))
-    (declare (type bignum-element-type low-mask high-mask)
-             (type bignum-index bignum-len))
-    (do ((i 0 (1+ i))
-         (j pos-digit j+1)
-         (j+1 (1+ pos-digit) (1+ j+1)))
-        ((or (= j end-digit) (= i bignum-len))
-         (cond
-          ((= j end-digit)
-           (setf (%bignum-ref result j)
-                 (cond
-                  ((>= pos-bits end-bits)
-                   (logand (%bignum-ref result j) (%make-ones end-bits)))
-                  ((< i bignum-len)
-                   (logior (%bignum-ref result j)
-                           (%ashl (logand (%bignum-ref bignum-byte i)
-                                          (%make-ones (- end-bits pos-bits)))
-                                  pos-bits)))
-                  (bignum-plusp
-                   (logand (%bignum-ref result j)
-                           ;; 0's between pos-bits and end-bits positions.
-                           (logior (%ashl (%make-ones (- digit-size end-bits))
-                                          end-bits)
-                                   low-mask)))
-                  (t (logior (%bignum-ref result j)
-                             (%ashl (%make-ones (- end-bits pos-bits))
-                                    pos-bits))))))
-          (bignum-plusp)
-          (t
-           (setf (%bignum-ref result j)
-                 (%ashl (%make-ones bits-past-pos-bits) pos-bits))
-           (do ((j j+1 (1+ j)))
-               ((= j end-digit)
-                (setf (%bignum-ref result j) (%make-ones end-bits)))
-             (declare (type bignum-index j))
-             (setf (%bignum-ref result j) all-ones-digit)))))
-      (declare (type bignum-index i j j+1))
-      (let ((digit (%bignum-ref bignum-byte i)))
-        (declare (type bignum-element-type digit))
-        (setf (%bignum-ref result j)
-              (logior (%bignum-ref result j)
-                      (%ashl (logand digit high-mask) pos-bits)))
-        (setf (%bignum-ref result j+1)
-              (logand (ash digit minus-high-bits)
-                      ;; LOGAND should be unnecessary here with a logical right
-                      ;; shift or a correct digit-sized one.
-                      low-mask))))))
-|#
+;;;; There used to be a bunch of code to implement "efficient" versions of LDB
+;;;; and DPB here.  But it apparently was never used, so it's been deleted.
+;;;;   --njf, 2007-02-04
 
 ;;;; TRUNCATE
 
@@ -2025,27 +1557,51 @@ IS LESS EFFICIENT BUT EASIER TO MAINTAIN. BILL SAYS THIS CODE CERTAINLY WORKS!
         ;;; normalization.
         ;;;
         ;;; We don't have to worry about shifting Y to make its most
-        ;;; significant digit sufficiently large for %FLOOR to return
+        ;;; significant digit sufficiently large for %BIGFLOOR to return
         ;;; digit-size quantities for the q-digit and r-digit. If Y is
         ;;; a single digit bignum, it is already large enough for
-        ;;; %FLOOR. That is, it has some bits on pretty high in the
+        ;;; %BIGFLOOR. That is, it has some bits on pretty high in the
         ;;; digit.
         ((bignum-truncate-single-digit (x len-x y)
            (declare (type bignum-index len-x))
-           (let ((q (%allocate-bignum len-x))
-                 (r 0)
-                 (y (%bignum-ref y 0)))
-             (declare (type bignum-element-type r y))
-             (do ((i (1- len-x) (1- i)))
-                 ((minusp i))
-               (multiple-value-bind (q-digit r-digit)
-                   (%floor r (%bignum-ref x i) y)
-                 (declare (type bignum-element-type q-digit r-digit))
-                 (setf (%bignum-ref q i) q-digit)
-                 (setf r r-digit)))
-             (let ((rem (%allocate-bignum 1)))
-               (setf (%bignum-ref rem 0) r)
-               (values q rem))))
+           (let ((y (%bignum-ref y 0)))
+             (declare (type bignum-element-type y))
+             (if (not (logtest y (1- y)))
+                 ;; Y is a power of two.
+                 ;; SHIFT-RIGHT-UNALIGNED won't do the right thing
+                 ;; with a shift count of 0 or -1, so special case this.
+                 (cond ((= y 0)
+                        (error 'division-by-zero))
+                       ((= y 1)
+                        ;; We could probably get away with (VALUES X 0)
+                        ;; here, but it's not clear that some of the
+                        ;; normalization logic further down would avoid
+                        ;; mutilating X.  Just go ahead and cons, consing's
+                        ;; cheap.
+                        (values (copy-bignum x len-x) 0))
+                       (t
+                        (let ((n-bits (1- (integer-length y))))
+                          (values
+                           (shift-right-unaligned x 0 n-bits len-x
+                                                  ((= j res-len-1)
+                                                   (setf (%bignum-ref res j)
+                                                         (%ashr (%bignum-ref x i) n-bits))
+                                                   res)
+                                                  res)
+                           (logand (%bignum-ref x 0) (1- y))))))
+                 (do ((i (1- len-x) (1- i))
+                      (q (%allocate-bignum len-x))
+                      (r 0))
+                     ((minusp i)
+                      (let ((rem (%allocate-bignum 1)))
+                        (setf (%bignum-ref rem 0) r)
+                        (values q rem)))
+                   (declare (type bignum-element-type r))
+                   (multiple-value-bind (q-digit r-digit)
+                       (%bigfloor r (%bignum-ref x i) y)
+                     (declare (type bignum-element-type q-digit r-digit))
+                     (setf (%bignum-ref q i) q-digit)
+                     (setf r r-digit))))))
         ;;; This returns a guess for the next division step. Y1 is the
         ;;; highest y digit, and y2 is the second to highest y
         ;;; digit. The x... variables are the three highest x digits
@@ -2070,7 +1626,7 @@ IS LESS EFFICIENT BUT EASIER TO MAINTAIN. BILL SAYS THIS CODE CERTAINLY WORKS!
            (declare (type bignum-element-type y1 y2 x-i x-i-1 x-i-2))
            (let ((guess (if (%digit-compare x-i y1)
                             all-ones-digit
-                            (%floor x-i x-i-1 y1))))
+                            (%bigfloor x-i x-i-1 y1))))
              (declare (type bignum-element-type guess))
              (loop
                  (multiple-value-bind (high-guess*y1 low-guess*y1)
@@ -2217,7 +1773,7 @@ IS LESS EFFICIENT BUT EASIER TO MAINTAIN. BILL SAYS THIS CODE CERTAINLY WORKS!
         ;;; digit-size.
         ;;;
         ;;; We shift y to make it sufficiently large that doing the
-        ;;; 2*digit-size by digit-size %FLOOR calls ensures the quotient and
+        ;;; 2*digit-size by digit-size %BIGFLOOR calls ensures the quotient and
         ;;; remainder fit in digit-size.
          (shift-y-for-truncate (y)
            (let* ((len (%bignum-length y))
@@ -2303,246 +1859,11 @@ IS LESS EFFICIENT BUT EASIER TO MAINTAIN. BILL SAYS THIS CODE CERTAINLY WORKS!
                         (%normalize-bignum rem (%bignum-length rem))))))))))
 
 
-;;;; %FLOOR primitive for BIGNUM-TRUNCATE
-
-;;; When a machine leaves out a 2*digit-size by digit-size divide
-;;; instruction (that is, two bignum-digits divided by one), we have to
-;;; roll our own (the hard way).  Basically, we treat the operation as
-;;; four digit-size/2 digits divided by two digit-size/2 digits. This
-;;; means we have duplicated most of the code above to do this nearly
-;;; general digit-size/2 digit bignum divide, but we've unrolled loops
-;;; and made use of other properties of this specific divide situation.
-
-;;;; %FLOOR for machines with a 32x32 divider.
-
-#!-sb-fluid
-(declaim (inline 32x16-subtract-with-borrow 32x16-add-with-carry
-                 32x16-divide 32x16-multiply 32x16-multiply-split))
-
-#!+32x16-divide
-(defconstant 32x16-base-1 (1- (ash 1 (/ sb!vm:n-word-bits 2))))
-
-#!+32x16-divide
-(deftype bignum-half-element-type () `(unsigned-byte ,(/ sb!vm:n-word-bits 2)))
-#!+32x16-divide
-(defconstant half-digit-size (/ digit-size 2))
-
-;;; This is similar to %SUBTRACT-WITH-BORROW. It returns a
-;;; half-digit-size difference and a borrow. Returning a 1 for the
-;;; borrow means there was no borrow, and 0 means there was one.
-#!+32x16-divide
-(defun 32x16-subtract-with-borrow (a b borrow)
-  (declare (type bignum-half-element-type a b)
-           (type (integer 0 1) borrow))
-  (let ((diff (+ (- a b) borrow 32x16-base-1)))
-    (declare (type (unsigned-byte #.(1+ half-digit-size)) diff))
-    (values (logand diff (1- (ash 1 half-digit-size)))
-            (ash diff (- half-digit-size)))))
-
-;;; This adds a and b, half-digit-size quantities, with the carry k. It
-;;; returns a half-digit-size sum and a second value, 0 or 1, indicating
-;;; whether there was a carry.
-#!+32x16-divide
-(defun 32x16-add-with-carry (a b k)
-  (declare (type bignum-half-element-type a b)
-           (type (integer 0 1) k))
-  (let ((res (the fixnum (+ a b k))))
-    (declare (type (unsigned-byte #.(1+ half-digit-size)) res))
-    (if (zerop (the fixnum (logand (ash 1 half-digit-size) res)))
-        (values res 0)
-        (values (the bignum-half-element-type (logand (1- (ash 1 half-digit-size)) res))
-                1))))
-
-;;; This is probably a digit-size by digit-size divide instruction.
-#!+32x16-divide
-(defun 32x16-divide (a b c)
-  (declare (type bignum-half-element-type a b c))
-  (floor (the bignum-element-type
-              (logior (the bignum-element-type (ash a 16))
-                      b))
-         c))
-
-;;; This basically exists since we know the answer won't overflow
-;;; bignum-element-type. It's probably just a basic multiply instruction, but
-;;; it can't cons an intermediate bignum. The result goes in a non-descriptor
-;;; register.
-#!+32x16-divide
-(defun 32x16-multiply (a b)
-  (declare (type bignum-half-element-type a b))
-  (the bignum-element-type (* a b)))
-
-;;; This multiplies a and b, half-digit-size quantities, and returns the
-;;; result as two half-digit-size quantities, high and low.
-#!+32x16-divide
-(defun 32x16-multiply-split (a b)
-  (let ((res (32x16-multiply a b)))
-    (declare (the bignum-element-type res))
-    (values (the bignum-half-element-type (logand (1- (ash 1 half-digit-size)) (ash res (- half-digit-size))))
-            (the bignum-half-element-type (logand (1- (ash 1 half-digit-size)) res)))))
-
-;;; The %FLOOR below uses this buffer the same way BIGNUM-TRUNCATE uses
-;;; *truncate-x*. There's no y buffer since we pass around the two
-;;; half-digit-size digits and use them slightly differently than the
-;;; general truncation algorithm above.
-#!+32x16-divide
-(defvar *32x16-truncate-x* (make-array 4 :element-type 'bignum-half-element-type
-                                       :initial-element 0))
-
-;;; This does the same thing as the %FLOOR above, but it does it at Lisp level
-;;; when there is no 64x32-bit divide instruction on the machine.
-;;;
-;;; It implements the higher level tactics of BIGNUM-TRUNCATE, but it
-;;; makes use of special situation provided, four half-digit-size digits
-;;; divided by two half-digit-size digits.
-#!+32x16-divide
-(defun %floor (a b c)
-  (declare (type bignum-element-type a b c))
-  ;; Setup *32x16-truncate-x* buffer from a and b.
-  (setf (aref *32x16-truncate-x* 0)
-        (the bignum-half-element-type (logand (1- (ash 1 half-digit-size)) b)))
-  (setf (aref *32x16-truncate-x* 1)
-        (the bignum-half-element-type
-             (logand (1- (ash 1 half-digit-size))
-                     (the bignum-half-element-type (ash b (- half-digit-size))))))
-  (setf (aref *32x16-truncate-x* 2)
-        (the bignum-half-element-type (logand (1- (ash 1 half-digit-size)) a)))
-  (setf (aref *32x16-truncate-x* 3)
-        (the bignum-half-element-type
-             (logand (1- (ash 1 half-digit-size))
-                     (the bignum-half-element-type (ash a (- half-digit-size))))))
-  ;; From DO-TRUNCATE, but unroll the loop.
-  (let* ((y1 (logand (1- (ash 1 half-digit-size)) (ash c (- half-digit-size))))
-         (y2 (logand (1- (ash 1 half-digit-size)) c))
-         (q (the bignum-element-type
-                 (ash (32x16-try-bignum-truncate-guess
-                       (32x16-truncate-guess y1 y2
-                                             (aref *32x16-truncate-x* 3)
-                                             (aref *32x16-truncate-x* 2)
-                                             (aref *32x16-truncate-x* 1))
-                       y1 y2 1)
-                      16))))
-    (declare (type bignum-element-type q)
-             (type bignum-half-element-type y1 y2))
-    (values (the bignum-element-type
-                 (logior q
-                         (the bignum-half-element-type
-                              (32x16-try-bignum-truncate-guess
-                               (32x16-truncate-guess
-                                y1 y2
-                                (aref *32x16-truncate-x* 2)
-                                (aref *32x16-truncate-x* 1)
-                                (aref *32x16-truncate-x* 0))
-                               y1 y2 0))))
-            (the bignum-element-type
-                 (logior (the bignum-element-type
-                              (ash (aref *32x16-truncate-x* 1) 16))
-                         (the bignum-half-element-type
-                              (aref *32x16-truncate-x* 0)))))))
-
-;;; This is similar to TRY-BIGNUM-TRUNCATE-GUESS, but this unrolls the two
-;;; loops. This also substitutes for %DIGIT-0-OR-PLUSP the equivalent
-;;; expression without any embellishment or pretense of abstraction. The first
-;;; loop is unrolled, but we've put the body of the loop into the function
-;;; 32X16-TRY-GUESS-ONE-RESULT-DIGIT.
-#!+32x16-divide
-(defun 32x16-try-bignum-truncate-guess (guess y-high y-low low-x-digit)
-  (declare (type bignum-index low-x-digit)
-           (type bignum-half-element-type guess y-high y-low))
-  (let ((high-x-digit (+ 2 low-x-digit)))
-    ;; Multiply guess and divisor, subtracting from dividend simultaneously.
-    (multiple-value-bind (guess*y-hold carry borrow)
-        (32x16-try-guess-one-result-digit guess y-low 0 0 1 low-x-digit)
-      (declare (type bignum-half-element-type guess*y-hold)
-               (fixnum carry borrow))
-      (multiple-value-bind (guess*y-hold carry borrow)
-          (32x16-try-guess-one-result-digit guess y-high guess*y-hold
-                                            carry borrow (1+ low-x-digit))
-        (declare (type bignum-half-element-type guess*y-hold)
-                 (fixnum borrow)
-                 (ignore carry))
-        (setf (aref *32x16-truncate-x* high-x-digit)
-              (32x16-subtract-with-borrow (aref *32x16-truncate-x* high-x-digit)
-                                          guess*y-hold borrow))))
-    ;; See whether guess is off by one, adding one Y back in if necessary.
-    (cond ((zerop (logand (ash 1 (1- half-digit-size))
-                          (aref *32x16-truncate-x* high-x-digit)))
-           ;; The subtraction result is zero or positive.
-           guess)
-          (t
-           ;; If subtraction has negative result, add one divisor value back
-           ;; in. The guess was one too large in magnitude.
-           (multiple-value-bind (v carry)
-               (32x16-add-with-carry y-low
-                                     (aref *32x16-truncate-x* low-x-digit)
-                                     0)
-             (declare (type bignum-half-element-type v))
-             (setf (aref *32x16-truncate-x* low-x-digit) v)
-             (multiple-value-bind (v carry)
-                 (32x16-add-with-carry y-high
-                                       (aref *32x16-truncate-x*
-                                             (1+ low-x-digit))
-                                       carry)
-               (setf (aref *32x16-truncate-x* (1+ low-x-digit)) v)
-               (setf (aref *32x16-truncate-x* high-x-digit)
-                     (32x16-add-with-carry (aref *32x16-truncate-x* high-x-digit)
-                                           carry 0))))
-           (if (zerop (logand (ash 1 (1- half-digit-size)) guess))
-               (1- guess)
-               (1+ guess))))))
-
-;;; This is similar to the body of the loop in TRY-BIGNUM-TRUNCATE-GUESS that
-;;; multiplies the guess by y and subtracts the result from x simultaneously.
-;;; This returns the digit remembered as part of the multiplication, the carry
-;;; from additions done on behalf of the multiplication, and the borrow from
-;;; doing the subtraction.
-#!+32x16-divide
-(defun 32x16-try-guess-one-result-digit (guess y-digit guess*y-hold
-                                         carry borrow x-index)
-  (multiple-value-bind (high-digit low-digit)
-      (32x16-multiply-split guess y-digit)
-    (declare (type bignum-half-element-type high-digit low-digit))
-    (multiple-value-bind (low-digit temp-carry)
-        (32x16-add-with-carry low-digit guess*y-hold carry)
-      (declare (type bignum-half-element-type low-digit))
-      (multiple-value-bind (high-digit temp-carry)
-          (32x16-add-with-carry high-digit temp-carry 0)
-        (declare (type bignum-half-element-type high-digit))
-        (multiple-value-bind (x temp-borrow)
-            (32x16-subtract-with-borrow (aref *32x16-truncate-x* x-index)
-                                        low-digit borrow)
-          (declare (type bignum-half-element-type x))
-          (setf (aref *32x16-truncate-x* x-index) x)
-          (values high-digit temp-carry temp-borrow))))))
-
-;;; This is similar to BIGNUM-TRUNCATE-GUESS, but instead of computing
-;;; the guess exactly as described in the its comments (digit by digit),
-;;; this massages the digit-size/2 quantities into digit-size quantities
-;;; and performs the
-#!+32x16-divide
-(defun 32x16-truncate-guess (y1 y2 x-i x-i-1 x-i-2)
-  (declare (type bignum-half-element-type y1 y2 x-i x-i-1 x-i-2))
-  (let ((guess (if (= x-i y1)
-                   (1- (ash 1 half-digit-size))
-                   (32x16-divide x-i x-i-1 y1))))
-    (declare (type bignum-half-element-type guess))
-    (loop
-      (let* ((guess*y1 (the bignum-element-type
-                            (ash (logand (1- (ash 1 half-digit-size))
-                                         (the bignum-element-type
-                                              (32x16-multiply guess y1)))
-                                 16)))
-             (x-y (%subtract-with-borrow
-                   (the bignum-element-type
-                        (logior (the bignum-element-type
-                                     (ash x-i-1 16))
-                                x-i-2))
-                   guess*y1
-                   1))
-             (guess*y2 (the bignum-element-type (%multiply guess y2))))
-        (declare (type bignum-element-type guess*y1 x-y guess*y2))
-        (if (%digit-greater guess*y2 x-y)
-            (decf guess)
-            (return guess))))))
+;;;; There used to be a pile of code for implementing division for bignum digits
+;;;; for machines that don't have a 2*digit-size by digit-size divide instruction.
+;;;; This happens to be most machines, but all the SBCL ports seem to be content
+;;;; to implement SB-BIGNUM:%BIGFLOOR as a VOP rather than using the code here.
+;;;; So it's been deleted.  --njf, 2007-02-04
 
 ;;;; general utilities
 
@@ -2612,6 +1933,6 @@ IS LESS EFFICIENT BUT EASIER TO MAINTAIN. BILL SAYS THIS CODE CERTAINLY WORKS!
       (let ((xi (%bignum-ref x i)))
         (mixf result
               (logand most-positive-fixnum
-                      xi
-                      (ash xi -7)))))
+                      (logxor xi
+                              (ash xi -7))))))
     result))