New functions: buf-not and buf-trunc.

* buf.c (buf_not, buf_trunc): New functions.
(buf_init): Register buf-not and buf-trunc intrinsics.

* buf.h (buf_not, buf_trunc): Declared.

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

* txr.1: Documented.

4 files changed, 166 insertions, 0 deletions

diff --git a/buf.c b/buf.c
index a916d92b..24319dad 100644
--- a/buf.c
+++ b/buf.c
@@ -1625,6 +1625,56 @@ val buf_xor(val bufa, val bufb)
   }
 }
 
+val buf_not(val buf)
+{
+  val self = lit("buf-not");
+  struct buf *b = buf_handle(buf, self);
+  ucnum l = c_unum(b->len, self);
+
+  if (l == 0) {
+    return buf;
+  } else if (l == convert(ucnum, -1)) {
+    uw_throwf(error_s, lit("~a: array size overflow"), self, nao);
+  } else {
+    val obuf = make_ubuf(l);
+    struct buf *ob = buf_handle(obuf, self);
+    ucnum i;
+
+    for (i = 0; i < l; i++)
+      ob->data[i] = b->data[i] ^ 0xff;
+
+    return obuf;
+  }
+}
+
+val buf_trunc(val buf, val bits)
+{
+  val self = lit("buf-not");
+  cnum b = c_num(bits, self);
+  struct buf *bh = buf_handle(buf, self);
+  ucnum l = c_unum(bh->len, self);
+
+  if (b <= 0) {
+    return make_buf(zero, nil, zero);
+  } else {
+    ucnum bytes = (b + 7) / 8;
+    val obuf = make_ubuf(bytes);
+    struct buf *ob = buf_handle(obuf, self);
+
+    if (bytes > l) {
+      memcpy(ob->data + bytes - l, bh->data, l);
+      memset(ob->data, 0, bytes - l);
+    } else {
+      memcpy(ob->data, bh->data + l - bytes, bytes);
+    }
+
+    if (b % 8 != 0)
+      ob->data[0] &= (0xffu >> (8 - b % 8));
+
+    return obuf;
+  }
+}
+
 void buf_init(void)
 {
   reg_fun(intern(lit("make-buf"), user_package), func_n3o(make_buf, 1));
@@ -1723,6 +1773,8 @@ void buf_init(void)
   reg_fun(intern(lit("buf-and"), user_package), func_n2(buf_and));
   reg_fun(intern(lit("buf-or"), user_package), func_n2(buf_or));
   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));
 
   fill_stream_ops(&buf_strm_ops);
 }
diff --git a/buf.h b/buf.h
index 1d5ac6b2..09941385 100644
--- a/buf.h
+++ b/buf.h
@@ -129,5 +129,7 @@ val buf_fash(val buf, val bits);
 val buf_and(val bufa, val bufb);
 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);
 
 void buf_init(void);
