math: hook buf support into bit ops.

* arith.c (zerop, logand, logior, logxor, logtest,
lognot, logtrunc, ash, bit, bitset, logcount,
width): Add support for buffer arguments via the
new bit manipulation functions provided by the
buffer module.

* txr.1: Documented.

2 files changed, 127 insertions, 12 deletions

diff --git a/arith.c b/arith.c
index a0d2ee10..5d990268 100644
--- a/arith.c
+++ b/arith.c
@@ -49,6 +49,7 @@
 #include "eval.h"
 #include "itypes.h"
 #include "struct.h"
+#include "buf.h"
 #include "txr.h"
 #include "psquare.h"
 #include "autoload.h"
@@ -1806,6 +1807,8 @@ val zerop(val num)
     return tnil(num == chr(0));
   case RNG:
     return and2(zerop(from(num)), zerop(to(num)));
+  case BUF:
+    return buf_zero_p(num);
   case COBJ:
     return do_unary_method(self, self, num);
   default:
@@ -1830,6 +1833,8 @@ val nzerop(val num)
     return tnil(num != chr(0));
   case RNG:
     return tnil(nzerop(from(num)) || nzerop(to(num)));
+  case BUF:
+    return tnil(!buf_zero_p(num));
   case COBJ:
     return tnil(!do_unary_method(self, zerop_s, num));
   default:
@@ -3606,6 +3611,8 @@ val logand(val a, val b)
   case TYPE_PAIR(NUM, COBJ):
   case TYPE_PAIR(BGNUM, COBJ):
     return do_binary_method(self, self, b, a);
+  case TYPE_PAIR(BUF, BUF):
+    return buf_and(a, b);
   default:
     uw_throwf(error_s, lit("~a: non-integral operands ~s ~s"), self, a, b, nao);
   }
@@ -3662,6 +3669,8 @@ val logior(val a, val b)
   case TYPE_PAIR(NUM, COBJ):
   case TYPE_PAIR(BGNUM, COBJ):
     return do_binary_method(self, self, b, a);
+  case TYPE_PAIR(BUF, BUF):
+    return buf_or(b, a);
   default:
     uw_throwf(error_s, lit("~a: non-integral operands ~s ~s"), self, a, b, nao);
   }
@@ -3718,6 +3727,8 @@ val logxor(val a, val b)
   case TYPE_PAIR(NUM, COBJ):
   case TYPE_PAIR(BGNUM, COBJ):
     return do_binary_method(self, self, b, a);
+  case TYPE_PAIR(BUF, BUF):
+    return buf_xor(b, a);
   default:
     uw_throwf(error_s, lit("~a: non-integral operands ~s ~s"), self, a, b, nao);
   }
@@ -3785,8 +3796,13 @@ bad:
 
 val logtest(val a, val b)
 {
-  /* TODO: optimize */
-  return logand(a, b) == zero ? nil : t;
+  switch (TYPE_PAIR(type(a), type(b))) {
+  case TYPE_PAIR(BUF, BUF):
+    return buf_test(a, b);
+  default:
+    /* TODO: optimize */
+    return logand(a, b) == zero ? nil : t;
+  }
 }
 
 static val comp_trunc(val a, val bits)
@@ -3854,6 +3870,8 @@ val lognot(val a, val bits)
     if (mp_comp(mp(a), mp(b)) != MP_OKAY)
       goto bad;
     return normalize(b);
+  case BUF:
+    return buf_not(a);
   case COBJ:
     return do_unary_method(self, self, a);
   default:
@@ -3896,6 +3914,8 @@ val logtrunc(val a, val bits)
     if ((mpe = mp_trunc(mp(a), mp(b), bn)) != MP_OKAY)
       do_mp_error(self, mpe);
     return normalize(b);
+  case BUF:
+    return buf_trunc(a, bits);
   case COBJ:
     return do_binary_method(self, self, a, bits);
   default:
