Faster bitwise operations on bignums (ticket larcenists#798)

src/Lib/Common/bitwise.sch

@@ -27,6 +27,7 @@
 (define (bitwise:low k) (mod k bitwise:modulus))
 
 ; Returns the (possibly negative) high-order bits of an exact integer.
+; FIXME: functions that call this repeatedly are slow.
 
 (define (bitwise:high k) (div k bitwise:modulus))
 
@@ -48,8 +49,6 @@
  (- (- x) 1))
  (else bitwise:complain x 'bitwise-not)))
 
-; FIXME: These procedures shouldn't be this slow.
-
 (define (bitwise-and . args)
  (define (bitwise-and2 x y)
  (cond ((and (fixnum? x) (fixnum? y))
@@ -59,9 +58,7 @@
  ((= x -1) y)
  ((= y -1) x)
  (else
- (bitwise:combine
- (bitwise-and2 (bitwise:high x) (bitwise:high y))
- (fxand (bitwise:low x) (bitwise:low y))))))
+ (integer-logand x y))))
  (cond ((null? args) -1)
  ((null? (cdr args)) (car args))
  ((null? (cddr args))
@@ -80,9 +77,7 @@
  ((= x -1) -1)
  ((= y -1) -1)
  (else
- (bitwise:combine
- (bitwise-ior2 (bitwise:high x) (bitwise:high y))
- (fxior (bitwise:low x) (bitwise:low y))))))
+ (integer-logior x y))))
  (cond ((null? args) 0)
  ((null? (cdr args)) (car args))
  ((null? (cddr args))
@@ -100,9 +95,7 @@
  ((= y 0) x)
  ((= x y) 0)
  (else
- (bitwise:combine
- (bitwise-xor2 (bitwise:high x) (bitwise:high y))
- (fxxor (bitwise:low x) (bitwise:low y))))))
+ (integer-logxor x y))))
  (cond ((null? args) 0)
  ((null? (cdr args)) (car args))
  ((null? (cddr args))

test/Benchmarking/R6RS/inputs/primes2.input

@@ -0,0 +1,5 @@
+10
+200
+(2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79
+ 83 89 97 101 103 107 109 113 127 131 137 139 149 151 157 163
+ 167 173 179 181 191 193 197 199)

test/Benchmarking/R6RS/src/primes2.sch

@@ -0,0 +1,51 @@
+;;; Implementation of the Sieve of Eratosthenes, using a bitset.
+;;; The bitset is immutable and thus copied on each modification,
+;;; which ruins the efficiency of the algorithm but makes it a
+;;; good benchmark for bitwise operations.
+
+(import (rnrs base)
+ (rnrs arithmetic bitwise)
+ (rnrs io simple))
+
+;;; A bitset is a non-negative exact integer.
+
+;; Returns a list of the indexes at which the bitset has a one.
+(define (bitset->list bs)
+ (define (loop bs l)
+ (if (zero? bs)
+ l
+ (let ((k (bitwise-first-bit-set bs)))
+ (loop (bitwise-copy-bit bs k 0)
+ (cons k l)))))
+ (reverse (loop bs '())))
+
+;; Returns a list of the prime numbers within the given bound.
+(define (primes<= n)
+ (define (filter-loop k m comps)
+ (if (> m n)
+ comps
+ (filter-loop k (+ k m) (bitwise-copy-bit comps m 1))))
+ (define (base-loop i comps)
+ (cond ((> i n)
+ comps)
+ ((bitwise-bit-set? comps i)
+ (base-loop (+ i 1) comps))
+ (else
+ (base-loop (+ i 1) (filter-loop i (+ i i) comps)))))
+ (bitset->list
+ (bitwise-not
+ (bitwise-ior (base-loop 2 3)
+ (bitwise-arithmetic-shift-left -1 (+ n 1))))))
+
+(define (main)
+ (let* ((count (read))
+ (input1 (read))
+ (output (read))
+ (s2 (number->string count))
+ (s1 (number->string input1))
+ (name "primes"))
+ (run-r6rs-benchmark
+ (string-append name ":" s1 ":" s2)
+ count
+ (lambda () (primes<= (hide count input1)))
+ (lambda (result) (equal? result output)))))