From 19b6ae71d5476730d63b0f308d432ac225a8f379 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Wed, 19 Sep 2012 16:32:11 -0700
Subject: [PATCH] math.bitwise: Fix on-bits for negative values, which also
 fixes bits. Add unit tests.

---
 basis/math/bitwise/bitwise-tests.factor | 23 +++++++++++++++++++++++
 basis/math/bitwise/bitwise.factor       |  2 +-
 2 files changed, 24 insertions(+), 1 deletion(-)

diff --git a/basis/math/bitwise/bitwise-tests.factor b/basis/math/bitwise/bitwise-tests.factor
index 2ad8280ed9..ba46256a3d 100644
--- a/basis/math/bitwise/bitwise-tests.factor
+++ b/basis/math/bitwise/bitwise-tests.factor
@@ -79,3 +79,26 @@ SPECIALIZED-ARRAY: uint-4
 [ -1 bit-count ] [ invalid-bit-count-target? ] must-fail-with
 
 { 0b11 } [ 0b110000 5 4 bit-range ] unit-test
+
+{ 0b1111 } [ 4 on-bits ] unit-test
+{ 0 } [ 0 on-bits ] unit-test
+{ 0 } [ -2 on-bits ] unit-test
+
+{ 0b11 } [ 0b1111 2 bits ] unit-test
+{ 0b111 } [ 0b1111 3 bits ] unit-test
+{ 0 } [ 0b1111 0 bits ] unit-test
+{ 0 } [ 0b1111 -2 bits ] unit-test
+
+{ 0b111 } [ 0b111 -1 clear-bit ] unit-test
+{ 0b110 } [ 0b111 0 clear-bit ] unit-test
+{ 0b101 } [ 0b111 1 clear-bit ] unit-test
+
+{ 0 } [ 0 -1 set-bit ] unit-test
+{ 0b1 } [ 0 0 set-bit ] unit-test
+{ 0b10 } [ 0 1 set-bit ] unit-test
+
+{ 0 } [ 0 -1 toggle-bit ] unit-test
+{ 0b1 } [ 0 0 toggle-bit ] unit-test
+{ 0b10 } [ 0 1 toggle-bit ] unit-test
+{ 0 } [ 0 0 toggle-bit 0 toggle-bit ] unit-test
+{ 0 } [ 0 1 toggle-bit 1 toggle-bit ] unit-test
diff --git a/basis/math/bitwise/bitwise.factor b/basis/math/bitwise/bitwise.factor
index 88469b207b..f2ce76ddd0 100644
--- a/basis/math/bitwise/bitwise.factor
+++ b/basis/math/bitwise/bitwise.factor
@@ -16,7 +16,7 @@ IN: math.bitwise
 : mask ( x n -- ? ) bitand ; inline
 : mask? ( x n -- ? ) mask zero? not ; inline
 : wrap ( m n -- m' ) 1 - bitand ; inline
-: on-bits ( m -- n ) 2^ 1 - ; inline
+: on-bits ( m -- n ) dup 0 <= [ drop 0 ] [ 2^ 1 - ] if ; inline
 : bits ( m n -- m' ) on-bits mask ; inline
 : mask-bit ( m n -- m' ) 2^ mask ; inline
 : toggle-bit ( m n -- m' ) 2^ bitxor ; inline