New function: buf-bit.

* buf.c (buf_bit): New function.
(buf_init): Register buf_bit intrinsic.

* buf.h (buf_bit): Declared.

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

* txr.1: Documented.

4 files changed, 54 insertions, 0 deletions

diff --git a/buf.c b/buf.c
index c3683d0d..0fad7481 100644
--- a/buf.c
+++ b/buf.c
@@ -1708,6 +1708,26 @@ val buf_bitset(val buf)
   return out;
 }
 
+val buf_bit(val buf, val bit)
+{
+  val self = lit("buf-bit");
+  struct buf *bh = buf_handle(buf, self);
+  ucnum l = c_unum(bh->len, self);
+  cnum b = c_num(bit, self);
+
+  if (b < 0) {
+    return nil;
+  } else {
+    ucnum byte = b / 8;
+    ucnum r = b % 8;
+
+    if (byte >= l)
+      return nil;
+
+    return tnil(bh->data[l - byte - 1] & (1U << r));
+  }
+}
+
 void buf_init(void)
 {
   reg_fun(intern(lit("make-buf"), user_package), func_n3o(make_buf, 1));
@@ -1809,6 +1829,7 @@ void buf_init(void)
   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));
+  reg_fun(intern(lit("buf-bit"), user_package), func_n2(buf_bit));
 
   fill_stream_ops(&buf_strm_ops);
 }
diff --git a/buf.h b/buf.h
index 713a3c64..dad9cf60 100644
--- a/buf.h
+++ b/buf.h
@@ -132,5 +132,6 @@ val buf_xor(val bufa, val bufb);
 val buf_not(val buf);
 val buf_trunc(val buf, val bits);
 val buf_bitset(val buf);
+val buf_bit(val buf, val bit);
 
 void buf_init(void);
diff --git a/tests/012/buf.tl b/tests/012/buf.tl
index 6e7a3159..3437d6bb 100644
--- a/tests/012/buf.tl
+++ b/tests/012/buf.tl
@@ -316,3 +316,9 @@
   (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))
+
+(mtest
+  (buf-bit #b'' -1) nil
+  (buf-bit #b'ffff' -1) nil
+  (mapcar (op buf-bit #b'fad5') 0..16)
+  (t nil t nil t nil t t nil t nil t t t t t))
diff --git a/txr.1 b/txr.1
index 7e407c1b..42f2372d 100644
--- a/txr.1
+++ b/txr.1
@@ -30424,6 +30424,32 @@ of the buffer.
   (buf-bitset #b'03fe') -> (1 2 3 4 5 6 7 8 9)
 .brev
 
+.coNP Function @ buf-bit
+.synb
+.mets (buf-bit < buf << bit )
+.syne
+.desc
+The
+.code buf-bit
+function tests the bit position specified by
+.meta bit
+of the buffer
+.metn buf .
+If the value of the bit is 1, then the function returns
+.codn t ,
+otherwise
+.codn nil .
+
+Bit position zero is the least significant bit of the rightmost
+byte of the buffer.
+
+If
+.meta bit
+refers to a position which lies outside of the buffer,
+due to being negative, or excessively positive,
+the value returned is
+.codn nil .
+
 .coNP Functions @ buf-compress and @ buf-decompress
 .synb
 .mets (buf-compress < buf <> [ level ])