X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fbignum.lisp;h=f96890aa5430332550c5af9c2542e82502a3486f;hb=b9519773faa7b3c98915eccb9cb1fd8a8270ee56;hp=7f54a05fa99ccbe6e61d901785db4b79fc7651e4;hpb=b6aed043108ac99142b124306a346d18a99d21ef;p=sbcl.git

diff --git a/src/code/bignum.lisp b/src/code/bignum.lisp
index 7f54a05..f96890a 100644
--- a/src/code/bignum.lisp
+++ b/src/code/bignum.lisp
@@ -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))
@@ -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)
@@ -1586,24 +1586,27 @@
              (declare (type bignum-element-type y))
              (if (not (logtest y (1- y)))
                  ;; Y is a power of two.
-                 (if (= y 1)
-                     ;; SHIFT-RIGHT-UNALIGNED won't do the right thing
-                     ;; with a shift count of 0, so special case this.
-                     ;; 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)
-                     (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)))))
+                 ;; 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))