SRFI-60: Reimplement 'rotate-bit-field' on inums to be more portable.

* libguile/srfi-60.c (scm_srfi60_rotate_bit_field): Avoid division by
  zero in the (start == end) case.  Rewrite inum case to work with
  unsigned integers in two's complement format.

* test-suite/tests/srfi-60.test ("rotate-bit-field"): Add more tests.

diff --git a/libguile/srfi-60.c b/libguile/srfi-60.c
index 1ed3c9e..de97cbc 100644 (file)
--- a/libguile/srfi-60.c
+++ b/libguile/srfi-60.c
@@ -1,6 +1,6 @@
 /* srfi-60.c --- Integers as Bits
  *
- * Copyright (C) 2005, 2006, 2008, 2010 Free Software Foundation, Inc.
+ * Copyright (C) 2005, 2006, 2008, 2010, 2014 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -155,7 +155,12 @@ SCM_DEFINE (scm_srfi60_rotate_bit_field, "rotate-bit-field", 4, 0, 0,
   SCM_ASSERT_RANGE (3, end, (ee >= ss));
   ww = ee - ss;
 
-  cc = scm_to_ulong (scm_modulo (count, scm_difference (end, start)));
+  /* we must avoid division by zero, and a field whose width is 0 or 1
+     will be left unchanged anyway, so in that case we set cc to 0. */
+  if (ww <= 1)
+    cc = 0;
+  else
+    cc = scm_to_ulong (scm_modulo (count, scm_difference (end, start)));
 
   if (SCM_I_INUMP (n))
     {
@@ -163,22 +168,40 @@ SCM_DEFINE (scm_srfi60_rotate_bit_field, "rotate-bit-field", 4, 0, 0,
 
       if (ee <= SCM_LONG_BIT-1)
         {
-          /* all within a long */
-          long below = nn & ((1L << ss) - 1);  /* before start */
-          long above = nn & (-1L << ee);       /* above end */
-          long fmask = (-1L << ss) & ((1L << ee) - 1);  /* field mask */
-          long ff = nn & fmask;                /* field */
-
-          return scm_from_long (above
-                                | ((ff << cc) & fmask)
-                                | ((ff >> (ww-cc)) & fmask)
-                                | below);
+          /* Everything fits within a long.  To avoid undefined behavior
+             when shifting negative numbers, we do all operations using
+             unsigned values, and then convert to signed at the end. */
+          unsigned long unn = nn;
+          unsigned long below = unn &  ((1UL << ss) - 1);  /* below start */
+          unsigned long above = unn & ~((1UL << ee) - 1);  /* above end */
+          unsigned long fmask = ((1UL << ww) - 1) << ss;   /* field mask */
+          unsigned long ff = unn & fmask;                  /* field */
+          unsigned long uresult = (above
+                                   | ((ff << cc) & fmask)
+                                   | ((ff >> (ww-cc)) & fmask)
+                                   | below);
+          long result;
+
+          if (uresult > LONG_MAX)
+            /* The high bit is set in uresult, so the result is
+               negative.  We have to handle the conversion to signed
+               integer carefully, to avoid undefined behavior.  First we
+               compute ~uresult, equivalent to (ULONG_MAX - uresult),
+               which will be between 0 and LONG_MAX (inclusive): exactly
+               the set of numbers that can be represented as both signed
+               and unsigned longs and thus convertible between them.  We
+               cast that difference to a signed long and then substract
+               it from -1. */
+            result = -1 - (long) ~uresult;
+          else
+            result = (long) uresult;
+
+          return scm_from_long (result);
         }
       else
         {
-          /* either no movement, or a field of only 0 or 1 bits, result
-             unchanged, avoid creating a bignum */
-          if (cc == 0 || ww <= 1)
+          /* if there's no movement, avoid creating a bignum. */
+          if (cc == 0)
             return n;
 
           n = scm_i_long2big (nn);
@@ -190,9 +213,8 @@ SCM_DEFINE (scm_srfi60_rotate_bit_field, "rotate-bit-field", 4, 0, 0,
       mpz_t tmp;
       SCM r;
 
-      /* either no movement, or in a field of only 0 or 1 bits, result
-         unchanged, avoid creating a new bignum */
-      if (cc == 0 || ww <= 1)
+      /* if there's no movement, avoid creating a new bignum. */
+      if (cc == 0)
         return n;
 
     big:
@@ -209,7 +231,7 @@ SCM_DEFINE (scm_srfi60_rotate_bit_field, "rotate-bit-field", 4, 0, 0,
       mpz_mul_2exp (tmp, tmp, ss + cc);
       mpz_ior (SCM_I_BIG_MPZ (r), SCM_I_BIG_MPZ (r), tmp);
 
-      /* field high part, count bits from end-count go to start */
+      /* field low part, count bits from end-count go to start */
       mpz_fdiv_q_2exp (tmp, SCM_I_BIG_MPZ (n), ee - cc);
       mpz_fdiv_r_2exp (tmp, tmp, cc);
       mpz_mul_2exp (tmp, tmp, ss);

diff --git a/test-suite/tests/srfi-60.test b/test-suite/tests/srfi-60.test
index 940934f..1c91943 100644 (file)
--- a/test-suite/tests/srfi-60.test
+++ b/test-suite/tests/srfi-60.test
@@ -268,27 +268,74 @@
 ;;
 
 (with-test-prefix "rotate-bit-field"
-  (pass-if (eqv? #b110  (rotate-bit-field #b110 1 1 2)))
-  (pass-if (eqv? #b1010 (rotate-bit-field #b110 1 2 4)))
-  (pass-if (eqv? #b1011 (rotate-bit-field #b0111 -1 1 4)))
-
-  (pass-if (eqv? #b0  (rotate-bit-field #b0 128 0 256)))
-  (pass-if (eqv? #b1  (rotate-bit-field #b1 128 1 256)))
-  (pass-if
-      (eqv? #x100000000000000000000000000000000
-           (rotate-bit-field #x100000000000000000000000000000000 128 0 64)))
-  (pass-if
-      (eqv? #x100000000000000000000000000000008
-           (rotate-bit-field #x100000000000000000000000000000001 3 0 64)))
-  (pass-if
-      (eqv? #x100000000000000002000000000000000
-           (rotate-bit-field #x100000000000000000000000000000001 -3 0 64)))
-
-  (pass-if (eqv? #b110 (rotate-bit-field #b110 0 0 10)))
-  (pass-if (eqv? #b110 (rotate-bit-field #b110 0 0 256)))
-
-  (pass-if "bignum becomes inum"
-    (eqv? 1 (rotate-bit-field #x100000000000000000000000000000000 1 0 129))))
+  (define-syntax-rule (check expected x count start end)
+    (begin
+      (pass-if-equal expected (rotate-bit-field x count start end))
+      (pass-if-equal (lognot expected)
+          (rotate-bit-field (lognot x) count start end))))
+
+  (check #b110  #b110 1 1 2)
+  (check #b1010 #b110 1 2 4)
+  (check #b1011 #b0111 -1 1 4)
+
+  (check #b0 #b0 128 0 256)
+  (check #b1 #b1 128 1 256)
+  (check #x100000000000000000000000000000000
+         #x100000000000000000000000000000000 128 0 64)
+  (check #x100000000000000000000000000000008
+         #x100000000000000000000000000000001 3 0 64)
+  (check #x100000000000000002000000000000000
+         #x100000000000000000000000000000001 -3 0 64)
+
+  (check #b110 #b110 0 0 10)
+  (check #b110 #b110 0 0 256)
+
+  (check #b110  #b110 1 1 1)
+
+  (check #b10111010001100111101110010101
+         #b11010001100111101110001110101 -26 5 28)
+  (check #b11000110011110111000111011001
+         #b11010001100111101110001110101 28 2 28)
+
+  (check #b01111010001100111101110010101
+         #b11010001100111101110001110101 -3 5 29)
+  (check #b10100011001111011100011101101
+         #b11010001100111101110001110101 28 2 29)
+
+  (check #b110110100011001111011100010101
+         #b011010001100111101110001110101 48 5 30)
+  (check #b110100011001111011100011101001
+         #b011010001100111101110001110101 85 2 30)
+  (check #b011010001100111101110001110101
+         #b110100011001111011100011101001 83 2 30)
+
+  (check
+   #b1101100110101001110000111110011010000111011101011101110111011
+   #b1100110101001110000111110011010000111011101011101110110111011 -3 5 60)
+  (check
+   #b1011010100111000011111001101000011101110101110111011011101110
+   #b1100110101001110000111110011010000111011101011101110110111011 62 0 60)
+
+  (check
+   #b1011100110101001110000111110011010000111011101011101110111011
+   #b1100110101001110000111110011010000111011101011101110110111011 53 5 61)
+  (check
+   #b1001101010011100001111100110100001110111010111011101101110111
+   #b1100110101001110000111110011010000111011101011101110110111011 62 0 61)
+
+  (check
+   #b11011001101010011100001111100110100001110111010111011100111011
+   #b01100110101001110000111110011010000111011101011101110110111011 53 7 62)
+  (check
+   #b11011001101010011100001111100110100001110111010111011100111011
+   #b01100110101001110000111110011010000111011101011101110110111011 -2 7 62)
+  (check
+   #b01100110101001110000111110011010000111011101011101110110111011
+   #b11011001101010011100001111100110100001110111010111011100111011 2 7 62)
+
+  (pass-if-equal "bignum becomes inum"
+      1
+    (rotate-bit-field #x100000000000000000000000000000000 1 0 129)))
 
 ;;
 ;; reverse-bit-field