New functions: buf-and, buf-or, buf-xor.

* buf.c (buf_and, buf_or, buf_xor): New functions.
(buf_init): buf-and, buf-or and buf-xor intrinsics registered.

* buf.h (buf_and, buf_or, buf_xor): Declared.

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

* txr.1: Documented.

4 files changed, 215 insertions, 0 deletions

diff --git a/buf.c b/buf.c
index 7332d5ad..a916d92b 100644
--- a/buf.c
+++ b/buf.c
@@ -1529,6 +1529,102 @@ val buf_fash(val buf, val bits)
   abort();
 }
 
+val buf_and(val bufa, val bufb)
+{
+  val self = lit("buf-and");
+  struct buf *ab = buf_handle(bufa, self);
+  struct buf *bb = buf_handle(bufb, self);
+  ucnum la = c_unum(ab->len, self);
+  ucnum lb = c_unum(bb->len, self);
+
+  if (la == 0) {
+    return make_buf(bb->len, zero, bb->len);
+  } else if (lb == 0) {
+    return make_buf(ab->len, zero, ab->len);
+  } else if (la < lb) {
+    return buf_and(bufb, bufa);
+  } else if (la == convert(ucnum, -1)) {
+    err_oflow(self);
+    abort();
+  } else {
+    val obuf = make_ubuf(la);
+    ucnum delta = la - lb;
+    ucnum i;
+    struct buf *ob = buf_handle(obuf, self);
+
+    memset(ob->data, 0, delta);
+
+    for (i = 0; i < lb; i++)
+      ob->data[i + delta] = ab->data[i + delta] & bb->data[i];
+
+    return obuf;
+  }
+}
+
+val buf_or(val bufa, val bufb)
+{
+  val self = lit("buf-or");
+  struct buf *ab = buf_handle(bufa, self);
+  struct buf *bb = buf_handle(bufb, self);
+  ucnum la = c_unum(ab->len, self);
+  ucnum lb = c_unum(bb->len, self);
+
+  if (la == 0) {
+    return bufb;
+  } else if (lb == 0) {
+    return bufa;
+  } else if (la < lb) {
+    return buf_or(bufb, bufa);
+  } else if (la == convert(ucnum, -1)) {
+    err_oflow(self);
+    abort();
+  } else {
+    val obuf = make_ubuf(la);
+    ucnum delta = la - lb;
+    ucnum i;
+    struct buf *ob = buf_handle(obuf, self);
+
+    memcpy(ob->data, ab->data, delta);
+
+    for (i = 0; i < lb; i++)
+      ob->data[i + delta] = ab->data[i + delta] | bb->data[i];
+
+    return obuf;
+  }
+}
+
+val buf_xor(val bufa, val bufb)
+{
+  val self = lit("buf-xor");
+  struct buf *ab = buf_handle(bufa, self);
+  struct buf *bb = buf_handle(bufb, self);
+  ucnum la = c_unum(ab->len, self);
+  ucnum lb = c_unum(bb->len, self);
+
+  if (la == 0) {
+    return bufb;
+  } else if (lb == 0) {
+    return bufa;
+  } else if (la < lb) {
+    return buf_xor(bufb, bufa);
+  } else if (la == convert(ucnum, -1)) {
+    err_oflow(self);
+    abort();
+  } else {
+    val obuf = make_ubuf(la);
+    ucnum delta = la - lb;
+    ucnum i;
+    struct buf *ob = buf_handle(obuf, self);
+
+    memcpy(ob->data, ab->data, delta);
+
+    for (i = 0; i < lb; i++)
+      ob->data[i + delta] = ab->data[i + delta] ^ bb->data[i];
+
+    return obuf;
+  }
+}
+
 void buf_init(void)
 {
   reg_fun(intern(lit("make-buf"), user_package), func_n3o(make_buf, 1));
@@ -1624,6 +1720,9 @@ void buf_init(void)
 
   reg_fun(intern(lit("buf-ash"), user_package), func_n2(buf_ash));
   reg_fun(intern(lit("buf-fash"), user_package), func_n2(buf_fash));
+  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));
 
   fill_stream_ops(&buf_strm_ops);
 }
diff --git a/buf.h b/buf.h
index 366706f2..1d5ac6b2 100644
--- a/buf.h
+++ b/buf.h
@@ -126,5 +126,8 @@ void buf_swap32(val buf);
 
 val buf_ash(val buf, val bits);
 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);
 
 void buf_init(void);