@@ -3971,6 +3991,7 @@ val ash(val a, val bits)
     switch (ta) {
     case NUM:
     case BGNUM:
+    case BUF:
       return a;
     default:
       goto bad3;
@@ -4008,6 +4029,8 @@ val ash(val a, val bits)
           break;
         return normalize(b);
       }
+    case BUF:
+      return buf_fash(a, bits);
     default:
       goto bad3;
     }
@@ -4028,6 +4051,8 @@ val ash(val a, val bits)
           break;
         return normalize(b);
       }
+    case BUF:
+      return buf_fash(a, bits);
     default:
       goto bad3;
     }
@@ -4049,7 +4074,6 @@ val bit(val a, val bit)
 {
   val self = bit_s;
   type_t ta = type(a);
-  cnum bn;
   mp_err mpe = MP_OKAY;
 
   if (ta == COBJ)
@@ -4058,15 +4082,14 @@ val bit(val a, val bit)
   if (!fixnump(bit))
     goto bad;
 
-  bn = c_n(bit);
-
-  if (bn < 0)
-    return nil;
-
   switch (ta) {
   case NUM:
     {
-      cnum an = c_n(a);
+      cnum an;
+      cnum bn = c_n(bit);
+      if (bn < 0)
+        return nil;
+      an = c_n(a);
       if (bn < (SIZEOF_PTR * CHAR_BIT))
         return (an & (convert(cnum, 1) << bn)) ? t : nil;
       return tnil(an < 0);
@@ -4074,12 +4097,14 @@ val bit(val a, val bit)
   case CHR:
     {
       cnum an = c_ch(a);
+      cnum bn = c_n(bit);
       if (bn < (SIZEOF_PTR * CHAR_BIT))
         return (an & (convert(cnum, 1) << bn)) ? t : nil;
       return tnil(an < 0);
     }
   case BGNUM:
     {
+      cnum bn = c_n(bit);
       mpe = mp_bit(mp(a), bn);
 
       switch (mpe) {
@@ -4091,6 +4116,8 @@ val bit(val a, val bit)
         goto bad3;
       }
     }
+  case BUF:
+    return buf_bit(a, bit);
   default:
     goto bad2;
   }
@@ -4186,6 +4213,8 @@ val bitset(val n)
 
       return out;
     }
+  case BUF:
+    return buf_bitset(n);
   case COBJ:
     return do_unary_method(self, self, n);
   default:
@@ -4231,6 +4260,8 @@ val logcount(val n)
         internal_error("problem in bignum arithmetic");
       return unum(co);
     }
+  case BUF:
+    return buf_count_ones(n);
   case COBJ:
     return do_unary_method(self, self, n);
   default:
@@ -4493,6 +4524,8 @@ val width(val obj)
       }
       return unum(count);
     }
+  case BUF:
+    return buf_binary_width(obj);
   case COBJ:
     return do_unary_method(self, self, obj);
   default:
diff --git a/txr.1 b/txr.1
index daa390c2..e5bb67aa 100644
--- a/txr.1
+++ b/txr.1
@@ -28943,7 +28943,7 @@ The
 function returns a value of type
 .codn cptr .
 
-.NP Arithmetic Conventions of Buffers
+.NP* Arithmetic Conventions of Buffers
 
 Buffers support a limited number of functions for dealing
 with buffers as if they were integers. Buffers may be
@@ -51866,6 +51866,11 @@ method of the
 .code a
 object decides how to handle zero.
 
+Some functions in the Math Library support arguments of type
+.code buf
+(buffers). For each function in this category, buffer support is
+noted.
+
 .coNP Functions @, + @ - and @ *
 .synb
 .mets (+ << number *)
@@ -52771,7 +52776,7 @@ The
 function tests
 .meta number
 for equivalence to zero. The argument must be
-a number or character. It returns
+a number, character, range or buffer. It returns
 .code t
 for the integer value
 .code 0
@@ -52797,6 +52802,15 @@ returns
 if both of the range endpoints individually satisfy
 .codn zerop .
 
