New function: buf-binary-width.

* buf.c (buf_binary_width): New function.
(buf_init): Register buf-binary-width intrinsic.

* buf.h (buf_binary_width): Declared.

* tests/012/buf.tl: New tests.

* txr.1: Documented.

4 files changed, 164 insertions, 0 deletions

diff --git a/buf.c b/buf.c
index c8d51cdc..f5f27b39 100644
--- a/buf.c
+++ b/buf.c
@@ -1809,6 +1809,94 @@ val buf_count_ones(val buf)
          : unum(total[1]);
 }
 
+val buf_binary_width(val buf)
+{
+  val self = lit("buf-bit-width");
+  struct buf *b = buf_handle(buf, self);
+  ucnum l = c_unum(b->len, self), i;
+  ucnum *ucdata = coerce(ucnum *, b->data);
+  ucnum zeros[2] = { 0, 0 };
+  int found = 0;
+
+  for (i = 0; !found && i < l / sizeof (ucnum); i++) {
+    ucnum d = ucdata[i];
+    unsigned z = sizeof (ucnum) * 8;
+
+#if !HAVE_LITTLE_ENDIAN
+    if (d != 0) {
+      found = 1;
+      if (d <= INT_PTR_MAX) {
+        z = sizeof (ucnum) * 8 - highest_bit(d);
+      } else {
+        z = 0;
+      }
+    }
+#else
+    if (d != 0) {
+      found = 1;
+      if ((d & 0xff) <= 0x7f) {
+#if SIZEOF_PTR == 8
+        d = (d << 32) | (d >> 32);
+        d = ((d & 0x0000FFFF0000FFFF) << 16) | ((d & 0xFFFF0000FFFF0000) >> 16);
+        d = ((d & 0x00FF00FF00FF00FF) << 8) | ((d & 0xFF00FF00FF00FF00) >> 8);
+#elif SIZEOF_PTR == 4
+        d = (d << 16) | (d >> 16);
+        d = ((d & 0x00FF00FF) << 8) | ((d & 0xFF00FF00) >> 8);
+#else
+#error portme
+#endif
+        z = sizeof (ucnum) * 8 - highest_bit(d);
+      } else {
+        z = 0;
+      }
+    }
+#endif
+
+    zeros[1] += z;
+    if (zeros[1] < z)
+      zeros[0]++;
+  }
+
+  for (i = l / sizeof (ucnum) * sizeof (ucnum); !found && i < l; i++) {
+    unsigned d = b->data[i];
+    unsigned z = 8;
+
+    if (d != 0) {
+      found = 1;
+
+      if ((d & 0xFE) == 0)
+        z = 7;
+      else if ((d & 0xFC) == 0)
+        z = 6;
+      else if ((d & 0xF8) == 0)
+        z = 5;
+      else if ((d & 0xF0) == 0)
+        z = 4;
+      else if ((d & 0xE0) == 0)
+        z = 3;
+      else if ((d & 0xC0) == 0)
+        z = 2;
+      else if ((d & 0x80) == 0)
+        z = 1;
+      else
+        z = 0;
+    }
+
+    zeros[1] += z;
+    if (zeros[1] < z)
+      zeros[0]++;
+  }
+
+  {
+    val tbits = mul(unum(l), num_fast(8));
+    val tzeros = zeros[0]
+                ? plus(ash(unum(zeros[0]), num_fast(8 * SIZEOF_PTR)),
+                       unum(zeros[1]))
+                : unum(zeros[1]);
+    return minus(tbits, tzeros);
+  }
+}
+
 void buf_init(void)
 {
   reg_fun(intern(lit("make-buf"), user_package), func_n3o(make_buf, 1));
@@ -1914,6 +2002,7 @@ void buf_init(void)
   reg_fun(intern(lit("buf-bit"), user_package), func_n2(buf_bit));
   reg_fun(intern(lit("buf-zero-p"), user_package), func_n1(buf_zero_p));
   reg_fun(intern(lit("buf-count-ones"), user_package), func_n1(buf_count_ones));
+  reg_fun(intern(lit("buf-binary-width"), user_package), func_n1(buf_binary_width));
 
   fill_stream_ops(&buf_strm_ops);
 }
