0.8.3.53:

	LOGBITP fixes
	... correctness fix: INDEX can be any UNSIGNED-BYTE, not just a
		positive fixnum or an INDEX;
	... efficiency fix: don't cons up a bignum as large as memory
		when given large INDEX numbers; instead, be efficient
		and grab just the relevant word of the INTEGER
		argument.

diff --git a/NEWS b/NEWS
index 9d2232a..ce1611e 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -2051,7 +2051,8 @@ changes in sbcl-0.8.4 relative to sbcl-0.8.3:
     ** LCM with two arguments of 0 returns 0 rather than signalling
        DIVISION-BY-ZERO.
     ** unsigned addition of a 32-bit constant with the high bit set no
-       longer causes an internal compiler error.
+       longer causes an internal compiler error on the x86.
+    ** LOGBITP accepts a non-negative bignum as its INDEX argument.
 
 planned incompatible changes in 0.8.x:
   * (not done yet, but planned:) When the profiling interface settles

diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index 6abfe48..7a0aac2 100644 (file)
--- a/package-data-list.lisp-expr
+++ b/package-data-list.lisp-expr
@@ -153,6 +153,7 @@ of SBCL which maintained the CMU-CL-style split into two packages.)"
              "BIGNUM-COMPARE" "BIGNUM-DEPOSIT-BYTE"
              "BIGNUM-ELEMENT-TYPE" "BIGNUM-GCD" "BIGNUM-INDEX"
              "BIGNUM-INTEGER-LENGTH" "BIGNUM-LOAD-BYTE"
+            "BIGNUM-LOGBITP"
              "BIGNUM-LOGCOUNT" "BIGNUM-LOGICAL-AND"
              "BIGNUM-LOGICAL-IOR" "BIGNUM-LOGICAL-NOT"
              "BIGNUM-LOGICAL-XOR" "BIGNUM-PLUS-P"

diff --git a/src/code/bignum.lisp b/src/code/bignum.lisp
index f7f7e5d..03f2337 100644 (file)
--- 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
@@ -1009,7 +1009,7 @@
      (t
       (round-up))))))
 \f
-;;;; integer length and logcount
+;;;; integer length and logbitp/logcount
 
 (defun bignum-integer-length (bignum)
   (declare (type bignum-type bignum))
@@ -1021,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))

diff --git a/src/code/numbers.lisp b/src/code/numbers.lisp
index f5cbddf..751b6f2 100644 (file)
--- a/src/code/numbers.lisp
+++ b/src/code/numbers.lisp
@@ -1008,8 +1008,9 @@
   if INTEGER is negative."
   (etypecase integer
     (fixnum
-     (logcount (truly-the (integer 0 #.(max most-positive-fixnum
-                                           (lognot most-negative-fixnum)))
+     (logcount (truly-the (integer 0
+                                  #.(max sb!xc:most-positive-fixnum
+                                         (lognot sb!xc:most-negative-fixnum)))
                          (if (minusp (truly-the fixnum integer))
                              (lognot (truly-the fixnum integer))
                              integer))))
@@ -1024,7 +1025,12 @@
 (defun logbitp (index integer)
   #!+sb-doc
   "Predicate returns T if bit index of integer is a 1."
-  (logbitp index integer))
+  (number-dispatch ((index integer) (integer integer))
+    ((fixnum fixnum) (if (> index #.(- sb!vm:n-word-bits sb!vm:n-lowtag-bits))
+                        (minusp integer)
+                        (not (zerop (logand integer (ash 1 index))))))
+    ((fixnum bignum) (bignum-logbitp index integer))
+    ((bignum (foreach fixnum bignum)) (minusp integer))))
 
 (defun ash (integer count)
   #!+sb-doc

diff --git a/src/compiler/fndb.lisp b/src/compiler/fndb.lisp
index b6cdfcb..eb0f4e6 100644 (file)
--- a/src/compiler/fndb.lisp
+++ b/src/compiler/fndb.lisp
@@ -370,7 +370,7 @@
 
 (defknown lognot (integer) integer (movable foldable flushable explicit-check))
 (defknown logtest (integer integer) boolean (movable foldable flushable))
-(defknown logbitp (bit-index integer) boolean (movable foldable flushable))
+(defknown logbitp (unsigned-byte integer) boolean (movable foldable flushable))
 (defknown ash (integer integer) integer
   (movable foldable flushable explicit-check))
 (defknown (logcount integer-length) (integer) bit-index

diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp
index 9fa22a2..f675b2e 100644 (file)
--- a/src/compiler/srctran.lisp
+++ b/src/compiler/srctran.lisp
@@ -179,8 +179,14 @@
 (define-source-transform logorc1 (x y) `(logior (lognot ,x) ,y))
 (define-source-transform logorc2 (x y) `(logior ,x (lognot ,y)))
 (define-source-transform logtest (x y) `(not (zerop (logand ,x ,y))))
-(define-source-transform logbitp (index integer)
-  `(not (zerop (logand (ash 1 ,index) ,integer))))
+
+(deftransform logbitp
+    ((index integer) (unsigned-byte (or (signed-byte #.sb!vm:n-word-bits)
+                                       (unsigned-byte #.sb!vm:n-word-bits))))
+  `(if (>= index #.sb!vm:n-word-bits)
+       (minusp integer)
+       (not (zerop (logand integer (ash 1 index))))))
+
 (define-source-transform byte (size position)
   `(cons ,size ,position))
 (define-source-transform byte-size (spec) `(car ,spec))

diff --git a/tests/arith.pure.lisp b/tests/arith.pure.lisp
index 16e015d..563f369 100644 (file)
--- a/tests/arith.pure.lisp
+++ b/tests/arith.pure.lisp
@@ -123,3 +123,17 @@
            (compile nil '(lambda (x) (declare (bit x)) (+ x #xf0000000)))
            1)
           #xf0000001))
+
+;;; LOGBITP on bignums:
+(dolist (x '(((1+ most-positive-fixnum) 1 nil)
+            ((1+ most-positive-fixnum) -1 t)
+            ((1+ most-positive-fixnum) (1+ most-positive-fixnum) nil)
+            ((1+ most-positive-fixnum) (1- most-negative-fixnum) t)
+            (1 (ash most-negative-fixnum 1) nil)
+            (29 most-negative-fixnum t)
+            (30 (ash most-negative-fixnum 1) t)
+            (31 (ash most-negative-fixnum 1) t)
+            (64 (ash most-negative-fixnum 36) nil)
+            (65 (ash most-negative-fixnum 36) t)))
+  (destructuring-bind (index int result) x
+    (assert (eq (eval `(logbitp ,index ,int)) result))))

diff --git a/version.lisp-expr b/version.lisp-expr
index 99d759d..698941d 100644 (file)
--- 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.3.52"
+"0.8.3.53"