+If
+.meta number
+is an object of type
+.code buf
+then
+.code zerop
+behaves like
+.codn buf-zero-p  .
+
 The
 .code nzerop
 function is the logical inverse of
@@ -54067,6 +54081,24 @@ is equivalent to the expression
 .codn "(logand (logand a b) c)" ,
 which features two two-argument cases.
 
+The operands may be buffers. If any operand is a buffer, the other
+operands must also be buffers. Operations on buffers are performed as
+if by the functions
+.codn buf-and ,
+.code buf-or
+and
+.codn buf-xor .
+
+When
+.code logand
+or
+.code logior
+are given three or more operands which are buffers,
+the operands are left-associatively reduced through operations identical to
+.code buf-and
+and
+.codn buf-or .
+
 .coNP Function @ logtest
 .synb
 .mets (logtest < int1 << int2 )
@@ -54085,6 +54117,10 @@ common. The following equivalence holds:
   (logtest a b) <--> (not (zerop (logand a b)))
 .brev
 
+If one operand is a buffer, the other one must be.
+The operation is then performed as if via
+.codn buf-test .
+
 .coNP Functions @ lognot and @ logtrunc
 .synb
 .mets (lognot < value <> [ bits ])
@@ -54140,6 +54176,14 @@ The return value of
 .code logtrunc
 is always a nonnegative integer.
 
+If
+.meta value
+is a buffer, the operation is performed as if via
+.code buf-not
+and
+.codn buf-trunc ,
+respectively.
+
 .coNP Function @ sign-extend
 .synb
 .mets (sign-extend < value << bits )
@@ -54161,6 +54205,11 @@ If the bits
 .meta bits
 argument is zero or negative the value returned is zero.
 
+This operation does not support a
+.meta value
+argument of type
+.codn buf .
+
 .TP* Examples:
 
 .verb
@@ -54215,6 +54264,17 @@ the bitwise representations of these values are
 and
 .codn ...11110 .
 
+The
+.meta value
+argument may be a buffer. In that case, the operation is performed
+as if by the
+.code buf-fash
+function.
+
+Note: the
+.code buf-ash
+function does not have a counterpart in the Math Library.
+
 .coNP Function @ bit
 .synb
 .mets (bit < value << bit )
@@ -54270,6 +54330,11 @@ since the infinite bit two's complement representation of
 is
 .codn ...11110 .
 
+If
+.meta value
+is a buffer, the operation is performed as if via
+.codn buf-bit .
+
 .coNP Function @ mask
 .synb
 .mets (mask << integer *)
@@ -54322,6 +54387,12 @@ In other words, the following equivalences hold:
   (mask a b c ...) <--> (logior (mask a) (mask b) (mask c) ...)
 .brev
 
+Note: there is no counterpart of the
+.code mask
+function which produces an object of type
+.code buf
+instead of an integer.
+
 .coNP Function @ bitset
 .synb
 .mets (bitset << integer )
@@ -54344,7 +54415,10 @@ is returned.
 A negative integer is treated as an infinite-bit two's complement
 representation.
 
-The argument may be a character.
+The argument may be a character or a buffer. The later is treated
+as if via the
+.code buf-bitset
+function.
 
 If
 .meta integer
@@ -54406,6 +54480,10 @@ two's complement bitfield 01 denotes 1, and 10 denotes -2.
 
 The argument may be a character.
 
+The argument may also be a buffer, in which case the operation is
+performed as if by
+.codn buf-binary-width .
+
 .coNP Function @ logcount
 .synb
 .mets (logcount << integer )
@@ -54425,6 +54503,10 @@ is zero, the value returned is zero.
 
 The argument may be a character.
 
+The argument may also be a buffer, in which case the operation is
+performed as if by
+.codn buf-count-ones .
+
 .coNP Macros @ set-mask and @ clear-mask
 .synb
 .mets (set-mask < place << integer *)