diff --git a/tests/012/buf.tl b/tests/012/buf.tl
index 4311e760..f6c35ac7 100644
--- a/tests/012/buf.tl
+++ b/tests/012/buf.tl
@@ -204,3 +204,72 @@
 (mtest
   (buf-fash #b'deadcafef00d' 4) #b'eadcafef00d0'
   (buf-fash #b'deadcafef00d' -4) #b'0deadcafef00')
+
+(mtest
+  (buf-and #b'' #b'') #b''
+  (buf-and #b'' #b'00') #b'00'
+  (buf-and #b'' #b'11') #b'00'
+  (buf-and #b'00' #b'00') #b'00'
+  (buf-and #b'ff' #b'00') #b'00'
+  (buf-and #b'00' #b'ff') #b'00'
+  (buf-and #b'aa' #b'ff') #b'aa'
+  (buf-and #b'ff' #b'aa') #b'aa'
+  (buf-and #b'ff55' #b'aa') #b'0000'
+  (buf-and #b'ff00' #b'00') #b'0000'
+  (buf-and #b'ffff' #b'00') #b'0000'
+  (buf-and #b'ff00' #b'ff') #b'0000'
+  (buf-and #b'ffaa' #b'ff') #b'00aa'
+  (buf-and #b'ffff' #b'aa') #b'00aa'
+  (buf-and #b'ff55' #b'aa') #b'0000'
+  (buf-and #b'00' #b'ff00') #b'0000'
+  (buf-and #b'ff' #b'ff00') #b'0000'
+  (buf-and #b'00' #b'ffff') #b'0000'
+  (buf-and #b'aa' #b'ffff') #b'00aa'
+  (buf-and #b'ff' #b'ffaa') #b'00aa'
+  (buf-and #b'ff00ff0f' #b'1baddeadbeef') #b'0000de00be0f')
+
+(mtest
+  (buf-or #b'' #b'') #b''
+  (buf-or #b'' #b'00') #b'00'
+  (buf-or #b'' #b'11') #b'11'
+  (buf-or #b'00' #b'00') #b'00'
+  (buf-or #b'ff' #b'00') #b'ff'
+  (buf-or #b'00' #b'ff') #b'ff'
+  (buf-or #b'aa' #b'ff') #b'ff'
+  (buf-or #b'ff' #b'aa') #b'ff'
+  (buf-or #b'ff55' #b'aa') #b'ffff'
+  (buf-or #b'ff00' #b'00') #b'ff00'
+  (buf-or #b'ffff' #b'00') #b'ffff'
+  (buf-or #b'ff00' #b'ff') #b'ffff'
+  (buf-or #b'ffaa' #b'ff') #b'ffff'
+  (buf-or #b'ffff' #b'aa') #b'ffff'
+  (buf-or #b'ff55' #b'aa') #b'ffff'
+  (buf-or #b'00' #b'ff00') #b'ff00'
+  (buf-or #b'ff' #b'ff00') #b'ffff'
+  (buf-or #b'00' #b'ffff') #b'ffff'
+  (buf-or #b'aa' #b'ffff') #b'ffff'
+  (buf-or #b'ff' #b'ffaa') #b'ffff'
+  (buf-or #b'ff00ff0f' #b'1baddeadbeef') #b'1badffadffef')
+
+(mtest
+  (buf-xor #b'' #b'') #b''
+  (buf-xor #b'' #b'00') #b'00'
+  (buf-xor #b'' #b'11') #b'11'
+  (buf-xor #b'00' #b'00') #b'00'
+  (buf-xor #b'ff' #b'00') #b'ff'
+  (buf-xor #b'00' #b'ff') #b'ff'
+  (buf-xor #b'aa' #b'ff') #b'55'
+  (buf-xor #b'ff' #b'aa') #b'55'
+  (buf-xor #b'ff55' #b'aa') #b'ffff'
+  (buf-xor #b'ff00' #b'00') #b'ff00'
+  (buf-xor #b'ffff' #b'00') #b'ffff'
+  (buf-xor #b'ff00' #b'ff') #b'ffff'
+  (buf-xor #b'ffaa' #b'ff') #b'ff55'
+  (buf-xor #b'ffff' #b'aa') #b'ff55'
+  (buf-xor #b'ff55' #b'aa') #b'ffff'
+  (buf-xor #b'00' #b'ff00') #b'ff00'
+  (buf-xor #b'ff' #b'ff00') #b'ffff'
+  (buf-xor #b'00' #b'ffff') #b'ffff'
+  (buf-xor #b'aa' #b'ffff') #b'ff55'
+  (buf-xor #b'ff' #b'ffaa') #b'ff55'
+  (buf-xor #b'ff00ff0f' #b'1baddeadbeef') #b'1bad21ad41e0')
diff --git a/txr.1 b/txr.1
index 62514296..d4989961 100644
--- a/txr.1
+++ b/txr.1
@@ -30273,6 +30273,50 @@ length is equal to that of
 Shifting an empty buffer by any number of bits results in
 an empty buffer.
 
+.coNP Functions @, buf-and @ buf-or and @ buf-xor
+.synb
+.mets (buf-and < buf1 << buf2 )
+.mets (buf-or < buf1 << buf2 )
+.mets (buf-xor < buf1 << buf2 )
+.syne
+.desc
+The functions
+.codn buf-and ,
+.code buf-or
+or
+.code buf-xor
+perform common bitwise Boolean operations on a pair of buffers,
+returning the result as a buffer.
+
+If the input operands
+.meta buf1
+and
+.meta buf2
+are of unequal lengths, the returned buffer exhibits the longer
+of the two lengths.
+
+The operands are considered to be aligned together so that their rightmost
+bytes correspond. For the purposes of each of these tree operations, the
+shorter operand is considered to be padded on the left with null bytes,
+which correspond with the leftmost bytes of the longer operand.
+
+If the returned buffer is the same as either
+.meta buf1
+or
+.meta buf2
+then that input buffer itself may be returned.
+
+The
+code buf-and
+function calculates the bitwise Boolean "and" operation between
+corresponding bytes of the two operands;
+.code buf-or
+calculates the bitwise Boolean "or" operation;
+and
+.code buf-xor
+calculates the bitwise Boolean exclusive "or".
+
+
 .coNP Functions @ buf-compress and @ buf-decompress
 .synb
 .mets (buf-compress < buf <> [ level ])