X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fbignum.lisp;h=c1889655d3dc0370b89e33b36f16f929b3db758c;hb=61dc1d5c0b4988f7e957be876a9abf9f31d51e0a;hp=719f369e4b91386a6f9da1e885625fea3e105ac9;hpb=237ecea4a44f33d40440ea40c67c54e9e23358b3;p=sbcl.git

diff --git a/src/code/bignum.lisp b/src/code/bignum.lisp
index 719f369..c188965 100644
--- a/src/code/bignum.lisp
+++ b/src/code/bignum.lisp
@@ -22,7 +22,7 @@
 ;;;       bignum-logical-and bignum-logical-ior bignum-logical-xor
 ;;;       bignum-logical-not bignum-load-byte bignum-deposit-byte
 ;;;       bignum-truncate bignum-plus-p bignum-compare make-small-bignum
-;;;       bignum-logcount
+;;;       bignum-logbitp bignum-logcount
 ;;;   These symbols define the interface to the compiler:
 ;;;       bignum-type bignum-element-type bignum-index %allocate-bignum
 ;;;       %bignum-length %bignum-set-length %bignum-ref %bignum-set
@@ -519,6 +519,26 @@
 
 ;;;; GCD
 
+;;; I'm not sure why I need this FTYPE declaration.  Compiled by the
+;;; target compiler, it can deduce the return type fine, but without
+;;; 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)
+			   (unsigned-byte 29))
+		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))
+  (do ((i 0 (1+ i))
+       (end (min len-a len-b)))
+      ((= i end) (error "Unexpected zero bignums?"))
+    (declare (type bignum-index i end))
+    (let ((or-digits (%logior (%bignum-ref a i) (%bignum-ref b i))))
+      (unless (zerop or-digits)
+	(return (do ((j 0 (1+ j))
+		     (or-digits or-digits (%ashr or-digits 1)))
+		    ((oddp or-digits) (+ (* i digit-size) j))
+		  (declare (type (mod 32) j))))))))
+
 (defun bignum-gcd (a b)
   (declare (type bignum-type a b))
   (let* ((a (if (%bignum-0-or-plusp a (%bignum-length a))
@@ -605,19 +625,6 @@
 		     (bignum-buffer-ashift-right a len-a
 						 (+ (* index digit-size)
 						    increment)))))))
-
-(defun bignum-factors-of-two (a len-a b len-b)
-  (declare (type bignum-index len-a len-b) (type bignum-type a))
-  (do ((i 0 (1+ i))
-       (end (min len-a len-b)))
-      ((= i end) (error "Unexpected zero bignums?"))
-    (declare (type bignum-index i end))
-    (let ((or-digits (%logior (%bignum-ref a i) (%bignum-ref b i))))
-      (unless (zerop or-digits)
-	(return (do ((j 0 (1+ j))
-		     (or-digits or-digits (%ashr or-digits 1)))
-		    ((oddp or-digits) (+ (* i digit-size) j))
-		  (declare (type (mod 32) j))))))))
 
 ;;;; negation
 
@@ -749,13 +756,13 @@
 				       (%normalize-bignum res res-len))
 				      res)))))
 	  ((> count bignum-len)
-	   0)
+	   (if (%bignum-0-or-plusp bignum bignum-len) 0 -1))
 	   ;; Since a FIXNUM should be big enough to address anything in
 	   ;; memory, including arrays of bits, and since arrays of bits
 	   ;; take up about the same space as corresponding fixnums, there
 	   ;; should be no way that we fall through to this case: any shift
 	   ;; right by a bignum should give zero. But let's check anyway:
-	  (t (error "bignum overflow: can't shift right by ~S")))))
+	  (t (error "bignum overflow: can't shift right by ~S" count)))))
 
 (defun bignum-ashift-right-digits (bignum digits)
   (declare (type bignum-type bignum)
@@ -1009,7 +1016,7 @@
      (t
       (round-up))))))
 
-;;;; integer length and logcount
+;;;; integer length and logbitp/logcount
 
 (defun bignum-integer-length (bignum)
   (declare (type bignum-type bignum))
@@ -1021,6 +1028,17 @@
     (+ (integer-length (%fixnum-digit-with-correct-sign digit))
        (* len-1 digit-size))))
 
+(defun bignum-logbitp (index bignum)
+  (declare (type bignum-type bignum))
+  (let ((len (%bignum-length bignum)))
+    (declare (type bignum-index len))
+    (multiple-value-bind (word-index bit-index)
+	(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))))))))
+
 (defun bignum-logcount (bignum)
   (declare (type bignum-type bignum))
   (let* ((length (%bignum-length bignum))