Marc:
This comp.lang.lisp thread
http://groups.google.com/group/comp.lang.lisp/browse_thread/thread/ b1cdf3a5106abe59/545e852f2be87053#545e852f2be87053
discusses various fixnum bitcount algorithms, so I tried these three:
(declare (standard-bindings)(extended-bindings)(block)(fixnum)(not safe)(not interrupts-enabled))
(define (bits n) ;; remove one bit at a time (let loop ((i 0) (n n)) (if (zero? n) i (loop (+ i 1) (##fixnum.bitwise-and n (- n 1))))))
(define (my-bitcount x) ;; do 6 at a time, from _num.scm (define (at-most-6 x) (##u8vector-ref '#u8(0 1 1 2 1 2 2 3 1 2 2 3 2 3 3 4 1 2 2 3 2 3 3 4 2 3 3 4 3 4 4 5 1 2 2 3 2 3 3 4 2 3 3 4 3 4 4 5 2 3 3 4 3 4 4 5 3 4 4 5 4 5 5 6) x)) (define (count x n) (if (##fixnum.< x 64) (##fixnum.+ n (at-most-6 x)) (count (##fixnum.arithmetic-shift-right x 6) (##fixnum.+ n (at-most-6 (##fixnum.bitwise-and x 63)))))) (count x 0))
(define (hakmem-bitcount n) (let* ((i (+ (##fixnum.bitwise-and n #x5555555) (##fixnum.bitwise-and (##fixnum.arithmetic-shift-right n 1) #x5555555))) (i (+ (##fixnum.bitwise-and i #x3333333) (##fixnum.bitwise-and (##fixnum.arithmetic-shift-right i 2) #x3333333))) (i (+ (##fixnum.bitwise-and i #xf0f0f0f) (##fixnum.bitwise-and (##fixnum.arithmetic-shift-right i 4) #xf0f0f0f))) (i (+ i (##fixnum.arithmetic-shift-right i 8))) (i (+ i (##fixnum.arithmetic-shift-right i 16) (##fixnum.arithmetic-shift-right n 28)))) (##fixnum.bitwise-and i #xff)))
;; time them, including calling the system routine
(time (do ((i 0 (+ i 1))) ((= i 20000000)) (bits i)))
(time (do ((i 0 (+ i 1))) ((= i 20000000)) (bit-count i)))
(time (do ((i 0 (+ i 1))) ((= i 20000000)) (my-bitcount i)))
(time (do ((i 0 (+ i 1))) ((= i 20000000)) (hakmem-bitcount i)))
which yields
[brad:~/Desktop] lucier% gsi bittest (time (do ((i 0 (+ i 1))) ((= i 20000000)) (bits i))) 927 ms real time 572 ms cpu time (565 user, 7 system) no collections no bytes allocated no minor faults no major faults (time (do ((i 0 (+ i 1))) ((= i 20000000)) (bit-count i))) 8225 ms real time 4446 ms cpu time (4394 user, 52 system) no collections no bytes allocated no minor faults no major faults (time (do ((i 0 (+ i 1))) ((= i 20000000)) (my-bitcount i))) 1067 ms real time 588 ms cpu time (582 user, 6 system) no collections no bytes allocated no minor faults no major faults (time (do ((i 0 (+ i 1))) ((= i 20000000)) (hakmem-bitcount i))) 638 ms real time 352 ms cpu time (349 user, 3 system) no collections no bytes allocated no minor faults no major faults
From which I conclude that (a) doing 6 at a time really isn't better than doing one at a time, (b) as usual, the trampoline takes an enormous amount of time, (c) the hakmem approach doesn't help too much on average, and (d) it would be best to find a way to specialize bit-count (and other small routines like it that aren't single GVM instructions) for fixnum arguments.
Brad