New function: buf-bitset.

* buf.c (buf_bitset): New function.
(buf_init): Register buf-bitset intrinsic.

* buf.h (buf_bitset): Declared.

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

* txr.1: Documented.

4 files changed, 73 insertions, 0 deletions

diff --git a/buf.c b/buf.c
index 24319dad..c3683d0d 100644
--- a/buf.c
+++ b/buf.c
@@ -1675,6 +1675,39 @@ val buf_trunc(val buf, val bits)
   }
 }
 
+val buf_bitset(val buf)
+{
+  val self = lit("buf-bitset");
+  struct buf *b = buf_handle(buf, self);
+  ucnum l = c_unum(b->len, self), i, j;
+  list_collect_decl (out, ptail);
+
+  for (i = l - 1, j = 0; i != convert(ucnum, -1); --i, j++) {
+    unsigned byte = b->data[i];
+    if (byte) {
+      val bitpos = mul(unum(j), num_fast(8));
+      if (byte & 1)
+        ptail = list_collect(ptail, bitpos);
+      if (byte & 2)
+        ptail = list_collect(ptail, succ(bitpos));
+      if (byte & 4)
+        ptail = list_collect(ptail, ssucc(bitpos));
+      if (byte & 8)
+        ptail = list_collect(ptail, sssucc(bitpos));
+      if (byte & 16)
+        ptail = list_collect(ptail, plus(bitpos, num_fast(4)));
+      if (byte & 32)
+        ptail = list_collect(ptail, plus(bitpos, num_fast(5)));
+      if (byte & 64)
+        ptail = list_collect(ptail, plus(bitpos, num_fast(6)));
+      if (byte & 128)
+        ptail = list_collect(ptail, plus(bitpos, num_fast(7)));
+    }
+  }
+
+  return out;
+}
+
 void buf_init(void)
 {
   reg_fun(intern(lit("make-buf"), user_package), func_n3o(make_buf, 1));
@@ -1775,6 +1808,7 @@ void buf_init(void)
   reg_fun(intern(lit("buf-xor"), user_package), func_n2(buf_xor));
   reg_fun(intern(lit("buf-not"), user_package), func_n1(buf_not));
   reg_fun(intern(lit("buf-trunc"), user_package), func_n2(buf_trunc));
+  reg_fun(intern(lit("buf-bitset"), user_package), func_n1(buf_bitset));
 
   fill_stream_ops(&buf_strm_ops);
 }
diff --git a/buf.h b/buf.h
index 09941385..713a3c64 100644
--- a/buf.h
+++ b/buf.h
@@ -131,5 +131,6 @@ val buf_or(val bufa, val bufb);
 val buf_xor(val bufa, val bufb);
 val buf_not(val buf);
 val buf_trunc(val buf, val bits);
+val buf_bitset(val buf);
 
 void buf_init(void);
diff --git a/tests/012/buf.tl b/tests/012/buf.tl
index 20f9d8d6..6e7a3159 100644
--- a/tests/012/buf.tl
+++ b/tests/012/buf.tl
@@ -300,3 +300,19 @@
   (buf-trunc #b'ff' 17) #b'0000ff'
   (buf-trunc #b'aabbccdd' 24) #b'bbccdd'
   (buf-trunc #b'aabbccdd' 20) #b'0bccdd')
+
+(mtest
+  (buf-bitset #b'') ()
+  (buf-bitset #b'00') ()
+  (buf-bitset #b'01') (0)
+  (buf-bitset #b'02') (1)
+  (buf-bitset #b'04') (2)
+  (buf-bitset #b'08') (3)
+  (buf-bitset #b'10') (4)
+  (buf-bitset #b'20') (5)
+  (buf-bitset #b'40') (6)
+  (buf-bitset #b'80') (7)
+  (buf-bitset #b'ff') (0 1 2 3 4 5 6 7)
+  (buf-bitset #b'ff00') (8 9 10 11 12 13 14 15)
+  (buf-bitset #b'03ff') (0 1 2 3 4 5 6 7 8 9)
+  (buf-bitset (buf-ash #b'03ff' 100)) (100 101 102 103 104 105 106 107 108 109))
diff --git a/txr.1 b/txr.1
index ac9bc870..7e407c1b 100644
--- a/txr.1
+++ b/txr.1
@@ -30402,6 +30402,28 @@ buffer is masked so that any bits which lie outside of the truncation are zero.
   (buf-trunc #b'ff' 0) -> #b''
 .brev
 
+.coNP Function @ buf-bitset
+.synb
+.mets (buf-bitset << buf )
+.syne
+.desc
+The
+.code buf-bitset
+function returns the positions all of bits within buffer
+.meta buf
+which are set (have a value of 1). The values appear in
+increasing order (right to left bit positions).
+Bit zero is the least significant bit of the last byte
+of the buffer.
+
+.TP* Examples:
+
+.verb
+  (buf-bitset #b'') -> nil
+  (buf-bitset #b'01') -> (0)
+  (buf-bitset #b'03fe') -> (1 2 3 4 5 6 7 8 9)
+.brev
+
 .coNP Functions @ buf-compress and @ buf-decompress
 .synb
 .mets (buf-compress < buf <> [ level ])