"Fossies" - the Fresh Open Source Software Archive

Member "txr-225/ffi.c" (11 Sep 2019, 180804 Bytes) of package /linux/misc/txr-225.tar.bz2:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) C and C++ source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "ffi.c" see the Fossies "Dox" file reference documentation and the latest Fossies "Diffs" side-by-side code changes report: 224_vs_225.

    1 /* Copyright 2017-2019
    2  * Kaz Kylheku <kaz@kylheku.com>
    3  * Vancouver, Canada
    4  * All rights reserved.
    5  *
    6  * Redistribution and use in source and binary forms, with or without
    7  * modification, are permitted provided that the following conditions are met:
    8  *
    9  * 1. Redistributions of source code must retain the above copyright notice, this
   10  *    list of conditions and the following disclaimer.
   11  *
   12  * 2. Redistributions in binary form must reproduce the above copyright notice,
   13  *    this list of conditions and the following disclaimer in the documentation
   14  *    and/or other materials provided with the distribution.
   15  *
   16  * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
   17  * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
   18  * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
   19  * DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
   20  * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
   21  * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
   22  * SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   23  * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
   24  * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
   25  * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
   26  */
   27 
   28 #include <limits.h>
   29 #include <float.h>
   30 #include <math.h>
   31 #include <stddef.h>
   32 #include <stdio.h>
   33 #include <stdlib.h>
   34 #include <stdarg.h>
   35 #include <string.h>
   36 #include <signal.h>
   37 #include <wchar.h>
   38 #include <time.h>
   39 #include "config.h"
   40 #if HAVE_LIBFFI
   41 #include <ffi.h>
   42 #endif
   43 #if HAVE_SYS_TYPES_H
   44 #include <sys/types.h>
   45 #endif
   46 #include "alloca.h"
   47 #include "lib.h"
   48 #include "stream.h"
   49 #include "gc.h"
   50 #include "signal.h"
   51 #include "unwind.h"
   52 #include "eval.h"
   53 #include "struct.h"
   54 #include "cadr.h"
   55 #include "buf.h"
   56 #include "itypes.h"
   57 #include "arith.h"
   58 #include "args.h"
   59 #include "utf8.h"
   60 #include "hash.h"
   61 #include "ffi.h"
   62 
   63 #define zalloca(size) memset(alloca(size), 0, size)
   64 
   65 #define alignof(type) offsetof(struct {char x; type y;}, y)
   66 
   67 #define pad_retval(size) (!(size) || convert(size_t, size) > sizeof (ffi_arg) \
   68                           ? (size) \
   69                           : sizeof (ffi_arg))
   70 
   71 #define min(a, b) ((a) < (b) ? (a) : (b))
   72 
   73 #if HAVE_LITTLE_ENDIAN
   74 #define ifbe(expr) (0)
   75 #define ifbe2(expr1, expr2) (expr2)
   76 #else
   77 #define ifbe(expr) (expr)
   78 #define ifbe2(expr1, expr2) (expr1)
   79 #endif
   80 
   81 #if !HAVE_LIBFFI
   82 typedef struct ffi_type {
   83   char type, size;
   84 } ffi_type;
   85 #define FFI_TYPE_STRUCT 0
   86 #endif
   87 
   88 typedef enum {
   89   FFI_KIND_VOID,
   90   FFI_KIND_NUM,
   91   FFI_KIND_ENUM,
   92   FFI_KIND_PTR,
   93   FFI_KIND_STRUCT,
   94   FFI_KIND_UNION,
   95   FFI_KIND_ARRAY
   96 } ffi_kind_t;
   97 
   98 val uint8_s, int8_s;
   99 val uint16_s, int16_s;
  100 val uint32_s, int32_s;
  101 val uint64_s, int64_s;
  102 
  103 val char_s, uchar_s, bchar_s, wchar_s;
  104 val short_s, ushort_s;
  105 val int_s, uint_s;
  106 val long_s, ulong_s;
  107 val double_s;
  108 val void_s;
  109 
  110 val val_s;
  111 
  112 val be_uint16_s, be_int16_s;
  113 val be_uint32_s, be_int32_s;
  114 val be_uint64_s, be_int64_s;
  115 val be_float_s, be_double_s;
  116 
  117 val le_uint16_s, le_int16_s;
  118 val le_uint32_s, le_int32_s;
  119 val le_uint64_s, le_int64_s;
  120 val le_float_s, le_double_s;
  121 
  122 val array_s, zarray_s, carray_s;
  123 
  124 val union_s;
  125 
  126 val str_d_s, wstr_s, wstr_d_s, bstr_s, bstr_d_s;
  127 
  128 val buf_d_s;
  129 
  130 
  131 val ptr_in_s, ptr_out_s, ptr_in_d_s, ptr_out_d_s, ptr_out_s_s, ptr_s;
  132 
  133 val closure_s;
  134 
  135 val sbit_s, ubit_s; /* bit_s is in arith.c */
  136 
  137 val enum_s, enumed_s, elemtype_s;
  138 
  139 val align_s;
  140 
  141 val bool_s;
  142 
  143 val ffi_type_s, ffi_call_desc_s, ffi_closure_s;
  144 
  145 static val ffi_typedef_hash, ffi_struct_tag_hash;
  146 
  147 #if HAVE_LIBFFI
  148 static uw_frame_t *s_exit_point;
  149 #endif
  150 
  151 #if !HAVE_LIBFFI
  152 static ffi_type ffi_type_void, ffi_type_pointer, ffi_type_sint;
  153 static ffi_type ffi_type_schar, ffi_type_uchar;
  154 static ffi_type ffi_type_sshort, ffi_type_ushort;
  155 static ffi_type ffi_type_sint, ffi_type_uint;
  156 static ffi_type ffi_type_slong, ffi_type_ulong;
  157 static ffi_type ffi_type_sint8, ffi_type_uint8;
  158 static ffi_type ffi_type_sint16, ffi_type_uint16;
  159 static ffi_type ffi_type_sint32, ffi_type_uint32;
  160 static ffi_type ffi_type_sint64, ffi_type_uint64;
  161 static ffi_type ffi_type_float, ffi_type_double;
  162 #endif
  163 
  164 struct smemb {
  165   val mname;
  166   val mtype;
  167   struct txr_ffi_type *mtft;
  168   cnum offs;
  169 };
  170 
  171 struct txr_ffi_type {
  172   val self;
  173   ffi_kind_t kind;
  174   ffi_type *ft;
  175   ffi_type *elements[1];
  176   val lt;
  177   val syntax;
  178   val eltype;
  179   cnum size, align;
  180   unsigned shift, mask;
  181   cnum nelem;
  182   struct smemb *memb;
  183   val tag;
  184   val sym_num, num_sym;
  185   unsigned null_term : 1;
  186   unsigned by_value_in : 1;
  187   unsigned char_conv : 1;
  188   unsigned wchar_conv : 1;
  189   unsigned bchar_conv : 1;
  190   unsigned incomplete : 1;
  191   unsigned flexible : 1;
  192   unsigned bitfield : 1;
  193   struct txr_ffi_type *(*clone)(struct txr_ffi_type *);
  194   void (*put)(struct txr_ffi_type *, val obj, mem_t *dst, val self);
  195   val (*get)(struct txr_ffi_type *, mem_t *src, val self);
  196   val (*in)(struct txr_ffi_type *, int copy, mem_t *src, val obj, val self);
  197   void (*out)(struct txr_ffi_type *, int copy, val obj, mem_t *dest, val self);
  198   void (*release)(struct txr_ffi_type *, val obj, mem_t *dst);
  199   cnum (*dynsize)(struct txr_ffi_type *, val obj, val self);
  200   mem_t *(*alloc)(struct txr_ffi_type *, val obj, val self);
  201   void (*free)(void *);
  202 #if !HAVE_LITTLE_ENDIAN
  203   void (*rput)(struct txr_ffi_type *, val obj, mem_t *dst, val self);
  204   val (*rget)(struct txr_ffi_type *, mem_t *src, val self);
  205 #endif
  206 };
  207 
  208 static struct txr_ffi_type *ffi_type_struct(val obj)
  209 {
  210   return coerce(struct txr_ffi_type *, obj->co.handle);
  211 }
  212 
  213 static struct txr_ffi_type *ffi_type_struct_checked(val self, val obj)
  214 {
  215   return coerce(struct txr_ffi_type *, cobj_handle(self, obj, ffi_type_s));
  216 }
  217 
  218 #if HAVE_LIBFFI
  219 static ffi_type *ffi_get_type(val self, val obj)
  220 {
  221   struct txr_ffi_type *tffi = ffi_type_struct_checked(self, obj);
  222   return tffi->ft;
  223 }
  224 #endif
  225 
  226 static val ffi_get_lisp_type(val self, val obj)
  227 {
  228   struct txr_ffi_type *tffi = ffi_type_struct_checked(self, obj);
  229   return tffi->lt;
  230 }
  231 
  232 static void ffi_type_print_op(val obj, val out, val pretty, struct strm_ctx *ctx)
  233 {
  234   struct txr_ffi_type *tft = ffi_type_struct(obj);
  235   put_string(lit("#<"), out);
  236   obj_print_impl(obj->co.cls, out, pretty, ctx);
  237   format(out, lit(" ~!~s>"), tft->syntax, nao);
  238 }
  239 
  240 static void ffi_type_struct_destroy_op(val obj)
  241 {
  242   struct txr_ffi_type *tft = ffi_type_struct(obj);
  243 #if HAVE_LIBFFI
  244   ffi_type *ft = tft->ft;
  245 #endif
  246 
  247 #if HAVE_LIBFFI
  248   ft->elements = 0;
  249   free(ft);
  250   tft->ft = 0;
  251 #endif
  252 
  253   free(tft->memb);
  254   tft->memb = 0;
  255   free(tft);
  256 }
  257 
  258 static void ffi_type_common_mark(struct txr_ffi_type *tft)
  259 {
  260   gc_mark(tft->lt);
  261   gc_mark(tft->syntax);
  262   gc_mark(tft->tag);
  263 }
  264 
  265 static void ffi_type_mark(val obj)
  266 {
  267   struct txr_ffi_type *tft = ffi_type_struct(obj);
  268   ffi_type_common_mark(tft);
  269 }
  270 
  271 static void ffi_struct_type_mark(val obj)
  272 {
  273   struct txr_ffi_type *tft = ffi_type_struct(obj);
  274   cnum i;
  275   ffi_type_common_mark(tft);
  276 
  277   if (tft->eltype)
  278     gc_mark(tft->eltype);
  279 
  280   if (tft->memb != 0) {
  281     for (i = 0; i < tft->nelem; i++) {
  282       gc_mark(tft->memb[i].mname);
  283       gc_mark(tft->memb[i].mtype);
  284     }
  285   }
  286 }
  287 
  288 static void ffi_ptr_type_mark(val obj)
  289 {
  290   struct txr_ffi_type *tft = ffi_type_struct(obj);
  291   ffi_type_common_mark(tft);
  292   gc_mark(tft->eltype);
  293 }
  294 
  295 static void ffi_enum_type_mark(val obj)
  296 {
  297   struct txr_ffi_type *tft = ffi_type_struct(obj);
  298   ffi_type_common_mark(tft);
  299   gc_mark(tft->sym_num);
  300   gc_mark(tft->num_sym);
  301 }
  302 
  303 static struct cobj_ops ffi_type_builtin_ops =
  304   cobj_ops_init(eq,
  305                 ffi_type_print_op,
  306                 cobj_destroy_free_op,
  307                 ffi_type_mark,
  308                 cobj_eq_hash_op);
  309 
  310 static struct cobj_ops ffi_type_struct_ops =
  311   cobj_ops_init(eq,
  312                 ffi_type_print_op,
  313                 ffi_type_struct_destroy_op,
  314                 ffi_struct_type_mark,
  315                 cobj_eq_hash_op);
  316 
  317 static struct cobj_ops ffi_type_ptr_ops =
  318   cobj_ops_init(eq,
  319                 ffi_type_print_op,
  320                 cobj_destroy_free_op,
  321                 ffi_ptr_type_mark,
  322                 cobj_eq_hash_op);
  323 
  324 static struct cobj_ops ffi_type_enum_ops =
  325   cobj_ops_init(eq,
  326                 ffi_type_print_op,
  327                 cobj_destroy_free_op,
  328                 ffi_enum_type_mark,
  329                 cobj_eq_hash_op);
  330 
  331 #if HAVE_LIBFFI
  332 
  333 struct txr_ffi_closure {
  334   ffi_closure *clo;
  335   mem_t *fptr;
  336   cnum nparam;
  337   val fun;
  338   val call_desc;
  339   val abort_retval;
  340   struct txr_ffi_call_desc *tfcd;
  341 };
  342 
  343 static struct txr_ffi_closure *ffi_closure_struct(val obj)
  344 {
  345   return coerce(struct txr_ffi_closure *, obj->co.handle);
  346 }
  347 
  348 static struct txr_ffi_closure *ffi_closure_struct_checked(val self, val obj)
  349 {
  350   return coerce(struct txr_ffi_closure *, cobj_handle(self, obj, ffi_closure_s));
  351 }
  352 
  353 static void ffi_closure_print_op(val obj, val out,
  354                                  val pretty, struct strm_ctx *ctx)
  355 {
  356   struct txr_ffi_closure *tfcl = ffi_closure_struct(obj);
  357   put_string(lit("#<"), out);
  358   obj_print_impl(obj->co.cls, out, pretty, ctx);
  359   format(out, lit(" ~s ~s>"), tfcl->fun, tfcl->call_desc, nao);
  360 }
  361 
  362 static void ffi_closure_destroy_op(val obj)
  363 {
  364   struct txr_ffi_closure *tfcl = ffi_closure_struct(obj);
  365   if (tfcl->clo != 0) {
  366     ffi_closure_free(tfcl->clo);
  367     tfcl->clo = 0;
  368     tfcl->fptr = 0;
  369   }
  370   free(tfcl);
  371 }
  372 
  373 static void ffi_closure_mark_op(val obj)
  374 {
  375   struct txr_ffi_closure *tfcl = ffi_closure_struct(obj);
  376   gc_mark(tfcl->fun);
  377   gc_mark(tfcl->call_desc);
  378   gc_mark(tfcl->abort_retval);
  379 }
  380 
  381 static struct cobj_ops ffi_closure_ops =
  382   cobj_ops_init(eq,
  383                 ffi_closure_print_op,
  384                 ffi_closure_destroy_op,
  385                 ffi_closure_mark_op,
  386                 cobj_eq_hash_op);
  387 
  388 #endif
  389 
  390 static void ffi_void_put(struct txr_ffi_type *tft, val n, mem_t *dst, val self)
  391 {
  392 }
  393 
  394 static cnum ffi_fixed_dynsize(struct txr_ffi_type *tft, val obj, val self)
  395 {
  396   return tft->size;
  397 }
  398 
  399 static mem_t *ffi_fixed_alloc(struct txr_ffi_type *tft, val obj, val self)
  400 {
  401   return chk_calloc(1, tft->size);
  402 }
  403 
  404 static cnum ffi_varray_dynsize(struct txr_ffi_type *tft, val obj, val self)
  405 {
  406   cnum len = c_num(length(obj)) + tft->null_term;
  407   val eltype = tft->eltype;
  408   struct txr_ffi_type *etft = ffi_type_struct(eltype);
  409   if (etft->incomplete)
  410     uw_throwf(error_s, lit("~a: incomplete type array element"), self, nao);
  411   if (INT_PTR_MAX / etft->size < len)
  412     uw_throwf(error_s, lit("~a: array too large"), self,  nao);
  413   return len * etft->size;
  414 }
  415 
  416 static mem_t *ffi_varray_alloc(struct txr_ffi_type *tft, val obj, val self)
  417 {
  418   cnum len = c_num(length(obj)) + tft->null_term;
  419   val eltype = tft->eltype;
  420   struct txr_ffi_type *etft = ffi_type_struct(eltype);
  421   return chk_calloc(len, etft->size);
  422 }
  423 
  424 static cnum ffi_flex_dynsize(struct txr_ffi_type *tft, val obj, val self)
  425 {
  426   struct smemb *lastm = &tft->memb[tft->nelem - 1];
  427   struct txr_ffi_type *ltft = lastm->mtft;
  428   val lobj = slot(obj, lastm->mname);
  429   cnum lmds = ltft->dynsize(ltft, lobj, self);
  430 
  431   if (lastm->offs > INT_PTR_MAX - lmds)
  432     uw_throwf(error_s, lit("~a: flexible struct size overflow"), self, nao);
  433 
  434   return lastm->offs + lmds;
  435 }
  436 
  437 static mem_t *ffi_flex_alloc(struct txr_ffi_type *tft, val obj, val self)
  438 {
  439   return chk_calloc(1, ffi_flex_dynsize(tft, obj, self));
  440 }
  441 
  442 static void ffi_noop_free(void *ptr)
  443 {
  444 }
  445 
  446 static val ffi_void_get(struct txr_ffi_type *tft, mem_t *src, val self)
  447 {
  448   return nil;
  449 }
  450 
  451 static void ffi_simple_release(struct txr_ffi_type *tft, val obj, mem_t *dst)
  452 {
  453   mem_t **loc = coerce(mem_t **, dst);
  454   free(*loc);
  455   *loc = 0;
  456 }
  457 
  458 #define align_sw_get(type, src)  {                                      \
  459   const int al = ((alignof (type) - 1) & coerce(uint_ptr_t, src)) == 0; \
  460   const size_t sz = sizeof (type);                                      \
  461   mem_t *src_prev = src;                                                \
  462   mem_t *buf = al ? src : convert(mem_t *, alloca(sz));                 \
  463   mem_t *src = al ? buf : (memcpy(buf, src_prev, sz), buf);
  464 
  465 #define align_sw_end                                                    \
  466 }
  467 
  468 #define align_sw_put_end                                                \
  469   if (al)                                                               \
  470     memcpy(src_prev, buf, sz);                                          \
  471 }
  472 
  473 #define align_sw_put(type, dst, expr) {                                 \
  474   if (((alignof (type) - 1) & coerce(uint_ptr_t, dst)) == 0) {          \
  475     expr;                                                               \
  476   } else {                                                              \
  477     mem_t *prev_dst = dst;                                              \
  478     mem_t *dst = convert(mem_t *, alloca(sizeof (type)));               \
  479     expr;                                                               \
  480     memcpy(prev_dst, dst, sizeof (type));                               \
  481   }                                                                     \
  482 }
  483 
  484 #if HAVE_I8
  485 static void ffi_i8_put(struct txr_ffi_type *tft, val n, mem_t *dst, val self)
  486 {
  487   i8_t v = c_i8(n, self);
  488   *coerce(i8_t *, dst) = v;
  489 }
  490 
  491 static val ffi_i8_get(struct txr_ffi_type *tft, mem_t *src, val self)
  492 {
  493   return num_fast(*src);
  494 }
  495 
  496 static void ffi_u8_put(struct txr_ffi_type *tft, val n, mem_t *dst, val self)
  497 {
  498   u8_t v = c_u8(n, self);
  499   *coerce(u8_t *, dst) = v;
  500 }
  501 
  502 static val ffi_u8_get(struct txr_ffi_type *tft, mem_t *src, val self)
  503 {
  504   return num_fast(*coerce(u8_t *, src));
  505 }
  506 
  507 #endif
  508 
  509 #if HAVE_I16
  510 static void ffi_i16_put(struct txr_ffi_type *tft, val n, mem_t *dst, val self)
  511 {
  512   i16_t v = c_i16(n, self);
  513   align_sw_put(i16_t, dst, *coerce(i16_t *, dst) = v);
  514 }
  515 
  516 static val ffi_i16_get(struct txr_ffi_type *tft, mem_t *src, val self)
  517 {
  518   align_sw_get(i16_t, src);
  519   i16_t n = *coerce(i16_t *, src);
  520   return num_fast(n);
  521   align_sw_end;
  522 }
  523 
  524 static void ffi_u16_put(struct txr_ffi_type *tft, val n, mem_t *dst, val self)
  525 {
  526   u16_t v = c_u16(n, self);
  527   align_sw_put(u16_t, dst, *coerce(u16_t *, dst) = v);
  528 }
  529 
  530 static val ffi_u16_get(struct txr_ffi_type *tft, mem_t *src, val self)
  531 {
  532   align_sw_get(u16_t, src);
  533   u16_t n = *coerce(u16_t *, src);
  534   return num_fast(n);
  535   align_sw_end;
  536 }
  537 #endif
  538 
  539 #if HAVE_I32
  540 static void ffi_i32_put(struct txr_ffi_type *tft, val n, mem_t *dst, val self)
  541 {
  542   i32_t v = c_i32(n, self);
  543   align_sw_put(i32_t, dst, *coerce(i32_t *, dst) = v);
  544 }
  545 
  546 static val ffi_i32_get(struct txr_ffi_type *tft, mem_t *src, val self)
  547 {
  548   align_sw_get(i32_t, src);
  549   i32_t n = *coerce(i32_t *, src);
  550   return num(n);
  551   align_sw_end;
  552 }
  553 
  554 static void ffi_u32_put(struct txr_ffi_type *tft, val n, mem_t *dst, val self)
  555 {
  556   u32_t v = c_u32(n, self);
  557   align_sw_put(u32_t, dst, *coerce(u32_t *, dst) = v);
  558 }
  559 
  560 static val ffi_u32_get(struct txr_ffi_type *tft, mem_t *src, val self)
  561 {
  562   align_sw_get(u32_t, src);
  563   u32_t n = *coerce(u32_t *, src);
  564   return unum(n);
  565   align_sw_end;
  566 }
  567 #endif
  568 
  569 #if HAVE_I64
  570 static void ffi_i64_put(struct txr_ffi_type *tft, val n, mem_t *dst, val self)
  571 {
  572   i64_t v = c_i64(n, self);
  573   align_sw_put(i64_t, dst, *coerce(i64_t *, dst) = v);
  574 }
  575 
  576 static val ffi_i64_get(struct txr_ffi_type *tft, mem_t *src, val self)
  577 {
  578   align_sw_get(i64_t, src);
  579   i64_t n = *coerce(i64_t *, src);
  580 
  581   if (sizeof (i64_t) <= sizeof (cnum)) {
  582     return num(n);
  583   } else {
  584     val high = num(n >> 32);
  585     val low = unum(n & 0xFFFFFFFF);
  586     return logior(ash(high, num_fast(32)), low);
  587   }
  588   align_sw_end;
  589 }
  590 
  591 static void ffi_u64_put(struct txr_ffi_type *tft, val n, mem_t *dst, val self)
  592 {
  593   u64_t v = c_u64(n, self);
  594   align_sw_put(u64_t, dst, *coerce(u64_t *, dst) = v);
  595 }
  596 
  597 static val ffi_u64_get(struct txr_ffi_type *tft, mem_t *src, val self)
  598 {
  599   align_sw_get(u64_t, src);
  600   u64_t n = *coerce(u64_t *, src);
  601 
  602   if (sizeof (u64_t) <= sizeof (uint_ptr_t)) {
  603     return unum(n);
  604   } else {
  605     val high = unum(n >> 32);
  606     val low = unum(n & 0xFFFFFFFF);
  607     return logior(ash(high, num_fast(32)), low);
  608   }
  609   align_sw_end;
  610 }
  611 
  612 #endif
  613 
  614 static void ffi_char_put(struct txr_ffi_type *tft, val n, mem_t *dst, val self)
  615 {
  616   char v = c_char(n, self);
  617   *coerce(char *, dst) = v;
  618 }
  619 
  620 static val ffi_char_get(struct txr_ffi_type *tft, mem_t *src, val self)
  621 {
  622   return chr(*coerce(char *, src));
  623 }
  624 
  625 static void ffi_uchar_put(struct txr_ffi_type *tft, val n, mem_t *dst,
  626                           val self)
  627 {
  628   unsigned char v = c_uchar(n, self);
  629   *coerce(unsigned char *, dst) = v;
  630 }
  631 
  632 static val ffi_uchar_get(struct txr_ffi_type *tft, mem_t *src, val self)
  633 {
  634   return num_fast(*src);
  635 }
  636 
  637 static val ffi_bchar_get(struct txr_ffi_type *tft, mem_t *src, val self)
  638 {
  639   return chr(*src);
  640 }
  641 
  642 static void ffi_short_put(struct txr_ffi_type *tft, val n, mem_t *dst,
  643                           val self)
  644 {
  645   short v = c_short(n, self);
  646   align_sw_put(short, dst, *coerce(short *, dst) = v);
  647 }
  648 
  649 static val ffi_short_get(struct txr_ffi_type *tft, mem_t *src, val self)
  650 {
  651   align_sw_get(short, src);
  652   short n = *coerce(short *, src);
  653   return num_fast(n);
  654   align_sw_end;
  655 }
  656 
  657 static void ffi_ushort_put(struct txr_ffi_type *tft, val n, mem_t *dst,
  658                            val self)
  659 {
  660   unsigned short v = c_ushort(n, self);
  661   align_sw_put(unsigned, dst, *coerce(unsigned short *, dst) = v);
  662 }
  663 
  664 static val ffi_ushort_get(struct txr_ffi_type *tft, mem_t *src, val self)
  665 {
  666   unsigned short n = *coerce(unsigned short *, src);
  667   return num_fast(n);
  668 }
  669 
  670 static void ffi_int_put(struct txr_ffi_type *tft, val n, mem_t *dst, val self)
  671 {
  672   int v = c_int(n, self);
  673   align_sw_put(int, dst, *coerce(int *, dst) = v);
  674 }
  675 
  676 static val ffi_int_get(struct txr_ffi_type *tft, mem_t *src, val self)
  677 {
  678   align_sw_get(int, src);
  679   int n = *coerce(int *, src);
  680   return num(n);
  681   align_sw_end;
  682 }
  683 
  684 static void ffi_uint_put(struct txr_ffi_type *tft, val n, mem_t *dst, val self)
  685 {
  686   unsigned v = c_uint(n, self);
  687   align_sw_put(unsigned, dst, *coerce(unsigned *, dst) = v);
  688 }
  689 
  690 static val ffi_uint_get(struct txr_ffi_type *tft, mem_t *src, val self)
  691 {
  692   align_sw_get(unsigned, src);
  693   unsigned n = *coerce(unsigned *, src);
  694   return unum(n);
  695   align_sw_end;
  696 }
  697 
  698 static void ffi_long_put(struct txr_ffi_type *tft, val n, mem_t *dst, val self)
  699 {
  700   long v = c_long(n, self);
  701   align_sw_put(long, dst, *coerce(long *, dst) = v);
  702 }
  703 
  704 static val ffi_long_get(struct txr_ffi_type *tft, mem_t *src, val self)
  705 {
  706   align_sw_get(long, src);
  707   long n = *coerce(long *, src);
  708   return num(n);
  709   align_sw_end;
  710 }
  711 
  712 static void ffi_ulong_put(struct txr_ffi_type *tft, val n, mem_t *dst, val self)
  713 {
  714   unsigned long v = c_ulong(n, self);
  715   align_sw_put(unsigned long, dst, *coerce(unsigned long *, dst) = v);
  716 }
  717 
  718 static val ffi_ulong_get(struct txr_ffi_type *tft, mem_t *src, val self)
  719 {
  720   align_sw_get(unsigned long, src);
  721   unsigned long n = *coerce(unsigned long *, src);
  722   return unum(n);
  723   align_sw_end;
  724 }
  725 
  726 static void ffi_float_put(struct txr_ffi_type *tft, val n, mem_t *dst, val self)
  727 {
  728   double v;
  729 
  730   switch (type(n)) {
  731   case NUM:
  732   case CHR:
  733     v = c_num(n);
  734     break;
  735   case BGNUM:
  736     n = int_flo(n);
  737     /* fallthrough */
  738   default:
  739     v = c_flo(n, self);
  740     break;
  741   }
  742 
  743   {
  744     double pv = fabs(v);
  745     if (pv > FLT_MAX || (pv != 0.0 && pv < FLT_MIN))
  746     uw_throwf(error_s, lit("~a: ~s is out of float range"), self, n, nao);
  747   }
  748 
  749   align_sw_put(double, dst, *coerce(float *, dst) = v);
  750 }
  751 
  752 static val ffi_float_get(struct txr_ffi_type *tft, mem_t *src, val self)
  753 {
  754   align_sw_get(float, src);
  755   float n = *coerce(float *, src);
  756   return flo(n);
  757   align_sw_end;
  758 }
  759 
  760 static void ffi_double_put(struct txr_ffi_type *tft, val n, mem_t *dst,
  761                            val self)
  762 {
  763   double v;
  764 
  765   switch (type(n)) {
  766   case NUM:
  767   case CHR:
  768     v = c_num(n);
  769     break;
  770   case BGNUM:
  771     n = int_flo(n);
  772     /* fallthrough */
  773   default:
  774     v = c_flo(n, self);
  775     break;
  776   }
  777 
  778   align_sw_put(double, dst, *coerce(double *, dst) = v);
  779 }
  780 
  781 static val ffi_double_get(struct txr_ffi_type *tft, mem_t *src, val self)
  782 {
  783   align_sw_get(double, src);
  784   double n = *coerce(double *, src);
  785   return flo(n);
  786   align_sw_end;
  787 }
  788 
  789 static void ffi_val_put(struct txr_ffi_type *tft, val v, mem_t *dst, val self)
  790 {
  791   align_sw_put(val *, dst, *coerce(val *, dst) = v);
  792 }
  793 
  794 static val ffi_val_get(struct txr_ffi_type *tft, mem_t *src, val self)
  795 {
  796   align_sw_get(val, src);
  797   val v = *coerce(val *, src);
  798   if (!valid_object_p(v))
  799     uw_throwf(error_s, lit("~a: bit pattern ~0,0*x isn't a valid Lisp object"),
  800               self, num_fast(sizeof (v) * 2), bits(v), nao);
  801   return v;
  802   align_sw_end;
  803 }
  804 
  805 static void ffi_be_i16_put(struct txr_ffi_type *tft, val n,
  806                            mem_t *dst, val self)
  807 {
  808   cnum v = c_num(n);
  809 
  810   if (v < -32768 || v > 32767)
  811     uw_throwf(error_s, lit("~a: value ~s is out of signed 16 bit range"),
  812               self, n, nao);
  813 
  814   dst[0] = (v >> 8) & 0xff;
  815   dst[1] = v & 0xff;
  816 }
  817 
  818 static val ffi_be_i16_get(struct txr_ffi_type *tft, mem_t *src, val self)
  819 {
  820   cnum n = (src[0] << 8) | src[1];
  821   if ((n & 0x8000) != 0)
  822     n = -((n ^ 0xFFFF) + 1);
  823   return num(n);
  824 }
  825 
  826 static void ffi_be_u16_put(struct txr_ffi_type *tft, val n,
  827                            mem_t *dst, val self)
  828 {
  829   cnum v = c_num(n);
  830 
  831   if (v < -32768 || v > 32767)
  832     uw_throwf(error_s, lit("~a: value ~s is out of signed 16 bit range"),
  833               self, n, nao);
  834 
  835   dst[0] = (v >> 8) & 0xff;
  836   dst[1] = v & 0xff;
  837 }
  838 
  839 static val ffi_be_u16_get(struct txr_ffi_type *tft, mem_t *src, val self)
  840 {
  841   cnum n = (src[0] << 8) | src[1];
  842   return num(n);
  843 }
  844 
  845 static void ffi_le_i16_put(struct txr_ffi_type *tft, val n,
  846                            mem_t *dst, val self)
  847 {
  848   cnum v = c_num(n);
  849 
  850   if (v < -32768 || v > 32767)
  851     uw_throwf(error_s, lit("~a: value ~s is out of signed 16 bit range"),
  852               self, n, nao);
  853 
  854   dst[1] = (v >> 8) & 0xff;
  855   dst[0] = v & 0xff;
  856 }
  857 
  858 static val ffi_le_i16_get(struct txr_ffi_type *tft, mem_t *src, val self)
  859 {
  860   cnum n = (src[1] << 8) | src[0];
  861   if ((n & 0x8000) != 0)
  862     n = -((n ^ 0xFFFF) + 1);
  863   return num(n);
  864 }
  865 
  866 static void ffi_le_u16_put(struct txr_ffi_type *tft, val n,
  867                            mem_t *dst, val self)
  868 {
  869   cnum v = c_num(n);
  870 
  871   if (v < 0|| v > 65535)
  872     uw_throwf(error_s, lit("~a: value ~s is out of unsigned 16 bit range"),
  873               self, n, nao);
  874 
  875   dst[1] = (v >> 8) & 0xff;
  876   dst[0] = v & 0xff;
  877 }
  878 
  879 static val ffi_le_u16_get(struct txr_ffi_type *tft, mem_t *src, val self)
  880 {
  881   cnum n = (src[1] << 8) | src[0];
  882   return num(n);
  883 }
  884 
  885 static void ffi_be_i32_put(struct txr_ffi_type *tft, val n,
  886                            mem_t *dst, val self)
  887 {
  888   cnum v = c_num(n);
  889 
  890   if (v < -convert(cnum, 0x7FFFFFFF) - 1 || v > 0x7FFFFFFF)
  891     uw_throwf(error_s, lit("~a: value ~s is out of signed 32 bit range"),
  892               self, n, nao);
  893 
  894   dst[0] = (v >> 24) & 0xff;
  895   dst[1] = (v >> 16) & 0xff;
  896   dst[2] = (v >> 8) & 0xff;
  897   dst[3] = v & 0xff;
  898 }
  899 
  900 static val ffi_be_i32_get(struct txr_ffi_type *tft, mem_t *src, val self)
  901 {
  902   cnum n = (convert(cnum, src[0]) << 24 | convert(cnum, src[1]) << 16 |
  903             convert(cnum, src[2]) << 8 | src[3]);
  904   if ((n & 0x80000000) != 0)
  905     n = -((n ^ 0xFFFFFFFF) + 1);
  906   return num(n);
  907 }
  908 
  909 static void ffi_be_u32_put(struct txr_ffi_type *tft, val n,
  910                            mem_t *dst, val self)
  911 {
  912   ucnum v = c_unum(n);
  913 
  914   if (v > 0xFFFFFFFF)
  915     uw_throwf(error_s, lit("~a: value ~s is out of unsigned 32 bit range"),
  916               self, n, nao);
  917 
  918   dst[0] = (v >> 24) & 0xff;
  919   dst[1] = (v >> 16) & 0xff;
  920   dst[2] = (v >> 8) & 0xff;
  921   dst[3] = v & 0xff;
  922 }
  923 
  924 static val ffi_be_u32_get(struct txr_ffi_type *tft, mem_t *src, val self)
  925 {
  926   ucnum n = (convert(ucnum, src[0]) << 24 | convert(ucnum, src[1]) << 16 |
  927              convert(ucnum, src[2]) << 8 | src[3]);
  928   return unum(n);
  929 }
  930 
  931 static void ffi_le_i32_put(struct txr_ffi_type *tft, val n,
  932                            mem_t *dst, val self)
  933 {
  934   cnum v = c_num(n);
  935 
  936   if (v < - convert(cnum, 0x7fffffff) - 1 || v > 0x7FFFFFFF)
  937     uw_throwf(error_s, lit("~a: value ~s is out of signed 32 bit range"),
  938               self, n, nao);
  939 
  940   dst[3] = (v >> 24) & 0xff;
  941   dst[2] = (v >> 16) & 0xff;
  942   dst[1] = (v >> 8) & 0xff;
  943   dst[0] = v & 0xff;
  944 }
  945 
  946 static val ffi_le_i32_get(struct txr_ffi_type *tft, mem_t *src, val self)
  947 {
  948   cnum n = (convert(cnum, src[3]) << 24 | convert(cnum, src[2]) << 16 |
  949             convert(cnum, src[1]) << 8 | src[0]);
  950   if ((n & 0x80000000) != 0)
  951     n = -((n ^ 0xFFFFFFFF) + 1);
  952   return num(n);
  953 }
  954 
  955 static void ffi_le_u32_put(struct txr_ffi_type *tft, val n,
  956                            mem_t *dst, val self)
  957 {
  958   ucnum v = c_unum(n);
  959 
  960   if (v > 0xFFFFFFFF)
  961     uw_throwf(error_s, lit("~a: value ~s is out of unsigned 32 bit range"),
  962               self, n, nao);
  963 
  964   dst[3] = (v >> 24) & 0xff;
  965   dst[2] = (v >> 16) & 0xff;
  966   dst[1] = (v >> 8) & 0xff;
  967   dst[0] = v & 0xff;
  968 }
  969 
  970 static val ffi_le_u32_get(struct txr_ffi_type *tft, mem_t *src, val self)
  971 {
  972   ucnum n = (convert(ucnum, src[3]) << 24 | convert(ucnum, src[2]) << 16 |
  973              convert(ucnum, src[1]) << 8 | src[0]);
  974   return unum(n);
  975 }
  976 
  977 static void ffi_be_i64_put(struct txr_ffi_type *tft, val n,
  978                            mem_t *dst, val self)
  979 {
  980   i64_t v = c_i64(n, self);
  981 
  982   dst[0] = (v >> 56) & 0xff;
  983   dst[1] = (v >> 48) & 0xff;
  984   dst[2] = (v >> 40) & 0xff;
  985   dst[3] = (v >> 32) & 0xff;
  986   dst[4] = (v >> 24) & 0xff;
  987   dst[5] = (v >> 16) & 0xff;
  988   dst[6] = (v >> 8) & 0xff;
  989   dst[7] = v & 0xff;
  990 }
  991 
  992 static val ffi_be_i64_get(struct txr_ffi_type *tft, mem_t *src, val self)
  993 {
  994   i64_t n = (convert(i64_t, src[0]) << 56 | convert(i64_t, src[1]) << 48 |
  995              convert(i64_t, src[2]) << 40 | convert(i64_t, src[3]) << 32 |
  996              convert(i64_t, src[4]) << 24 | convert(i64_t, src[5]) << 16 |
  997              convert(i64_t, src[6]) << 8 | src[7]);
  998   return num_64(n);
  999 }
 1000 
 1001 static void ffi_be_u64_put(struct txr_ffi_type *tft, val n,
 1002                            mem_t *dst, val self)
 1003 {
 1004   u64_t v = c_u64(n, self);
 1005 
 1006   dst[0] = (v >> 56) & 0xff;
 1007   dst[1] = (v >> 48) & 0xff;
 1008   dst[2] = (v >> 40) & 0xff;
 1009   dst[3] = (v >> 32) & 0xff;
 1010   dst[4] = (v >> 24) & 0xff;
 1011   dst[5] = (v >> 16) & 0xff;
 1012   dst[6] = (v >> 8) & 0xff;
 1013   dst[7] = v & 0xff;
 1014   return;
 1015 }
 1016 
 1017 static val ffi_be_u64_get(struct txr_ffi_type *tft, mem_t *src, val self)
 1018 {
 1019   u64_t n = (convert(u64_t, src[0]) << 56 | convert(u64_t, src[1]) << 48 |
 1020              convert(u64_t, src[2]) << 40 | convert(u64_t, src[3]) << 32 |
 1021              convert(u64_t, src[4]) << 24 | convert(u64_t, src[5]) << 16 |
 1022              convert(u64_t, src[6]) << 8 | src[7]);
 1023   return unum_64(n);
 1024 }
 1025 
 1026 static void ffi_le_i64_put(struct txr_ffi_type *tft, val n,
 1027                            mem_t *dst, val self)
 1028 {
 1029   i64_t v = c_i64(n, self);
 1030 
 1031   dst[7] = (v >> 56) & 0xff;
 1032   dst[6] = (v >> 48) & 0xff;
 1033   dst[5] = (v >> 40) & 0xff;
 1034   dst[4] = (v >> 32) & 0xff;
 1035   dst[3] = (v >> 24) & 0xff;
 1036   dst[2] = (v >> 16) & 0xff;
 1037   dst[1] = (v >> 8) & 0xff;
 1038   dst[0] = v & 0xff;
 1039 }
 1040 
 1041 static val ffi_le_i64_get(struct txr_ffi_type *tft, mem_t *src, val self)
 1042 {
 1043   u64_t n = (convert(u64_t, src[7]) << 56 | convert(u64_t, src[6]) << 48 |
 1044              convert(u64_t, src[5]) << 40 | convert(u64_t, src[4]) << 32 |
 1045              convert(u64_t, src[3]) << 24 | convert(u64_t, src[2]) << 16 |
 1046              convert(u64_t, src[1]) << 8 | src[0]);
 1047   return num_64(n);
 1048 }
 1049 
 1050 static void ffi_le_u64_put(struct txr_ffi_type *tft, val n,
 1051                            mem_t *dst, val self)
 1052 {
 1053   u64_t v = c_u64(n, self);
 1054 
 1055   dst[7] = (v >> 56) & 0xff;
 1056   dst[6] = (v >> 48) & 0xff;
 1057   dst[5] = (v >> 40) & 0xff;
 1058   dst[4] = (v >> 32) & 0xff;
 1059   dst[3] = (v >> 24) & 0xff;
 1060   dst[2] = (v >> 16) & 0xff;
 1061   dst[1] = (v >> 8) & 0xff;
 1062   dst[0] = v & 0xff;
 1063 }
 1064 
 1065 static val ffi_le_u64_get(struct txr_ffi_type *tft, mem_t *src, val self)
 1066 {
 1067   u64_t n = (convert(u64_t, src[7]) << 56 | convert(u64_t, src[6]) << 48 |
 1068              convert(u64_t, src[5]) << 40 | convert(u64_t, src[4]) << 32 |
 1069              convert(u64_t, src[3]) << 24 | convert(u64_t, src[2]) << 16 |
 1070              convert(u64_t, src[1]) << 8 | src[0]);
 1071   return unum_64(n);
 1072 }
 1073 
 1074 static void ffi_be_float_put(struct txr_ffi_type *tft, val n,
 1075                              mem_t *dst, val self)
 1076 {
 1077 #if HAVE_LITTLE_ENDIAN
 1078   mem_t *c = convert(mem_t *, alloca(4));
 1079   ffi_float_put(tft, n, c, self);
 1080 
 1081   dst[0] = c[3];
 1082   dst[1] = c[2];
 1083   dst[2] = c[1];
 1084   dst[3] = c[0];
 1085 #else
 1086   ffi_float_put(tft, n, dst, self);
 1087 #endif
 1088 }
 1089 
 1090 static val ffi_be_float_get(struct txr_ffi_type *tft, mem_t *src, val self)
 1091 {
 1092 #if HAVE_LITTLE_ENDIAN
 1093   mem_t *c = convert(mem_t *, alloca(4));
 1094 
 1095   c[0] = src[3];
 1096   c[1] = src[2];
 1097   c[2] = src[1];
 1098   c[3] = src[0];
 1099 
 1100   return ffi_float_get(tft, c, self);
 1101 #else
 1102   return ffi_float_get(tft, src, self);
 1103 #endif
 1104 }
 1105 
 1106 static void ffi_le_float_put(struct txr_ffi_type *tft, val n,
 1107                              mem_t *dst, val self)
 1108 {
 1109 #if !HAVE_LITTLE_ENDIAN
 1110   mem_t *c = convert(mem_t *, alloca(4));
 1111 
 1112   ffi_float_put(tft, n, c, self);
 1113 
 1114   dst[0] = c[3];
 1115   dst[1] = c[2];
 1116   dst[2] = c[1];
 1117   dst[3] = c[0];
 1118 #else
 1119   ffi_float_put(tft, n, dst, self);
 1120 #endif
 1121 }
 1122 
 1123 static val ffi_le_float_get(struct txr_ffi_type *tft, mem_t *src, val self)
 1124 {
 1125 #if !HAVE_LITTLE_ENDIAN
 1126   mem_t *c = convert(mem_t *, alloca(4));
 1127 
 1128   c[0] = src[3];
 1129   c[1] = src[2];
 1130   c[2] = src[1];
 1131   c[3] = src[0];
 1132 
 1133   return ffi_float_get(tft, c, self);
 1134 #else
 1135   return ffi_float_get(tft, src, self);
 1136 #endif
 1137 }
 1138 
 1139 static void ffi_be_double_put(struct txr_ffi_type *tft, val n,
 1140                              mem_t *dst, val self)
 1141 {
 1142 #if HAVE_LITTLE_ENDIAN
 1143   mem_t *c = convert(mem_t *, alloca(8));
 1144 
 1145   ffi_double_put(tft, n, c, self);
 1146 
 1147   dst[0] = c[7];
 1148   dst[1] = c[6];
 1149   dst[2] = c[5];
 1150   dst[3] = c[4];
 1151   dst[4] = c[3];
 1152   dst[5] = c[2];
 1153   dst[6] = c[1];
 1154   dst[7] = c[0];
 1155 #else
 1156   ffi_double_put(tft, n, dst, self);
 1157 #endif
 1158 }
 1159 
 1160 static val ffi_be_double_get(struct txr_ffi_type *tft, mem_t *src, val self)
 1161 {
 1162 #if HAVE_LITTLE_ENDIAN
 1163   mem_t *c = convert(mem_t *, alloca(8));
 1164 
 1165   c[0] = src[7];
 1166   c[1] = src[6];
 1167   c[2] = src[5];
 1168   c[3] = src[4];
 1169   c[4] = src[3];
 1170   c[5] = src[2];
 1171   c[6] = src[1];
 1172   c[7] = src[0];
 1173 
 1174   return ffi_double_get(tft, c, self);
 1175 #else
 1176   return ffi_double_get(tft, src, self);
 1177 #endif
 1178 }
 1179 
 1180 static void ffi_le_double_put(struct txr_ffi_type *tft, val n,
 1181                               mem_t *dst, val self)
 1182 {
 1183 #if !HAVE_LITTLE_ENDIAN
 1184   mem_t *c = convert(mem_t *, alloca(8));
 1185 
 1186   ffi_double_put(tft, n, c, self);
 1187 
 1188   dst[0] = c[7];
 1189   dst[1] = c[6];
 1190   dst[2] = c[5];
 1191   dst[3] = c[4];
 1192   dst[4] = c[3];
 1193   dst[5] = c[2];
 1194   dst[6] = c[1];
 1195   dst[7] = c[0];
 1196 #else
 1197   ffi_double_put(tft, n, dst, self);
 1198 #endif
 1199 }
 1200 
 1201 static val ffi_le_double_get(struct txr_ffi_type *tft, mem_t *src, val self)
 1202 {
 1203 #if !HAVE_LITTLE_ENDIAN
 1204   mem_t *c = convert(mem_t *, alloca(8));
 1205 
 1206   c[0] = src[7];
 1207   c[1] = src[6];
 1208   c[2] = src[5];
 1209   c[3] = src[4];
 1210   c[4] = src[3];
 1211   c[5] = src[2];
 1212   c[6] = src[1];
 1213   c[7] = src[0];
 1214 
 1215   return ffi_double_get(tft, c, self);
 1216 #else
 1217   return ffi_double_get(tft, src, self);
 1218 #endif
 1219 }
 1220 
 1221 #if SIZEOF_WCHAR_T == SIZEOF_SHORT
 1222 #define ffi_type_wchar ffi_type_ushort
 1223 #elif SIZEOF_WCHAR_T == SIZEOF_INT
 1224 #define ffi_type_wchar ffi_type_uint
 1225 #elif SIZEOF_WCHAR_T == SIZEOF_LONG
 1226 #define ffi_type_wchar ffi_type_long
 1227 #else
 1228 #error portme
 1229 #endif
 1230 
 1231 static void ffi_wchar_put(struct txr_ffi_type *tft, val ch, mem_t *dst,
 1232                           val self)
 1233 {
 1234   wchar_t c = c_chr(ch);
 1235   align_sw_put(wchar_t, dst, *coerce(wchar_t *, dst) = c);
 1236 }
 1237 
 1238 static val ffi_wchar_get(struct txr_ffi_type *tft, mem_t *src, val self)
 1239 {
 1240   align_sw_get(wchar_t, src);
 1241   wchar_t c = *coerce(wchar_t *, src);
 1242   return chr(c);
 1243   align_sw_end;
 1244 }
 1245 
 1246 static void ffi_sbit_put(struct txr_ffi_type *tft, val n,
 1247                          mem_t *dst, val self)
 1248 {
 1249   unsigned mask = tft->mask;
 1250   unsigned sbmask = mask ^ (mask >> 1);
 1251   int shift = tft->shift;
 1252   cnum cn = c_num(n);
 1253   int in = cn;
 1254   unsigned uput = (convert(unsigned, in) << shift) & mask;
 1255 
 1256   if (in != cn)
 1257     goto range;
 1258 
 1259   if (uput & sbmask) {
 1260     int icheck = -convert(int, ((uput ^ mask) >> shift) + 1);
 1261     if (icheck != cn)
 1262       goto range;
 1263   } else if (convert(cnum, uput >> shift) != cn) {
 1264     goto range;
 1265   }
 1266 
 1267   {
 1268     align_sw_get(unsigned, dst);
 1269     unsigned field = *coerce(unsigned *, dst);
 1270     field &= ~mask;
 1271     field |= uput;
 1272     *coerce(unsigned *, dst) = field;
 1273     align_sw_put_end;
 1274   }
 1275 
 1276   return;
 1277 range:
 1278   uw_throwf(error_s, lit("~a: value ~s is out of range of "
 1279                          "signed ~s bit-field"),
 1280             self, n, num_fast(tft->nelem), nao);
 1281 }
 1282 
 1283 static val ffi_sbit_get(struct txr_ffi_type *tft, mem_t *src, val self)
 1284 {
 1285   align_sw_get(unsigned int, src);
 1286   unsigned mask = tft->mask;
 1287   unsigned sbmask = mask ^ (mask >> 1);
 1288   int shift = tft->shift;
 1289   unsigned uget = *coerce(unsigned *, src) & mask;
 1290 
 1291   if (uget & sbmask)
 1292     return num(-convert(int, ((uget ^ mask) >> shift) + 1));
 1293   return unum(uget >> shift);
 1294   align_sw_end;
 1295 }
 1296 
 1297 static void ffi_ubit_put(struct txr_ffi_type *tft, val n,
 1298                          mem_t *dst, val self)
 1299 {
 1300   unsigned mask = tft->mask;
 1301   int shift = tft->shift;
 1302   ucnum cn = c_unum(n);
 1303   unsigned un = cn;
 1304   unsigned uput = (un << shift) & mask;
 1305 
 1306   if (un != cn)
 1307     goto range;
 1308 
 1309   if (uput >> shift != cn)
 1310     goto range;
 1311 
 1312   {
 1313     align_sw_get(unsigned, dst);
 1314     unsigned field = *coerce(unsigned *, dst);
 1315     field &= ~mask;
 1316     field |= uput;
 1317     *coerce(unsigned *, dst) = field;
 1318     align_sw_put_end;
 1319   }
 1320 
 1321   return;
 1322 
 1323 range:
 1324   uw_throwf(error_s, lit("~a: value ~s is out of range of "
 1325                          "unsigned ~s bit-field"),
 1326             self, n, num_fast(tft->nelem), nao);
 1327 }
 1328 
 1329 static val ffi_ubit_get(struct txr_ffi_type *tft, mem_t *src, val self)
 1330 {
 1331   align_sw_get(unsigned, src);
 1332   unsigned mask = tft->mask;
 1333   int shift = tft->shift;
 1334   unsigned uget = *coerce(unsigned *, src) & mask;
 1335   return unum(uget >> shift);
 1336   align_sw_end;
 1337 }
 1338 
 1339 static void ffi_generic_sbit_put(struct txr_ffi_type *tft, val n,
 1340                                  mem_t *dst, val self)
 1341 {
 1342   mem_t *tmp = coerce(mem_t *, zalloca(sizeof (int)));
 1343   memcpy(tmp, dst, tft->size);
 1344   ffi_sbit_put(tft, n, tmp, self);
 1345   memcpy(dst, tmp, tft->size);
 1346 }
 1347 
 1348 static val ffi_generic_sbit_get(struct txr_ffi_type *tft,
 1349                                 mem_t *src, val self)
 1350 {
 1351   mem_t *tmp = coerce(mem_t *, zalloca(sizeof (int)));
 1352   memcpy(tmp, src, tft->size);
 1353   return ffi_sbit_get(tft, tmp, self);
 1354 }
 1355 
 1356 static void ffi_generic_ubit_put(struct txr_ffi_type *tft, val n,
 1357                                  mem_t *dst, val self)
 1358 {
 1359   mem_t *tmp = coerce(mem_t *, zalloca(sizeof (int)));
 1360   memcpy(tmp, dst, tft->size);
 1361   ffi_ubit_put(tft, n, tmp, self);
 1362   memcpy(dst, tmp, tft->size);
 1363 }
 1364 
 1365 static val ffi_generic_ubit_get(struct txr_ffi_type *tft,
 1366                                 mem_t *src, val self)
 1367 {
 1368   mem_t *tmp = coerce(mem_t *, zalloca(sizeof (int)));
 1369   memcpy(tmp, src, tft->size);
 1370   return ffi_ubit_get(tft, tmp, self);
 1371 }
 1372 
 1373 static void ffi_bool_put(struct txr_ffi_type *tft, val truth,
 1374                          mem_t *dst, val self)
 1375 {
 1376   val n = truth ? one : zero;
 1377   struct txr_ffi_type *tgtft = ffi_type_struct(tft->eltype);
 1378   tgtft->put(tft, n, dst, self); /* tft deliberate */
 1379 }
 1380 
 1381 static val ffi_bool_get(struct txr_ffi_type *tft, mem_t *src, val self)
 1382 {
 1383   struct txr_ffi_type *tgtft = ffi_type_struct(tft->eltype);
 1384   val n = tgtft->get(tft, src, self); /* tft deliberate */
 1385   return null(zerop(n));
 1386 }
 1387 
 1388 #if !HAVE_LITTLE_ENDIAN
 1389 
 1390 static void ffi_i8_rput(struct txr_ffi_type *tft, val n, mem_t *dst, val self)
 1391 {
 1392   i8_t v = c_i8(n, self);
 1393   *coerce(i8_t *, dst) = v;
 1394 }
 1395 
 1396 static val ffi_i8_rget(struct txr_ffi_type *tft, mem_t *src, val self)
 1397 {
 1398   return num_fast(*src);
 1399 }
 1400 
 1401 static void ffi_u8_rput(struct txr_ffi_type *tft, val n, mem_t *dst, val self)
 1402 {
 1403   u8_t v = c_u8(n, self);
 1404   *coerce(u8_t *, dst) = v;
 1405 }
 1406 
 1407 static val ffi_u8_rget(struct txr_ffi_type *tft, mem_t *src, val self)
 1408 {
 1409   return num_fast(*coerce(u8_t *, src));
 1410 }
 1411 
 1412 #if HAVE_I16
 1413 static void ffi_i16_rput(struct txr_ffi_type *tft, val n, mem_t *dst, val self)
 1414 {
 1415   i16_t v = c_i16(n, self);
 1416   *coerce(ffi_arg *, dst) = v;
 1417 }
 1418 
 1419 static val ffi_i16_rget(struct txr_ffi_type *tft, mem_t *src, val self)
 1420 {
 1421   i16_t n = *coerce(ffi_arg *, src);
 1422   return num_fast(n);
 1423 }
 1424 
 1425 static void ffi_u16_rput(struct txr_ffi_type *tft, val n, mem_t *dst, val self)
 1426 {
 1427   u16_t v = c_u16(n, self);
 1428   *coerce(ffi_arg *, dst) = v;
 1429 }
 1430 
 1431 static val ffi_u16_rget(struct txr_ffi_type *tft, mem_t *src, val self)
 1432 {
 1433   u16_t n = *coerce(ffi_arg *, src);
 1434   return num_fast(n);
 1435 }
 1436 #endif
 1437 
 1438 #if HAVE_I32
 1439 static void ffi_i32_rput(struct txr_ffi_type *tft, val n, mem_t *dst, val self)
 1440 {
 1441   i32_t v = c_i32(n, self);
 1442   *coerce(ffi_arg *, dst) = v;
 1443 }
 1444 
 1445 static val ffi_i32_rget(struct txr_ffi_type *tft, mem_t *src, val self)
 1446 {
 1447   i32_t n = *coerce(ffi_arg *, src);
 1448   return num(n);
 1449 }
 1450 #endif
 1451 
 1452 static void ffi_u32_rput(struct txr_ffi_type *tft, val n, mem_t *dst, val self)
 1453 {
 1454   u32_t v = c_u32(n, self);
 1455   *coerce(ffi_arg *, dst) = v;
 1456 }
 1457 
 1458 static val ffi_u32_rget(struct txr_ffi_type *tft, mem_t *src, val self)
 1459 {
 1460   u32_t n = *coerce(ffi_arg *, src);
 1461   return unum(n);
 1462 }
 1463 
 1464 static void ffi_char_rput(struct txr_ffi_type *tft, val n, mem_t *dst, val self)
 1465 {
 1466   char v = c_char(n, self);
 1467   *coerce(ffi_arg *, dst) = v;
 1468 }
 1469 
 1470 static val ffi_char_rget(struct txr_ffi_type *tft, mem_t *src, val self)
 1471 {
 1472   return chr((char) *coerce(ffi_arg *, src));
 1473 }
 1474 
 1475 static void ffi_uchar_rput(struct txr_ffi_type *tft, val n, mem_t *dst,
 1476                           val self)
 1477 {
 1478   unsigned char v = c_uchar(n, self);
 1479   *coerce(ffi_arg *, dst) = v;
 1480 }
 1481 
 1482 static val ffi_uchar_rget(struct txr_ffi_type *tft, mem_t *src, val self)
 1483 {
 1484   return num_fast((unsigned char) *coerce(ffi_arg *, src));
 1485 }
 1486 
 1487 static val ffi_bchar_rget(struct txr_ffi_type *tft, mem_t *src, val self)
 1488 {
 1489   return chr((unsigned char) *coerce(ffi_arg *, src));
 1490 }
 1491 
 1492 static void ffi_short_rput(struct txr_ffi_type *tft, val n, mem_t *dst,
 1493                           val self)
 1494 {
 1495   short v = c_short(n, self);
 1496   *coerce(ffi_arg *, dst) = v;
 1497 }
 1498 
 1499 static val ffi_short_rget(struct txr_ffi_type *tft, mem_t *src, val self)
 1500 {
 1501   short n = *coerce(ffi_arg *, src);
 1502   return num_fast(n);
 1503 }
 1504 
 1505 static void ffi_ushort_rput(struct txr_ffi_type *tft, val n, mem_t *dst,
 1506                            val self)
 1507 {
 1508   unsigned short v = c_ushort(n, self);
 1509   *coerce(ffi_arg *, dst) = v;
 1510 }
 1511 
 1512 static val ffi_ushort_rget(struct txr_ffi_type *tft, mem_t *src, val self)
 1513 {
 1514   unsigned short n = *coerce(ffi_arg *, src);
 1515   return num_fast(n);
 1516 }
 1517 
 1518 static void ffi_int_rput(struct txr_ffi_type *tft, val n, mem_t *dst, val self)
 1519 {
 1520   int v = c_int(n, self);
 1521   *coerce(ffi_arg *, dst) = v;
 1522 }
 1523 
 1524 static val ffi_int_rget(struct txr_ffi_type *tft, mem_t *src, val self)
 1525 {
 1526   int n = *coerce(ffi_arg *, src);
 1527   return num(n);
 1528 }
 1529 
 1530 static void ffi_uint_rput(struct txr_ffi_type *tft, val n, mem_t *dst, val self)
 1531 {
 1532   unsigned v = c_uint(n, self);
 1533   *coerce(ffi_arg *, dst) = v;
 1534 }
 1535 
 1536 static val ffi_uint_rget(struct txr_ffi_type *tft, mem_t *src, val self)
 1537 {
 1538   unsigned n = *coerce(ffi_arg *, src);
 1539   return unum(n);
 1540 }
 1541 
 1542 static void ffi_long_rput(struct txr_ffi_type *tft, val n, mem_t *dst, val self)
 1543 {
 1544   long v = c_long(n, self);
 1545   *coerce(ffi_arg *, dst) = v;
 1546 }
 1547 
 1548 static val ffi_long_rget(struct txr_ffi_type *tft, mem_t *src, val self)
 1549 {
 1550   long n = *coerce(ffi_arg *, src);
 1551   return num(n);
 1552 }
 1553 
 1554 static void ffi_ulong_rput(struct txr_ffi_type *tft, val n, mem_t *dst, val self)
 1555 {
 1556   unsigned long v = c_ulong(n, self);
 1557   *coerce(ffi_arg *, dst) = v;
 1558 }
 1559 
 1560 static val ffi_ulong_rget(struct txr_ffi_type *tft, mem_t *src, val self)
 1561 {
 1562   unsigned long n = *coerce(ffi_arg *, src);
 1563   return unum(n);
 1564 }
 1565 
 1566 static void ffi_wchar_rput(struct txr_ffi_type *tft, val ch, mem_t *dst,
 1567                            val self)
 1568 {
 1569   wchar_t c = c_chr(ch);
 1570   *coerce(ffi_arg *, dst) = c;
 1571 }
 1572 
 1573 static val ffi_wchar_rget(struct txr_ffi_type *tft, mem_t *src, val self)
 1574 {
 1575   wchar_t c = *coerce(ffi_arg *, src);
 1576   return chr(c);
 1577 }
 1578 
 1579 static void ffi_be_i16_rput(struct txr_ffi_type *tft, val n, mem_t *dst,
 1580                             val self)
 1581 {
 1582   memset(dst, 0, 6);
 1583   ffi_be_i16_put(tft, n, dst + 6, self);
 1584 }
 1585 
 1586 static val ffi_be_i16_rget(struct txr_ffi_type *tft, mem_t *src, val self)
 1587 {
 1588   return ffi_be_i16_get(tft, src + 6, self);
 1589 }
 1590 
 1591 static void ffi_be_u16_rput(struct txr_ffi_type *tft, val n, mem_t *dst,
 1592                             val self)
 1593 {
 1594   memset(dst, 0, 6);
 1595   ffi_be_u16_put(tft, n, dst + 6, self);
 1596 }
 1597 
 1598 static val ffi_be_u16_rget(struct txr_ffi_type *tft, mem_t *src, val self)
 1599 {
 1600   return ffi_be_u16_get(tft, src + 6, self);
 1601 }
 1602 
 1603 static void ffi_be_i32_rput(struct txr_ffi_type *tft, val n, mem_t *dst,
 1604                             val self)
 1605 {
 1606   memset(dst, 0, 4);
 1607   ffi_be_i32_put(tft, n, dst + 4, self);
 1608 }
 1609 
 1610 static val ffi_be_i32_rget(struct txr_ffi_type *tft, mem_t *src, val self)
 1611 {
 1612   return ffi_be_i32_get(tft, src + 4, self);
 1613 }
 1614 
 1615 static void ffi_be_u32_rput(struct txr_ffi_type *tft, val n, mem_t *dst,
 1616                             val self)
 1617 {
 1618   memset(dst, 0, 4);
 1619   ffi_be_u32_put(tft, n, dst + 4, self);
 1620 }
 1621 
 1622 static val ffi_be_u32_rget(struct txr_ffi_type *tft, mem_t *src, val self)
 1623 {
 1624   return ffi_be_u32_get(tft, src + 4, self);
 1625 }
 1626 
 1627 static void ffi_le_i16_rput(struct txr_ffi_type *tft, val n, mem_t *dst,
 1628                             val self)
 1629 {
 1630   memset(dst, 0, 6);
 1631   ffi_le_i16_put(tft, n, dst + 6, self);
 1632 }
 1633 
 1634 static val ffi_le_i16_rget(struct txr_ffi_type *tft, mem_t *src, val self)
 1635 {
 1636   return ffi_le_i16_get(tft, src + 6, self);
 1637 }
 1638 
 1639 static void ffi_le_u16_rput(struct txr_ffi_type *tft, val n, mem_t *dst,
 1640                             val self)
 1641 {
 1642   memset(dst, 0, 6);
 1643   ffi_le_u16_put(tft, n, dst + 6, self);
 1644 }
 1645 
 1646 static val ffi_le_u16_rget(struct txr_ffi_type *tft, mem_t *src, val self)
 1647 {
 1648   return ffi_le_u16_get(tft, src + 6, self);
 1649 }
 1650 
 1651 static void ffi_le_i32_rput(struct txr_ffi_type *tft, val n, mem_t *dst,
 1652                             val self)
 1653 {
 1654   memset(dst, 0, 4);
 1655   ffi_le_i32_put(tft, n, dst + 4, self);
 1656 }
 1657 
 1658 static val ffi_le_i32_rget(struct txr_ffi_type *tft, mem_t *src, val self)
 1659 {
 1660   return ffi_le_i32_get(tft, src + 4, self);
 1661 }
 1662 
 1663 static void ffi_le_u32_rput(struct txr_ffi_type *tft, val n, mem_t *dst,
 1664                             val self)
 1665 {
 1666   memset(dst, 0, 4);
 1667   ffi_le_u32_put(tft, n, dst + 4, self);
 1668 }
 1669 
 1670 static val ffi_le_u32_rget(struct txr_ffi_type *tft, mem_t *src, val self)
 1671 {
 1672   return ffi_le_u32_get(tft, src + 4, self);
 1673 }
 1674 
 1675 static void ffi_bool_rput(struct txr_ffi_type *tft, val truth,
 1676                           mem_t *dst, val self)
 1677 {
 1678   val n = truth ? one : zero;
 1679   struct txr_ffi_type *tgtft = ffi_type_struct(tft->eltype);
 1680   tgtft->rput(tft, n, dst, self); /* tft deliberate */
 1681 }
 1682 
 1683 static val ffi_bool_rget(struct txr_ffi_type *tft, mem_t *src, val self)
 1684 {
 1685   struct txr_ffi_type *tgtft = ffi_type_struct(tft->eltype);
 1686   val n = tgtft->rget(tft, src, self); /* tft deliberate */
 1687   return null(zerop(n));
 1688 }
 1689 
 1690 #endif
 1691 
 1692 static void ffi_cptr_put(struct txr_ffi_type *tft, val n, mem_t *dst,
 1693                          val self)
 1694 {
 1695   mem_t *p = cptr_handle(n, tft->tag, self);
 1696   *coerce(mem_t **, dst) = p;
 1697 }
 1698 
 1699 static val ffi_cptr_get(struct txr_ffi_type *tft, mem_t *src, val self)
 1700 {
 1701   mem_t *p = *coerce(mem_t **, src);
 1702   return cptr_typed(p, tft->tag, 0);
 1703 }
 1704 
 1705 static mem_t *ffi_cptr_alloc(struct txr_ffi_type *tft, val ptr, val self)
 1706 {
 1707   return coerce(mem_t *, cptr_addr_of(ptr, tft->tag, self));
 1708 }
 1709 
 1710 static val ffi_str_in(struct txr_ffi_type *tft, int copy,
 1711                       mem_t *src, val obj, val self)
 1712 {
 1713   char **loc = coerce(char **, src);
 1714   if (copy)
 1715     obj = if2(*loc, string_utf8(*loc));
 1716   free(*loc);
 1717   *loc = 0;
 1718   return obj;
 1719 }
 1720 
 1721 static void ffi_str_put(struct txr_ffi_type *tft, val s, mem_t *dst,
 1722                         val self)
 1723 {
 1724   if (s == nil) {
 1725     *coerce(const char **, dst) = 0;
 1726   } else {
 1727     const wchar_t *ws = c_str(s);
 1728     char *u8s = utf8_dup_to(ws);
 1729     *coerce(const char **, dst) = u8s;
 1730   }
 1731 }
 1732 
 1733 static val ffi_str_get(struct txr_ffi_type *tft, mem_t *src, val self)
 1734 {
 1735   const char *p = *coerce(const char **, src);
 1736   return p ? string_utf8(p) : nil;
 1737 }
 1738 
 1739 static val ffi_str_d_get(struct txr_ffi_type *tft, mem_t *src, val self)
 1740 {
 1741   char **loc = coerce(char **, src);
 1742   val ret = *loc ? string_utf8(*loc) : nil;
 1743   free(*loc);
 1744   *loc = 0;
 1745   return ret;
 1746 }
 1747 
 1748 static val ffi_wstr_in(struct txr_ffi_type *tft, int copy,
 1749                        mem_t *src, val obj, val self)
 1750 {
 1751   wchar_t **loc = coerce(wchar_t **, src);
 1752   if (copy)
 1753     obj = if2(*loc, string(*loc));
 1754   free(*loc);
 1755   *loc = 0;
 1756   return obj;
 1757 }
 1758 
 1759 static val ffi_wstr_get(struct txr_ffi_type *tft, mem_t *src, val self)
 1760 {
 1761   const wchar_t *p = *coerce(wchar_t **, src);
 1762   return p ? string(p) : 0;
 1763 }
 1764 
 1765 static void ffi_wstr_put(struct txr_ffi_type *tft, val s, mem_t *dst,
 1766                            val self)
 1767 {
 1768   if (s == nil) {
 1769     *coerce(const wchar_t **, dst) = 0;
 1770   } else {
 1771     const wchar_t *ws = c_str(s);
 1772     *coerce(const wchar_t **, dst) = chk_strdup(ws);
 1773   }
 1774 }
 1775 
 1776 static val ffi_wstr_d_get(struct txr_ffi_type *tft, mem_t *src, val self)
 1777 {
 1778   wchar_t **loc = coerce(wchar_t **, src);
 1779   val ret = *loc ? string_own(*loc) : nil;
 1780   *loc = 0;
 1781   return ret;
 1782 }
 1783 
 1784 static val ffi_bstr_in(struct txr_ffi_type *tft, int copy,
 1785                        mem_t *src, val obj, val self)
 1786 {
 1787   unsigned char **loc = coerce(unsigned char **, src);
 1788   if (copy)
 1789     obj = if2(*loc, string_8bit(*loc));
 1790   free(*loc);
 1791   *loc = 0;
 1792   return obj;
 1793 }
 1794 
 1795 static void ffi_bstr_put(struct txr_ffi_type *tft, val s, mem_t *dst,
 1796                          val self)
 1797 {
 1798   if (s == nil) {
 1799     *coerce(unsigned char **, dst) = 0;
 1800   } else {
 1801     const wchar_t *ws = c_str(s);
 1802     unsigned char *u8s = chk_strdup_8bit(ws);
 1803     *coerce(unsigned char **, dst) = u8s;
 1804   }
 1805 }
 1806 
 1807 static val ffi_bstr_get(struct txr_ffi_type *tft, mem_t *src, val self)
 1808 {
 1809   unsigned char *p = *coerce(unsigned char **, src);
 1810   return p ? string_8bit(p) : nil;
 1811 }
 1812 
 1813 static val ffi_bstr_d_get(struct txr_ffi_type *tft, mem_t *src, val self)
 1814 {
 1815   unsigned char **loc = coerce(unsigned char **, src);
 1816   val ret = *loc ? string_8bit(*loc) : nil;
 1817   free(*loc);
 1818   *loc = 0;
 1819   return ret;
 1820 }
 1821 
 1822 static val ffi_buf_in(struct txr_ffi_type *tft, int copy, mem_t *src,
 1823                       val obj, val self)
 1824 {
 1825   mem_t **loc = coerce(mem_t **, src);
 1826   mem_t *origptr = if3(obj, buf_get(obj, self), 0);
 1827 
 1828   if (copy && *loc != origptr)
 1829     obj = if2(*loc, make_duplicate_buf(length_buf(obj), *loc));
 1830 
 1831   return obj;
 1832 }
 1833 
 1834 static void ffi_buf_put(struct txr_ffi_type *tft, val buf, mem_t *dst,
 1835                         val self)
 1836 {
 1837   if (buf == nil) {
 1838     *coerce(const mem_t **, dst) = 0;
 1839   } else {
 1840     mem_t *b = buf_get(buf, self);
 1841     *coerce(const mem_t **, dst) = b;
 1842   }
 1843 }
 1844 
 1845 static val ffi_buf_get(struct txr_ffi_type *tft, mem_t *src, val self)
 1846 {
 1847   mem_t *p = *coerce(mem_t **, src);
 1848   return p ? make_duplicate_buf(num(tft->nelem), p) : nil;
 1849 }
 1850 
 1851 static val ffi_buf_d_in(struct txr_ffi_type *tft, int copy, mem_t *src,
 1852                         val obj, val self)
 1853 {
 1854   mem_t **loc = coerce(mem_t **, src);
 1855 
 1856   if (copy) {
 1857     obj = if2(*loc, make_borrowed_buf(num(tft->nelem), *loc));
 1858     *loc = 0;
 1859   }
 1860 
 1861   return obj;
 1862 }
 1863 
 1864 static void ffi_buf_d_put(struct txr_ffi_type *tft, val buf, mem_t *dst,
 1865                           val self)
 1866 {
 1867   if (buf == nil) {
 1868     *coerce(const mem_t **, dst) = 0;
 1869   } else {
 1870     mem_t *b = buf_get(buf, self);
 1871     *coerce(const mem_t **, dst) = chk_copy_obj(b, c_num(length(buf)));
 1872   }
 1873 }
 1874 
 1875 static val ffi_buf_d_get(struct txr_ffi_type *tft, mem_t *src, val self)
 1876 {
 1877   mem_t **loc = coerce(mem_t **, src);
 1878   val ret = *loc ? make_borrowed_buf(num(tft->nelem), *loc) : nil;
 1879   *loc = 0;
 1880   return ret;
 1881 }
 1882 
 1883 #if HAVE_LIBFFI
 1884 static void ffi_closure_put(struct txr_ffi_type *tft, val ptr, mem_t *dst,
 1885                             val self)
 1886 {
 1887   val type = typeof(ptr);
 1888   mem_t *p = 0;
 1889 
 1890   if (type == cptr_s) {
 1891     p = ptr->co.handle;
 1892   } else if (type == ffi_closure_s) {
 1893     struct txr_ffi_closure *tfcl = ffi_closure_struct(ptr);
 1894     p = tfcl->fptr;
 1895   } else {
 1896     uw_throwf(error_s, lit("~a: ~s cannot be used as function pointer"),
 1897               self, ptr, nao);
 1898   }
 1899 
 1900   memcpy(dst, &p, sizeof p);
 1901 }
 1902 #endif
 1903 
 1904 static val ffi_ptr_in_in(struct txr_ffi_type *tft, int copy, mem_t *src,
 1905                          val obj, val self)
 1906 {
 1907   val tgttype = tft->eltype;
 1908   struct txr_ffi_type *tgtft = ffi_type_struct(tgttype);
 1909   mem_t **loc = coerce(mem_t **, src);
 1910   if (!*loc)
 1911     return nil;
 1912   if (tgtft->in != 0 && tgtft->by_value_in)
 1913     tgtft->in(tgtft, 0, *loc, obj, self);
 1914   tgtft->free(*loc);
 1915   *loc = 0;
 1916   return obj;
 1917 }
 1918 
 1919 static val ffi_ptr_in_d_in(struct txr_ffi_type *tft, int copy, mem_t *src,
 1920                            val obj, val self)
 1921 {
 1922   val tgttype = tft->eltype;
 1923   struct txr_ffi_type *tgtft = ffi_type_struct(tgttype);
 1924   mem_t **loc = coerce(mem_t **, src);
 1925   if (!*loc)
 1926     return nil;
 1927   if (tgtft->in != 0 && tgtft->by_value_in)
 1928     tgtft->in(tgtft, 0, *loc, obj, self);
 1929   return obj;
 1930 }
 1931 
 1932 static void ffi_ptr_in_out(struct txr_ffi_type *tft, int copy, val s,
 1933                            mem_t *dst, val self)
 1934 {
 1935   val tgttype = tft->eltype;
 1936   struct txr_ffi_type *tgtft = ffi_type_struct(tgttype);
 1937   if (tgtft->out != 0) {
 1938     mem_t *buf = *coerce(mem_t **, dst);
 1939     tgtft->out(tgtft, 0, s, buf, self);
 1940   }
 1941 }
 1942 
 1943 static val ffi_ptr_out_in(struct txr_ffi_type *tft, int copy, mem_t *src,
 1944                           val obj, val self)
 1945 {
 1946   val tgttype = tft->eltype;
 1947   struct txr_ffi_type *tgtft = ffi_type_struct(tgttype);
 1948   mem_t **loc = coerce(mem_t **, src);
 1949   if (!*loc)
 1950     return nil;
 1951   if (tgtft->in != 0)
 1952     obj = tgtft->in(tgtft, 1, *loc, obj, self);
 1953   else
 1954     obj = tgtft->get(tgtft, *loc, self);
 1955   tgtft->free(*loc);
 1956   *loc = 0;
 1957   return obj;
 1958 }
 1959 
 1960 static void ffi_ptr_out_put(struct txr_ffi_type *tft, val s, mem_t *dst,
 1961                             val self)
 1962 {
 1963   val tgttype = tft->eltype;
 1964   struct txr_ffi_type *tgtft = ffi_type_struct(tgttype);
 1965   if (s == nil) {
 1966     *coerce(mem_t **, dst) =  0;
 1967   } else {
 1968     mem_t *buf = tgtft->alloc(tgtft, s, self);
 1969     *coerce(mem_t **, dst) = buf;
 1970   }
 1971 }
 1972 
 1973 static void ffi_ptr_out_out(struct txr_ffi_type *tft, int copy, val s,
 1974                             mem_t *dst, val self)
 1975 {
 1976   val tgttype = tft->eltype;
 1977   struct txr_ffi_type *tgtft = ffi_type_struct(tgttype);
 1978   mem_t *buf = *coerce(mem_t **, dst);
 1979   if (tgtft->out != 0)
 1980     tgtft->out(tgtft, 1, s, buf, self);
 1981   else
 1982     tgtft->put(tgtft, s, buf, self);
 1983 }
 1984 
 1985 static val ffi_ptr_get(struct txr_ffi_type *tft, mem_t *src, val self)
 1986 {
 1987   val tgttype = tft->eltype;
 1988   struct txr_ffi_type *tgtft = ffi_type_struct(tgttype);
 1989   mem_t *ptr = *coerce(mem_t **, src);
 1990   return ptr ? tgtft->get(tgtft, ptr, self) : nil;
 1991 }
 1992 
 1993 static val ffi_ptr_d_get(struct txr_ffi_type *tft, mem_t *src, val self)
 1994 {
 1995   val tgttype = tft->eltype;
 1996   struct txr_ffi_type *tgtft = ffi_type_struct(tgttype);
 1997   mem_t **loc = coerce(mem_t **, src);
 1998   val ret = *loc ? tgtft->get(tgtft, *loc, self) : nil;
 1999   free(*loc);
 2000   *loc = 0;
 2001   return ret;
 2002 }
 2003 
 2004 static void ffi_ptr_in_put(struct txr_ffi_type *tft, val s, mem_t *dst,
 2005                            val self)
 2006 {
 2007   val tgttype = tft->eltype;
 2008   struct txr_ffi_type *tgtft = ffi_type_struct(tgttype);
 2009   if (s == nil) {
 2010     *coerce(mem_t **, dst) = 0;
 2011   } else {
 2012     mem_t *buf = tgtft->alloc(tgtft, s, self);
 2013     tgtft->put(tgtft, s, buf, self);
 2014     *coerce(mem_t **, dst) = buf;
 2015   }
 2016 }
 2017 
 2018 static void ffi_ptr_out_null_put(struct txr_ffi_type *tft, val s, mem_t *dst,
 2019                                  val self)
 2020 {
 2021   *coerce(mem_t **, dst) =  0;
 2022 }
 2023 
 2024 static val ffi_ptr_out_s_in(struct txr_ffi_type *tft, int copy,
 2025                             mem_t *src, val obj, val self)
 2026 {
 2027   val tgttype = tft->eltype;
 2028   struct txr_ffi_type *tgtft = ffi_type_struct(tgttype);
 2029   mem_t **loc = coerce(mem_t **, src);
 2030   if (!*loc)
 2031     return nil;
 2032   if (tgtft->in != 0)
 2033     obj = tgtft->in(tgtft, 1, *loc, obj, self);
 2034   else
 2035     obj = tgtft->get(tgtft, *loc, self);
 2036   return obj;
 2037 }
 2038 
 2039 static void ffi_ptr_in_release(struct txr_ffi_type *tft, val obj, mem_t *dst)
 2040 {
 2041   struct txr_ffi_type *tgtft = ffi_type_struct(tft->eltype);
 2042   mem_t **loc = coerce(mem_t **, dst);
 2043 
 2044   if (tgtft->release != 0 && *loc != 0)
 2045     tgtft->release(tgtft, obj, *loc);
 2046   free(*loc);
 2047   *loc = 0;
 2048 }
 2049 
 2050 static val ffi_flex_struct_in(struct txr_ffi_type *tft, val strct, val self)
 2051 {
 2052   struct smemb *lastm = &tft->memb[tft->nelem - 1];
 2053   val length_meth = get_special_slot(strct, length_m);
 2054 
 2055   if (length_meth) {
 2056     val len = funcall1(length_meth, strct);
 2057     val memb = slot(strct, lastm->mname);
 2058     if (vectorp(memb))
 2059       return vec_set_length(memb, len);
 2060     else
 2061       return slotset(strct, lastm->mname, vector(len, nil));
 2062   }
 2063 
 2064   return slot(strct, lastm->mname);
 2065 }
 2066 
 2067 static val ffi_struct_in(struct txr_ffi_type *tft, int copy, mem_t *src,
 2068                          val strct, val self)
 2069 {
 2070   cnum i, nmemb = tft->nelem;
 2071   struct smemb *memb = tft->memb;
 2072   int flexp = tft->flexible;
 2073 
 2074   if (!copy && (!tft->by_value_in || strct == nil))
 2075     return strct;
 2076 
 2077   if (strct == nil) {
 2078     args_decl(args, 0);
 2079     strct = make_struct(tft->lt, nil, args);
 2080   }
 2081 
 2082   for (i = 0; i < nmemb; i++) {
 2083     val slsym = memb[i].mname;
 2084     struct txr_ffi_type *mtft = memb[i].mtft;
 2085     ucnum offs = memb[i].offs;
 2086     if (slsym) {
 2087       if (flexp && copy && i == nmemb - 1)
 2088         ffi_flex_struct_in(tft, strct, self);
 2089       if (mtft->in != 0) {
 2090         val slval = slot(strct, slsym);
 2091         slotset(strct, slsym, mtft->in(mtft, copy, src + offs, slval, self));
 2092       } else if (copy) {
 2093         val slval = mtft->get(mtft, src + offs, self);
 2094         slotset(strct, slsym, slval);
 2095       }
 2096     }
 2097   }
 2098 
 2099   return strct;
 2100 }
 2101 
 2102 static void ffi_struct_put(struct txr_ffi_type *tft, val strct, mem_t *dst,
 2103                            val self)
 2104 {
 2105   cnum i, nmemb = tft->nelem;
 2106   struct smemb *memb = tft->memb;
 2107 
 2108   for (i = 0; i < nmemb; i++) {
 2109     val slsym = memb[i].mname;
 2110     struct txr_ffi_type *mtft = memb[i].mtft;
 2111     ucnum offs = memb[i].offs;
 2112     if (slsym) {
 2113       val slval = slot(strct, slsym);
 2114       mtft->put(mtft, slval, dst + offs, self);
 2115     }
 2116   }
 2117 }
 2118 
 2119 static void ffi_struct_out(struct txr_ffi_type *tft, int copy, val strct,
 2120                            mem_t *dst, val self)
 2121 {
 2122   cnum i, nmemb = tft->nelem;
 2123   struct smemb *memb = tft->memb;
 2124 
 2125   for (i = 0; i < nmemb; i++) {
 2126     val slsym = memb[i].mname;
 2127     struct txr_ffi_type *mtft = memb[i].mtft;
 2128     ucnum offs = memb[i].offs;
 2129     if (slsym) {
 2130       if (mtft->out != 0) {
 2131         val slval = slot(strct, slsym);
 2132         mtft->out(mtft, copy, slval, dst + offs, self);
 2133       } else if (copy) {
 2134         val slval = slot(strct, slsym);
 2135         mtft->put(mtft, slval, dst + offs, self);
 2136       }
 2137     }
 2138   }
 2139 }
 2140 
 2141 static val ffi_struct_get(struct txr_ffi_type *tft, mem_t *src, val self)
 2142 {
 2143   cnum i, nmemb = tft->nelem;
 2144   struct smemb *memb = tft->memb;
 2145   args_decl(args, 0);
 2146   val strct = make_struct(tft->lt, nil, args);
 2147   int flexp = tft->flexible;
 2148 
 2149   for (i = 0; i < nmemb; i++) {
 2150     val slsym = memb[i].mname;
 2151     struct txr_ffi_type *mtft = memb[i].mtft;
 2152     ucnum offs = memb[i].offs;
 2153     if (slsym) {
 2154       if (flexp && i == nmemb - 1) {
 2155         val slval = ffi_flex_struct_in(tft, strct, self);
 2156         if (mtft->in != 0)
 2157           slotset(strct, slsym, mtft->in(mtft, 1, src + offs, slval, self));
 2158       } else {
 2159         val slval = mtft->get(mtft, src + offs, self);
 2160         slotset(strct, slsym, slval);
 2161       }
 2162     }
 2163   }
 2164 
 2165   return strct;
 2166 }
 2167 
 2168 static void ffi_struct_release(struct txr_ffi_type *tft, val strct, mem_t *dst)
 2169 {
 2170   cnum i, nmemb = tft->nelem;
 2171   struct smemb *memb = tft->memb;
 2172 
 2173   if (strct == nil)
 2174     return;
 2175 
 2176   for (i = 0; i < nmemb; i++) {
 2177     val slsym = memb[i].mname;
 2178     struct txr_ffi_type *mtft = memb[i].mtft;
 2179     ucnum offs = memb[i].offs;
 2180     if (slsym) {
 2181       if (mtft->release != 0) {
 2182         val slval = slot(strct, slsym);
 2183         mtft->release(mtft, slval, dst + offs);
 2184       }
 2185     }
 2186   }
 2187 }
 2188 
 2189 static val ffi_char_array_get(struct txr_ffi_type *tft, mem_t *src,
 2190                               cnum nelem)
 2191 {
 2192   if (nelem == 0) {
 2193     return null_string;
 2194   } else {
 2195     const char *chptr = coerce(const char *, src);
 2196     if (tft->null_term) {
 2197       return string_utf8(chptr);
 2198     } else {
 2199       wchar_t *wch = utf8_dup_from_buf(chptr, nelem);
 2200       return string_own(wch);
 2201     }
 2202   }
 2203 }
 2204 
 2205 static void ffi_char_array_put(struct txr_ffi_type *tft, val str, mem_t *dst,
 2206                                cnum nelem)
 2207 {
 2208   int nt = tft->null_term;
 2209   const wchar_t *wstr = c_str(str);
 2210   cnum needed = utf8_to_buf(0, wstr, nt);
 2211 
 2212   if (needed <= nelem) {
 2213     utf8_to_buf(dst, wstr, nt);
 2214     memset(dst + needed, 0, nelem - needed);
 2215   } else {
 2216     char *u8str = utf8_dup_to(wstr);
 2217     memcpy(dst, u8str, nelem);
 2218     free(u8str);
 2219   }
 2220 
 2221   if (nt)
 2222     dst[nelem - 1] = 0;
 2223 }
 2224 
 2225 static val ffi_wchar_array_get(struct txr_ffi_type *tft, mem_t *src,
 2226                                cnum nelem)
 2227 {
 2228   if (nelem == 0) {
 2229     return null_string;
 2230   } else {
 2231     const wchar_t *wchptr = coerce(const wchar_t *, src);
 2232 
 2233     if (tft->null_term) {
 2234       return string(wchptr);
 2235     } else {
 2236       val ustr = mkustring(num_fast(nelem));
 2237       return init_str(ustr, wchptr);
 2238     }
 2239   }
 2240 }
 2241 
 2242 static void ffi_wchar_array_put(struct txr_ffi_type *tft, val str, mem_t *dst,
 2243                                 cnum nelem)
 2244 {
 2245   const wchar_t *wstr = c_str(str);
 2246   wcsncpy(coerce(wchar_t *, dst), wstr, nelem);
 2247   if (tft->null_term)
 2248     dst[nelem - 1] = 0;
 2249 }
 2250 
 2251 static val ffi_bchar_array_get(struct txr_ffi_type *tft, mem_t *src,
 2252                                cnum nelem)
 2253 {
 2254   if (nelem == 0) {
 2255     return null_string;
 2256   } else {
 2257     const unsigned char *chptr = coerce(const unsigned char *, src);
 2258     if (tft->null_term)
 2259       return string_8bit(chptr);
 2260     else
 2261       return string_8bit_size(chptr, nelem);
 2262   }
 2263 }
 2264 
 2265 static void ffi_bchar_array_put(struct txr_ffi_type *tft, val str, mem_t *dst,
 2266                                 cnum nelem, val self)
 2267 {
 2268   const wchar_t *wstr = c_str(str);
 2269   cnum i;
 2270 
 2271   for (i = 0; i < nelem && wstr[i]; i++) {
 2272     wchar_t wch = wstr[i];
 2273     if (wch < 0 || wch > 255)
 2274       uw_throwf(error_s, lit("~a: character ~s out of unsigned 8 bit range"),
 2275                 self, chr(wch), nao);
 2276     dst[i] = wch;
 2277   }
 2278 
 2279   if (i < nelem) {
 2280     for (; i < nelem; i++)
 2281       dst[i] = 0;
 2282   } else if (tft->null_term) {
 2283     dst[nelem - 1] = 0;
 2284   }
 2285 }
 2286 
 2287 static val ffi_array_in_common(struct txr_ffi_type *tft, int copy,
 2288                                mem_t *src, val vec, val self, cnum nelem)
 2289 {
 2290   val eltype = tft->eltype;
 2291   ucnum offs = 0;
 2292   struct txr_ffi_type *etft = ffi_type_struct(eltype);
 2293   cnum elsize = etft->size, i;
 2294   cnum znelem = if3(tft->null_term && nelem > 0 &&
 2295                     vec && length(vec) < num_fast(nelem), nelem - 1, nelem);
 2296 
 2297   if (!copy && (!tft->by_value_in || vec == nil))
 2298     return vec;
 2299 
 2300   if (vec == nil)
 2301     vec = vector(num_fast(znelem), nil);
 2302 
 2303   for (i = 0; i < znelem; i++) {
 2304     if (etft->in != 0) {
 2305       val elval = ref(vec, num_fast(i));
 2306       refset(vec, num_fast(i), etft->in(etft, copy, src + offs, elval, self));
 2307     } else if (copy) {
 2308       val elval = etft->get(etft, src + offs, self);
 2309       refset(vec, num_fast(i), elval);
 2310     }
 2311     offs += elsize;
 2312   }
 2313 
 2314   return vec;
 2315 }
 2316 
 2317 static val ffi_array_in(struct txr_ffi_type *tft, int copy, mem_t *src,
 2318                         val vec, val self)
 2319 {
 2320   if (copy) {
 2321     if (tft->char_conv) {
 2322       val str = ffi_char_array_get(tft, src, tft->nelem);
 2323       return if3(vec, replace(vec, str, zero, t), str);
 2324     } else if (tft->wchar_conv) {
 2325       val str = ffi_wchar_array_get(tft, src, tft->nelem);
 2326       return if3(vec, replace(vec, str, zero, t), str);
 2327     } else if (tft->bchar_conv) {
 2328       val str = ffi_bchar_array_get(tft, src, tft->nelem);
 2329       return if3(vec, replace(vec, str, zero, t), str);
 2330     }
 2331   }
 2332   return ffi_array_in_common(tft, copy, src, vec, self, tft->nelem);
 2333 }
 2334 
 2335 static void ffi_array_put_common(struct txr_ffi_type *tft, val vec, mem_t *dst,
 2336                                  val self, cnum nelem)
 2337 {
 2338   val eltype = tft->eltype;
 2339   struct txr_ffi_type *etft = ffi_type_struct(eltype);
 2340   cnum elsize = etft->size;
 2341   int nt = tft->null_term;
 2342   cnum i = 0;
 2343   ucnum offs = 0;
 2344   seq_info_t si = seq_info(vec);
 2345 
 2346   switch (si.kind) {
 2347   case SEQ_NIL:
 2348   case SEQ_LISTLIKE:
 2349     {
 2350       val iter = si.obj;
 2351 
 2352       for (; i < nelem - nt && !endp(iter); i++, iter = cdr(iter)) {
 2353         val elval = car(iter);
 2354         etft->put(etft, elval, dst + offs, self);
 2355         offs += elsize;
 2356       }
 2357     }
 2358     break;
 2359   case SEQ_VECLIKE:
 2360     {
 2361       val v = si.obj;
 2362       cnum lim = min(nelem - nt, c_num(length(si.obj)));
 2363 
 2364       for (; i < lim; i++) {
 2365         val elval = ref(v, num_fast(i));
 2366         etft->put(etft, elval, dst + offs, self);
 2367         offs += elsize;
 2368       }
 2369     }
 2370     break;
 2371   default:
 2372     uw_throwf(error_s, lit("~a: ~s isn't convertible to a C array"), self,
 2373               vec, nao);
 2374   }
 2375 
 2376   if (i < nelem)
 2377     memset(dst + offs, 0, elsize * (nelem - i));
 2378 }
 2379 
 2380 static void ffi_array_put(struct txr_ffi_type *tft, val vec, mem_t *dst,
 2381                           val self)
 2382 {
 2383   if (tft->char_conv && stringp(vec))
 2384     ffi_char_array_put(tft, vec, dst, tft->nelem);
 2385   else if (tft->wchar_conv && stringp(vec))
 2386     ffi_wchar_array_put(tft, vec, dst, tft->nelem);
 2387   else if (tft->bchar_conv && stringp(vec))
 2388     ffi_bchar_array_put(tft, vec, dst, tft->nelem, self);
 2389   else
 2390     ffi_array_put_common(tft, vec, dst, self, tft->nelem);
 2391 }
 2392 
 2393 static void ffi_array_out_common(struct txr_ffi_type *tft, int copy, val vec,
 2394                                  mem_t *dst, val self, cnum nelem)
 2395 {
 2396   val eltype = tft->eltype;
 2397   struct txr_ffi_type *etft = ffi_type_struct(eltype);
 2398   cnum elsize = etft->size;
 2399   int nt = tft->null_term;
 2400   cnum i;
 2401   ucnum offs = 0;
 2402 
 2403   for (i = 0; i < nelem; i++) {
 2404     if (nt && i == nelem - 1) {
 2405       memset(dst + offs, 0, elsize);
 2406       break;
 2407     }
 2408     if (etft->out != 0) {
 2409       val elval = ref(vec, num_fast(i));
 2410       etft->out(etft, copy, elval, dst + offs, self);
 2411     } else if (copy) {
 2412       val elval = ref(vec, num_fast(i));
 2413       etft->put(etft, elval, dst + offs, self);
 2414     }
 2415     offs += elsize;
 2416   }
 2417 }
 2418 
 2419 static void ffi_array_out(struct txr_ffi_type *tft, int copy, val vec,
 2420                           mem_t *dst, val self)
 2421 {
 2422   if (tft->char_conv && stringp(vec))
 2423     ffi_char_array_put(tft, vec, dst, tft->nelem);
 2424   else if (tft->wchar_conv && stringp(vec))
 2425     ffi_wchar_array_put(tft, vec, dst, tft->nelem);
 2426   else if (tft->bchar_conv && stringp(vec))
 2427     ffi_bchar_array_put(tft, vec, dst, tft->nelem, self);
 2428   else
 2429     ffi_array_out_common(tft, copy, vec, dst, self, tft->nelem);
 2430 }
 2431 
 2432 static val ffi_array_get_common(struct txr_ffi_type *tft, mem_t *src, val self,
 2433                                 cnum nelem)
 2434 {
 2435   val eltype = tft->eltype;
 2436 
 2437   if (tft->char_conv) {
 2438     return ffi_char_array_get(tft, src, nelem);
 2439   } else if (tft->wchar_conv) {
 2440     return ffi_wchar_array_get(tft, src, nelem);
 2441   } else if (tft->bchar_conv) {
 2442     return ffi_bchar_array_get(tft, src, nelem);
 2443   } else {
 2444     cnum znelem = if3(tft->null_term && nelem > 0, nelem - 1, nelem);
 2445     val vec = vector(num_fast(znelem), nil);
 2446     struct txr_ffi_type *etft = ffi_type_struct(eltype);
 2447     cnum elsize = etft->size;
 2448     cnum offs, i;
 2449 
 2450     for (i = 0, offs = 0; i < znelem; i++) {
 2451       val elval = etft->get(etft, src + offs, self);
 2452       refset(vec, num_fast(i), elval);
 2453       offs += elsize;
 2454     }
 2455 
 2456     return vec;
 2457   }
 2458 }
 2459 
 2460 static val ffi_array_get(struct txr_ffi_type *tft, mem_t *src, val self)
 2461 {
 2462   cnum nelem = tft->nelem;
 2463   return ffi_array_get_common(tft, src, self, nelem);
 2464 }
 2465 
 2466 static void ffi_array_release_common(struct txr_ffi_type *tft, val vec,
 2467                                      mem_t *dst, cnum nelem)
 2468 {
 2469   val eltype = tft->eltype;
 2470   ucnum offs = 0;
 2471   struct txr_ffi_type *etft = ffi_type_struct(eltype);
 2472   cnum elsize = etft->size, i;
 2473   cnum znelem = if3(tft->null_term && nelem > 0 &&
 2474                     vec && length(vec) < num_fast(nelem), nelem - 1, nelem);
 2475 
 2476   if (vec == nil)
 2477     return;
 2478 
 2479   if (tft->char_conv || tft->bchar_conv || tft->wchar_conv)
 2480     return;
 2481 
 2482   for (i = 0; i < znelem; i++) {
 2483     if (etft->release != 0) {
 2484       val elval = ref(vec, num_fast(i));
 2485       etft->release(etft, elval, dst + offs);
 2486     }
 2487     offs += elsize;
 2488   }
 2489 }
 2490 
 2491 static void ffi_array_release(struct txr_ffi_type *tft, val vec, mem_t *dst)
 2492 {
 2493   ffi_array_release_common(tft, vec, dst, tft->nelem);
 2494 }
 2495 
 2496 static void ffi_varray_put(struct txr_ffi_type *tft, val vec, mem_t *dst,
 2497                            val self)
 2498 {
 2499   cnum nelem = c_num(length(vec)) + tft->null_term;
 2500   ffi_array_put_common(tft, vec, dst, self, nelem);
 2501 }
 2502 
 2503 static val ffi_varray_in(struct txr_ffi_type *tft, int copy, mem_t *src,
 2504                          val vec, val self)
 2505 {
 2506   if (copy && vec) {
 2507     cnum nelem = c_num(length(vec)) + tft->null_term;
 2508     return ffi_array_in_common(tft, copy, src, vec, self, nelem);
 2509   }
 2510   return vec;
 2511 }
 2512 
 2513 static val ffi_varray_null_term_in(struct txr_ffi_type *tft, int copy, mem_t *src,
 2514                                    val vec_in, val self)
 2515 {
 2516   val vec = vector(zero, nil);
 2517   val eltype = tft->eltype;
 2518   struct txr_ffi_type *etft = ffi_type_struct(eltype);
 2519   cnum elsize = etft->size;
 2520   cnum offs, i;
 2521   cnum nelem_orig = c_num(length(vec_in));
 2522 
 2523   for (i = 0, offs = 0; ; i++) {
 2524     mem_t *el = src + offs, *p;
 2525 
 2526     for (p = el; p < el + elsize; p++)
 2527       if (*p)
 2528         break;
 2529 
 2530     if (p == el + elsize)
 2531       break;
 2532 
 2533     if (etft->in != 0 && i < nelem_orig) {
 2534       val elval = ref(vec_in, num_fast(i));
 2535       vec_push(vec, etft->in(etft, copy, src + offs, elval, self));
 2536     } else if (copy) {
 2537       val elval = etft->get(etft, src + offs, self);
 2538       vec_push(vec, elval);
 2539     }
 2540 
 2541     offs += elsize;
 2542   }
 2543 
 2544   return if3(vec_in, replace(vec_in, vec, zero, t), vec);
 2545 }
 2546 
 2547 static val ffi_varray_null_term_get(struct txr_ffi_type *tft, mem_t *src,
 2548                                     val self)
 2549 {
 2550   val eltype = tft->eltype;
 2551 
 2552   if (tft->char_conv || tft->wchar_conv || tft->bchar_conv) {
 2553     return ffi_array_get_common(tft, src, self, INT_PTR_MAX);
 2554   } else {
 2555     val vec = vector(zero, nil);
 2556     struct txr_ffi_type *etft = ffi_type_struct(eltype);
 2557     cnum elsize = etft->size;
 2558     cnum offs, i;
 2559 
 2560     for (i = 0, offs = 0; ; i++) {
 2561       mem_t *el = src + offs, *p;
 2562 
 2563       for (p = el; p < el + elsize; p++)
 2564         if (*p)
 2565           break;
 2566 
 2567       if (p == el + elsize)
 2568         break;
 2569 
 2570       {
 2571         val elval = etft->get(etft, src + offs, self);
 2572         vec_push(vec, elval);
 2573         offs += elsize;
 2574       }
 2575     }
 2576 
 2577     return vec;
 2578   }
 2579 }
 2580 
 2581 static void ffi_varray_release(struct txr_ffi_type *tft, val vec, mem_t *dst)
 2582 {
 2583   cnum nelem = c_num(length(vec)) + tft->null_term;
 2584   ffi_array_release_common(tft, vec, dst, nelem);
 2585 }
 2586 
 2587 static val ffi_carray_get(struct txr_ffi_type *tft, mem_t *src, val self)
 2588 {
 2589   mem_t *p = *coerce(mem_t **, src);
 2590   return make_carray(tft->eltype, p, -1, nil, 0);
 2591 }
 2592 
 2593 static void ffi_carray_put(struct txr_ffi_type *tft, val carray, mem_t *dst,
 2594                            val self)
 2595 {
 2596   mem_t *p = carray_ptr(carray, tft->eltype, self);
 2597   *coerce(mem_t **, dst) = p;
 2598 }
 2599 
 2600 static void ffi_enum_put(struct txr_ffi_type *tft, val n, mem_t *dst, val self)
 2601 {
 2602   struct txr_ffi_type *etft = ffi_type_struct(tft->eltype);
 2603 
 2604   if (symbolp(n)) {
 2605     val n_num = gethash(tft->num_sym, n);
 2606     if (!n_num)
 2607       uw_throwf(error_s, lit("~a: ~s has no member ~s"), self,
 2608                 tft->syntax, n, nao);
 2609     n = n_num;
 2610   }
 2611   etft->put(tft, n, dst, self); /* tft deliberate */
 2612 }
 2613 
 2614 static val ffi_enum_get(struct txr_ffi_type *tft, mem_t *src, val self)
 2615 {
 2616   struct txr_ffi_type *etft = ffi_type_struct(tft->eltype);
 2617   val n = etft->get(tft, src, self); /* tft deliberate */
 2618   val sym = gethash(tft->sym_num, n);
 2619   return if3(sym, sym, n);
 2620 }
 2621 
 2622 #if !HAVE_LITTLE_ENDIAN
 2623 
 2624 static void ffi_enum_rput(struct txr_ffi_type *tft, val n, mem_t *dst, val self)
 2625 {
 2626   struct txr_ffi_type *etft = ffi_type_struct(tft->eltype);
 2627 
 2628   if (symbolp(n)) {
 2629     val n_num = gethash(tft->num_sym, n);
 2630     if (!n_num)
 2631       uw_throwf(error_s, lit("~a: ~s has no member ~s"), self,
 2632                 tft->syntax, n, nao);
 2633     n = n_num;
 2634   }
 2635   etft->rput(tft, n, dst, self); /* tft deliberate */
 2636 }
 2637 
 2638 static val ffi_enum_rget(struct txr_ffi_type *tft, mem_t *src, val self)
 2639 {
 2640   struct txr_ffi_type *etft = ffi_type_struct(tft->eltype);
 2641   val n = etft->rget(tft, src, self); /* tft deliberate */
 2642   val sym = gethash(tft->sym_num, n);
 2643   return if3(sym, sym, n);
 2644 }
 2645 
 2646 #endif
 2647 
 2648 static struct txr_ffi_type *ffi_find_memb(struct txr_ffi_type *tft, val name)
 2649 {
 2650   cnum i;
 2651   for (i = 0; i < tft->nelem; i++) {
 2652     if (tft->memb[i].mname == name)
 2653       return tft->memb[i].mtft;
 2654   }
 2655 
 2656   return 0;
 2657 }
 2658 
 2659 static void ffi_memb_not_found(val type, val name, val self)
 2660 {
 2661   uw_throwf(error_s, lit("~a: ~s doesn't name a member of ~s"),
 2662             type, name, self, nao);
 2663 }
 2664 
 2665 static val make_union_tft(mem_t *buf, struct txr_ffi_type *tft);
 2666 
 2667 static val ffi_union_in(struct txr_ffi_type *tft, int copy, mem_t *src,
 2668                         val uni, val self)
 2669 {
 2670   if (copy) {
 2671     if (uni == nil) {
 2672       uni = make_union_tft(src, tft);
 2673     } else {
 2674       mem_t *ptr = union_get_ptr(self, uni);
 2675       memcpy(ptr, src, tft->size);
 2676     }
 2677   }
 2678 
 2679   return uni;
 2680 }
 2681 
 2682 static void ffi_union_put(struct txr_ffi_type *tft, val uni,
 2683                           mem_t *dst, val self)
 2684 {
 2685   mem_t *ptr = union_get_ptr(self, uni);
 2686   memcpy(dst, ptr, tft->size);
 2687 }
 2688 
 2689 static val ffi_union_get(struct txr_ffi_type *tft, mem_t *src, val self)
 2690 {
 2691   return make_union_tft(src, tft);
 2692 }
 2693 
 2694 static struct txr_ffi_type *ffi_simple_clone(struct txr_ffi_type *orig)
 2695 {
 2696   return coerce(struct txr_ffi_type *, chk_copy_obj(coerce(mem_t *, orig),
 2697                                                     sizeof *orig));
 2698 }
 2699 
 2700 static val make_ffi_type_builtin(val syntax, val lisp_type, ffi_kind_t kind,
 2701                                  cnum size, cnum align, ffi_type *ft,
 2702                                  void (*put)(struct txr_ffi_type *,
 2703                                              val obj, mem_t *dst, val self),
 2704                                  val (*get)(struct txr_ffi_type *,
 2705                                             mem_t *src, val self),
 2706                                  void (*rput)(struct txr_ffi_type *,
 2707                                              val obj, mem_t *dst, val self),
 2708                                  val (*rget)(struct txr_ffi_type *,
 2709                                              mem_t *src, val self))
 2710 {
 2711   struct txr_ffi_type *tft = coerce(struct txr_ffi_type *,
 2712                                     chk_calloc(1, sizeof *tft));
 2713 
 2714   val obj = cobj(coerce(mem_t *, tft), ffi_type_s, &ffi_type_builtin_ops);
 2715 
 2716   tft->self = obj;
 2717   tft->kind = kind;
 2718   tft->ft = ft;
 2719   tft->syntax = syntax;
 2720   tft->lt = lisp_type;
 2721   tft->size = size;
 2722   tft->align = align;
 2723   tft->clone = ffi_simple_clone;
 2724   tft->put = put;
 2725   tft->get = get;
 2726   tft->alloc = ffi_fixed_alloc;
 2727   tft->dynsize = ffi_fixed_dynsize;
 2728   tft->free = free;
 2729 #if !HAVE_LITTLE_ENDIAN
 2730   tft->rput = (rput ? rput : put);
 2731   tft->rget = (rget ? rget : get);
 2732 #endif
 2733 
 2734   return obj;
 2735 }
 2736 
 2737 static val make_ffi_type_pointer(val syntax, val lisp_type,
 2738                                  void (*put)(struct txr_ffi_type *, val obj,
 2739                                              mem_t *dst, val self),
 2740                                  val (*get)(struct txr_ffi_type *,
 2741                                             mem_t *src, val self),
 2742                                  val (*in)(struct txr_ffi_type *, int copy,
 2743                                            mem_t *src, val obj, val self),
 2744                                  void (*out)(struct txr_ffi_type *, int copy,
 2745                                              val obj, mem_t *dst, val self),
 2746                                  void (*release)(struct txr_ffi_type *,
 2747                                                  val obj, mem_t *dst),
 2748                                  val tgtype)
 2749 {
 2750   val self = lit("ffi-type-compile");
 2751   struct txr_ffi_type *tgtft = ffi_type_struct(tgtype);
 2752 
 2753   if (tgtft->bitfield) {
 2754     uw_throwf(error_s, lit("~a: type combination ~s not allowed"),
 2755               self, syntax, nao);
 2756   } else {
 2757     struct txr_ffi_type *tft = coerce(struct txr_ffi_type *,
 2758                                       chk_calloc(1, sizeof *tft));
 2759 
 2760     val obj = cobj(coerce(mem_t *, tft), ffi_type_s, &ffi_type_ptr_ops);
 2761 
 2762     tft->self = obj;
 2763     tft->kind = FFI_KIND_PTR;
 2764     tft->ft = &ffi_type_pointer;
 2765     tft->syntax = syntax;
 2766     tft->lt = lisp_type;
 2767     tft->size = sizeof (mem_t *);
 2768     tft->align = alignof (mem_t *);
 2769     tft->clone = ffi_simple_clone;
 2770     tft->put = put;
 2771     tft->get = get;
 2772 #if !HAVE_LITTLE_ENDIAN
 2773     tft->rput = put;
 2774     tft->rget = get;
 2775 #endif
 2776     tft->eltype = tgtype;
 2777     tft->in = in;
 2778     tft->out = out;
 2779     tft->release = release;
 2780     tft->alloc = ffi_fixed_alloc;
 2781     tft->dynsize = ffi_fixed_dynsize;
 2782     tft->free = free;
 2783     tft->by_value_in = 1;
 2784 
 2785     return obj;
 2786   }
 2787 }
 2788 
 2789 static struct txr_ffi_type *ffi_struct_clone(struct txr_ffi_type *orig)
 2790 {
 2791   cnum nmemb = orig->nelem;
 2792   struct txr_ffi_type *copy = ffi_simple_clone(orig);
 2793   size_t memb_size = sizeof *orig->memb * nmemb;
 2794   ffi_type *ft = coerce(ffi_type *, chk_copy_obj(coerce(mem_t *, orig->ft),
 2795                                                  sizeof *orig->ft));
 2796 
 2797   copy->ft = ft;
 2798 #if HAVE_LIBFFI
 2799   ft->elements = copy->elements;
 2800 #endif
 2801   copy->memb = coerce(struct smemb *, chk_copy_obj(coerce(mem_t *,
 2802                                                           orig->memb),
 2803                                                    memb_size));
 2804 
 2805   return copy;
 2806 }
 2807 
 2808 static val ffi_memb_compile(val syntax, int last, int *pflexp, val self)
 2809 {
 2810   val type = cadr(syntax);
 2811   val comp_type = ffi_type_compile(type);
 2812   struct txr_ffi_type *ctft = ffi_type_struct(comp_type);
 2813   if (cddr(syntax))
 2814     uw_throwf(error_s, lit("~a: excess elements in type-member pair ~s"),
 2815               self, syntax, nao);
 2816   if (ctft->flexible || (ctft->incomplete && ctft->kind == FFI_KIND_ARRAY)) {
 2817     if (!last)
 2818       uw_throwf(error_s,
 2819                 lit("~a: flexible type ~s can only be last member"),
 2820                 self, type, nao);
 2821     *pflexp = 1;
 2822   } else if (ctft->incomplete) {
 2823     uw_throwf(error_s,
 2824               lit("~a: incomplete type ~s can't be struct/union member"),
 2825               self, type, nao);
 2826   }
 2827 
 2828   return comp_type;
 2829 }
 2830 
 2831 static val make_ffi_type_struct(val syntax, val lisp_type,
 2832                                 val use_existing, val self)
 2833 {
 2834   struct txr_ffi_type *tft = if3(use_existing,
 2835                                  ffi_type_struct(use_existing),
 2836                                  coerce(struct txr_ffi_type *,
 2837                                         chk_calloc(1, sizeof *tft)));
 2838   ffi_type *ft = if3(use_existing,
 2839                      tft->ft,
 2840                      coerce(ffi_type *, chk_calloc(1, sizeof *ft)));
 2841   int flexp = 0;
 2842   val slot_exprs = cddr(syntax);
 2843   cnum nmemb = c_num(length(slot_exprs)), i;
 2844   struct smemb *memb = coerce(struct smemb *,
 2845                               chk_calloc(nmemb, sizeof *memb));
 2846   val obj = if3(use_existing,
 2847                 tft->self,
 2848                 cobj(coerce(mem_t *, tft), ffi_type_s, &ffi_type_struct_ops));
 2849   ucnum offs = 0;
 2850   ucnum most_align = 0;
 2851   int need_out_handler = 0;
 2852   int bit_offs = 0;
 2853   const unsigned bits_int = 8 * sizeof(int);
 2854 
 2855   if (use_existing) {
 2856     if (tft->nelem != 0) {
 2857       free(memb);
 2858       return make_ffi_type_struct(syntax, lisp_type, nil, self);
 2859     }
 2860     free(tft->memb);
 2861     memset(tft, 0, sizeof *tft);
 2862   }
 2863 
 2864   tft->self = obj;
 2865   tft->kind = FFI_KIND_STRUCT;
 2866   tft->ft = ft;
 2867   tft->syntax = syntax;
 2868   tft->lt = lisp_type;
 2869   tft->clone = ffi_struct_clone;
 2870   tft->put = ffi_struct_put;
 2871   tft->get = ffi_struct_get;
 2872 #if !HAVE_LITTLE_ENDIAN
 2873   tft->rput = ffi_struct_put;
 2874   tft->rget = ffi_struct_get;
 2875 #endif
 2876   tft->in = ffi_struct_in;
 2877   tft->release = ffi_struct_release;
 2878   tft->alloc = ffi_fixed_alloc;
 2879   tft->dynsize = ffi_fixed_dynsize;
 2880   tft->free = free;
 2881   tft->memb = memb;
 2882 
 2883   tft->incomplete = 1;
 2884 
 2885   setcheck(obj, syntax);
 2886   setcheck(obj, lisp_type);
 2887 
 2888   sethash(ffi_struct_tag_hash, cadr(syntax), obj);
 2889 
 2890   for (i = 0; i < nmemb; i++) {
 2891     val slot_syntax = pop(&slot_exprs);
 2892     val slot = car(slot_syntax);
 2893     val type = ffi_memb_compile(slot_syntax, i == nmemb - 1, &flexp, self);
 2894     struct txr_ffi_type *mtft = ffi_type_struct(type);
 2895     cnum size = mtft->size;
 2896 
 2897     tft->nelem = i + 1;
 2898 
 2899     memb[i].mtype = type;
 2900     memb[i].mname = slot;
 2901     memb[i].mtft = mtft;
 2902 
 2903     setcheck(obj, slot);
 2904     setcheck(obj, type);
 2905 
 2906     if (mtft->bitfield) {
 2907       ucnum size = mtft->size;
 2908       ucnum bits_type = 8 * size;
 2909       ucnum bits = mtft->nelem;
 2910       ucnum offs_mask = size - 1;
 2911       ucnum align_mask = ~offs_mask;
 2912       ucnum unit_offs = offs & align_mask;
 2913       ucnum bits_alloc = 8 * (offs - unit_offs) + bit_offs;
 2914       ucnum room = bits_type - bits_alloc;
 2915 
 2916       if (bits == 0) {
 2917         if (offs != unit_offs)
 2918           offs = unit_offs + size;
 2919         bit_offs = 0;
 2920         nmemb--, i--;
 2921         continue;
 2922       }
 2923 
 2924       if (bits > room) {
 2925         offs = unit_offs + size;
 2926         bit_offs = bits_alloc = 0;
 2927       }
 2928 
 2929       if (bits_alloc == 0) {
 2930         if (most_align < (ucnum) mtft->align)
 2931           most_align = mtft->align;
 2932       }
 2933 
 2934       memb[i].offs = offs;
 2935 
 2936 #if HAVE_LITTLE_ENDIAN
 2937       mtft->shift = bit_offs;
 2938 #else
 2939       mtft->shift = bits_int - bit_offs - bits;
 2940 #endif
 2941       if (bits == bits_int)
 2942         mtft->mask = UINT_MAX;
 2943       else
 2944         mtft->mask = ((1U << bits) - 1) << mtft->shift;
 2945       bit_offs += bits;
 2946       offs += bit_offs / 8;
 2947       bit_offs %= 8;
 2948     } else {
 2949       ucnum align = mtft->align;
 2950       ucnum almask = align - 1;
 2951 
 2952       if (bit_offs > 0) {
 2953         bug_unless (bit_offs < 8);
 2954         offs++;
 2955         bit_offs = 0;
 2956       }
 2957 
 2958       offs = (offs + almask) & ~almask;
 2959       memb[i].offs = offs;
 2960       offs += size;
 2961 
 2962       if (align > most_align)
 2963         most_align = align;
 2964     }
 2965 
 2966     need_out_handler = need_out_handler || mtft->out != 0;
 2967 
 2968     if (mtft->by_value_in)
 2969       tft->by_value_in = 1;
 2970   }
 2971 
 2972   if (bit_offs > 0) {
 2973     bug_unless (bit_offs < 8);
 2974     offs++;
 2975   }
 2976 
 2977   tft->incomplete = (flexp || nmemb == 0);
 2978   tft->flexible = flexp;
 2979 
 2980   if (need_out_handler)
 2981     tft->out = ffi_struct_out;
 2982 
 2983   if (flexp) {
 2984     tft->size = offs;
 2985     tft->alloc = ffi_flex_alloc;
 2986     tft->dynsize = ffi_flex_dynsize;
 2987   } else {
 2988     tft->size = (offs + most_align - 1) & ~(most_align - 1);
 2989   }
 2990 
 2991   tft->align = most_align;
 2992 
 2993 #if HAVE_LIBFFI
 2994   ft->type = FFI_TYPE_STRUCT;
 2995   ft->size = tft->size;
 2996   ft->alignment = tft->align;
 2997   ft->elements = tft->elements;
 2998 #endif
 2999 
 3000   return obj;
 3001 }
 3002 
 3003 static val make_ffi_type_union(val syntax, val use_existing, val self)
 3004 {
 3005   struct txr_ffi_type *tft = if3(use_existing,
 3006                                  ffi_type_struct(use_existing),
 3007                                  coerce(struct txr_ffi_type *,
 3008                                         chk_calloc(1, sizeof *tft)));
 3009   ffi_type *ft = if3(use_existing,
 3010                      tft->ft,
 3011                      coerce(ffi_type *, chk_calloc(1, sizeof *ft)));
 3012   int flexp = 0;
 3013   val slot_exprs = cddr(syntax);
 3014   cnum nmemb = c_num(length(slot_exprs)), i;
 3015   struct smemb *memb = coerce(struct smemb *,
 3016                               chk_calloc(nmemb, sizeof *memb));
 3017   val obj = if3(use_existing,
 3018                 tft->self,
 3019                 cobj(coerce(mem_t *, tft), ffi_type_s, &ffi_type_struct_ops));
 3020   ucnum most_align = 0;
 3021   ucnum biggest_size = 0;
 3022   const unsigned bits_int = 8 * sizeof(int);
 3023 
 3024   if (use_existing) {
 3025     if (tft->nelem != 0) {
 3026       free(memb);
 3027       return make_ffi_type_union(syntax, nil, self);
 3028     }
 3029     free(tft->memb);
 3030     memset(tft, 0, sizeof *tft);
 3031   }
 3032 
 3033   tft->self = obj;
 3034   tft->kind = FFI_KIND_UNION;
 3035   tft->ft = ft;
 3036   tft->syntax = syntax;
 3037   tft->lt = union_s;
 3038   tft->nelem = nmemb;
 3039   tft->clone = ffi_struct_clone;
 3040   tft->put = ffi_union_put;
 3041   tft->get = ffi_union_get;
 3042 #if !HAVE_LITTLE_ENDIAN
 3043   tft->rput = ffi_union_put;
 3044   tft->rget = ffi_union_get;
 3045 #endif
 3046   tft->in = ffi_union_in;
 3047   tft->alloc = ffi_fixed_alloc;
 3048   tft->dynsize = ffi_fixed_dynsize;
 3049   tft->free = free;
 3050   tft->memb = memb;
 3051 
 3052   tft->incomplete = 1;
 3053 
 3054   setcheck(obj, syntax);
 3055 
 3056   sethash(ffi_struct_tag_hash, cadr(syntax), obj);
 3057 
 3058   for (i = 0; i < nmemb; i++) {
 3059     val slot_syntax = pop(&slot_exprs);
 3060     val slot = car(slot_syntax);
 3061     val type = ffi_memb_compile(slot_syntax, i == nmemb - 1, &flexp, self);
 3062     struct txr_ffi_type *mtft = ffi_type_struct(type);
 3063 
 3064     memb[i].mtype = type;
 3065     memb[i].mname = slot;
 3066     memb[i].mtft = mtft;
 3067     memb[i].offs = 0;
 3068 
 3069     setcheck(obj, slot);
 3070     setcheck(obj, type);
 3071 
 3072     if (most_align < (ucnum) mtft->align)
 3073       most_align = mtft->align;
 3074 
 3075     if (biggest_size < (ucnum) mtft->size)
 3076       biggest_size = mtft->size;
 3077 
 3078     if (mtft->bitfield) {
 3079       ucnum bits = mtft->nelem;
 3080 
 3081       if (bits == 0) {
 3082         nmemb--, i--;
 3083         continue;
 3084       }
 3085 
 3086 #if HAVE_LITTLE_ENDIAN
 3087       mtft->shift = 0;
 3088 #else
 3089       mtft->shift = bits_int - bits;
 3090 #endif
 3091       if (bits == bits_int)
 3092         mtft->mask = UINT_MAX;
 3093       else
 3094         mtft->mask = ((1U << bits) - 1) << mtft->shift;
 3095     }
 3096   }
 3097 
 3098   if (flexp)
 3099     uw_throwf(error_s,
 3100               lit("~a: unions cannot contain incomplete member"),
 3101               self, nao);
 3102 
 3103   tft->nelem = i;
 3104 
 3105   tft->size = biggest_size;
 3106   tft->align = most_align;
 3107 
 3108 #if HAVE_LIBFFI
 3109   ft->type = FFI_TYPE_STRUCT;
 3110   ft->size = tft->size;
 3111   ft->alignment = tft->align;
 3112   ft->elements = tft->elements;
 3113 #endif
 3114 
 3115   return obj;
 3116 }
 3117 
 3118 
 3119 static struct txr_ffi_type *ffi_array_clone(struct txr_ffi_type *orig)
 3120 {
 3121   struct txr_ffi_type *copy = ffi_simple_clone(orig);
 3122   ffi_type *ft = coerce(ffi_type *, chk_copy_obj(coerce(mem_t *, orig->ft),
 3123                                                  sizeof *orig->ft));
 3124 
 3125   copy->ft = ft;
 3126 #if HAVE_LIBFFI
 3127   ft->elements = copy->elements;
 3128 #endif
 3129   return copy;
 3130 }
 3131 
 3132 static val make_ffi_type_array(val syntax, val lisp_type,
 3133                                val dim, val eltype, val self)
 3134 {
 3135   struct txr_ffi_type *tft = coerce(struct txr_ffi_type *,
 3136                                     chk_calloc(1, sizeof *tft));
 3137   ffi_type *ft = coerce(ffi_type *, chk_calloc(1, sizeof *ft));
 3138   cnum nelem = c_num(dim);
 3139   val obj = cobj(coerce(mem_t *, tft), ffi_type_s, &ffi_type_struct_ops);
 3140 
 3141   struct txr_ffi_type *etft = ffi_type_struct(eltype);
 3142 
 3143   tft->self = obj;
 3144   tft->kind = FFI_KIND_ARRAY;
 3145   tft->ft = ft;
 3146   tft->syntax = syntax;
 3147   tft->lt = lisp_type;
 3148   tft->eltype = eltype;
 3149   tft->clone = ffi_array_clone;
 3150   tft->put = ffi_array_put;
 3151   tft->get = ffi_array_get;
 3152 #if !HAVE_LITTLE_ENDIAN
 3153   tft->rput = ffi_array_put;
 3154   tft->rget = ffi_array_get;
 3155 #endif
 3156   tft->in = ffi_array_in;
 3157   tft->release = ffi_array_release;
 3158   tft->alloc = ffi_fixed_alloc;
 3159   tft->dynsize = ffi_fixed_dynsize;
 3160   tft->free = free;
 3161   tft->by_value_in = etft->by_value_in;
 3162   tft->size = etft->size * nelem;
 3163   tft->align = etft->align;
 3164   if (etft->out != 0)
 3165     tft->out = ffi_array_out;
 3166   tft->nelem = nelem;
 3167 
 3168 #if HAVE_LIBFFI
 3169   ft->type = FFI_TYPE_STRUCT;
 3170   ft->size = tft->size;
 3171   ft->alignment = etft->align;
 3172   ft->elements = tft->elements;
 3173 #endif
 3174 
 3175   return obj;
 3176 }
 3177 
 3178 static val ffi_eval_expr(val expr, val menv, val env)
 3179 {
 3180   val expr_ex = expand(expr, menv);
 3181   return eval(expr_ex, env, expr_ex);
 3182 }
 3183 
 3184 static val make_ffi_type_enum(val syntax, val enums,
 3185                               val base_type, val self)
 3186 {
 3187   struct txr_ffi_type *tft = coerce(struct txr_ffi_type *,
 3188                                     chk_calloc(1, sizeof *tft));
 3189   struct txr_ffi_type *btft = ffi_type_struct(base_type);
 3190 
 3191   val sym_num = make_hash(nil, nil, t);
 3192   val num_sym = make_hash(nil, nil, nil);
 3193   val obj = cobj(coerce(mem_t *, tft), ffi_type_s, &ffi_type_enum_ops);
 3194   cnum lowest = INT_PTR_MAX;
 3195   cnum highest = INT_PTR_MIN;
 3196   cnum cur = -1;
 3197   ucnum count = 0;
 3198   val iter;
 3199   val enum_env = make_env(nil, nil, nil);
 3200   val shadow_menv = make_env(nil, nil, nil);
 3201 
 3202   tft->self = obj;
 3203   tft->kind = FFI_KIND_ENUM;
 3204   tft->ft = btft->ft;
 3205   tft->syntax = syntax;
 3206   tft->lt = sym_s;
 3207   tft->size = btft->size;
 3208   tft->align = btft->align;
 3209   tft->clone = btft->clone;
 3210   tft->put = ffi_enum_put;
 3211   tft->get = ffi_enum_get;
 3212 #if !HAVE_LITTLE_ENDIAN
 3213   tft->rput = ffi_enum_rput;
 3214   tft->rget = ffi_enum_rget;
 3215 #endif
 3216   tft->alloc = btft->alloc;
 3217   tft->free = btft->free;
 3218   tft->eltype = base_type;
 3219 
 3220   tft->num_sym = num_sym;
 3221   tft->sym_num = sym_num;
 3222 
 3223   for (iter = enums; !endp(iter); iter = cdr(iter), count++) {
 3224     val en = car(iter);
 3225     val nn;
 3226     if (symbolp(en)) {
 3227       val sym = en;
 3228       if (!bindable(sym))
 3229         uw_throwf(error_s, lit("~a: ~s member ~s isn't a bindable symbol"),
 3230                   self, syntax, sym, nao);
 3231       if (cur == INT_MAX)
 3232         uw_throwf(error_s, lit("~a: ~s overflow at member ~s"),
 3233                   self, syntax, sym, nao);
 3234       if (gethash(num_sym, sym))
 3235         uw_throwf(error_s, lit("~a: ~s duplicate member ~s"),
 3236                   self, syntax, sym, nao);
 3237       sethash(num_sym, sym, nn = num(++cur));
 3238       sethash(sym_num, nn, sym);
 3239       env_vbind(enum_env, sym, nn);
 3240       env_vbind(shadow_menv, sym, special_s);
 3241       if (cur > highest)
 3242         highest = cur;
 3243     } else {
 3244       val expr = cadr(en);
 3245       val sym = car(en);
 3246       val n;
 3247       if (!bindable(sym))
 3248         uw_throwf(error_s, lit("~a: ~s member ~s isn't a bindable symbol"),
 3249                   self, syntax, sym, nao);
 3250       if (gethash(num_sym, sym))
 3251         uw_throwf(error_s, lit("~a: ~s duplicate member ~s"),
 3252                   self, syntax, sym, nao);
 3253 
 3254       n = ffi_eval_expr(expr, shadow_menv, enum_env);
 3255 
 3256       if (!integerp(n)) {
 3257         uw_throwf(error_s, lit("~a: ~s member ~s value ~s not integer"),
 3258                   self, syntax, n, nao);
 3259       }
 3260 
 3261       cur = c_num(n);
 3262       if (cur > INT_MAX)
 3263         uw_throwf(error_s, lit("~a: ~s member ~s value ~s too large"),
 3264                   self, syntax, n, nao);
 3265       sethash(num_sym, sym, nn = num(cur));
 3266       sethash(sym_num, nn, sym);
 3267       env_vbind(enum_env, sym, nn);
 3268       env_vbind(shadow_menv, sym, special_s);
 3269       if (cur < lowest)
 3270         lowest = cur;
 3271     }
 3272   }
 3273 
 3274   return obj;
 3275 }
 3276 
 3277 static val ffi_type_copy(val orig)
 3278 {
 3279   struct txr_ffi_type *otft = ffi_type_struct(orig);
 3280   struct txr_ffi_type *ctft = otft->clone(otft);
 3281   return cobj(coerce(mem_t *, ctft), orig->co.cls, orig->co.ops);
 3282 }
 3283 
 3284 static val ffi_type_lookup(val sym)
 3285 {
 3286   return gethash(ffi_typedef_hash, sym);
 3287 }
 3288 
 3289 val ffi_type_compile(val syntax)
 3290 {
 3291   val self = lit("ffi-type-compile");
 3292 
 3293   if (consp(syntax)) {
 3294     val sym = car(syntax);
 3295 
 3296     if (!cdr(syntax))
 3297       goto toofew;
 3298 
 3299     if (sym == struct_s) {
 3300       val name = cadr(syntax);
 3301       val membs = cddr(syntax);
 3302       val sname = if3(name, name, gensym(lit("ffi-struct-")));
 3303       val existing_type = if2(name, gethash(ffi_struct_tag_hash, sname));
 3304 
 3305       if (!membs) {
 3306         if (!existing_type) {
 3307           val xsyntax = cons(struct_s, cons(sname, nil));
 3308           return make_ffi_type_struct(xsyntax, nil, nil, self);
 3309         } else {
 3310           return existing_type;
 3311         }
 3312       } else {
 3313         uses_or2;
 3314         val slots = mapcar(car_f, membs);
 3315         val stype = or2(if2(name, find_struct_type(sname)),
 3316                         make_struct_type(sname, nil, nil,
 3317                                          remq(nil, slots, nil),
 3318                                          nil, nil, nil, nil));
 3319         val xsyntax = cons(struct_s,
 3320                            cons(sname, membs));
 3321         return make_ffi_type_struct(xsyntax, stype, existing_type, self);
 3322       }
 3323     } else if (sym == union_s) {
 3324       val name = cadr(syntax);
 3325       val membs = cddr(syntax);
 3326       val sname = if3(name, name, gensym(lit("ffi-union-")));
 3327       val existing_type = if2(name, gethash(ffi_struct_tag_hash, sname));
 3328       val xsyntax = cons(union_s,
 3329                          cons(sname, membs));
 3330       return make_ffi_type_union(xsyntax, existing_type, self);
 3331     } else if (sym == array_s || sym == zarray_s) {
 3332       if (length(syntax) == two) {
 3333         val eltype_syntax = cadr(syntax);
 3334         val eltype = ffi_type_compile(eltype_syntax);
 3335         val type = make_ffi_type_pointer(syntax, vec_s,
 3336                                          ffi_varray_put, ffi_void_get,
 3337                                          ffi_varray_in, 0, ffi_varray_release,
 3338                                          eltype);
 3339         struct txr_ffi_type *tft = ffi_type_struct(type);
 3340         struct txr_ffi_type *etft = ffi_type_struct(eltype);
 3341 
 3342         tft->kind = FFI_KIND_ARRAY;
 3343 
 3344         if (etft->incomplete || etft->bitfield)
 3345           uw_throwf(error_s,
 3346                     lit("~a: ~a ~s cannot be array element"),
 3347                     self,
 3348                     if3(etft->bitfield,
 3349                         lit("bitfield"), lit("incomplete type")),
 3350                     eltype_syntax, nao);
 3351         if (sym == zarray_s) {
 3352           tft->null_term = 1;
 3353           tft->get = ffi_varray_null_term_get;
 3354           tft->in = ffi_varray_null_term_in;
 3355         }
 3356         if (etft->syntax == char_s)
 3357           tft->char_conv = 1;
 3358         else if (etft->syntax == wchar_s)
 3359           tft->wchar_conv = 1;
 3360         else if (etft->syntax == bchar_s)
 3361           tft->bchar_conv = 1;
 3362         tft->alloc = ffi_varray_alloc;
 3363         tft->dynsize = ffi_varray_dynsize;
 3364         tft->free = free;
 3365         tft->size = 0;
 3366         tft->incomplete = 1;
 3367         return type;
 3368       } else if (length(syntax) == three) {
 3369         val dim = ffi_eval_expr(cadr(syntax), nil, nil);
 3370         val eltype_syntax = caddr(syntax);
 3371         val eltype = ffi_type_compile(eltype_syntax);
 3372         val xsyntax = list(sym, dim, eltype_syntax, nao);
 3373         struct txr_ffi_type *etft = ffi_type_struct(eltype);
 3374 
 3375         if (etft->incomplete || etft->bitfield)
 3376           uw_throwf(error_s,
 3377                     lit("~a: ~a ~s cannot be array element"),
 3378                     self,
 3379                     if3(etft->bitfield,
 3380                         lit("bitfield"), lit("incomplete type")),
 3381                     eltype_syntax, nao);
 3382 
 3383         if (minusp(dim))
 3384           uw_throwf(error_s, lit("~a: negative dimension in ~s"),
 3385                     self, syntax, nao);
 3386 
 3387         {
 3388           val type = make_ffi_type_array(xsyntax, vec_s, dim, eltype, self);
 3389           struct txr_ffi_type *tft = ffi_type_struct(type);
 3390 
 3391           if (sym == zarray_s) {
 3392             tft->null_term = 1;
 3393             if (zerop(dim))
 3394               uw_throwf(error_s, lit("~a: zero dimension in ~s"),
 3395                         self, syntax, nao);
 3396           }
 3397 
 3398           if (etft->syntax == char_s)
 3399             tft->char_conv = 1;
 3400           else if (etft->syntax == wchar_s)
 3401             tft->wchar_conv = 1;
 3402           else if (etft->syntax == bchar_s)
 3403             tft->bchar_conv = 1;
 3404           return type;
 3405         }
 3406       } else {
 3407         goto excess;
 3408       }
 3409     } else if (sym == ptr_in_s) {
 3410       val target_type = ffi_type_compile(cadr(syntax));
 3411       if (cddr(syntax))
 3412         goto excess;
 3413       return make_ffi_type_pointer(syntax, ffi_get_lisp_type(self, target_type),
 3414                                    ffi_ptr_in_put, ffi_ptr_get,
 3415                                    ffi_ptr_in_in, ffi_ptr_in_out,
 3416                                    ffi_ptr_in_release, target_type);
 3417     } else if (sym == ptr_in_d_s) {
 3418       val target_type = ffi_type_compile(cadr(syntax));
 3419       if (cddr(syntax))
 3420         goto excess;
 3421       return make_ffi_type_pointer(syntax, ffi_get_lisp_type(self, target_type),
 3422                                    ffi_ptr_in_put, ffi_ptr_d_get,
 3423                                    ffi_ptr_in_d_in, ffi_ptr_in_out,
 3424                                    ffi_ptr_in_release, target_type);
 3425     } else if (sym == ptr_out_s) {
 3426       val target_type = ffi_type_compile(cadr(syntax));
 3427       if (cddr(syntax))
 3428         goto excess;
 3429       return make_ffi_type_pointer(syntax, ffi_get_lisp_type(self, target_type),
 3430                                    ffi_ptr_out_put, ffi_ptr_get,
 3431                                    ffi_ptr_out_in, ffi_ptr_out_out,
 3432                                    ffi_simple_release, target_type);
 3433     } else if (sym == ptr_out_d_s) {
 3434       val target_type = ffi_type_compile(cadr(syntax));
 3435       if (cddr(syntax))
 3436         goto excess;
 3437       return make_ffi_type_pointer(syntax, ffi_get_lisp_type(self, target_type),
 3438                                    ffi_ptr_out_null_put, ffi_ptr_d_get,
 3439                                    ffi_ptr_out_in, ffi_ptr_out_out,
 3440                                    0, target_type);
 3441     } else if (sym == ptr_s) {
 3442       val target_type = ffi_type_compile(cadr(syntax));
 3443       if (cddr(syntax))
 3444         goto excess;
 3445       return make_ffi_type_pointer(syntax, ffi_get_lisp_type(self, target_type),
 3446                                    ffi_ptr_in_put, ffi_ptr_get,
 3447                                    ffi_ptr_out_in, ffi_ptr_out_out,
 3448                                    ffi_ptr_in_release, target_type);
 3449     } else if (sym == ptr_out_s_s) {
 3450       val target_type = ffi_type_compile(cadr(syntax));
 3451       if (cddr(syntax))
 3452         goto excess;
 3453       return make_ffi_type_pointer(syntax, ffi_get_lisp_type(self, target_type),
 3454                                    ffi_ptr_out_null_put, ffi_ptr_get,
 3455                                    ffi_ptr_out_s_in, ffi_ptr_out_out,
 3456                                    0, target_type);
 3457     } else if (sym == buf_s || sym == buf_d_s) {
 3458       val size = ffi_eval_expr(cadr(syntax), nil, nil);
 3459       val xsyntax = list(sym, size, nao);
 3460       cnum nelem = c_num(size);
 3461       val type = make_ffi_type_builtin(xsyntax, buf_s, FFI_KIND_PTR,
 3462                                        sizeof (mem_t *),
 3463                                        alignof (mem_t *),
 3464                                        &ffi_type_pointer,
 3465                                        if3(sym == buf_s,
 3466                                            ffi_buf_put, ffi_buf_d_put),
 3467                                        if3(sym == buf_s,
 3468                                            ffi_buf_get, ffi_buf_d_get),
 3469                                        0, 0);
 3470       struct txr_ffi_type *tft = ffi_type_struct(type);
 3471 
 3472       if (cddr(syntax))
 3473         goto excess;
 3474 
 3475       if (nelem < 0)
 3476         uw_throwf(error_s, lit("~a: negative size in ~s"),
 3477                   self, syntax, nao);
 3478 
 3479       if (sym == buf_s) {
 3480         tft->in = ffi_buf_in;
 3481       } else {
 3482         tft->in = ffi_buf_d_in;
 3483         tft->release = ffi_simple_release;
 3484       }
 3485 
 3486       tft->nelem = nelem;
 3487       return type;
 3488     } else if (sym == cptr_s) {
 3489       val tag = cadr(syntax);
 3490       val type = make_ffi_type_builtin(cptr_s, cptr_s, FFI_KIND_PTR,
 3491                                        sizeof (mem_t *), alignof (mem_t *),
 3492                                        &ffi_type_pointer,
 3493                                        ffi_cptr_put, ffi_cptr_get, 0, 0);
 3494       struct txr_ffi_type *tft = ffi_type_struct(type);
 3495       tft->alloc = ffi_cptr_alloc;
 3496       tft->free = ffi_noop_free;
 3497       tft->tag = tag;
 3498       if (cddr(syntax))
 3499         goto excess;
 3500       return type;
 3501     } else if (sym == carray_s) {
 3502       val eltype = ffi_type_compile(cadr(syntax));
 3503       if (cddr(syntax))
 3504         goto excess;
 3505       return make_ffi_type_pointer(syntax, carray_s,
 3506                                    ffi_carray_put, ffi_carray_get,
 3507                                    0, 0, 0, eltype);
 3508     } else if (sym == sbit_s || sym == ubit_s) {
 3509       val nbits = ffi_eval_expr(cadr(syntax), nil, nil);
 3510       cnum nb = c_num(nbits);
 3511       val xsyntax = list(sym, nbits, nao);
 3512       val type = make_ffi_type_builtin(xsyntax, integer_s,
 3513                                        FFI_KIND_NUM,
 3514                                        sizeof (int), alignof (int),
 3515                                        &ffi_type_void,
 3516                                        if3(sym == sbit_s,
 3517                                            ffi_sbit_put, ffi_ubit_put),
 3518                                        if3(sym == sbit_s,
 3519                                            ffi_sbit_get, ffi_ubit_get),
 3520                                        0, 0);
 3521       struct txr_ffi_type *tft = ffi_type_struct(type);
 3522       const int bits_int = 8 * sizeof(int);
 3523       if (cddr(syntax))
 3524         goto excess;
 3525       if (nb < 0 || nb > bits_int)
 3526         uw_throwf(error_s, lit("~a: invalid bitfield size ~s; "
 3527                                "must be 0 to ~s"),
 3528                   self, nbits, num_fast(bits_int), nao);
 3529       tft->nelem = c_num(nbits);
 3530       tft->bitfield = 1;
 3531       return type;
 3532     } else if (sym == bit_s && !consp(cddr(syntax))) {
 3533       goto toofew;
 3534     } else if (sym == bit_s) {
 3535       val nbits = ffi_eval_expr(cadr(syntax), nil, nil);
 3536       cnum nb = c_num(nbits);
 3537       val type_syntax = caddr(syntax);
 3538       val xsyntax = list(sym, nbits, type_syntax, nao);
 3539       val type = ffi_type_compile(type_syntax);
 3540       struct txr_ffi_type *tft = ffi_type_struct(type);
 3541       const cnum max_bits = 8 * tft->size;
 3542       val type_copy = ffi_type_copy(type);
 3543       struct txr_ffi_type *tft_cp = ffi_type_struct(type_copy);
 3544       val syn = tft->syntax;
 3545       int unsgnd = 0;
 3546 
 3547       if (cdddr(syntax))
 3548         goto excess;
 3549 
 3550       if (syn == uint8_s || syn == uint16_s || syn == uint32_s ||
 3551           syn == uchar_s || syn == ushort_s || syn == uint_s)
 3552       {
 3553         unsgnd = 1;
 3554       } else if (syn != int8_s && syn != int16_s && syn != int32_s &&
 3555                  syn != char_s && syn != short_s && syn != int_s)
 3556       {
 3557         uw_throwf(error_s, lit("~a: ~s not supported as bitfield type"),
 3558                   self, type, nao);
 3559       }
 3560 
 3561       if (nb < 0 || nb > max_bits)
 3562         uw_throwf(error_s, lit("~a: invalid bitfield size ~s; "
 3563                                "must be 0 to ~s"),
 3564                   self, nbits, num_fast(max_bits), nao);
 3565       tft_cp->syntax = xsyntax;
 3566       tft_cp->nelem = nb;
 3567       tft_cp->put = if3(unsgnd, ffi_generic_ubit_put, ffi_generic_sbit_put);
 3568       tft_cp->get = if3(unsgnd, ffi_generic_ubit_get, ffi_generic_sbit_get);
 3569       tft_cp->bitfield = 1;
 3570       return type_copy;
 3571     } else if (sym == enum_s) {
 3572       val name = cadr(syntax);
 3573       val enums = cddr(syntax);
 3574       val xsyntax = cons(enum_s, cons(name, nil));
 3575       if (name && !bindable(name))
 3576         uw_throwf(error_s,
 3577                   lit("~a: enum name ~s must be bindable symbol or nil"),
 3578                   self, name, nao);
 3579       return make_ffi_type_enum(xsyntax, enums, ffi_type_lookup(int_s), self);
 3580     } else if (sym == enumed_s && !consp(cddr(syntax))) {
 3581       goto toofew;
 3582     } else if (sym == enumed_s) {
 3583       val base_type_syntax = cadr(syntax);
 3584       val name = caddr(syntax);
 3585       val enums = cdddr(syntax);
 3586       val xsyntax = list(enumed_s, base_type_syntax, name, nao);
 3587       val base_type = ffi_type_compile(base_type_syntax);
 3588       if (name && !bindable(name))
 3589         uw_throwf(error_s,
 3590                   lit("~a: enum name ~s must be bindable symbol or nil"),
 3591                   self, name, nao);
 3592       return make_ffi_type_enum(xsyntax, enums, base_type, self);
 3593     } else if (sym == align_s && !consp(cddr(syntax))) {
 3594       goto toofew;
 3595     } else if (sym == align_s) {
 3596       val align = ffi_eval_expr(cadr(syntax), nil, nil);
 3597       ucnum al = c_num(align);
 3598       if (cdddr(syntax))
 3599         goto excess;
 3600       if (al <= 0) {
 3601         uw_throwf(error_s, lit("~a: alignment must be positive"),
 3602                   self, nao);
 3603       } else if (al != 0 && (al & (al - 1)) != 0) {
 3604         uw_throwf(error_s, lit("~a: alignment must be a power of two"),
 3605                   self, nao);
 3606       } else {
 3607         val alsyntax = caddr(syntax);
 3608         val altype = ffi_type_compile(alsyntax);
 3609         val altype_copy = ffi_type_copy(altype);
 3610         struct txr_ffi_type *atft = ffi_type_struct(altype_copy);
 3611         atft->align = al;
 3612         return altype_copy;
 3613       }
 3614     } else if (sym == bool_s) {
 3615       val type_syntax = cadr(syntax);
 3616       val type = ffi_type_compile(type_syntax);
 3617       val type_copy = ffi_type_copy(type);
 3618       struct txr_ffi_type *tft = ffi_type_struct(type_copy);
 3619       if (cddr(syntax))
 3620         goto excess;
 3621       if (tft->eltype || tft->memb != 0)
 3622         uw_throwf(error_s, lit("~a: type ~s can't be basis for bool"),
 3623                   self, tft->syntax, nao);
 3624       tft->syntax = syntax;
 3625       tft->eltype = type;
 3626       tft->get = ffi_bool_get;
 3627       tft->put = ffi_bool_put;
 3628 #if !HAVE_LITTLE_ENDIAN
 3629       tft->rget = ffi_bool_rget;
 3630       tft->rput = ffi_bool_rput;
 3631 #endif
 3632       return type_copy;
 3633     } else if (sym == qref_s) {
 3634       val args = cdr(syntax);
 3635       val type = nil;
 3636       struct txr_ffi_type *tft = 0;
 3637 
 3638       for (; consp(args); args = cdr(args)) {
 3639         val next = car(args);
 3640         if (!tft) {
 3641           type = ffi_type_compile(next);
 3642           tft = ffi_type_struct(type);
 3643           if (tft->clone != ffi_struct_clone)
 3644             uw_throwf(error_s, lit("~a: ~s in ~s isn't a struct/union type"),
 3645                       self, next, syntax, nao);
 3646         } else {
 3647           tft = ffi_find_memb(tft, next);
 3648           if (!tft)
 3649             uw_throwf(error_s, lit("~a: ~s in ~s is a nonexistent member"),
 3650                       self, next, syntax, nao);
 3651           type = tft->self;
 3652         }
 3653       }
 3654 
 3655       if (type == nil || args)
 3656         uw_throwf(error_s, lit("~a: invalid ~s syntax"), self, sym, nao);
 3657 
 3658       return type;
 3659     } else if (sym == elemtype_s) {
 3660       val args = cdr(syntax);
 3661       if (!consp(args) || cdr(args)) {
 3662         uw_throwf(error_s, lit("~a: one argument required"), self, qref_s, nao);
 3663       } else {
 3664         val expr = car(args);
 3665         val type = ffi_type_compile(expr);
 3666         struct txr_ffi_type *tft = ffi_type_struct_checked(self, type);
 3667 
 3668         if (!tft->eltype) {
 3669           uw_throwf(error_s, lit("~a: ~s isn't an array, pointer or enum"),
 3670                     self, type, nao);
 3671         }
 3672 
 3673         return tft->eltype;
 3674       }
 3675     }
 3676 
 3677     uw_throwf(error_s, lit("~a: unrecognized type operator: ~s"),
 3678               self, sym, nao);
 3679   } else {
 3680     val sub = gethash(ffi_typedef_hash, syntax);
 3681 
 3682     if (sub != nil)
 3683       return sub;
 3684 
 3685     uw_throwf(error_s, lit("~a: unrecognized type specifier: ~!~s"),
 3686               self, syntax, nao);
 3687   }
 3688 
 3689 toofew:
 3690   uw_throwf(error_s, lit("~a: missing arguments in ~s"),
 3691             self, syntax, nao);
 3692 
 3693 excess:
 3694   uw_throwf(error_s, lit("~a: excess elements in ~s"),
 3695             self, syntax, nao);
 3696 }
 3697 
 3698 val ffi_type_operator_p(val sym)
 3699 {
 3700   return tnil(sym == struct_s || sym == union_s || sym == array_s ||
 3701               sym == zarray_s || sym == ptr_in_s || sym == ptr_in_d_s ||
 3702               sym == ptr_out_s || sym == ptr_out_d_s || sym == ptr_s ||
 3703               sym == ptr_out_s_s || sym == buf_s || sym == buf_d_s ||
 3704               sym == cptr_s || sym == carray_s || sym == sbit_s ||
 3705               sym == ubit_s || sym == bit_s || sym == enum_s ||
 3706               sym == enumed_s || sym == align_s || sym == bool_s);
 3707 }
 3708 
 3709 val ffi_type_p(val sym)
 3710 {
 3711   return tnil(gethash(ffi_typedef_hash, sym));
 3712 }
 3713 
 3714 static void ffi_init_types(void)
 3715 {
 3716 #if UCHAR_MAX == CHAR_MAX
 3717   ffi_type *ffi_char = &ffi_type_uchar;
 3718 #else
 3719   ffi_type *ffi_char = &ffi_type_schar;
 3720 #endif
 3721 
 3722 #if HAVE_I8
 3723   ffi_typedef(uint8_s, make_ffi_type_builtin(uint8_s, integer_s,
 3724                                              FFI_KIND_NUM,
 3725                                              sizeof (i8_t), alignof (i8_t),
 3726                                              &ffi_type_uint8,
 3727                                              ffi_u8_put, ffi_u8_get,
 3728                                              ifbe(ffi_u8_rput),
 3729                                              ifbe(ffi_u8_rget)));
 3730   ffi_typedef(int8_s, make_ffi_type_builtin(int8_s, integer_s,
 3731                                             FFI_KIND_NUM,
 3732                                             sizeof (i8_t), alignof (i8_t),
 3733                                             &ffi_type_sint8,
 3734                                             ffi_i8_put, ffi_i8_get,
 3735                                             ifbe(ffi_i8_rput),
 3736                                             ifbe(ffi_i8_rget)));
 3737 #endif
 3738 #if HAVE_I16
 3739   ffi_typedef(uint16_s, make_ffi_type_builtin(uint16_s, integer_s,
 3740                                               FFI_KIND_NUM,
 3741                                               sizeof (i16_t), alignof (i16_t),
 3742                                               &ffi_type_uint16,
 3743                                               ffi_u16_put, ffi_u16_get,
 3744                                               ifbe(ffi_u16_rput),
 3745                                               ifbe(ffi_u16_rget)));
 3746   ffi_typedef(int16_s, make_ffi_type_builtin(int16_s, integer_s,
 3747                                              FFI_KIND_NUM,
 3748                                              sizeof (i16_t), alignof (i16_t),
 3749                                              &ffi_type_sint16,
 3750                                              ffi_i16_put, ffi_i16_get,
 3751                                              ifbe(ffi_i16_rput),
 3752                                              ifbe(ffi_i16_rget)));
 3753 #endif
 3754 #if HAVE_I32
 3755   ffi_typedef(uint32_s, make_ffi_type_builtin(uint32_s, integer_s,
 3756                                               FFI_KIND_NUM,
 3757                                               sizeof (i32_t), alignof (i32_t),
 3758                                               &ffi_type_uint32,
 3759                                               ffi_u32_put, ffi_u32_get,
 3760                                               ifbe(ffi_u32_rput),
 3761                                               ifbe(ffi_u32_rget)));
 3762   ffi_typedef(int32_s, make_ffi_type_builtin(int32_s, integer_s,
 3763                                              FFI_KIND_NUM,
 3764                                              sizeof (i32_t), alignof (i32_t),
 3765                                              &ffi_type_sint32,
 3766                                              ffi_i32_put, ffi_i32_get,
 3767                                              ifbe(ffi_i32_rput),
 3768                                              ifbe(ffi_i32_rget)));
 3769 #endif
 3770 #if HAVE_I64
 3771   ffi_typedef(uint64_s, make_ffi_type_builtin(uint64_s, integer_s,
 3772                                               FFI_KIND_NUM,
 3773                                               sizeof (i64_t), alignof (i64_t),
 3774                                               &ffi_type_uint64,
 3775                                               ffi_u64_put, ffi_u64_get, 0, 0));
 3776   ffi_typedef(int64_s, make_ffi_type_builtin(int64_s, integer_s,
 3777                                              FFI_KIND_NUM,
 3778                                              sizeof (i64_t), alignof (i64_t),
 3779                                              &ffi_type_sint64,
 3780                                              ffi_i64_put, ffi_i64_get, 0, 0));
 3781 #endif
 3782   ffi_typedef(uchar_s, make_ffi_type_builtin(uchar_s, integer_s,
 3783                                              FFI_KIND_NUM,
 3784                                              1, 1,
 3785                                              &ffi_type_uchar,
 3786                                              ffi_uchar_put, ffi_uchar_get,
 3787                                              ifbe(ffi_uchar_rput),
 3788                                              ifbe(ffi_uchar_rget)));
 3789   ffi_typedef(char_s, make_ffi_type_builtin(char_s, integer_s,
 3790                                             FFI_KIND_NUM,
 3791                                             1, 1,
 3792                                             ffi_char, ffi_char_put,
 3793                                             ffi_char_get,
 3794                                             ifbe(ffi_char_rput),
 3795                                             ifbe(ffi_char_rget)));
 3796   ffi_typedef(bchar_s, make_ffi_type_builtin(bchar_s, char_s,
 3797                                              FFI_KIND_NUM,
 3798                                              1, 1,
 3799                                              &ffi_type_uchar,
 3800                                              ffi_uchar_put, ffi_bchar_get,
 3801                                              ifbe(ffi_uchar_rput),
 3802                                              ifbe(ffi_bchar_rget)));
 3803   ffi_typedef(wchar_s, make_ffi_type_builtin(wchar_s, char_s,
 3804                                              FFI_KIND_NUM,
 3805                                              sizeof (wchar_t),
 3806                                              alignof (wchar_t),
 3807                                              &ffi_type_wchar,
 3808                                              ffi_wchar_put, ffi_wchar_get,
 3809                                              ifbe(ffi_wchar_rput),
 3810                                              ifbe(ffi_wchar_rget)));
 3811   ffi_typedef(ushort_s, make_ffi_type_builtin(ushort_s, integer_s,
 3812                                               FFI_KIND_NUM,
 3813                                               sizeof (short), alignof (short),
 3814                                               &ffi_type_ushort,
 3815                                               ffi_ushort_put, ffi_ushort_get,
 3816                                               ifbe(ffi_ushort_rput),
 3817                                               ifbe(ffi_ushort_rget)));
 3818   ffi_typedef(short_s, make_ffi_type_builtin(short_s, integer_s,
 3819                                              FFI_KIND_NUM,
 3820                                              sizeof (short), alignof (short),
 3821                                              &ffi_type_sshort,
 3822                                              ffi_short_put, ffi_short_get,
 3823                                              ifbe(ffi_short_rput),
 3824                                              ifbe(ffi_short_rget)));
 3825   ffi_typedef(int_s, make_ffi_type_builtin(int_s, integer_s,
 3826                                            FFI_KIND_NUM,
 3827                                            sizeof (int), alignof (int),
 3828                                            &ffi_type_sint,
 3829                                            ffi_int_put, ffi_int_get,
 3830                                            ifbe(ffi_int_rput),
 3831                                            ifbe(ffi_int_rget)));
 3832   ffi_typedef(uint_s, make_ffi_type_builtin(uint_s, integer_s,
 3833                                             FFI_KIND_NUM,
 3834                                             sizeof (int), alignof (int),
 3835                                             &ffi_type_uint,
 3836                                             ffi_uint_put, ffi_uint_get,
 3837                                             ifbe(ffi_uint_rput),
 3838                                             ifbe(ffi_uint_rget)));
 3839   ffi_typedef(ulong_s, make_ffi_type_builtin(ulong_s, integer_s,
 3840                                              FFI_KIND_NUM,
 3841                                              sizeof (long), alignof (long),
 3842                                              &ffi_type_ulong,
 3843                                              ffi_ulong_put, ffi_ulong_get,
 3844                                              ifbe(ffi_ulong_rput),
 3845                                              ifbe(ffi_ulong_rget)));
 3846   ffi_typedef(long_s, make_ffi_type_builtin(long_s, integer_s,
 3847                                             FFI_KIND_NUM,
 3848                                             sizeof (long), alignof (long),
 3849                                             &ffi_type_slong,
 3850                                             ffi_long_put, ffi_long_get,
 3851                                             ifbe(ffi_long_rput),
 3852                                             ifbe(ffi_long_rget)));
 3853   ffi_typedef(float_s, make_ffi_type_builtin(float_s, float_s,
 3854                                              FFI_KIND_NUM,
 3855                                              sizeof (float), alignof (float),
 3856                                              &ffi_type_float,
 3857                                              ffi_float_put, ffi_float_get,
 3858                                              0, 0));
 3859   ffi_typedef(double_s, make_ffi_type_builtin(double_s, float_s,
 3860                                               FFI_KIND_NUM,
 3861                                               sizeof (double),
 3862                                               alignof (double),
 3863                                               &ffi_type_double,
 3864                                               ffi_double_put, ffi_double_get,
 3865                                               0, 0));
 3866   ffi_typedef(val_s, make_ffi_type_builtin(val_s, t,
 3867                                            FFI_KIND_PTR,
 3868                                            sizeof (val),
 3869                                            alignof (val),
 3870                                            &ffi_type_pointer,
 3871                                            ffi_val_put, ffi_val_get,
 3872                                            0, 0));
 3873   ffi_typedef(be_uint16_s, make_ffi_type_builtin(be_uint16_s, integer_s,
 3874                                                  FFI_KIND_NUM,
 3875                                                  sizeof (u16_t),
 3876                                                  alignof (u16_t),
 3877                                                  &ffi_type_uint16,
 3878                                                  ffi_be_u16_put,
 3879                                                  ffi_be_u16_get,
 3880                                                  ifbe(ffi_be_u16_rput),
 3881                                                  ifbe(ffi_be_u16_rget)));
 3882   ffi_typedef(be_int16_s, make_ffi_type_builtin(be_int16_s, integer_s,
 3883                                                 FFI_KIND_NUM,
 3884                                                 sizeof (i16_t),
 3885                                                 alignof (i16_t),
 3886                                                 &ffi_type_sint16,
 3887                                                 ffi_be_i16_put,
 3888                                                 ffi_be_i16_get,
 3889                                                 ifbe(ffi_be_i16_rput),
 3890                                                 ifbe(ffi_be_i16_rget)));
 3891   ffi_typedef(be_uint32_s, make_ffi_type_builtin(be_uint32_s, integer_s,
 3892                                                  FFI_KIND_NUM,
 3893                                                  sizeof (u32_t),
 3894                                                  alignof (u32_t),
 3895                                                  &ffi_type_uint32,
 3896                                                  ffi_be_u32_put,
 3897                                                  ffi_be_u32_get,
 3898                                                  ifbe(ffi_be_u32_rput),
 3899                                                  ifbe(ffi_be_u32_rget)));
 3900   ffi_typedef(be_int32_s, make_ffi_type_builtin(be_int32_s, integer_s,
 3901                                                 FFI_KIND_NUM,
 3902                                                 sizeof (i32_t),
 3903                                                 alignof (i32_t),
 3904                                                 &ffi_type_sint32,
 3905                                                 ffi_be_i32_put,
 3906                                                 ffi_be_i32_get,
 3907                                                 ifbe(ffi_be_i32_rput),
 3908                                                 ifbe(ffi_be_i32_rget)));
 3909   ffi_typedef(be_uint64_s, make_ffi_type_builtin(be_uint64_s, integer_s,
 3910                                                  FFI_KIND_NUM,
 3911                                                  sizeof (u64_t),
 3912                                                  alignof (u64_t),
 3913                                                  &ffi_type_uint64,
 3914                                                  ffi_be_u64_put,
 3915                                                  ffi_be_u64_get, 0, 0));
 3916   ffi_typedef(be_int64_s, make_ffi_type_builtin(be_int64_s, integer_s,
 3917                                                 FFI_KIND_NUM,
 3918                                                 sizeof (i64_t),
 3919                                                 alignof (i64_t),
 3920                                                 &ffi_type_sint64,
 3921                                                 ffi_be_i64_put,
 3922                                                 ffi_be_i64_get, 0, 0));
 3923   ffi_typedef(be_float_s, make_ffi_type_builtin(be_float_s, integer_s,
 3924                                                 FFI_KIND_NUM,
 3925                                                 sizeof (float),
 3926                                                 alignof (float),
 3927                                                 &ffi_type_float,
 3928                                                 ffi_be_float_put,
 3929                                                 ffi_be_float_get, 0, 0));
 3930   ffi_typedef(be_double_s, make_ffi_type_builtin(be_double_s, integer_s,
 3931                                                  FFI_KIND_NUM,
 3932                                                  sizeof (double),
 3933                                                  alignof (double),
 3934                                                  &ffi_type_double,
 3935                                                  ffi_be_double_put,
 3936                                                  ffi_be_double_get, 0, 0));
 3937   ffi_typedef(le_uint16_s, make_ffi_type_builtin(le_uint16_s, integer_s,
 3938                                                  FFI_KIND_NUM,
 3939                                                  sizeof (u16_t),
 3940                                                  alignof (u16_t),
 3941                                                  &ffi_type_uint16,
 3942                                                  ffi_le_u16_put,
 3943                                                  ffi_le_u16_get,
 3944                                                  ifbe(ffi_le_u16_rput),
 3945                                                  ifbe(ffi_le_u16_rget)));
 3946   ffi_typedef(le_int16_s, make_ffi_type_builtin(le_int16_s, integer_s,
 3947                                                 FFI_KIND_NUM,
 3948                                                 sizeof (i16_t),
 3949                                                 alignof (i16_t),
 3950                                                 &ffi_type_sint16,
 3951                                                 ffi_le_i16_put,
 3952                                                 ffi_le_i16_get,
 3953                                                 ifbe(ffi_le_i16_rput),
 3954                                                 ifbe(ffi_le_i16_rget)));
 3955   ffi_typedef(le_uint32_s, make_ffi_type_builtin(le_uint32_s, integer_s,
 3956                                                  FFI_KIND_NUM,
 3957                                                  sizeof (u32_t),
 3958                                                  alignof (u32_t),
 3959                                                  &ffi_type_uint32,
 3960                                                  ffi_le_u32_put,
 3961                                                  ffi_le_u32_get,
 3962                                                  ifbe(ffi_le_u32_rput),
 3963                                                  ifbe(ffi_le_u32_rget)));
 3964   ffi_typedef(le_int32_s, make_ffi_type_builtin(le_int32_s, integer_s,
 3965                                                 FFI_KIND_NUM,
 3966                                                 sizeof (i32_t),
 3967                                                 alignof (i32_t),
 3968                                                 &ffi_type_sint32,
 3969                                                 ffi_le_i32_put,
 3970                                                 ffi_le_i32_get,
 3971                                                 ifbe(ffi_le_i32_rput),
 3972                                                 ifbe(ffi_le_i32_rget)));
 3973   ffi_typedef(le_uint64_s, make_ffi_type_builtin(le_uint64_s, integer_s,
 3974                                                  FFI_KIND_NUM,
 3975                                                  sizeof (u64_t),
 3976                                                  alignof (u64_t),
 3977                                                  &ffi_type_uint64,
 3978                                                  ffi_le_u64_put,
 3979                                                  ffi_le_u64_get, 0, 0));
 3980   ffi_typedef(le_int64_s, make_ffi_type_builtin(le_int64_s, integer_s,
 3981                                                 FFI_KIND_NUM,
 3982                                                 sizeof (i64_t),
 3983                                                 alignof (i64_t),
 3984                                                 &ffi_type_sint64,
 3985                                                 ffi_le_i64_put,
 3986                                                 ffi_le_i64_get, 0, 0));
 3987   ffi_typedef(le_float_s, make_ffi_type_builtin(le_float_s, integer_s,
 3988                                                 FFI_KIND_NUM,
 3989                                                 sizeof (float),
 3990                                                 alignof (float),
 3991                                                 &ffi_type_float,
 3992                                                 ffi_le_float_put,
 3993                                                 ffi_le_float_get, 0, 0));
 3994   ffi_typedef(le_double_s, make_ffi_type_builtin(le_double_s, integer_s,
 3995                                                  FFI_KIND_NUM,
 3996                                                  sizeof (double),
 3997                                                  alignof (double),
 3998                                                  &ffi_type_double,
 3999                                                  ffi_le_double_put,
 4000                                                  ffi_le_double_get, 0, 0));
 4001   {
 4002     val type = make_ffi_type_builtin(cptr_s, cptr_s, FFI_KIND_PTR,
 4003                                      sizeof (mem_t *), alignof (mem_t *),
 4004                                      &ffi_type_pointer,
 4005                                      ffi_cptr_put, ffi_cptr_get, 0, 0);
 4006     struct txr_ffi_type *tft = ffi_type_struct(type);
 4007     tft->alloc = ffi_cptr_alloc;
 4008     tft->free = ffi_noop_free;
 4009     tft->tag = nil;
 4010     ffi_typedef(cptr_s, type);
 4011   }
 4012 
 4013   {
 4014     val type = make_ffi_type_builtin(str_s, str_s, FFI_KIND_PTR,
 4015                                      sizeof (mem_t *), alignof (mem_t *),
 4016                                      &ffi_type_pointer,
 4017                                      ffi_str_put, ffi_str_get, 0, 0);
 4018     struct txr_ffi_type *tft = ffi_type_struct(type);
 4019     tft->in = ffi_str_in;
 4020     tft->release = ffi_simple_release;
 4021     tft->by_value_in = 1;
 4022     ffi_typedef(str_s, type);
 4023   }
 4024 
 4025   {
 4026     val type = make_ffi_type_builtin(bstr_s, str_s, FFI_KIND_PTR,
 4027                                      sizeof (mem_t *), alignof (mem_t *),
 4028                                      &ffi_type_pointer,
 4029                                      ffi_bstr_put, ffi_bstr_get, 0, 0);
 4030     struct txr_ffi_type *tft = ffi_type_struct(type);
 4031     tft->in = ffi_bstr_in;
 4032     tft->release = ffi_simple_release;
 4033     tft->by_value_in = 1;
 4034     ffi_typedef(bstr_s, type);
 4035   }
 4036 
 4037   ffi_typedef(str_d_s, make_ffi_type_builtin(str_d_s, str_s, FFI_KIND_PTR,
 4038                                              sizeof (mem_t *), alignof (mem_t *),
 4039                                              &ffi_type_pointer,
 4040                                              ffi_str_put, ffi_str_d_get, 0, 0));
 4041   {
 4042     val type = ffi_typedef(wstr_s, make_ffi_type_builtin(wstr_s, str_s,
 4043                                                          FFI_KIND_PTR,
 4044                                                          sizeof (mem_t *),
 4045                                                          alignof (mem_t *),
 4046                                                          &ffi_type_pointer,
 4047                                                          ffi_wstr_put,
 4048                                                          ffi_wstr_get, 0, 0));
 4049     struct txr_ffi_type *tft = ffi_type_struct(type);
 4050     tft->in = ffi_wstr_in;
 4051     tft->release = ffi_simple_release;
 4052     tft->by_value_in = 1;
 4053     ffi_typedef(wstr_s, type);
 4054   }
 4055 
 4056   ffi_typedef(wstr_d_s, make_ffi_type_builtin(wstr_d_s, str_s, FFI_KIND_PTR,
 4057                                               sizeof (mem_t *),
 4058                                               alignof (mem_t *),
 4059                                               &ffi_type_pointer,
 4060                                               ffi_wstr_put, ffi_wstr_d_get,
 4061                                               0, 0));
 4062   ffi_typedef(bstr_d_s, make_ffi_type_builtin(bstr_d_s, str_s, FFI_KIND_PTR,
 4063                                               sizeof (mem_t *),
 4064                                               alignof (mem_t *),
 4065                                               &ffi_type_pointer,
 4066                                               ffi_bstr_put, ffi_bstr_d_get,
 4067                                               0, 0));
 4068 
 4069   {
 4070     val iter;
 4071 
 4072     for (iter = list(buf_s, buf_d_s, nao); iter; iter = cdr(iter)) {
 4073       val sym = car(iter);
 4074       ffi_typedef(sym, make_ffi_type_builtin(sym, buf_s, FFI_KIND_PTR,
 4075                                              sizeof (mem_t *),
 4076                                              alignof (mem_t *),
 4077                                              &ffi_type_pointer,
 4078                                              if3(sym == buf_s,
 4079                                                  ffi_buf_put, ffi_buf_d_put),
 4080                                              ffi_void_get, 0, 0));
 4081     }
 4082   }
 4083 
 4084 #if HAVE_LIBFFI
 4085   ffi_typedef(closure_s, make_ffi_type_builtin(closure_s, fun_s, FFI_KIND_PTR,
 4086                                                sizeof (mem_t *),
 4087                                                alignof (mem_t *),
 4088                                                &ffi_type_pointer,
 4089                                                ffi_closure_put, ffi_cptr_get,
 4090                                                0, 0));
 4091 #endif
 4092 
 4093   {
 4094     val type = ffi_typedef(void_s, make_ffi_type_builtin(void_s, null_s,
 4095                                                          FFI_KIND_VOID,
 4096                                                          0, 0,
 4097                                                          &ffi_type_void,
 4098                                                          ffi_void_put,
 4099                                                          ffi_void_get,
 4100                                                          0, 0));
 4101     struct txr_ffi_type *tft = ffi_type_struct(type);
 4102     tft->incomplete = 1;
 4103   }
 4104 
 4105   ffi_typedef(bool_s, ffi_type_compile(cons(bool_s, cons(uchar_s, nil))));
 4106 }
 4107 
 4108 static void ffi_init_extra_types(void)
 4109 {
 4110   val type_by_size[2][18] = { { 0 }, { 0 } };
 4111 
 4112 #if HAVE_I64
 4113   type_by_size[0][sizeof (i64_t)] = ffi_type_lookup(int64_s);
 4114   type_by_size[1][sizeof (i64_t)] = ffi_type_lookup(uint64_s);
 4115 #endif
 4116 #if HAVE_I32
 4117   type_by_size[0][sizeof (i32_t)] = ffi_type_lookup(int32_s);
 4118   type_by_size[1][sizeof (i32_t)] = ffi_type_lookup(uint32_s);
 4119 #endif
 4120 #if HAVE_I16
 4121   type_by_size[0][sizeof (i16_t)] = ffi_type_lookup(int16_s);
 4122   type_by_size[1][sizeof (i16_t)] = ffi_type_lookup(uint16_s);
 4123 #endif
 4124 #if HAVE_I8
 4125   type_by_size[0][sizeof (i8_t)] = ffi_type_lookup(int8_s);
 4126   type_by_size[1][sizeof (i8_t)] = ffi_type_lookup(uint8_s);
 4127 #endif
 4128   type_by_size[0][sizeof (long)] = ffi_type_lookup(long_s);
 4129   type_by_size[1][sizeof (long)] = ffi_type_lookup(ulong_s);
 4130   type_by_size[0][sizeof (int)] = ffi_type_lookup(int_s);
 4131   type_by_size[1][sizeof (int)] = ffi_type_lookup(uint_s);
 4132   type_by_size[0][sizeof (short)] = ffi_type_lookup(short_s);
 4133   type_by_size[1][sizeof (short)] = ffi_type_lookup(ushort_s);
 4134 
 4135   ffi_typedef(intern(lit("size-t"), user_package),
 4136               type_by_size[1][sizeof (size_t)]);
 4137   ffi_typedef(intern(lit("time-t"), user_package),
 4138               type_by_size[convert(time_t, -1) > 0][sizeof (time_t)]);
 4139   ffi_typedef(intern(lit("clock-t"), user_package),
 4140               if3(convert(clock_t, 0.5) == 0,
 4141                   type_by_size[convert(clock_t, -1) > 0][sizeof (clock_t)],
 4142                   if3(sizeof (clock_t) == sizeof (float),
 4143                       ffi_type_lookup(float_s),
 4144                       if2(sizeof (clock_t) == sizeof (double),
 4145                           ffi_type_lookup(double_s)))));
 4146   ffi_typedef(intern(lit("int-ptr-t"), user_package),
 4147               type_by_size[convert(int_ptr_t, -1) > 0][sizeof (int_ptr_t)]);
 4148   ffi_typedef(intern(lit("uint-ptr-t"), user_package),
 4149               type_by_size[convert(uint_ptr_t, -1) > 0][sizeof (uint_ptr_t)]);
 4150   ffi_typedef(intern(lit("sig-atomic-t"), user_package),
 4151               type_by_size[convert(sig_atomic_t, -1) > 0][sizeof (sig_atomic_t)]);
 4152   ffi_typedef(intern(lit("ptrdiff-t"), user_package),
 4153               type_by_size[convert(ptrdiff_t, -1) > 0][sizeof (ptrdiff_t)]);
 4154   ffi_typedef(intern(lit("wint-t"), user_package),
 4155               type_by_size[convert(wint_t, -1) > 0][sizeof (wint_t)]);
 4156 
 4157 #if HAVE_SYS_TYPES_H
 4158   ffi_typedef(intern(lit("blkcnt-t"), user_package),
 4159               type_by_size[convert(blkcnt_t, -1) > 0][sizeof (blkcnt_t)]);
 4160   ffi_typedef(intern(lit("blksize-t"), user_package),
 4161               type_by_size[convert(blksize_t, -1) > 0][sizeof (blksize_t)]);
 4162 #if HAVE_CLOCKID_T
 4163   ffi_typedef(intern(lit("clockid-t"), user_package),
 4164               type_by_size[convert(clockid_t, -1) > 0][sizeof (clockid_t)]);
 4165 #endif
 4166   ffi_typedef(intern(lit("dev-t"), user_package),
 4167               type_by_size[convert(dev_t, -1) > 0][sizeof (dev_t)]);
 4168   ffi_typedef(intern(lit("fsblkcnt-t"), user_package),
 4169               type_by_size[convert(fsblkcnt_t, -1) > 0][sizeof (fsblkcnt_t)]);
 4170   ffi_typedef(intern(lit("fsfilcnt-t"), user_package),
 4171               type_by_size[convert(fsfilcnt_t, -1) > 0][sizeof (fsfilcnt_t)]);
 4172   ffi_typedef(intern(lit("gid-t"), user_package),
 4173               type_by_size[convert(gid_t, -1) > 0][sizeof (gid_t)]);
 4174   ffi_typedef(intern(lit("id-t"), user_package),
 4175               type_by_size[convert(id_t, -1) > 0][sizeof (id_t)]);
 4176   ffi_typedef(intern(lit("ino-t"), user_package),
 4177               type_by_size[convert(ino_t, -1) > 0][sizeof (ino_t)]);
 4178   ffi_typedef(intern(lit("key-t"), user_package),
 4179               type_by_size[convert(key_t, -1) > 0][sizeof (key_t)]);
 4180 #if HAVE_LOFF_T
 4181   ffi_typedef(intern(lit("loff-t"), user_package),
 4182               type_by_size[convert(loff_t, -1) > 0][sizeof (loff_t)]);
 4183 #endif
 4184   ffi_typedef(intern(lit("mode-t"), user_package),
 4185               type_by_size[convert(mode_t, -1) > 0][sizeof (mode_t)]);
 4186   ffi_typedef(intern(lit("nlink-t"), user_package),
 4187               type_by_size[convert(nlink_t, -1) > 0][sizeof (nlink_t)]);
 4188   ffi_typedef(intern(lit("off-t"), user_package),
 4189               type_by_size[convert(off_t, -1) > 0][sizeof (off_t)]);
 4190   ffi_typedef(intern(lit("pid-t"), user_package),
 4191               type_by_size[convert(pid_t, -1) > 0][sizeof (pid_t)]);
 4192   ffi_typedef(intern(lit("ssize-t"), user_package),
 4193               type_by_size[convert(ssize_t, -1) > 0][sizeof (ssize_t)]);
 4194   ffi_typedef(intern(lit("uid-t"), user_package),
 4195               type_by_size[convert(uid_t, -1) > 0][sizeof (uid_t)]);
 4196 #endif
 4197   ffi_typedef(intern(lit("longlong"), user_package),
 4198               type_by_size[0][sizeof (long long)]);
 4199   ffi_typedef(intern(lit("ulonglong"), user_package),
 4200               type_by_size[1][sizeof (long long)]);
 4201 }
 4202 
 4203 #if HAVE_LIBFFI
 4204 
 4205 struct txr_ffi_call_desc {
 4206   ffi_cif cif;
 4207   ffi_type **args;
 4208   int variadic;
 4209   cnum nfixed, ntotal;
 4210   val argtypes;
 4211   val rettype;
 4212 };
 4213 
 4214 static struct txr_ffi_call_desc *ffi_call_desc(val obj)
 4215 {
 4216   return coerce(struct txr_ffi_call_desc *, obj->co.handle);
 4217 }
 4218 
 4219 static struct txr_ffi_call_desc *ffi_call_desc_checked(val self, val obj)
 4220 {
 4221   return coerce(struct txr_ffi_call_desc *, cobj_handle(self, obj,
 4222                                                         ffi_call_desc_s));
 4223 }
 4224 
 4225 static void ffi_call_desc_print_op(val obj, val out,
 4226                                    val pretty, struct strm_ctx *ctx)
 4227 {
 4228   struct txr_ffi_call_desc *tfcd = ffi_call_desc(obj);
 4229   put_string(lit("#<"), out);
 4230   obj_print_impl(obj->co.cls, out, pretty, ctx);
 4231   format(out, lit(" ~s ~!~s>"), tfcd->rettype, tfcd->argtypes, nao);
 4232 }
 4233 
 4234 static void ffi_call_desc_destroy_op(val obj)
 4235 {
 4236   struct txr_ffi_call_desc *tfcd = ffi_call_desc(obj);
 4237   free(tfcd->args);
 4238   tfcd->args = 0;
 4239   free(tfcd);
 4240 }
 4241 
 4242 static void ffi_call_desc_mark_op(val obj)
 4243 {
 4244   struct txr_ffi_call_desc *tfcd = ffi_call_desc(obj);
 4245   gc_mark(tfcd->argtypes);
 4246   gc_mark(tfcd->rettype);
 4247 }
 4248 
 4249 static struct cobj_ops ffi_call_desc_ops =
 4250   cobj_ops_init(eq,
 4251                 ffi_call_desc_print_op,
 4252                 ffi_call_desc_destroy_op,
 4253                 ffi_call_desc_mark_op,
 4254                 cobj_eq_hash_op);
 4255 
 4256 val ffi_make_call_desc(val ntotal, val nfixed, val rettype, val argtypes)
 4257 {
 4258   val self = lit("ffi-make-call-desc");
 4259   cnum nf = c_num(default_arg(nfixed, zero));
 4260   cnum nt = c_num(ntotal), i;
 4261   struct txr_ffi_call_desc *tfcd = coerce(struct txr_ffi_call_desc *,
 4262                                           chk_calloc(1, sizeof *tfcd));
 4263   ffi_type **args = coerce(ffi_type **, chk_xalloc(nt, sizeof *args, self));
 4264   val obj = cobj(coerce(mem_t *, tfcd), ffi_call_desc_s, &ffi_call_desc_ops);
 4265   ffi_status ffis = FFI_OK;
 4266 
 4267   tfcd->variadic = (nfixed != nil);
 4268   tfcd->nfixed = nf;
 4269   tfcd->ntotal = nt;
 4270   tfcd->argtypes = argtypes;
 4271   tfcd->rettype = rettype;
 4272   tfcd->args = args;
 4273 
 4274   for (i = 0; i < nt; i++) {
 4275     val type = pop(&argtypes);
 4276     struct txr_ffi_type *tft = ffi_type_struct_checked(self, type);
 4277     if (tft->incomplete)
 4278       uw_throwf(error_s, lit("~a: can't pass incomplete type ~s by value"),
 4279                 self, type, nao);
 4280     if (tft->bitfield)
 4281       uw_throwf(error_s, lit("~a: can't pass bitfield as argument"),
 4282                 self, nao);
 4283     args[i] = tft->ft;
 4284   }
 4285 
 4286   {
 4287     struct txr_ffi_type *tft = ffi_type_struct_checked(self, rettype);
 4288     if (tft->incomplete && tft->ft != &ffi_type_void)
 4289       uw_throwf(error_s, lit("~a: can't return incomplete type ~s by value"),
 4290                 self, rettype, nao);
 4291     if (tft->bitfield)
 4292       uw_throwf(error_s, lit("~a: can't return bitfield from function"),
 4293                 self, nao);
 4294   }
 4295 
 4296   if (tfcd->variadic)
 4297     ffis = ffi_prep_cif_var(&tfcd->cif, FFI_DEFAULT_ABI, nf, nt,
 4298                             ffi_get_type(self, rettype), args);
 4299   else
 4300     ffis = ffi_prep_cif(&tfcd->cif, FFI_DEFAULT_ABI, nt,
 4301                         ffi_get_type(self, rettype), args);
 4302 
 4303   if (ffis != FFI_OK)
 4304     uw_throwf(error_s, lit("~a: ffi_prep_cif failed: ~s"),
 4305               self, num(ffis), nao);
 4306 
 4307   return obj;
 4308 }
 4309 
 4310 val ffi_call_wrap(val fptr, val ffi_call_desc, struct args *args)
 4311 {
 4312   val self = lit("ffi-call");
 4313   struct txr_ffi_call_desc *tfcd = ffi_call_desc_checked(self, ffi_call_desc);
 4314   mem_t *fp = cptr_get(fptr);
 4315   cnum n = tfcd->ntotal;
 4316   void **values = convert(void **, alloca(sizeof *values * tfcd->ntotal));
 4317   val types = tfcd->argtypes;
 4318   val rtype = tfcd->rettype;
 4319   struct txr_ffi_type *rtft = ffi_type_struct(rtype);
 4320   void *rc = alloca(pad_retval(rtft->size));
 4321   int in_pass_needed = 0;
 4322   volatile int cleanup_needed = 1;
 4323   volatile cnum i;
 4324   val ret;
 4325   struct txr_ffi_type **type = convert(struct txr_ffi_type **,
 4326                                        alloca(n * sizeof *type));
 4327 
 4328   if (args->argc < n) {
 4329     args_decl(args_copy, n);
 4330     args_copy_zap(args_copy, args);
 4331     args = args_copy;
 4332   }
 4333 
 4334   args_normalize_least(args, n);
 4335 
 4336   if (args->fill < n || args->list)
 4337     uw_throwf(error_s, lit("~a: ~s requires ~s arguments"),
 4338               self, ffi_call_desc, num(n), nao);
 4339 
 4340   for (i = 0; i < n; i++) {
 4341     struct txr_ffi_type *mtft = type[i] = ffi_type_struct(pop(&types));
 4342     values[i] = zalloca(mtft->size);
 4343     in_pass_needed = in_pass_needed || mtft->by_value_in;
 4344   }
 4345 
 4346   uw_simple_catch_begin;
 4347 
 4348   for (i = 0; i < n; i++) {
 4349     struct txr_ffi_type *mtft = type[i];
 4350     mtft->put(mtft, args->arg[i], convert(mem_t *, values[i]), self);
 4351   }
 4352 
 4353   cleanup_needed = 0;
 4354 
 4355   uw_unwind {
 4356     if (cleanup_needed && in_pass_needed) {
 4357       cnum nreached = i;
 4358       for (i = 0; i < nreached; i++) {
 4359         struct txr_ffi_type *mtft = type[i];
 4360         if (mtft->release != 0)
 4361           mtft->release(mtft, args->arg[i], convert(mem_t *, values[i]));
 4362       }
 4363     }
 4364   }
 4365 
 4366   uw_catch_end;
 4367 
 4368   ffi_call(&tfcd->cif, coerce(void (*)(void), fp), rc, values);
 4369 
 4370   ret = ifbe2(rtft->rget, rtft->get)(rtft, convert(mem_t *, rc), self);
 4371 
 4372   if (in_pass_needed) {
 4373     for (i = 0; i < n; i++) {
 4374       struct txr_ffi_type *mtft = type[i];
 4375       if (mtft->by_value_in)
 4376         mtft->in(mtft, 0, convert(mem_t *, values[i]), args->arg[i], self);
 4377     }
 4378   }
 4379 
 4380   if (s_exit_point) {
 4381     uw_frame_t *ep = s_exit_point;
 4382     s_exit_point = 0;
 4383     uw_continue(ep);
 4384   }
 4385 
 4386   return ret;
 4387 }
 4388 
 4389 static void ffi_closure_dispatch(ffi_cif *cif, void *cret,
 4390                                  void *cargs[], void *clo)
 4391 {
 4392   val self = lit("ffi-closure-dispatch");
 4393   val closure = coerce(val, clo);
 4394   struct txr_ffi_closure *tfcl = ffi_closure_struct(closure);
 4395   cnum i, nargs = tfcl->nparam;
 4396   struct txr_ffi_call_desc *tfcd = tfcl->tfcd;
 4397   val types = tfcd->argtypes;
 4398   val rtype = tfcd->rettype;
 4399   struct txr_ffi_type *rtft = ffi_type_struct(rtype);
 4400   val retval = nil;
 4401   int out_pass_needed = 0;
 4402   args_decl(args, nargs);
 4403   args_decl(args_cp, nargs);
 4404 
 4405   for (i = 0; i < nargs; i++) {
 4406     val type = pop(&types);
 4407     struct txr_ffi_type *mtft = ffi_type_struct(type);
 4408     val arg = mtft->get(mtft, convert(mem_t *, cargs[i]), self);
 4409     args_add(args, arg);
 4410     if (mtft->out != 0)
 4411       out_pass_needed = 1;
 4412   }
 4413 
 4414   args_copy(args_cp, args);
 4415 
 4416   retval = generic_funcall(tfcl->fun, args);
 4417 
 4418   if (out_pass_needed) {
 4419     for (types = tfcd->argtypes, i = 0; i < nargs; i++) {
 4420       val type = pop(&types);
 4421       val arg = args_at(args_cp, i);
 4422       struct txr_ffi_type *mtft = ffi_type_struct(type);
 4423       if (mtft->out != 0)
 4424         mtft->out(mtft, 0, arg, convert(mem_t *, cargs[i]), self);
 4425     }
 4426   }
 4427 
 4428   ifbe2(rtft->rput, rtft->put)(rtft, retval, convert(mem_t *, cret), self);
 4429 }
 4430 
 4431 static void ffi_closure_dispatch_safe(ffi_cif *cif, void *cret,
 4432                                       void *cargs[], void *clo)
 4433 {
 4434   val self = lit("ffi-closure-dispatch-safe");
 4435   val closure = coerce(val, clo);
 4436   struct txr_ffi_closure *tfcl = ffi_closure_struct(closure);
 4437   cnum i, nargs = tfcl->nparam;
 4438   struct txr_ffi_call_desc *tfcd = tfcl->tfcd;
 4439   val types = tfcd->argtypes;
 4440   val rtype = tfcd->rettype;
 4441   struct txr_ffi_type *rtft = ffi_type_struct(rtype);
 4442   volatile val retval = nao;
 4443   int out_pass_needed = 0;
 4444   size_t rsize = pad_retval(rtft->size);
 4445   uw_frame_t cont_guard;
 4446 
 4447   if (rtft->release != 0)
 4448     memset(cret, 0, rsize);
 4449 
 4450   s_exit_point = 0;
 4451 
 4452   uw_push_guard(&cont_guard, 0);
 4453 
 4454   uw_simple_catch_begin;
 4455 
 4456   {
 4457     args_decl(args, nargs);
 4458     args_decl(args_cp, nargs);
 4459 
 4460     for (i = 0; i < nargs; i++) {
 4461       val type = pop(&types);
 4462       struct txr_ffi_type *mtft = ffi_type_struct(type);
 4463       val arg = mtft->get(mtft, convert(mem_t *, cargs[i]), self);
 4464       args_add(args, arg);
 4465       if (mtft->out != 0)
 4466         out_pass_needed = 1;
 4467     }
 4468 
 4469     args_copy(args_cp, args);
 4470 
 4471     retval = generic_funcall(tfcl->fun, args);
 4472 
 4473     if (out_pass_needed) {
 4474       for (types = tfcd->argtypes, i = 0; i < nargs; i++) {
 4475         val type = pop(&types);
 4476         val arg = args_at(args_cp, i);
 4477         struct txr_ffi_type *mtft = ffi_type_struct(type);
 4478         if (mtft->out != 0)
 4479           mtft->out(mtft, 0, arg, convert(mem_t *, cargs[i]), self);
 4480       }
 4481     }
 4482 
 4483     ifbe2(rtft->rput, rtft->put)(rtft, retval, convert(mem_t *, cret), self);
 4484   }
 4485 
 4486   uw_unwind {
 4487     s_exit_point = uw_curr_exit_point;
 4488     if (s_exit_point) {
 4489       if (rtft->release != 0 && retval != nao)
 4490         rtft->release(rtft, retval, convert(mem_t *, cret));
 4491       if (!tfcl->abort_retval)
 4492         memset(cret, 0, rsize);
 4493       else
 4494         ifbe2(rtft->rput, rtft->put)(rtft, tfcl->abort_retval,
 4495                                      convert(mem_t *, cret), self);
 4496     }
 4497     uw_curr_exit_point = 0; /* stops unwinding */
 4498   }
 4499 
 4500   uw_catch_end;
 4501 
 4502   uw_pop_frame(&cont_guard);
 4503 }
 4504 
 4505 
 4506 val ffi_make_closure(val fun, val call_desc, val safe_p_in, val abort_ret_in)
 4507 {
 4508   val self = lit("ffi-make-closure");
 4509   struct txr_ffi_closure *tfcl = coerce(struct txr_ffi_closure *,
 4510                                         chk_calloc(1, sizeof *tfcl));
 4511   struct txr_ffi_call_desc *tfcd = ffi_call_desc_checked(self, call_desc);
 4512   val obj = cobj(coerce(mem_t *, tfcl), ffi_closure_s, &ffi_closure_ops);
 4513   val safe_p = default_arg_strict(safe_p_in, t);
 4514   ffi_status ffis = FFI_OK;
 4515 
 4516   tfcl->clo = convert(ffi_closure *,
 4517                       ffi_closure_alloc(sizeof *tfcl->clo,
 4518                                         coerce(void **, &tfcl->fptr)));
 4519 
 4520   if (!tfcl->clo)
 4521     uw_throwf(error_s, lit("~a: failed to allocate special closure memory"),
 4522               self, nao);
 4523 
 4524   if ((ffis = ffi_prep_closure_loc(tfcl->clo, &tfcd->cif,
 4525                                    if3(safe_p,
 4526                                        ffi_closure_dispatch_safe,
 4527                                        ffi_closure_dispatch),
 4528                                    obj,
 4529                                    coerce(void *, tfcl->fptr))) != FFI_OK)
 4530     uw_throwf(error_s, lit("~a: ffi_prep_closure_loc failed: ~s"),
 4531               self, num(ffis), nao);
 4532 
 4533   tfcl->nparam = tfcd->ntotal;
 4534   tfcl->fun = fun;
 4535   tfcl->call_desc = call_desc;
 4536   tfcl->tfcd = tfcd;
 4537   tfcl->abort_retval = default_null_arg(abort_ret_in);
 4538 
 4539   return obj;
 4540 }
 4541 
 4542 mem_t *ffi_closure_get_fptr(val self, val closure)
 4543 {
 4544   struct txr_ffi_closure *tfcl = ffi_closure_struct_checked(self, closure);
 4545   return tfcl->fptr;
 4546 }
 4547 
 4548 #endif
 4549 
 4550 val ffi_typedef(val name, val type)
 4551 {
 4552   val self = lit("ffi-typedef");
 4553   struct txr_ffi_type *tft = ffi_type_struct_checked(self, type);
 4554   if (tft->bitfield)
 4555     uw_throwf(error_s, lit("~a: cannot create a typedef for bitfield type"),
 4556               self, nao);
 4557   return sethash(ffi_typedef_hash, name, type);
 4558 }
 4559 
 4560 val ffi_size(val type)
 4561 {
 4562   val self = lit("ffi-size");
 4563   struct txr_ffi_type *tft = ffi_type_struct_checked(self, type);
 4564   if (tft->bitfield)
 4565     uw_throwf(error_s, lit("~a: bitfield type ~s has no size"),
 4566               self, type, nao);
 4567   return num(tft->size);
 4568 }
 4569 
 4570 val ffi_alignof(val type)
 4571 {
 4572   val self = lit("ffi-alignof");
 4573   struct txr_ffi_type *tft = ffi_type_struct_checked(self, type);
 4574   if (tft->bitfield)
 4575     uw_throwf(error_s, lit("~a: bitfield type ~s has no alignment"),
 4576               self, type, nao);
 4577   return num(tft->align);
 4578 }
 4579 
 4580 val ffi_offsetof(val type, val memb)
 4581 {
 4582   val self = lit("ffi-offsetof");
 4583   struct txr_ffi_type *tft = ffi_type_struct_checked(self, type);
 4584   cnum i;
 4585 
 4586   if (!tft->memb)
 4587     uw_throwf(error_s, lit("~a: ~s isn't a struct type"), self, type, nao);
 4588 
 4589   for (i = 0; i < tft->nelem; i++) {
 4590     struct smemb *pmemb = tft->memb + i;
 4591 
 4592     if (pmemb->mname == memb) {
 4593       if (pmemb->mtft->mask != 0)
 4594         uw_throwf(error_s, lit("~a: ~s is a bitfield in ~s"), self,
 4595                   memb, type, nao);
 4596       return num(tft->memb[i].offs);
 4597     }
 4598   }
 4599 
 4600   uw_throwf(error_s, lit("~a: ~s has no member ~s"), self, type, memb, nao);
 4601 }
 4602 
 4603 val ffi_arraysize(val type)
 4604 {
 4605   val self = lit("ffi-put-into");
 4606   struct txr_ffi_type *tft = ffi_type_struct_checked(self, type);
 4607   if (!tft->eltype)
 4608     uw_throwf(error_s, lit("~a: ~s isn't an array"), self, type, nao);
 4609   return num(tft->nelem);
 4610 }
 4611 
 4612 val ffi_elemsize(val type)
 4613 {
 4614   val self = lit("ffi-elemsize");
 4615   struct txr_ffi_type *tft = ffi_type_struct_checked(self, type);
 4616   if (!tft->eltype) {
 4617     uw_throwf(error_s, lit("~a: ~s isn't an array, pointer or enum"),
 4618               self, type, nao);
 4619   } else {
 4620     struct txr_ffi_type *etft = ffi_type_struct(tft->eltype);
 4621     return num(etft->size);
 4622   }
 4623 }
 4624 
 4625 val ffi_elemtype(val type)
 4626 {
 4627   val self = lit("ffi-elemtype");
 4628   struct txr_ffi_type *tft = ffi_type_struct_checked(self, type);
 4629   val eltype = tft->eltype;
 4630 
 4631   if (!eltype) {
 4632     uw_throwf(error_s, lit("~a: ~s isn't an array, pointer or enum"),
 4633               self, type, nao);
 4634   }
 4635 
 4636   return eltype;
 4637 }
 4638 
 4639 val ffi_put_into(val dstbuf, val obj, val type, val offset_in)
 4640 {
 4641   val self = lit("ffi-put-into");
 4642   struct txr_ffi_type *tft = ffi_type_struct_checked(self, type);
 4643   mem_t *dst = buf_get(dstbuf, self);
 4644   val offset = default_arg(offset_in, zero);
 4645   cnum offsn = c_num(offset);
 4646   cnum room = c_num(minus(length_buf(dstbuf), offset));
 4647   cnum size = tft->dynsize(tft, obj, self);
 4648   if (offsn < 0)
 4649     uw_throwf(error_s, lit("~a: negative offset ~s specified"),
 4650               self, offset, nao);
 4651   if (room < size)
 4652     uw_throwf(error_s, lit("~a: buffer ~s is too small for type ~s at offset ~s"),
 4653               self, dstbuf, type, offset, nao);
 4654   tft->put(tft, obj, dst + offsn, self);
 4655   return dstbuf;
 4656 }
 4657 
 4658 val ffi_put(val obj, val type)
 4659 {
 4660   val self = lit("ffi-put");
 4661   struct txr_ffi_type *tft = ffi_type_struct_checked(self, type);
 4662   val buf = make_buf(num(tft->dynsize(tft, obj, self)), zero, nil);
 4663   mem_t *dst = buf_get(buf, self);
 4664   tft->put(tft, obj, dst, self);
 4665   return buf;
 4666 }
 4667 
 4668 val ffi_in(val srcbuf, val obj, val type, val copy_p, val offset_in)
 4669 {
 4670   val self = lit("ffi-in");
 4671   struct txr_ffi_type *tft = ffi_type_struct_checked(self, type);
 4672   mem_t *src = buf_get(srcbuf, self);
 4673   val offset = default_arg(offset_in, zero);
 4674   cnum offsn = c_num(offset);
 4675   cnum room = c_num(minus(length_buf(srcbuf), offset));
 4676   cnum size = tft->dynsize(tft, obj, self);
 4677   if (offsn < 0)
 4678     uw_throwf(error_s, lit("~a: negative offset ~s specified"),
 4679               self, offset, nao);
 4680   if (room < size)
 4681     uw_throwf(error_s, lit("~a: buffer ~s is too small for type ~s at offset ~s"),
 4682               self, srcbuf, type, offset, nao);
 4683   if (tft->in != 0)
 4684     return tft->in(tft, copy_p != nil, src + offsn, obj, self);
 4685   else if (copy_p)
 4686     return tft->get(tft, src + offsn, self);
 4687   return obj;
 4688 }
 4689 
 4690 val ffi_get(val srcbuf, val type, val offset_in)
 4691 {
 4692   val self = lit("ffi-get");
 4693   struct txr_ffi_type *tft = ffi_type_struct_checked(self, type);
 4694   mem_t *src = buf_get(srcbuf, self);
 4695   val offset = default_arg(offset_in, zero);
 4696   cnum offsn = c_num(offset);
 4697   cnum room = c_num(minus(length_buf(srcbuf), offset));
 4698   if (offsn < 0)
 4699     uw_throwf(error_s, lit("~a: negative offset ~s specified"),
 4700               self, offset, nao);
 4701   if (room < tft->size)
 4702     uw_throwf(error_s, lit("~a: buffer ~s is too small for type ~s at offset ~s"),
 4703               self, srcbuf, type, offset, nao);
 4704   return tft->get(tft, src + offsn, self);
 4705 }
 4706 
 4707 val ffi_out(val dstbuf, val obj, val type, val copy_p, val offset_in)
 4708 {
 4709   val self = lit("ffi-out");
 4710   struct txr_ffi_type *tft = ffi_type_struct_checked(self, type);
 4711   mem_t *dst = buf_get(dstbuf, self);
 4712   val offset = default_arg(offset_in, zero);
 4713   cnum offsn = c_num(offset);
 4714   cnum room = c_num(minus(length_buf(dstbuf), offset));
 4715   cnum size = tft->dynsize(tft, obj, self);
 4716   if (offsn < 0)
 4717     uw_throwf(error_s, lit("~a: negative offset ~s specified"),
 4718               self, offset, nao);
 4719   if (room < size)
 4720     uw_throwf(error_s, lit("~a: buffer ~s is too small for type ~s at offset ~s"),
 4721               self, dstbuf, type, offset, nao);
 4722   if (tft->out != 0)
 4723     tft->out(tft, copy_p != nil, obj, dst + offsn, self);
 4724   else
 4725     tft->put(tft, obj, dst + offsn, self);
 4726   return dstbuf;
 4727 }
 4728 
 4729 struct carray {
 4730   val eltype;
 4731   struct txr_ffi_type *eltft;
 4732   mem_t *data;
 4733   cnum nelem;
 4734   val ref;
 4735   cnum offs;
 4736   val artype;
 4737 };
 4738 
 4739 static struct carray *carray_struct(val carray)
 4740 {
 4741   return coerce(struct carray*, carray->co.handle);
 4742 }
 4743 
 4744 static struct carray *carray_struct_checked(val self, val carray)
 4745 {
 4746   return coerce(struct carray*, cobj_handle(self, carray, carray_s));
 4747 }
 4748 
 4749 static void carray_print_op(val obj, val out, val pretty, struct strm_ctx *ctx)
 4750 {
 4751   struct carray *scry = carray_struct(obj);
 4752   put_string(lit("#<"), out);
 4753   obj_print_impl(obj->co.cls, out, pretty, ctx);
 4754   format(out, lit(" ~a"), if3(scry->nelem < 0,
 4755                               lit("unknown-len"), num(scry->nelem)), nao);
 4756   format(out, lit(" ~s>"), scry->eltype, nao);
 4757 }
 4758 
 4759 static void carray_mark_op(val obj)
 4760 {
 4761   struct carray *scry = carray_struct(obj);
 4762   gc_mark(scry->eltype);
 4763   gc_mark(scry->ref);
 4764   gc_mark(scry->artype);
 4765 }
 4766 
 4767 static void carray_destroy_op(val obj)
 4768 {
 4769   struct carray *scry = carray_struct(obj);
 4770   free(scry->data);
 4771   scry->data = 0;
 4772   free(scry);
 4773 }
 4774 
 4775 static struct cobj_ops carray_borrowed_ops =
 4776   cobj_ops_init(eq,
 4777                 carray_print_op,
 4778                 cobj_destroy_free_op,
 4779                 carray_mark_op,
 4780                 cobj_eq_hash_op);
 4781 
 4782 static struct cobj_ops carray_owned_ops =
 4783   cobj_ops_init(eq,
 4784                 carray_print_op,
 4785                 carray_destroy_op,
 4786                 carray_mark_op,
 4787                 cobj_eq_hash_op);
 4788 
 4789 val make_carray(val type, mem_t *data, cnum nelem, val ref, cnum offs)
 4790 {
 4791   val self = lit("make-carray");
 4792   struct carray *scry = coerce(struct carray *, chk_malloc(sizeof *scry));
 4793   val obj;
 4794   scry->eltype = nil;
 4795   scry->eltft = ffi_type_struct_checked(self, type);
 4796   scry->data = data;
 4797   scry->nelem = nelem;
 4798   scry->ref = nil;
 4799   scry->artype = nil;
 4800   obj = cobj(coerce(mem_t *, scry), carray_s, &carray_borrowed_ops);
 4801   scry->eltype = type;
 4802   scry->ref = ref;
 4803   scry->offs = offs;
 4804   return obj;
 4805 }
 4806 
 4807 val carrayp(val obj)
 4808 {
 4809   return tnil(typeof(obj) == carray_s);
 4810 }
 4811 
 4812 val carray_set_length(val carray, val nelem)
 4813 {
 4814   val self = lit("carray-set-length");
 4815   struct carray *scry = carray_struct_checked(self, carray);
 4816   cnum nel = c_num(nelem);
 4817 
 4818   if (carray->co.ops == &carray_owned_ops)
 4819     uw_throwf(error_s,
 4820               lit("~a: can't set length of owned carray ~s"), self,
 4821               carray, nao);
 4822 
 4823   if (nel < 0)
 4824     uw_throwf(error_s,
 4825               lit("~a: can't set length of ~s to negative value"), self,
 4826               carray, nao);
 4827 
 4828   scry->nelem = nel;
 4829   return nil;
 4830 }
 4831 
 4832 val carray_dup(val carray)
 4833 {
 4834   val self = lit("carray-dup");
 4835   struct carray *scry = carray_struct_checked(self, carray);
 4836 
 4837   if (carray->co.ops == &carray