Common Lisp allows for an object type of "simple-bit-vector" along with the usual bit-wise boolean operations. Now, one might think that this would be a natural representation for bitboards. Well, maybe it is, but unfortunately there's no requirement that a Lisp interpreter or compiler has to handle the representation and operations efficiently.
I became suspicious with the long running times of certain tests and didn't think all of the slowness could be attributed to my usual sloth-like code. So I decided to roll my own bitboards from integer arrays of four 16 bit values.
Code: Select all
;;; Bits in a byte
(defconstant byte-bit-limit 8)
(defconstant byte-limit (ash 1 byte-bit-limit))
(defconstant byte-mask (1- byte-limit))
(defconstant byte-right-shift-limit (- byte-bit-limit))
(defun first-bit-in-byte (my-byte)
"Return the position of the first bit of a single byte; return nil if none."
(let ((result nil))
(do ((index 0 (1+ index))) ((or result (= index byte-bit-limit)))
(when (logbitp index my-byte)
(setf result index)))
result))
;;; Look-up vector for first bit in a byte
(defun initialize-byte-first-bit-vec ()
"Provide the initial value for the byte first bit position vector."
(let ((result (make-array byte-limit)))
(dotimes (index byte-limit)
(setf (svref result index) (first-bit-in-byte index)))
result))
(defconstant byte-first-bit-vec (initialize-byte-first-bit-vec))
;;; Bits in a word
(defconstant word-byte-limit 2)
(defconstant word-bit-limit (* byte-bit-limit word-byte-limit))
(defconstant word-limit (ash 1 word-bit-limit))
(defconstant word-mask (1- word-limit))
;;; Look-up vector for first bit in a word
(defun initialize-word-first-bit-vec ()
"Provide the initial value for the byte first bit position vector."
(let ((result (make-array word-limit)))
(dotimes (index word-limit)
(let ((byte0 (logand index byte-mask)))
(if (nonzero? byte0)
(setf (svref result index) (first-bit-in-byte byte0))
(let ((byte1 (ash index byte-right-shift-limit)))
(if (nonzero? byte1)
(setf (svref result index) (+ (first-bit-in-byte byte1) byte-bit-limit))
(setf (svref result index) nil))))))
result))
(defconstant word-first-bit-vec (initialize-word-first-bit-vec))
(defmacro first-bit-in-word (my-word)
"Return the position of the first bit of a two byte word; return nil if none."
`(svref word-first-bit-vec ,my-word))
;;; Bitboard representation
(defconstant board-word-limit (/ sq-limit word-bit-limit))
(defmacro mk-bb () `(make-array board-word-limit :initial-element 0))
;;; Bitboard square set/reset/test
(defmacro set-sq (my-bb my-sq)
"Set a square in a bitboard."
`(let ((wi (ash ,my-sq -4)) (bi (logand ,my-sq 15)))
(setf (svref ,my-bb wi) (logior (svref ,my-bb wi) (ash 1 bi)))))
(defmacro reset-sq (my-bb my-sq)
"Reset a square in a bitboard."
`(let ((wi (ash ,my-sq -4)) (bi (logand ,my-sq 15)))
(setf (svref ,my-bb wi) (logandc2 (svref ,my-bb wi) (ash 1 bi)))))
(defmacro sq-set? (my-bb my-sq)
"Test a square in a bitboard."
`(logbitp (logand ,my-sq 15) (svref ,my-bb (ash ,my-sq -4))))
(defmacro sq-reset? (my-bb my-sq)
"Test a square in a bitboard; return inverted sense."
`(not (logbitp (logand ,my-sq 15) (svref ,my-bb (ash ,my-sq -4)))))
;;; Bitboard boolean operation macros
(defmacro bb-not (my-bb)
"Perform boolean complement of a single bitboard."
`(let ((result (mk-bb)))
(setf (svref result 0) (logxor (svref ,my-bb 0) word-mask))
(setf (svref result 1) (logxor (svref ,my-bb 1) word-mask))
(setf (svref result 2) (logxor (svref ,my-bb 2) word-mask))
(setf (svref result 3) (logxor (svref ,my-bb 3) word-mask))
result))
(defmacro bb-or2 (my-bb0 my-bb1)
"Perform boolean inclusive or of two bitboards."
`(let ((result (mk-bb)))
(setf (svref result 0) (logior (svref ,my-bb0 0) (svref ,my-bb1 0)))
(setf (svref result 1) (logior (svref ,my-bb0 1) (svref ,my-bb1 1)))
(setf (svref result 2) (logior (svref ,my-bb0 2) (svref ,my-bb1 2)))
(setf (svref result 3) (logior (svref ,my-bb0 3) (svref ,my-bb1 3)))
result))
(defmacro bb-or2d (my-bb0 my-bb1)
"Perform inclusive or of two bitboards; store result into the first."
`(progn
(setf (svref ,my-bb0 0) (logior (svref ,my-bb0 0) (svref ,my-bb1 0)))
(setf (svref ,my-bb0 1) (logior (svref ,my-bb0 1) (svref ,my-bb1 1)))
(setf (svref ,my-bb0 2) (logior (svref ,my-bb0 2) (svref ,my-bb1 2)))
(setf (svref ,my-bb0 3) (logior (svref ,my-bb0 3) (svref ,my-bb1 3)))
,my-bb0))
(defmacro bb-and2 (my-bb0 my-bb1)
"Perform boolean and of two bitboards."
`(let ((result (mk-bb)))
(setf (svref result 0) (logand (svref ,my-bb0 0) (svref ,my-bb1 0)))
(setf (svref result 1) (logand (svref ,my-bb0 1) (svref ,my-bb1 1)))
(setf (svref result 2) (logand (svref ,my-bb0 2) (svref ,my-bb1 2)))
(setf (svref result 3) (logand (svref ,my-bb0 3) (svref ,my-bb1 3)))
result))
(defmacro bb-and2d (my-bb0 my-bb1)
"Perform boolean and of two bitboards; store result into the first."
`(progn
(setf (svref ,my-bb0 0) (logand (svref ,my-bb0 0) (svref ,my-bb1 0)))
(setf (svref ,my-bb0 1) (logand (svref ,my-bb0 1) (svref ,my-bb1 1)))
(setf (svref ,my-bb0 2) (logand (svref ,my-bb0 2) (svref ,my-bb1 2)))
(setf (svref ,my-bb0 3) (logand (svref ,my-bb0 3) (svref ,my-bb1 3)))
,my-bb0))
(defmacro bb-and2c2 (my-bb0 my-bb1)
"Perform boolean and of two bitboards (complement 2nd prior)."
`(let ((result (mk-bb)))
(setf (svref result 0) (logandc2 (svref ,my-bb0 0) (svref ,my-bb1 0)))
(setf (svref result 1) (logandc2 (svref ,my-bb0 1) (svref ,my-bb1 1)))
(setf (svref result 2) (logandc2 (svref ,my-bb0 2) (svref ,my-bb1 2)))
(setf (svref result 3) (logandc2 (svref ,my-bb0 3) (svref ,my-bb1 3)))
result))
(defmacro bb-and2c2d (my-bb0 my-bb1)
"Perform boolean and of two bitboards (complement 2nd prior); store result into the first."
`(progn
(setf (svref ,my-bb0 0) (logandc2 (svref ,my-bb0 0) (svref ,my-bb1 0)))
(setf (svref ,my-bb0 1) (logandc2 (svref ,my-bb0 1) (svref ,my-bb1 1)))
(setf (svref ,my-bb0 2) (logandc2 (svref ,my-bb0 2) (svref ,my-bb1 2)))
(setf (svref ,my-bb0 3) (logandc2 (svref ,my-bb0 3) (svref ,my-bb1 3)))
,my-bb0))
;;; Bitboard square scanning
(defmacro first-sq (my-bb)
"Return the index of the first bit in a bitboard; return nil if none."
`(let ((result nil) (index nil))
(setf index (first-bit-in-word (svref ,my-bb 0)))
(if index
(setf result index)
(progn
(setf index (first-bit-in-word (svref ,my-bb 1)))
(if index
(setf result (+ index 16))
(progn
(setf index (first-bit-in-word (svref ,my-bb 2)))
(if index
(setf result (+ index 32))
(progn
(setf index (first-bit-in-word (svref, my-bb 3)))
(if index
(setf result (+ index 48)))))))))
result))
(defmacro next-sq (my-bb)
"Return the index of the first bit in a bitboard and clear; return nil if none."
`(let ((result nil) (index (first-sq ,my-bb)))
(when index
(reset-sq ,my-bb index)
(setf result index))
result))
;;; Iteration
(defmacro loop-bb ((my-bb my-sq) &rest my-body)
"Destructively iterate through the set squares in a bitboard."
`(do ((,my-sq (next-sq ,my-bb) (next-sq ,my-bb))) ((not ,my-sq))
,@my-body))
;;; Reset and reset tests
(defmacro reset-bb (my-bb)
"Reset a bitboard."
`(progn
(setf (svref ,my-bb 0) 0)
(setf (svref ,my-bb 1) 0)
(setf (svref ,my-bb 2) 0)
(setf (svref ,my-bb 3) 0)
,my-bb))
(defmacro bb-reset? (my-bb)
"Return t if the given bitboard is reset (e.g., empty)."
`(and
(zero? (svref ,my-bb 0))
(zero? (svref ,my-bb 1))
(zero? (svref ,my-bb 2))
(zero? (svref ,my-bb 3))))
(defmacro bb-not-reset? (my-bb)
"Return t if the given bitboard is not empty."
`(or
(nonzero? (svref ,my-bb 0))
(nonzero? (svref ,my-bb 1))
(nonzero? (svref ,my-bb 2))
(nonzero? (svref ,my-bb 3))))
;;; Bitboard cardinality
(defmacro card (my-bb)
"Cardinality: count the number of squares set in a bitboard."
`(+
(logcount (svref ,my-bb 0))
(logcount (svref ,my-bb 1))
(logcount (svref ,my-bb 2))
(logcount (svref ,my-bb 3))))
;;; Bitboard equality
(defmacro bb-equal? (my-bb0 my-bb1)
"Return t if the given bitboards are equal (e.g., same squares)."
`(and
(= (svref ,my-bb0 0) (svref ,my-bb1 0))
(= (svref ,my-bb0 1) (svref ,my-bb1 1))
(= (svref ,my-bb0 2) (svref ,my-bb1 2))
(= (svref ,my-bb0 3) (svref ,my-bb1 3))))
(defmacro bb-not-equal? (my-bb0 my-bb1)
"Return t if the given bitboards are not equal (e.g., different squares)."
`(or
(/= (svref ,my-bb0 0) (svref ,my-bb1 0))
(/= (svref ,my-bb0 1) (svref ,my-bb1 1))
(/= (svref ,my-bb0 2) (svref ,my-bb1 2))
(/= (svref ,my-bb0 3) (svref ,my-bb1 3))))
;;; Cloning and copying
(defmacro clone-bb (my-bb)
"Return a clone of the given bitboard."
`(copy-seq ,my-bb))
(defmacro copy-bb (my-source-bb my-target-bb)
"Copy the source bitboard into the target bitboard; return the target bitboard."
`(progn
(setf (svref ,my-target-bb 0) (svref ,my-source-bb 0))
(setf (svref ,my-target-bb 1) (svref ,my-source-bb 1))
(setf (svref ,my-target-bb 2) (svref ,my-source-bb 2))
(setf (svref ,my-target-bb 3) (svref ,my-source-bb 3))
,my-target-bb))
