From 1678c6aa47ad3d9517552face6a03c25fd230f61 Mon Sep 17 00:00:00 2001
From: Alex Shinn <ashinn@users.noreply.github.com>
Date: Wed, 26 Feb 2014 20:03:28 +0900
Subject: [PATCH] Fixing bit-set? on fixnums with larger than word-size index.
 Fixing some cases of arithmetic shift on bignums with zero modulo word-sized
 offset.

---
 lib/srfi/33/bit.c       | 19 ++++++++++++-------
 tests/srfi-33-tests.scm |  6 ++++++
 2 files changed, 18 insertions(+), 7 deletions(-)

diff --git a/lib/srfi/33/bit.c b/lib/srfi/33/bit.c
index 0546cc33..995d4da7 100644
--- a/lib/srfi/33/bit.c
+++ b/lib/srfi/33/bit.c
@@ -202,7 +202,8 @@ static sexp sexp_arithmetic_shift (sexp ctx, sexp self, sexp_sint_t n, sexp i, s
       for (j=tmp=0; j<len; j++) {
         sexp_bignum_data(res)[j+offset]
           = (sexp_bignum_data(i)[j] << bit_shift) + tmp;
-        tmp = sexp_bignum_data(i)[j] >> tail_shift;
+        if (bit_shift != 0)
+          tmp = sexp_bignum_data(i)[j] >> tail_shift;
       }
       if (bit_shift != 0) sexp_bignum_data(res)[len+offset] = tmp;
     }
@@ -286,20 +287,24 @@ static sexp sexp_integer_length (sexp ctx, sexp self, sexp_sint_t n, sexp x) {
 }
 
 static sexp sexp_bit_set_p (sexp ctx, sexp self, sexp_sint_t n, sexp i, sexp x) {
+  sexp_sint_t pos;
 #if SEXP_USE_BIGNUMS
-  sexp_uint_t pos;
+  sexp_sint_t rem;
 #endif
   if (! sexp_fixnump(i))
     return sexp_type_exception(ctx, self, SEXP_FIXNUM, i);
+  pos = sexp_unbox_fixnum(i);
+  if (pos < 0)
+    return sexp_xtype_exception(ctx, self, "index must be non-negative", i);
   if (sexp_fixnump(x)) {
-    return sexp_make_boolean(sexp_unbox_fixnum(x) & (1UL<<sexp_unbox_fixnum(i)));
+    return sexp_make_boolean((pos < sizeof(sexp_uint_t)*CHAR_BIT)
+                             && (sexp_unbox_fixnum(x) & (1UL<<pos)));
 #if SEXP_USE_BIGNUMS
   } else if (sexp_bignump(x)) {
-    pos = sexp_unbox_fixnum(i) / (sizeof(sexp_uint_t)*CHAR_BIT);
+    pos /= (sizeof(sexp_uint_t)*CHAR_BIT);
+    rem = (sexp_unbox_fixnum(i) - pos*sizeof(sexp_uint_t)*CHAR_BIT);
     return sexp_make_boolean((pos < sexp_bignum_length(x))
-                             && (sexp_bignum_data(x)[pos]
-                                 & (1UL<<(sexp_unbox_fixnum(i)
-                                          - pos*sizeof(sexp_uint_t)*CHAR_BIT))));
+                             && (sexp_bignum_data(x)[pos] & (1UL<<rem)));
 #endif
   } else {
     return sexp_type_exception(ctx, self, SEXP_FIXNUM, x);
diff --git a/tests/srfi-33-tests.scm b/tests/srfi-33-tests.scm
index d314bd4a..31790166 100644
--- a/tests/srfi-33-tests.scm
+++ b/tests/srfi-33-tests.scm
@@ -38,4 +38,10 @@
 (test 0 (arithmetic-shift 1 -64))
 (test 0 (arithmetic-shift 1 -65))
 
+(test #x1000000000000000100000000000000000000000000000000
+    (arithmetic-shift #x100000000000000010000000000000000 64))
+
+(test-not (bit-set? 64 1))
+(test-assert (bit-set? 64 #x10000000000000000))
+
 (test-end)