diff --git a/buf.h b/buf.h
index 3782ef25..c3c0fb29 100644
--- a/buf.h
+++ b/buf.h
@@ -136,5 +136,6 @@ val buf_bitset(val buf);
 val buf_bit(val buf, val bit);
 val buf_zero_p(val buf);
 val buf_count_ones(val buf);
+val buf_binary_width(val buf);
 
 void buf_init(void);
diff --git a/tests/012/buf.tl b/tests/012/buf.tl
index 923a945e..128b3566 100644
--- a/tests/012/buf.tl
+++ b/tests/012/buf.tl
@@ -508,3 +508,59 @@
     (buf-count-ones (buf-ash #b'7B' i)) 6
     (buf-count-ones (buf-ash #b'7D' i)) 6
     (buf-count-ones (buf-ash #b'7f' i)) 7))
+
+(mtest
+  (buf-binary-width #b'') 0
+  (buf-binary-width #b'01') 1
+  (buf-binary-width #b'02') 2
+  (buf-binary-width #b'04') 3
+  (buf-binary-width #b'08') 4
+  (buf-binary-width #b'10') 5
+  (buf-binary-width #b'20') 6
+  (buf-binary-width #b'40') 7
+  (buf-binary-width #b'80') 8
+  (buf-binary-width #b'03') 2
+  (buf-binary-width #b'05') 3
+  (buf-binary-width #b'06') 3
+  (buf-binary-width #b'07') 3
+  (buf-binary-width #b'09') 4
+  (buf-binary-width #b'0F') 4
+  (buf-binary-width #b'30') 6
+  (buf-binary-width #b'40') 7
+  (buf-binary-width #b'50') 7
+  (buf-binary-width #b'60') 7
+  (buf-binary-width #b'80') 8
+  (buf-binary-width #b'C0') 8
+  (buf-binary-width #b'E0') 8
+  (buf-binary-width #b'F0') 8
+  (buf-binary-width #b'F8') 8
+  (buf-binary-width #b'FC') 8
+  (buf-binary-width #b'FE') 8
+  (buf-binary-width #b'FF') 8
+  (buf-binary-width #b'0000') 0
+  (buf-binary-width #b'AAAA') 16
+  (buf-binary-width #b'00000000') 0
+  (buf-binary-width #b'AAAAAAAA') 32
+  (buf-binary-width #b'80000000') 32
+  (buf-binary-width #b'7fffffff') 31
+  (buf-binary-width #b'01ffffff') 25
+  (buf-binary-width #b'0000000000') 0
+  (buf-binary-width #b'AAAAAAAA00') 40
+  (buf-binary-width #b'8000000000') 40
+  (buf-binary-width #b'7fffffff00') 39
+  (buf-binary-width #b'01ffffff00') 33
+  (buf-binary-width #b'0000000000000000') 0
+  (buf-binary-width #b'AAAAAAAAAAAAAAAA') 64
+  (buf-binary-width #b'8000000000000000') 64
+  (buf-binary-width #b'7fffffffffffffff') 63
+  (buf-binary-width #b'01ffffffffffffff') 57
+  (buf-binary-width #b'000000000000000000') 0
+  (buf-binary-width #b'AAAAAAAAAAAAAAAA00') 72
+  (buf-binary-width #b'800000000000000000') 72
+  (buf-binary-width #b'7fffffffffffffff00') 71
+  (buf-binary-width #b'01ffffffffffffff00') 65)
+
+(each ((i 0..256))
+  (mvtest
+    (buf-binary-width (buf-ash #b'01' i)) (succ i)
+    (width (uint-buf (buf-ash #b'01' i))) (succ i)))
diff --git a/txr.1 b/txr.1
index a2338dea..b6bdaa04 100644
--- a/txr.1
+++ b/txr.1
@@ -30497,6 +30497,24 @@ function returns a non-negative integer indicating the number of
 occurrences of the bit value 1 in
 .metn buf .
 
+.coNP Function @ buf-binary-width
+.synb
+.mets (buf-binary-width << buf )
+.syne
+.desc
+The
+.code buf-binary-width
+considers the buffer
+.meta buf
+to be the representation of a big-endian unsigned integer, and calculates
+that integer's width.
+
+The following equivalence holds:
+
+.verb
+  (buf-binary-width b)  <-->  (width (uint-buf b))
+.brev
+
 .coNP Functions @ buf-compress and @ buf-decompress
 .synb
 .mets (buf-compress < buf <> [ level ])