diff options
| -rw-r--r-- | ffi.c | 236 | ||||
| -rw-r--r-- | ffi.h | 2 | ||||
| -rw-r--r-- | txr.1 | 129 |
3 files changed, 341 insertions, 26 deletions
@@ -89,6 +89,8 @@ val ptr_in_s, ptr_out_s, ptr_in_d_s, ptr_out_d_s, ptr_out_s_s, ptr_s; val closure_s; +val sbit_s, ubit_s; + val ffi_type_s, ffi_call_desc_s, ffi_closure_s; static val ffi_typedef_hash; @@ -108,6 +110,7 @@ struct txr_ffi_type { val syntax; val eltype; cnum size, align; + unsigned shift, mask; cnum nelem; struct smemb *memb; unsigned null_term : 1; @@ -613,6 +616,91 @@ static val ffi_wchar_get(struct txr_ffi_type *tft, mem_t *src, val self) return chr(c); } +static void ffi_sbit_put(struct txr_ffi_type *tft, val n, + mem_t *dst, val self) +{ + unsigned mask = tft->mask; + unsigned sbmask = mask ^ (mask >> 1); + int shift = tft->shift; + cnum cn = c_num(n); + int in = cn; + unsigned uput = (((unsigned) in) << shift) & mask; + + if (in != cn) + goto range; + + if (uput & sbmask) { + int icheck = -(int)(((uput ^ mask) >> shift) + 1); + if (icheck != cn) + goto range; + } else if (uput >> shift != cn) { + goto range; + } + + { + unsigned field = *coerce(unsigned *, dst); + field &= ~mask; + field |= uput; + *coerce(unsigned *, dst) = field; + } + + return; +range: + uw_throwf(error_s, lit("~a: value ~s is out of range of " + "signed ~s bit-field"), + self, n, num_fast(tft->nelem), nao); +} + +static val ffi_sbit_get(struct txr_ffi_type *tft, mem_t *src, val self) +{ + unsigned mask = tft->mask; + unsigned sbmask = mask ^ (mask >> 1); + int shift = tft->shift; + unsigned uget = *coerce(unsigned *, src) & mask; + + if (uget & sbmask) + return num(-(int)(((uget ^ mask) >> shift) + 1)); + return unum(uget >> shift); +} + +static void ffi_ubit_put(struct txr_ffi_type *tft, val n, + mem_t *dst, val self) +{ + unsigned mask = tft->mask; + int shift = tft->shift; + ucnum cn = c_unum(n); + unsigned un = cn; + unsigned uput = (un << shift) & mask; + + if (un != cn) + goto range; + + if (uput >> shift != cn) + goto range; + + { + unsigned field = *coerce(unsigned *, dst); + field &= ~mask; + field |= uput; + *coerce(unsigned *, dst) = field; + } + + return; + +range: + uw_throwf(error_s, lit("~a: value ~s is out of range of " + "unsigned ~s bit-field"), + self, n, num_fast(tft->nelem), nao); +} + +static val ffi_ubit_get(struct txr_ffi_type *tft, mem_t *src, val self) +{ + unsigned mask = tft->mask; + int shift = tft->shift; + unsigned uget = *coerce(unsigned *, src) & mask; + return unum(uget >> shift); +} + static void ffi_cptr_put(struct txr_ffi_type *tft, val n, mem_t *dst, val self) { @@ -1443,6 +1531,16 @@ static void ffi_carray_put(struct txr_ffi_type *tft, val carray, mem_t *dst, *coerce(mem_t **, dst) = p; } +static val bitfield_syntax_p(val syntax) +{ + if (!consp(syntax)) { + return nil; + } else { + val sym = car(syntax); + return tnil(sym == sbit_s || sym == ubit_s); + } +} + static val make_ffi_type_builtin(val syntax, val lisp_type, cnum size, cnum align, ffi_type *ft, void (*put)(struct txr_ffi_type *, @@ -1481,26 +1579,34 @@ static val make_ffi_type_pointer(val syntax, val lisp_type, val obj, mem_t *dst), val tgtype) { - struct txr_ffi_type *tft = coerce(struct txr_ffi_type *, - chk_calloc(1, sizeof *tft)); + val self = lit("ffi-type-compile"); + struct txr_ffi_type *tgtft = ffi_type_struct(tgtype); - val obj = cobj(coerce(mem_t *, tft), ffi_type_s, &ffi_type_ptr_ops); + if (tgtft->size == 0 && bitfield_syntax_p(tgtft->syntax)) { + uw_throwf(error_s, lit("~a: type combination ~s not allowed"), + self, syntax, nao); + } else { + struct txr_ffi_type *tft = coerce(struct txr_ffi_type *, + chk_calloc(1, sizeof *tft)); - tft->ft = &ffi_type_pointer; - tft->syntax = syntax; - tft->lt = lisp_type; - tft->size = sizeof (mem_t *); - tft->align = alignof (mem_t *); - tft->put = put; - tft->get = get; - tft->eltype = tgtype; - tft->in = in; - tft->out = out; - tft->release = release; - tft->alloc = ffi_fixed_alloc; - tft->free = free; + val obj = cobj(coerce(mem_t *, tft), ffi_type_s, &ffi_type_ptr_ops); - return obj; + tft->ft = &ffi_type_pointer; + tft->syntax = syntax; + tft->lt = lisp_type; + tft->size = sizeof (mem_t *); + tft->align = alignof (mem_t *); + tft->put = put; + tft->get = get; + tft->eltype = tgtype; + tft->in = in; + tft->out = out; + tft->release = release; + tft->alloc = ffi_fixed_alloc; + tft->free = free; + + return obj; + } } static val make_ffi_type_struct(val syntax, val lisp_type, @@ -1519,6 +1625,8 @@ static val make_ffi_type_struct(val syntax, val lisp_type, ucnum offs = 0; ucnum most_align = 0; int need_out_handler = 0; + int bit_offs = 0; + const int bits_int = 8 * sizeof(int); ft->type = FFI_TYPE_STRUCT; ft->size = 0; @@ -1539,26 +1647,77 @@ static val make_ffi_type_struct(val syntax, val lisp_type, val type = pop(&types); val slot = pop(&slots); struct txr_ffi_type *mtft = ffi_type_struct(type); - cnum align = mtft->align; cnum size = mtft->size; - ucnum almask = align - 1; elements[i] = mtft->ft; memb[i].mtype = type; memb[i].mname = slot; memb[i].mtft = mtft; - memb[i].offs = offs; - if (align > most_align) - most_align = align; + if (size == 0 && bitfield_syntax_p(mtft->syntax)) { + int bits = mtft->nelem; + int room = bits_int - bit_offs; - need_out_handler = need_out_handler || mtft->out != 0; + if (bits == 0) { + if (bit_offs > 0) { + offs += sizeof (int); + bit_offs = 0; + } + nmemb--, i--; + continue; + } + + if (bit_offs == 0) { + ucnum almask = alignof (int) - 1; + offs = (offs + almask) & ~almask; + } + + if (most_align < alignof (int)) + most_align = alignof (int); + + if (bits > room) { + offs += sizeof (int); + bit_offs = 0; + } - offs += size; - offs = (offs + almask) & ~almask; + memb[i].offs = offs; + +#if HAVE_LITTLE_ENDIAN + mtft->shift = bit_offs; +#else + mtft->shift = bits_int - bit_offs - bits; +#endif + if (bits == bits_int) + mtft->mask = UINT_MAX; + else + mtft->mask = ((1U << bits) - 1) << mtft->shift; + bit_offs += bits; + } else { + cnum align = mtft->align; + ucnum almask = align - 1; + + if (bit_offs > 0) { + offs += sizeof (int); + bit_offs = 0; + } + + offs = (offs + almask) & ~almask; + memb[i].offs = offs; + offs += size; + + if (align > most_align) + most_align = align; + } + + need_out_handler = need_out_handler || mtft->out != 0; } + if (bit_offs > 0) + offs += sizeof (int); + + tft->nelem = i; + elements[i] = 0; if (need_out_handler) @@ -1633,7 +1792,7 @@ static val ffi_struct_compile(val membs, val *ptypes, val self) if (cddr(mp)) uw_throwf(error_s, lit("~a: excess elements in type-member pair ~s"), self, mp, nao); - if (ctft->size == 0) + if (ctft->size == 0 && !bitfield_syntax_p(ctft->syntax)) uw_throwf(error_s, lit("~a: incomplete type ~s cannot be struct member"), self, type, nao); pttail = list_collect(pttail, comp_type); @@ -1797,7 +1956,25 @@ val ffi_type_compile(val syntax) return make_ffi_type_pointer(syntax, carray_s, ffi_carray_put, ffi_carray_get, 0, 0, 0, eltype); + } else if (sym == sbit_s || sym == ubit_s) { + val nbits = cadr(syntax); + cnum nb = c_num(nbits); + val type = make_ffi_type_builtin(syntax, integer_s, 0, 0, + &ffi_type_void, + if3(sym == sbit_s, + ffi_sbit_put, ffi_ubit_put), + if3(sym == sbit_s, + ffi_sbit_get, ffi_ubit_get)); + struct txr_ffi_type *tft = ffi_type_struct(type); + const int bits_int = 8 * sizeof(int); + if (nb < 0 || nb > bits_int) + uw_throwf(error_s, lit("~a: invalid bitfield size ~s; " + "must be 0 to ~s"), + self, nbits, num_fast(bits_int), nao); + tft->nelem = c_num(nbits); + return type; } + uw_throwf(error_s, lit("~a: unrecognized type operator: ~s"), self, sym, nao); } else { @@ -2422,6 +2599,11 @@ mem_t *ffi_closure_get_fptr(val closure) val ffi_typedef(val name, val type) { + val self = lit("ffi-typedef"); + struct txr_ffi_type *tft = ffi_type_struct_checked(type); + if (tft->size == 0 && bitfield_syntax_p(tft->syntax)) + uw_throwf(error_s, lit("~a: cannot create a typedef for bitfield type"), + self, nao); return sethash(ffi_typedef_hash, name, type); } @@ -2836,6 +3018,8 @@ void ffi_init(void) ptr_out_s_s = intern(lit("ptr-out-s"), user_package); ptr_s = intern(lit("ptr"), user_package); closure_s = intern(lit("closure"), user_package); + sbit_s = intern(lit("sbit"), user_package); + ubit_s = intern(lit("ubit"), user_package); ffi_type_s = intern(lit("ffi-type"), user_package); ffi_call_desc_s = intern(lit("ffi-call-desc"), user_package); ffi_closure_s = intern(lit("ffi-closure"), user_package); @@ -51,6 +51,8 @@ extern val ptr_in_s, ptr_out_s, ptr_in_d_s, ptr_out_d_s, ptr_out_s_s, ptr_s; extern val closure_s; +extern val sbit_s, ubit_s; + extern val ffi_type_s, ffi_call_desc_s, ffi_closure_s; val ffi_type_compile(val syntax); @@ -53770,6 +53770,11 @@ anonymous padding member simply generates a skip of the number of byte corresponding to the size of its type, plus any necessary additional padding for the alignment of the subsequent member. +Structure members may be bitfields, which are described using the +.code ubit +and +.code sbit +compound type operators. .meIP (array < dim << type ) The FFI .code array @@ -54114,6 +54119,130 @@ object. The get semantics retrieves a Lisp value without freeing. +.meIP ({ubit | sbit} << width ) +The +.code ubit +and +.code sbit +types denote C language style bitfields. These types can only appear +as members of structures. A bitfield type cannot be the argument or return +value of a foreign function or closure, and cannot be a foreign variable. +Arrays of bitfields and pointers, of any kind, to bitfields are a forbidden +type combination that is rejected by the type system. + +The +.code ubit +type denotes a bitfield of type +.codn uint , +corresponding to an +.code unsigned +bitfield in the C language. + +The +.code sbit +type denotes a bitfield of type +.codn int . +Unlike in the C language, it is not implementation-defined whether such +a bit-field represents signed values; it converts between Lisp integers +that may be positive or negative, and a foreign representation which is +two's complement. + +Bitfields of any other type are not supported. + +The +.meta width +parameter of the type indicates the number of bits. It may range from +zero to the number of bits in the +.code uint +type. + +In a structure, bitfields are allocated out in storage units which have the +same width and alignment requirements as a +.codn uint . +These storage units themselves can be regarded as anonymous members of the +structure. When a new unit needs to be allocated in a structure to hold +bitfields, it is allocated in the same manner as a named member of type +.code uint +would be at the same position. + +If a bitfield with non-zero width is not preceded by any non-zero-width +bitfield, then a new unit is allocated, and the bitfield is placed into the +first available position in that unit. On a big-endian machine, the first +available position starts at the most significant bit of the underlying +storage word. On a little-endian machine, the first available bit position +is the least significant bit of the storage word. + +If a non-zero-width bitfield is preceded by a non-zero-width bitfield, then +the new bitfield is packed into the same storage unit as that bitfield if +there is enough remaining room in that unit. Otherwise, it is placed into a +new unit. Bitfields are not split across unit boundaries. + +A zero-length bitfield is permitted. It may be given a name, but the field +will not perform any conversions to and from the corresponding slot in the +Lisp structure. Note that the FFI struct definition itself causes the +corresponding Lisp structure type to come into existence, then the Lisp +structure type will have slots for all the zero width named bitfields, +even though those slots don't participate in any conversions in conjunction +with the FFI type. + +A zero-length bitfield functions in a similar manner in the FFI type +system as in the C language. If it is placed between two bitfields, then it +forces them to be in separate storage units. That is to say, the bitfield +which follows is placed into a new storage unit, even if the previous +bitfield leaves enough room in it storage unit. + +A zero-length bitfield that does not appear between non-zero-length +bitfields has no effect. + +A +.code ubit +field stores values which follow a pure binary enumeration. For instance, +a bit field of width 4 stores values from 0 to 15. On conversion from +the Lisp structure to the foreign structure, the corresponding member +must be a integer value in this range, or an error exception is thrown. + +On conversion from the foreign representation to Lisp, the integer +corresponding to the bit pattern is recovered. Bitfields follow the +bit order of the underlying storage word. That is to say, the most +significant binary digit of the bitfield is the one which is closest +to the the most significant bit of the underlying storage unit. +If a four-bit field is placed into an empty storage unit and the value +8 its stored, then on a big-endian machine, this has the effect of +setting to 1 the most significant bit of the underlying storage word. +On a little-endian machine, it has the effect of setting bit 3 of +the word (where bit 0 is the least significant bit). + +The +.code sbit +field creates a correspondence between a range of Lisp integers, +and a foreign representation based on the two's complement system. +The most significant bit of the bit field functions as a sign bit. +Values whose most significant bit is clear are positive, and use +a pure binary representation just like their +.code ubit +counterparts. The representation of negative values is defined +by the "two's complement" operation, which maps each value to +its additive inverse. The operation consists of temporarily treating the +entire bitfield as unsigned, and inverting the logical value of all the +bits, and then adding 1 with "wrap-around" to zero if 1 is added to a field +consisting of all 1 bits. (Thus zero maps to zero, as expected). +An anomaly in the two's complement system is that the most negative +value has no positive counterpart. The two's complement operation +on the most negative value produces that same value itself. + +A +.code sbit +field of width 1 +can only store two values: -1 and 0, represented by the bit patterns +1 and 0. An attempt to convert any other integer value to a +.code sbit +field of width 1 results in an error. + +A +.code sbit +field of width 2 can represent the values -2, -1, 0 and 1, which are +stored as the bit patterns 10, 11, 00 and 01, respectively. + .meIP ({buf | buf-d} << size ) The parametrized .code buf |