From: Taylor R Campbell <campbell@mumble.net>
Date: Wed, 8 Jun 2011 15:55:09 +0000 (+0000)
Subject: Fix up bit-indexed integer operations.
X-Git-Tag: 20110609-Gtk~1^2~3
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=03ef4acd768f46d58a461e81d705d5a9edc413c8;p=mit-scheme.git

Fix up bit-indexed integer operations.

. Fix sense of BIT-SET?.
. Add BIT-CLEAR?, for symmetry.
. Export forgotten TOGGLE-BIT.
. Add some tests for these operations.
---

diff --git a/src/runtime/integer-bits.scm b/src/runtime/integer-bits.scm
index 70e8f0260..f63f1e3ff 100644
--- a/src/runtime/integer-bits.scm
+++ b/src/runtime/integer-bits.scm
@@ -125,6 +125,9 @@ USA.
   (extract-bit-field 1 bit integer))
 
 (define-integrable (bit-set? bit integer)
+  (not (bit-clear? bit integer)))
+
+(define-integrable (bit-clear? bit integer)
   (zero? (extract-bit-field 1 bit integer)))
 
 ;;; SRFI 60 operations
diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 98bfc7afc..d8887e816 100644
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -336,6 +336,7 @@ USA.
 	  any-bits-set?
 	  arithmetic-shift
 	  bit-antimask
+	  bit-clear?
 	  bit-count
 	  bit-mask
 	  bit-set?
@@ -355,6 +356,7 @@ USA.
 	  splice-bit-field
 	  test-bit-field
 	  test-bit-field?
+	  toggle-bit
 
 	  ;; Truth table order
 	  bitwise-and
diff --git a/tests/runtime/test-integer-bits.scm b/tests/runtime/test-integer-bits.scm
index bf2ff18c0..5eb602bfe 100644
--- a/tests/runtime/test-integer-bits.scm
+++ b/tests/runtime/test-integer-bits.scm
@@ -370,11 +370,11 @@ USA.
   (lambda (a b)
     (if (not (eqv? (hamming-distance a b)
                    (if (eqv? (negative? a) (negative? b))
-                    (bit-count (bitwise-xor a b))
-                    -1)))
+                       (bit-count (bitwise-xor a b))
+                       -1)))
         (error "Failed:" `(HAMMING-DISTANCE ,a ,b)
                '=> (hamming-distance a b)))))
-
+
 (define-test 'BIT-MASK
   (lambda ()
     (do ((i 0 (+ i 1))) ((>= i #x1000))
@@ -394,3 +394,22 @@ USA.
                     (bitwise-not
                      (shift-left (bitwise-not (shift-left -1 size))
                                  position)))))))
+
+(define (define-per-bit-test name procedure)
+  (define-test name
+    (lambda ()
+      (do ((i 0 (+ i 1))) ((>= i #x100))
+        (procedure (random-integer-of-weight (random-integer #x1000) #x1000)
+                   (random-integer #x1000))))))
+
+(define-per-bit-test 'SET-BIT
+  (lambda (n i) (assert-true (bit-set? i (set-bit i n)))))
+
+(define-per-bit-test 'CLEAR-BIT
+  (lambda (n i) (assert-true (bit-clear? i (clear-bit i n)))))
+
+(define-per-bit-test 'TOGGLE-BIT
+  (lambda (n i) (assert-eqv (bit-clear? i (toggle-bit i n)) (bit-set? i n))))
+
+(define-per-bit-test 'EXTRACT-BIT
+  (lambda (n i) (assert-eqv (zero? (extract-bit i n)) (bit-clear? i n))))