diff --git a/code/bignum.lisp b/code/bignum.lisp index c3ae58286983ef4c0a0e1fbbdc4db64dfc6b94b5..0b7bac52c9c5b2cac9465174830f93b10fa7dcdf 100644 --- a/code/bignum.lisp +++ b/code/bignum.lisp @@ -1,11 +1,11 @@ -;;; -*- Mode: completion; Log: code.log; Package: bignum -*- +;;; -*- Mode: Lisp; Log: code.log; Package: bignum -*- ;;; ;;; ********************************************************************** ;;; This code was written as part of the CMU Common Lisp project at ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/bignum.lisp,v 1.25 1998/03/21 08:11:49 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/bignum.lisp,v 1.26 1999/11/11 16:34:40 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -24,7 +24,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-logcount bignum-logbitp)) ;;; These symbols define the interface to the compiler. @@ -1162,6 +1162,20 @@ (declare (type bignum-element-type digit)) (incf result (logcount (if plusp digit (%lognot digit)))))))) +(defun bignum-logbitp (index bignum) + (declare (type bignum-type bignum)) + ;; For bignums, locate the word we're interested in and test + ;; the appropriate bit. As in the fixnum case, if the index + ;; is too big, the answer is the sign of the number. + (let ((len (bignum::%bignum-length bignum))) + (multiple-value-bind (word-index bit-index) + (floor index digit-size) + (if (>= word-index len) + (not (bignum-plus-p bignum)) + (not (zerop (logand (ash 1 bit-index) + (%bignum-ref bignum word-index)))))))) + + ;;;; Logical operations. diff --git a/code/numbers.lisp b/code/numbers.lisp index d0f5b19c25948fba6cb4d94cb7aa3f8dab6dc874..f7a4fcfd1a78883243c537893477954f0d9f10bb 100644 --- a/code/numbers.lisp +++ b/code/numbers.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/numbers.lisp,v 1.34 1998/07/24 17:17:54 dtc Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/numbers.lisp,v 1.35 1999/11/11 16:34:41 dtc Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1039,8 +1039,11 @@ (logtest integer1 integer2)) (defun logbitp (index integer) - "Predicate returns T if bit index of integer is a 1." - (logbitp index integer)) + "Predicate returns T if bit index of integer is a 1. The least +significant bit of INTEGER is bit 0." + (etypecase integer + (fixnum (logbitp index integer)) + (bignum (bignum-logbitp index integer)))) (defun ash (integer count) "Shifts integer left by count places preserving sign. - count shifts right."