New functions for buf <--> integer conversion.

* buf.c (buf_int, buf_uint, int_buf, uint_buf): New static
functions.
(buf_init): buf-int, buf-uint, int-buf and uint-buf intrinsic
functions registered.

* txr.1: Documented.

2 files changed, 192 insertions, 0 deletions

diff --git a/buf.c b/buf.c
index be0c5ab6..1ed66322 100644
--- a/buf.c
+++ b/buf.c
@@ -1103,6 +1103,87 @@ static val str_buf(val buf, val null_term)
   return string_own(str);
 }
 
+static val buf_int(val num)
+{
+  val self = lit("buf-int");
+
+  switch (type(num)) {
+  case NUM: case CHR:
+    num = bignum(c_num(num));
+    /* fallthrough */
+  case BGNUM:
+    {
+      val wi = width(num);
+      val bits = succ(wi);
+      val bytes = ash(plus(bits, num_fast(7)), num_fast(-3));
+      val bitsround = ash(bytes, num_fast(3));
+      val un = logtrunc(num, bitsround);
+      val ube = if3(bignump(un), un, bignum(c_num(un)));
+      mp_int *m = mp(ube);
+      size_t numsize = mp_unsigned_bin_size(m);
+      size_t bufsize = c_unum(bytes);
+      mem_t *data = chk_malloc(bufsize);
+      data[0] = 0;
+      mp_to_unsigned_bin(m, data + (bufsize - numsize));
+      return make_owned_buf(unum(bufsize), data);
+    }
+  default:
+    uw_throwf(type_error_s, lit("~a: ~s isn't an integer or character"),
+              self, num, nao);
+  }
+}
+
+static val buf_uint(val num)
+{
+  val self = lit("buf-uint");
+
+  switch (type(num)) {
+  case NUM: case CHR:
+    num = bignum(c_num(num));
+    /* fallthrough */
+  case BGNUM:
+    {
+      mp_int *m = mp(num);
+      if (!mp_isneg(m)) {
+        size_t size = mp_unsigned_bin_size(m);
+        mem_t *data = chk_malloc(size);
+        mp_to_unsigned_bin(m, data);
+        return make_owned_buf(unum(size), data);
+      }
+    }
+    uw_throwf(type_error_s, lit("~a: ~s isn't a non-negative integer"),
+              self, num, nao);
+  default:
+    uw_throwf(type_error_s, lit("~a: ~s isn't an integer or character"),
+              self, num, nao);
+  }
+}
+
+static val int_buf(val buf)
+{
+  val self = lit("int-buf");
+  struct buf *b = buf_handle(buf, self);
+  ucnum size = c_unum(b->size);
+  ucnum bits = size * 8;
+  val ubn = make_bignum();
+  mp_err mpe = mp_read_unsigned_bin(mp(ubn), b->data, size);
+  if (mpe != MP_OKAY)
+    do_mp_error(self, mpe);
+  return sign_extend(normalize(ubn), unum(bits));
+}
+
+static val uint_buf(val buf)
+{
+  val self = lit("int-buf");
+  struct buf *b = buf_handle(buf, self);
+  ucnum size = c_unum(b->size);
+  val ubn = make_bignum();
+  mp_err mpe = mp_read_unsigned_bin(mp(ubn), b->data, size);
+  if (mpe != MP_OKAY)
+    do_mp_error(self, mpe);
+  return normalize(ubn);
+}
+
 unsigned char *utf8_dup_to_buf(const wchar_t *, size_t *pnbytes,
                                int null_term);
 void buf_init(void)
@@ -1187,6 +1268,10 @@ void buf_init(void)
 
   reg_fun(intern(lit("buf-str"), user_package), func_n2o(buf_str, 1));
   reg_fun(intern(lit("str-buf"), user_package), func_n2o(str_buf, 1));
+  reg_fun(intern(lit("buf-int"), user_package), func_n1(buf_int));
+  reg_fun(intern(lit("buf-uint"), user_package), func_n1(buf_uint));
+  reg_fun(intern(lit("int-buf"), user_package), func_n1(int_buf));
+  reg_fun(intern(lit("uint-buf"), user_package), func_n1(uint_buf));
 
   fill_stream_ops(&buf_strm_ops);
 }
diff --git a/txr.1 b/txr.1
index d175a774..b47607e3 100644
--- a/txr.1
+++ b/txr.1
@@ -25004,6 +25004,113 @@ This byte is added even if the previous byte is already a null byte
 from the conversion of a pseudo-null character occurring in
 .metn str .
 
+.coNP Functions @ buf-int and @ buf-uint
+.synb
+.mets (buf-int < integer )
+.mets (buf-uint < integer )
+.syne
+.desc
+The
+.code buf-int
+and
+.code buf-uint
+functions convert a signed and unsigned integer, respectively, or else a
+character, into a binary representation, which is returned as a buffer object.
+
+Under both functions, the representation uses big endian byte order: most
+significant byte first.
+
+The
+.code buf-uint
+function requires a non-negative
+.meta integer
+argument, which may be a character. The representation stored in the
+buffer is a pure binary representation of the value using the smallest
+number of bytes required for the given
+.meta integer
+value.
+
+The
+.code buf-int
+function requires an integer or character argument. The representation
+stored in the buffer is a two's complement representation of
+.meta integer
+using the smallest number of bytes which can represent that value.
+If
+.meta integer
+is non-negative, then the first byte of the buffer lies in the range
+0 to 127.
+If
+.meta integer
+is negative, then the first byte of the buffer lies in the range 128 to 255.
+The integer 255 therefore doesn't convert to the buffer
+.code #b'ff'
+but rather
+.codn #b'00ff' .
+The buffer
+.code #b'ff'
+represents -1.
+
+If the
+.meta integer
+argument is a character object, it is taken to be its Unicode code
+point value, as returned by the
+.code int-chr
+function.
+
+.coNP Functions @ int-buf and @ uint-buf
+.synb
+.mets (int-buf < buf )
+.mets (uint-buf < buf )
+.syne
+.desc
+The
+.code int-buf
+and
+.code uint-buf
+functions recover an integer value from its binary form which appears
+inside
+.metn buf ,
+which must be a buffer object. These functions expect
+.meta buf
+to contain the representation produced by, respectively, the functions
+.code buf-int
+and
+.codn buf-uint .
+
+If
+.meta buf
+holds the representation of an integer value
+.metn n ,
+as produced by
+.mono
+.meti (buf-int << n )
+.onom
+then
+.mono
+.meti (int-buf << buf )
+.onom
+returns
+.metn n .
+
+The same relationship holds between
+.code buf-uint
+and
+.codn uint-buf .
+
+Thus, these equalities hold:
+
+.verb
+.mets (= (int-buf (buf-int << n )) << n )
+.mets (= (uint-buf (buf-uint << n )) << n )
+.brev
+
+provided that
+.meta n
+is of integer type and, in the case of
+.codn buf-uint ,
+nonnegative.
+
 .SS* Structures
 
 \*(TX supports a structure data type. Structures are objects which