X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fbignum.lisp;h=c0606e65fbdbd7ba66ff614b29b6947d14837682;hb=d4c7ab04ed10729a2cfa3321f4382d8a218ad958;hp=9fd50857505fb47688b2138be6b0c7f3a8528054;hpb=08307967c71c580058a503d46aa087cfefcf8c69;p=sbcl.git

diff --git a/src/code/bignum.lisp b/src/code/bignum.lisp
index 9fd5085..c0606e6 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
@@ -749,13 +749,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)
@@ -812,7 +812,7 @@
 	  (bignum-ashift-left-unaligned bignum digits n-bits res-len))))
     ;; Left shift by a number too big to be represented as a fixnum
     ;; would exceed our memory capacity, since a fixnum is big enough
-    ;; index any array, including a bit array.
+    ;; to index any array, including a bit array.
     (error "can't represent result of left shift")))
 
 (defun bignum-ashift-left-digits (bignum bignum-len digits)
@@ -980,8 +980,16 @@
 	       (declare (type bignum-index len))
 	       (let ((exp (+ exp bias)))
 		 (when (> exp max)
-		   (error "Too large to be represented as a ~S:~%  ~S"
-			  format x))
+		   ;; Why a SIMPLE-TYPE-ERROR? Well, this is mainly
+		   ;; called by COERCE, which requires an error of
+		   ;; TYPE-ERROR if the conversion can't happen
+		   ;; (except in certain circumstances when we are
+		   ;; coercing to a FUNCTION) -- CSR, 2002-09-18
+		   (error 'simple-type-error
+			  :format-control "Too large to be represented as a ~S:~%  ~S"
+			  :format-arguments (list format x)
+			  :expected-type format
+			  :datum x))
 		 exp)))
 
     (cond
@@ -1001,7 +1009,7 @@
      (t
       (round-up))))))
 
-;;;; integer length and logcount
+;;;; integer length and logbitp/logcount
 
 (defun bignum-integer-length (bignum)
   (declare (type bignum-type bignum))
@@ -1013,6 +1021,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))