diff options
| -rw-r--r-- | ffi.c | 110 | ||||
| -rw-r--r-- | ffi.h | 4 | ||||
| -rw-r--r-- | txr.1 | 97 |
3 files changed, 211 insertions, 0 deletions
@@ -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(); @@ -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); @@ -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 |