From 6cc71ab8ffad49f43895ad0a1df6885c81876687 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Thu, 11 Sep 2003 15:49:43 +0000 Subject: [PATCH] 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. --- NEWS | 3 ++- package-data-list.lisp-expr | 1 + src/code/bignum.lisp | 15 +++++++++++++-- src/code/numbers.lisp | 12 +++++++++--- src/compiler/fndb.lisp | 2 +- src/compiler/srctran.lisp | 10 ++++++++-- tests/arith.pure.lisp | 14 ++++++++++++++ version.lisp-expr | 2 +- 8 files changed, 49 insertions(+), 10 deletions(-) diff --git a/NEWS b/NEWS index 9d2232a..ce1611e 100644 --- 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 --- 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 --- 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)))))) -;;;; 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 --- 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 --- 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 --- 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 --- 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 --- 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" -- 1.7.10.4