From b8f3be619a5060e9220734d4c0aa7ec411ca9c68 Mon Sep 17 00:00:00 2001
From: Justin Koser <jmk@ccs.neu.edu>
Date: Fri, 9 Jun 2017 14:58:14 -0400
Subject: [PATCH] Faster bitwise operations on bignums (ticket #798)

---
 src/Lib/Common/bitwise.sch                  | 15 ++----
 test/Benchmarking/R6RS/inputs/primes2.input |  5 ++
 test/Benchmarking/R6RS/src/primes2.sch      | 51 +++++++++++++++++++++
 3 files changed, 60 insertions(+), 11 deletions(-)
 create mode 100644 test/Benchmarking/R6RS/inputs/primes2.input
 create mode 100644 test/Benchmarking/R6RS/src/primes2.sch

diff --git a/src/Lib/Common/bitwise.sch b/src/Lib/Common/bitwise.sch
index 29cc799a..600b4a79 100644
--- a/src/Lib/Common/bitwise.sch
+++ b/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))
diff --git a/test/Benchmarking/R6RS/inputs/primes2.input b/test/Benchmarking/R6RS/inputs/primes2.input
new file mode 100644
index 00000000..26f20285
--- /dev/null
+++ b/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)
diff --git a/test/Benchmarking/R6RS/src/primes2.sch b/test/Benchmarking/R6RS/src/primes2.sch
new file mode 100644
index 00000000..b53bff72
--- /dev/null
+++ b/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)))))