Skip to content
Snippets Groups Projects
Commit 3a8fb61c authored by dtc's avatar dtc
Browse files

Add bignum-logbitp, and update logbitp to use logbitp or

bignum-logbitp as needed.
parent 063974c5
No related branches found
No related tags found
No related merge requests found
;;; -*- 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.
......
......@@ -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."
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment