ffi: new integer-carray conversion functions.

* ffi.c (carray_unum, carray_num, unum_carray, num_carray):
New functions.
(ffi_init): New intrinsics registered: carray-unum,
carray-num, unum-carray, num-carray.

* ffi.h (carray_unum, carray_num, unum_carray, num_carray):
Declared.

* txr.1: Documented.

3 files changed, 211 insertions, 0 deletions

diff --git a/ffi.c b/ffi.c
index 8776aad4..fc73a65d 100644
--- a/ffi.c
+++ b/ffi.c
@@ -4793,6 +4793,112 @@ val carray_pun(val carray, val type)
   return make_carray(type, scry->data, size / tft->size, carray);
 }
 
+val carray_unum(val num, val eltype_in)
+{
+  val self = lit("carray-unum");
+  val eltype = default_arg(eltype_in, ffi_type_compile(uchar_s));
+  struct txr_ffi_type *tft = ffi_type_struct(eltype);
+
+  if (tft->size == 0)
+    uw_throwf(error_s,
+              lit("~a: incomplete type ~s cannot be carray element"),
+              self, tft->syntax, nao);
+
+  switch (type(num)) {
+  case NUM: case CHR:
+    num = bignum(c_num(num));
+    /* fallthrough */
+  case BGNUM:
+    if (minusp(num))
+      uw_throwf(error_s,
+                lit("~a: negative number ~s passed; non-negative required"),
+                self, num, nao);
+    {
+      mp_int *m = mp(num);
+      ucnum size = mp_unsigned_bin_size(m);
+      ucnum nelem = (size + tft->size - 1) / tft->size;
+      mem_t *data = chk_xalloc(nelem, tft->size, self);
+      ucnum delta = nelem * tft->size - size;
+      val ca = make_carray(eltype, data, nelem, nil);
+      memset(data, 0, delta);
+      mp_to_unsigned_bin(m, data + delta);
+      gc_hint(num);
+      return ca;
+    }
+  default:
+    uw_throwf(type_error_s, lit("~a: ~s isn't an integer or character"),
+              self, num, nao);
+  }
+}
+
+val carray_num(val num, val eltype_in)
+{
+  val self = lit("carray-unum");
+  val eltype = default_arg(eltype_in, ffi_type_compile(uchar_s));
+  struct txr_ffi_type *tft = ffi_type_struct(eltype);
+
+  if (tft->size == 0)
+    uw_throwf(error_s,
+              lit("~a: incomplete type ~s cannot be carray element"),
+              self, tft->syntax, nao);
+
+  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);
+      ucnum size = mp_unsigned_bin_size(m);
+      ucnum nelem = (c_unum(bytes) + tft->size - 1) / tft->size;
+      mem_t *data = chk_xalloc(nelem, tft->size, self);
+      ucnum delta = nelem * tft->size - size;
+      val ca = make_carray(eltype, data, nelem, nil);
+      mp_to_unsigned_bin(m, data + delta);
+      memset(data, if3(bit(ube, wi), 0xff, 0), delta);
+      gc_hint(num);
+      gc_hint(ube);
+      return ca;
+    }
+  default:
+    uw_throwf(type_error_s, lit("~a: ~s isn't an integer or character"),
+              self, num, nao);
+  }
+}
+
+val unum_carray(val carray)
+{
+  val self = lit("unum-carray");
+  struct carray *scry = carray_struct_checked(carray);
+  struct txr_ffi_type *etft = scry->eltft;
+  ucnum size = (ucnum) etft->size * (ucnum) scry->nelem;
+  val ubn = make_bignum();
+  if ((ucnum) (int) size != size)
+    uw_throwf(error_s, lit("~a: bignum size overflow"), self, nao);
+  mp_read_unsigned_bin(mp(ubn), scry->data, size);
+  return normalize(ubn);
+}
+
+val num_carray(val carray)
+{
+  val self = lit("num-carray");
+  struct carray *scry = carray_struct_checked(carray);
+  struct txr_ffi_type *etft = scry->eltft;
+  ucnum size = (ucnum) etft->size * (ucnum) scry->nelem;
+  ucnum bits = size * 8;
+  val ubn = make_bignum();
+  if ((ucnum) (int) size != size || bits / 8 != size)
+    uw_throwf(error_s, lit("~a: bignum size overflow"), self, nao);
+  mp_read_unsigned_bin(mp(ubn), scry->data, size);
+  return sign_extend(normalize(ubn), unum(bits));
+}
+
 void ffi_init(void)
 {
   prot1(&ffi_typedef_hash);
@@ -4901,6 +5007,10 @@ void ffi_init(void)
   reg_fun(intern(lit("carray-put"), user_package), func_n2(carray_put));
   reg_fun(intern(lit("carray-putz"), user_package), func_n2(carray_putz));
   reg_fun(intern(lit("carray-pun"), user_package), func_n2(carray_pun));
+  reg_fun(intern(lit("carray-unum"), user_package), func_n2o(carray_unum, 1));
+  reg_fun(intern(lit("carray-num"), user_package), func_n2o(carray_num, 1));
+  reg_fun(intern(lit("unum-carray"), user_package), func_n1(unum_carray));
+  reg_fun(intern(lit("num-carray"), user_package), func_n1(num_carray));
   ffi_typedef_hash = make_hash(nil, nil, nil);
   ffi_init_types();
   ffi_init_extra_types();
diff --git a/ffi.h b/ffi.h
index 3995bb03..82e9ef4b 100644
--- a/ffi.h
+++ b/ffi.h
@@ -112,4 +112,8 @@ val carray_getz(val carray);
 val carray_put(val array, val seq);
 val carray_putz(val array, val seq);
 val carray_pun(val carray, val type);
+val carray_unum(val num, val type);
+val carray_num(val num, val type);
+val unum_carray(val carray);
+val num_carray(val carray);
 void ffi_init(void);
diff --git a/txr.1 b/txr.1
index 451b219c..3e3e1e00 100644
--- a/txr.1
+++ b/txr.1
@@ -57078,6 +57078,103 @@ is invoked on the aliasing array.
 The meaning of the aliasing depends entirely on the bitwise representations of
 the types involved.
 
+.coNP Functions @ carray-unum and @ carray-num
+.synb
+.mets (carray-unum < number <> [ type ])
+.mets (carray-num < number <> [ type ])
+.syne
+.desc
+The
+.code carray-unum
+and
+.code carray-num
+functions convert
+.metn number ,
+an integer, to a binary image, which is then used as
+the underlying storage for a
+.codn carray .
+
+The
+.meta type
+argument, a compiled FFI type, determines the element type for the returned
+.codn carray .
+If it is omitted, it defaults to the
+.code uint
+type, so that the array is effectively of bytes.
+
+Regardless of
+.metn type ,
+these functions first determine the number of bytes required to represent
+.meta number
+in a big endian format. Then the number of elements is determined for the
+array, so that it provides at least as that many bytes of storage. The
+representation of
+.meta number
+is then placed into this storage, such that its least significant byte
+coincides with the last byte of that storage. If the number is smaller
+than the storage provided by the array, it extended with padding bytes on the
+left, near the beginning of the array.
+
+In the case of
+.codn carray-unum ,
+.meta number
+must be a non-negative integer. An unsigned representation is produced
+which carries no sign bit. The representation is as many bytes wide as
+are required to cover the number up to its most significant bit whose
+value is 1. If any padding bytes are required due to the array being larger,
+they are always zero.
+
+The
+.code carray-num
+function encodes negative integers also, using a variable-length two's
+complement representation. The number of bits required to hold the number
+is calculated as the smallest width which can represent the value in two's
+complement, including a sign bit.  Any unused bits in the most significant
+byte are filled with copies of the sign bit: in other words, sign extension
+takes place up to the byte size.  The sign extension continues through the
+padding bytes if the array is larger than the number of bytes required to represent
+.metn number ;
+the padding bytes are filled with the value
+.code #b11111111
+(255) if the number is negative, or else 0 if it is non-negative.
+
+.coNP Functions @ unum-carray and @ num-carray
+.synb
+.mets (unum-carray << carray )
+.mets (num-carray < number <> [ type ])
+.syne
+.desc
+The
+.code unum-carray
+and
+.code num-carray
+functions treat the storage bytes
+.meta carray
+object as the representation of an integer.
+
+The
+.code unum-carray
+function simply treats all of the bytes as a big-endian unsigned integer in
+a pure binary representation, and returns that integer, which is necessarily
+always non-negative.
+
+The
+.code num-carray
+function treats the bytes as a two's complement representation. The returned
+number is negative if the first storage byte of
+.meta carray
+has a 1 in the most significant bit position: in other words, is in the
+range
+.code #x80
+to
+.codn #xFF .
+In this case, the two's complement of the entire representation is calculated:
+all of the bits are inverted, the resulting positive integer is extracted.
+Then 1 is added to that integer, and it is negated. Thus, for example, if all
+of the bytes are
+.codn #xFF ,
+the value -1 is returned.
+
 .SH* INTERACTIVE LISTENER
 
 .SS* Overview