diff --git a/tests/012/buf.tl b/tests/012/buf.tl
index f6c35ac7..20f9d8d6 100644
--- a/tests/012/buf.tl
+++ b/tests/012/buf.tl
@@ -273,3 +273,30 @@
   (buf-xor #b'aa' #b'ffff') #b'ff55'
   (buf-xor #b'ff' #b'ffaa') #b'ff55'
   (buf-xor #b'ff00ff0f' #b'1baddeadbeef') #b'1bad21ad41e0')
+
+(mtest
+  (buf-not #b'') #b''
+  (buf-not #b'00') #b'ff'
+  (buf-not #b'aa') #b'55'
+  (buf-not #b'aa55') #b'55aa'
+  (buf-not #b'ff00ff00ff00') #b'00ff00ff00ff')
+
+(mtest
+  (buf-trunc #b'' -1) #b''
+  (buf-trunc #b'' -0) #b''
+  (buf-trunc #b'' -1) #b''
+  (buf-trunc #b'' -1000) #b''
+  (buf-trunc #b'ff' 8) #b'ff'
+  (buf-trunc #b'ff' 7) #b'7f'
+  (buf-trunc #b'ff' 6) #b'3f'
+  (buf-trunc #b'ff' 5) #b'1f'
+  (buf-trunc #b'ff' 4) #b'0f'
+  (buf-trunc #b'ff' 3) #b'07'
+  (buf-trunc #b'ff' 2) #b'03'
+  (buf-trunc #b'ff' 1) #b'01'
+  (buf-trunc #b'ff' 0) #b''
+  (buf-trunc #b'ff' 9) #b'00ff'
+  (buf-trunc #b'ff' 16) #b'00ff'
+  (buf-trunc #b'ff' 17) #b'0000ff'
+  (buf-trunc #b'aabbccdd' 24) #b'bbccdd'
+  (buf-trunc #b'aabbccdd' 20) #b'0bccdd')
diff --git a/txr.1 b/txr.1
index d4989961..ac9bc870 100644
--- a/txr.1
+++ b/txr.1
@@ -30316,6 +30316,91 @@ and
 .code buf-xor
 calculates the bitwise Boolean exclusive "or".
 
+.coNP Function @ buf-not
+.synb
+.mets (buf-not << buf )
+.syne
+.desc
+The
+.code buf-not
+function returns the bitwise complement of
+.codn buf .
+
+If
+.meta buf
+is empty, then an empty buffer is returned which may be
+.meta buf
+itself.
+
+Otherwise, a new buffer is returned of the same length as
+.meta buf
+whose bytes are the bitwise complements of corresponding bytes in
+.metn buf .
+
+Complement means that wherever
+.meta buf
+has a bit whose value is 1, the corresponding bit in the same position
+of the returned buffer has a zero, and vice versa.
+
+.TP* Examples:
+
+.verb
+  (buf-not #b'') -> #b''
+  (buf-not #b'fe') -> #b'01
+  (buf-not #b'aa55') -> #b'55aa'
+  (buf-not #b'00008000') -> #b'ffff7fff'
+.brev
+
+.coNP Function @ buf-trunc
+.synb
+.mets (buf-trunc < buf << bits )
+.syne
+.desc
+The
+.code buf-trunc
+function calculates a buffer by either truncating or extending
+.meta buf
+to the specified number of bits.
+
+If
+.meta bits
+is zero or less, then an empty buffer is returned; if
+.meta buf
+is also empty then the returned buffer may be
+.meta buf
+itself.
+
+Truncation or extension takes place the left side of the
+buffer value. If both the input and output buffer are non-empty
+(have at least one byte), then their rightmost bytes correspond.
+
+Because buffers are composed of a whole number of bytes, the
+.code buf-trunc
+cannot produce a buffer which is exactly
+.meta bits
+wide when
+.meta bits
+is not divisible by 8.  In this situation,
+.meta bits
+is rounded up to a value divisible by 8, which is used to determine the
+adjusted length of the returned buffer.  The leftmost byte of the returned
+buffer is masked so that any bits which lie outside of the truncation are zero.
+
+.TP* Examples:
+
+.verb
+  (buf-trunc #b'' 0) -> #b''
+  (buf-trunc #b'' 16) -> #b'0000'
+  (buf-trunc #b'' 17) -> #b'000000'
+  (buf-trunc #b'ffff' 17) -> #b'00ffff'
+  (buf-trunc #b'ffff' 14) -> #b'3fff'
+  (buf-trunc #b'ffff' 12) -> #b'0fff'
+  (buf-trunc #b'ff' 8) -> #b'ff'
+  (buf-trunc #b'ff' 7) -> #b'7f'
+  (buf-trunc #b'ff' 2) -> #b'03'
+  (buf-trunc #b'ff' 1) -> #b'01'
+  (buf-trunc #b'ff' 0) -> #b''
+.brev
 
 .coNP Functions @ buf-compress and @ buf-decompress
 .synb