klisp

an open source interpreter for the Kernel Programming Language.
git clone http://git.hanabi.in/repos/klisp.git
Log | Files | Refs | README

kgffi.c (35769B)


      1 /*
      2 ** kgffi.c
      3 ** Foreign function interface
      4 ** See Copyright Notice in klisp.h
      5 */
      6 
      7 /*
      8  * Detect dynamic linking facilities.
      9  *
     10  */
     11 #if !defined(KLISP_USE_POSIX) && defined(_WIN32)
     12 #    define KGFFI_WIN32 true
     13 #else
     14 #    define KGFFI_DLFCN true
     15 #endif
     16 
     17 #include <assert.h>
     18 #include <stdlib.h>
     19 #include <stdbool.h>
     20 #include <stdint.h>
     21 #include <string.h>
     22 
     23 #if KGFFI_DLFCN
     24 #    include <dlfcn.h>
     25 #elif KGFFI_WIN32
     26 #    include <windows.h>
     27 #else
     28 #    error
     29 #endif
     30 
     31 #include <ffi.h>
     32 
     33 #include "imath.h"
     34 #include "kstate.h"
     35 #include "kobject.h"
     36 #include "kinteger.h"
     37 #include "kpair.h"
     38 #include "kerror.h"
     39 #include "kbytevector.h"
     40 #include "kencapsulation.h"
     41 #include "ktable.h"
     42 
     43 #include "kghelpers.h"
     44 #include "kgffi.h"
     45 
     46 /* Set to 0 to ignore aligment errors during direct
     47  * memory read/writes. */
     48 
     49 #define KGFFI_CHECK_ALIGNMENT 1
     50 
     51 typedef struct ffi_codec_s ffi_codec_t;
     52 struct ffi_codec_s {
     53     const char *name;
     54     ffi_type *libffi_type;
     55     TValue (*decode)(ffi_codec_t *self, klisp_State *K, const void *buf);
     56     void (*encode)(ffi_codec_t *self, klisp_State *K, TValue v, void *buf);
     57 };
     58 
     59 typedef struct {
     60     ffi_cif cif;
     61     size_t buffer_size;
     62     ffi_codec_t *rcodec;
     63     size_t nargs;
     64     ffi_type **argtypes;
     65     ffi_codec_t **acodecs;
     66 } ffi_call_interface_t;
     67 
     68 typedef struct {
     69     ffi_closure libffi_closure;
     70     klisp_State *K;
     71     Table *table;
     72     size_t index;
     73 } ffi_callback_t;
     74 
     75 #define CB_INDEX_N         0
     76 #define CB_INDEX_STACK  1
     77 #define CB_INDEX_FIRST_CALLBACK  2
     78 
     79 /* Continuations */
     80 void do_ffi_callback_encode_result(klisp_State *K);
     81 void do_ffi_callback_return(klisp_State *K);
     82 
     83 static TValue ffi_decode_void(ffi_codec_t *self, klisp_State *K, const void *buf)
     84 {
     85     UNUSED(self);
     86     UNUSED(K);
     87     UNUSED(buf);
     88     return KINERT;
     89 }
     90 
     91 static void ffi_encode_void(ffi_codec_t *self, klisp_State *K, TValue v, void *buf)
     92 {
     93     /* useful only with callbacks */
     94     UNUSED(self);
     95     UNUSED(K);
     96     UNUSED(buf);
     97     if (!ttisinert(v))
     98         klispE_throw_simple_with_irritants(K, "only inert can be cast to C void", 1, v);
     99 }
    100 
    101 static TValue ffi_decode_sint(ffi_codec_t *self, klisp_State *K, const void *buf)
    102 {
    103     UNUSED(self);
    104     UNUSED(K);
    105     return i2tv(* (int *) buf);
    106 }
    107 
    108 static void ffi_encode_sint(ffi_codec_t *self, klisp_State *K, TValue v, void *buf)
    109 {
    110     if (!ttisfixint(v)) {
    111         klispE_throw_simple_with_irritants(K, "unable to convert to C int", 1, v);
    112         return;
    113     }
    114     /* TODO: bigint, ... */
    115     * (int *) buf = ivalue(v);
    116 }
    117 
    118 static TValue ffi_decode_pointer(ffi_codec_t *self, klisp_State *K, const void *buf)
    119 {
    120     UNUSED(self);
    121     void *p = *(void **)buf;
    122     return (p) ? p2tv(p) : KNIL;
    123 }
    124 
    125 static void ffi_encode_pointer(ffi_codec_t *self, klisp_State *K, TValue v, void *buf)
    126 {
    127     if (ttisbytevector(v)) {
    128         *(void **)buf = tv2bytevector(v)->b;
    129     } else if (ttisstring(v)) {
    130         *(void **)buf = kstring_buf(v);
    131     } else if (ttisnil(v)) {
    132         *(void **)buf = NULL;
    133     } else if (tbasetype_(v) == K_TAG_USER) {
    134         /* TODO: do not use internal macro tbasetype_ */
    135         *(void **)buf = pvalue(v);
    136     } else {
    137         klispE_throw_simple_with_irritants(K, "neither bytevector, string, pointer or nil", 1, v);
    138     }
    139 }
    140 
    141 static TValue ffi_decode_string(ffi_codec_t *self, klisp_State *K, const void *buf)
    142 {
    143     UNUSED(self);
    144     char *s = *(char **) buf;
    145     return (s) ? kstring_new_b_imm(K, s) : KNIL;
    146 }
    147 
    148 static void ffi_encode_string(ffi_codec_t *self, klisp_State *K, TValue v, void *buf)
    149 {
    150     if (ttisstring(v)) {
    151         *(void **)buf = kstring_buf(v);
    152     } else {
    153         klispE_throw_simple_with_irritants(K, "not a string", 1, v);
    154     }
    155 }
    156 
    157 static TValue ffi_decode_uint8(ffi_codec_t *self, klisp_State *K, const void *buf)
    158 {
    159     UNUSED(self);
    160     UNUSED(K);
    161     return i2tv(*(uint8_t *)buf);
    162 }
    163 
    164 static void ffi_encode_uint8(ffi_codec_t *self, klisp_State *K, TValue v, void *buf)
    165 {
    166     UNUSED(self);
    167     if (ttisfixint(v) && 0 <= ivalue(v) && ivalue(v) <= UINT8_MAX) {
    168         *(uint8_t *) buf = ivalue(v);
    169     } else {
    170         klispE_throw_simple_with_irritants(K, "unable to convert to C uint8_t", 1, v);
    171         return;
    172     }
    173 }
    174 
    175 static TValue ffi_decode_sint8(ffi_codec_t *self, klisp_State *K, const void *buf)
    176 {
    177     UNUSED(self);
    178     UNUSED(K);
    179     return i2tv(*(int8_t *)buf);
    180 }
    181 
    182 static void ffi_encode_sint8(ffi_codec_t *self, klisp_State *K, TValue v, void *buf)
    183 {
    184     UNUSED(self);
    185     if (ttisfixint(v) && INT8_MIN <= ivalue(v) && ivalue(v) <= INT8_MAX) {
    186         *(int8_t *) buf = ivalue(v);
    187     } else {
    188         klispE_throw_simple_with_irritants(K, "unable to convert to C int8_t", 1, v);
    189         return;
    190     }
    191 }
    192 
    193 static TValue ffi_decode_uint16(ffi_codec_t *self, klisp_State *K, const void *buf)
    194 {
    195     UNUSED(self);
    196     return i2tv(*(uint16_t *)buf);
    197 }
    198 
    199 static void ffi_encode_uint16(ffi_codec_t *self, klisp_State *K, TValue v, void *buf)
    200 {
    201     UNUSED(self);
    202     if (ttisfixint(v) && 0 <= ivalue(v) && ivalue(v) <= UINT16_MAX) {
    203         *(uint16_t *) buf = ivalue(v);
    204     } else {
    205         klispE_throw_simple_with_irritants(K, "unable to convert to C uint16_t", 1, v);
    206         return;
    207     }
    208 }
    209 
    210 static TValue ffi_decode_sint16(ffi_codec_t *self, klisp_State *K, const void *buf)
    211 {
    212     UNUSED(self);
    213     return i2tv(*(int16_t *)buf);
    214 }
    215 
    216 static void ffi_encode_sint16(ffi_codec_t *self, klisp_State *K, TValue v, void *buf)
    217 {
    218     UNUSED(self);
    219     if (ttisfixint(v) && INT16_MIN <= ivalue(v) && ivalue(v) <= INT16_MAX) {
    220         *(int16_t *) buf = ivalue(v);
    221     } else {
    222         klispE_throw_simple_with_irritants(K, "unable to convert to C int16_t", 1, v);
    223         return;
    224     }
    225 }
    226 
    227 static TValue ffi_decode_uint32(ffi_codec_t *self, klisp_State *K, const void *buf)
    228 {
    229     UNUSED(self);
    230     uint32_t x = *(uint32_t *)buf;
    231     if (x <= INT32_MAX) {
    232         return i2tv((int32_t) x);
    233     } else {
    234         TValue res = kbigint_make_simple(K);
    235         krooted_tvs_push(K, res);
    236 
    237         uint8_t d[4];
    238         for (int i = 3; i >= 0; i--) {
    239             d[i] = (x & 0xFF);
    240             x >>= 8;
    241         }
    242         mp_int_read_unsigned(K, tv2bigint(res), d, 4);
    243 
    244         krooted_tvs_pop(K);
    245         return res;
    246     }
    247 }
    248 
    249 static void ffi_encode_uint32(ffi_codec_t *self, klisp_State *K, TValue v, void *buf)
    250 {
    251     UNUSED(self);
    252     uint32_t tmp;
    253 
    254     if (ttisfixint(v) && 0 <= ivalue(v)) {
    255         *(uint32_t *) buf = ivalue(v);
    256     } else if (ttisbigint(v) && mp_int_to_uint(tv2bigint(v), &tmp) == MP_OK) {
    257         *(uint32_t *) buf = tmp;
    258     } else {
    259         klispE_throw_simple_with_irritants(K, "unable to convert to C uint32_t", 1, v);
    260         return;
    261     }
    262 }
    263 
    264 static TValue ffi_decode_sint32(ffi_codec_t *self, klisp_State *K, const void *buf)
    265 {
    266     UNUSED(self);
    267     return i2tv(*(int32_t *)buf);
    268 }
    269 
    270 static void ffi_encode_sint32(ffi_codec_t *self, klisp_State *K, TValue v, void *buf)
    271 {
    272     UNUSED(self);
    273     if (ttisfixint(v)) {
    274         *(int32_t *) buf = ivalue(v);
    275     } else {
    276         klispE_throw_simple_with_irritants(K, "unable to convert to C int32_t", 1, v);
    277         return;
    278     }
    279 }
    280 
    281 static TValue ffi_decode_uint64(ffi_codec_t *self, klisp_State *K, const void *buf)
    282 {
    283     UNUSED(self);
    284     return kinteger_new_uint64(K, *(uint64_t *)buf);
    285 }
    286 
    287 static void ffi_encode_uint64(ffi_codec_t *self, klisp_State *K, TValue v, void *buf)
    288 {
    289     /* TODO */
    290     UNUSED(self);
    291 
    292     if (ttisfixint(v) && 0 <= ivalue(v)) {
    293         *(uint64_t *) buf = ivalue(v);
    294     } else if (ttisbigint(v)
    295                && mp_int_compare_zero(tv2bigint(v)) >= 0
    296                && mp_int_unsigned_len(tv2bigint(v)) <= 8) {
    297         uint8_t d[8];
    298 
    299         mp_int_to_unsigned(K, tv2bigint(v), d, 8);
    300         uint64_t tmp = d[0];
    301         for (int i = 1; i < 8; i++)
    302             tmp = (tmp << 8) | d[i];
    303         *(uint64_t *) buf = tmp;
    304     } else {
    305         klispE_throw_simple_with_irritants(K, "unable to convert to C uint64_t", 1, v);
    306         return;
    307     }
    308 }
    309 
    310 static TValue ffi_decode_double(ffi_codec_t *self, klisp_State *K, const void *buf)
    311 {
    312     UNUSED(self);
    313     return d2tv(*(double *)buf);
    314 }
    315 
    316 static void ffi_encode_double(ffi_codec_t *self, klisp_State *K, TValue v, void *buf)
    317 {
    318     UNUSED(self);
    319     if (ttisdouble(v)) {
    320         *(double *) buf = dvalue(v);
    321     } else {
    322         klispE_throw_simple_with_irritants(K, "unable to cast to C double", 1, v);
    323         return;
    324     }
    325 }
    326 
    327 static TValue ffi_decode_float(ffi_codec_t *self, klisp_State *K, const void *buf)
    328 {
    329     UNUSED(self);
    330     return d2tv((double) *(float *)buf);
    331 }
    332 
    333 static void ffi_encode_float(ffi_codec_t *self, klisp_State *K, TValue v, void *buf)
    334 {
    335     UNUSED(self);
    336     if (ttisdouble(v)) {
    337         /* TODO: avoid double rounding for rationals/bigints ?*/
    338         *(float *) buf = dvalue(v);
    339     } else {
    340         klispE_throw_simple_with_irritants(K, "unable to cast to C float", 1, v);
    341         return;
    342     }
    343 }
    344 
    345 static ffi_codec_t ffi_codecs[] = {
    346     { "string", &ffi_type_pointer, ffi_decode_string, ffi_encode_string },
    347 #define SIMPLE_TYPE(t) { #t, &ffi_type_ ## t, ffi_decode_ ## t, ffi_encode_ ## t }
    348     SIMPLE_TYPE(void),
    349     SIMPLE_TYPE(sint),
    350     SIMPLE_TYPE(pointer),
    351     SIMPLE_TYPE(uint8),
    352     SIMPLE_TYPE(sint8),
    353     SIMPLE_TYPE(uint16),
    354     SIMPLE_TYPE(sint16),
    355     SIMPLE_TYPE(uint32),
    356     SIMPLE_TYPE(sint32),
    357     SIMPLE_TYPE(uint64),
    358     SIMPLE_TYPE(float),
    359     SIMPLE_TYPE(double)
    360 #undef SIMPLE_TYPE
    361 };
    362 
    363 #ifdef KGFFI_WIN32
    364 static TValue ffi_win32_error_message(klisp_State *K, DWORD dwMessageId)
    365 {
    366     LPTSTR s;
    367     if (0 == FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_ALLOCATE_BUFFER,
    368                            NULL,
    369                            dwMessageId,
    370                            MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),
    371                            (LPTSTR)&s, 0, NULL)) {
    372         return kstring_new_b_imm(K, "Unknown error");
    373     } else {
    374         TValue v = kstring_new_b_imm(K, s);
    375         LocalFree(s);
    376         return v;
    377     }
    378 }
    379 #endif
    380 
    381 void ffi_load_library(klisp_State *K)
    382 {
    383     TValue *xparams = K->next_xparams;
    384     TValue ptree = K->next_value;
    385     TValue denv = K->next_env;
    386     klisp_assert(ttisenvironment(K->next_env));
    387     UNUSED(denv);
    388     /*
    389     ** xparams[0]: encapsulation key denoting loaded library
    390     */
    391 
    392     TValue filename = ptree;
    393     const char *filename_c =
    394         get_opt_tpar(K, filename, "string", ttisstring)
    395         ? kstring_buf(filename) : NULL;
    396 
    397 #if KGFFI_DLFCN
    398     void *handle = dlopen(filename_c, RTLD_LAZY | RTLD_GLOBAL);
    399     if (handle == NULL) {
    400         krooted_tvs_push(K, filename);
    401         const char *err_c = dlerror();
    402         TValue err = (err_c == NULL) ? KNIL : kstring_new_b_imm(K, err_c);
    403         klispE_throw_simple_with_irritants(K, "couldn't load dynamic library",
    404                                            2, filename, err);
    405         return;
    406     }
    407 #elif KGFFI_WIN32
    408     /* TODO: unicode and wide character issues ??? */
    409     HMODULE handle = LoadLibrary(filename_c);
    410     if (handle == NULL) {
    411         krooted_tvs_push(K, filename);
    412         TValue err = ffi_win32_error_message(K, GetLastError());
    413         klispE_throw_simple_with_irritants(K, "couldn't load dynamic library",
    414                                            2, filename, err);
    415         return;
    416     }
    417 #else
    418 #   error
    419 #endif
    420     TValue key = xparams[0];
    421     krooted_tvs_push(K, key);
    422 
    423     TValue safe_filename = (filename_c) ? filename : kstring_new_b_imm(K, "interpreter binary or statically linked library");
    424     krooted_tvs_push(K, safe_filename);
    425 
    426     TValue lib_tv = kcons(K, p2tv(handle), safe_filename);
    427     krooted_tvs_push(K, lib_tv);
    428 
    429     TValue enc = kmake_encapsulation(K, key, lib_tv);
    430     krooted_tvs_pop(K);
    431     krooted_tvs_pop(K);
    432     krooted_tvs_pop(K);
    433     kapply_cc(K, enc);
    434 }
    435 
    436 static ffi_abi tv2ffi_abi(klisp_State *K, TValue v)
    437 {
    438     if (!strcmp("FFI_DEFAULT_ABI", kstring_buf(v))) {
    439         return FFI_DEFAULT_ABI;
    440     } else if (!strcmp("FFI_SYSV", kstring_buf(v))) {
    441         return FFI_SYSV;
    442 #if KGFFI_WIN32
    443     } else if (!strcmp("FFI_STDCALL", kstring_buf(v))) {
    444         return FFI_STDCALL;
    445 #endif
    446     } else {
    447         klispE_throw_simple_with_irritants(K, "unsupported FFI ABI", 1, v);
    448         return 0;
    449     }
    450 }
    451 
    452 static ffi_codec_t *tv2ffi_codec(klisp_State *K, TValue v)
    453 {
    454     for (size_t i = 0; i < sizeof(ffi_codecs)/sizeof(ffi_codecs[0]); i++) {
    455         if (!strcmp(ffi_codecs[i].name, kstring_buf(v)))
    456             return &ffi_codecs[i];
    457     }
    458     klispE_throw_simple_with_irritants(K, "unsupported FFI type", 1, v);
    459     return NULL;
    460 }
    461 
    462 static inline size_t align(size_t offset, size_t alignment)
    463 {
    464     assert(alignment > 0);
    465     return offset + (alignment - offset % alignment) % alignment;
    466 }
    467 
    468 void ffi_make_call_interface(klisp_State *K)
    469 {
    470     TValue *xparams = K->next_xparams;
    471     TValue ptree = K->next_value;
    472     TValue denv = K->next_env;
    473     klisp_assert(ttisenvironment(K->next_env));
    474     UNUSED(denv);
    475     /*
    476     ** xparams[0]: encapsulation key denoting call interface
    477     */
    478 
    479 #define ttislist(v) (ttispair(v) || ttisnil(v))
    480     bind_3tp(K, ptree,
    481              "abi string", ttisstring, abi_tv,
    482              "rtype string", ttisstring, rtype_tv,
    483              "argtypes string list", ttislist, argtypes_tv);
    484 #undef ttislist
    485 
    486     size_t nargs;
    487     check_typed_list(K, kstringp, false, argtypes_tv, (int32_t *) &nargs, 
    488                      NULL);
    489 
    490     /* Allocate C structure ffi_call_interface_t inside
    491        a mutable bytevector. The structure contains C pointers
    492        into itself. It must never be reallocated or copied.
    493        The bytevector will be encapsulated later to protect
    494        it from lisp code. */
    495 
    496     size_t bytevector_size = sizeof(ffi_call_interface_t) + (sizeof(ffi_codec_t *) + sizeof(ffi_type)) * nargs;
    497     TValue bytevector = kbytevector_new_sf(K, bytevector_size, 0);
    498     krooted_tvs_push(K, bytevector);
    499 
    500     ffi_call_interface_t *p = (ffi_call_interface_t *) tv2bytevector(bytevector)->b;
    501     p->acodecs = (ffi_codec_t **) ((char *) p + sizeof(ffi_call_interface_t));
    502     p->argtypes = (ffi_type **) ((char *) p + sizeof(ffi_call_interface_t) + nargs * sizeof(ffi_codec_t *));
    503     p->nargs = nargs;
    504     p->rcodec = tv2ffi_codec(K, rtype_tv);
    505     if (p->rcodec->decode == NULL) {
    506         klispE_throw_simple_with_irritants(K, "this type is not allowed as a return type", 1, rtype_tv);
    507         return;
    508     }
    509 
    510     p->buffer_size = p->rcodec->libffi_type->size;
    511     TValue tail = argtypes_tv;
    512     for (int i = 0; i < nargs; i++) {
    513         p->acodecs[i] = tv2ffi_codec(K, kcar(tail));
    514         if (p->acodecs[i]->encode == NULL) {
    515             klispE_throw_simple_with_irritants(K, "this type is not allowed in argument list", 1, kcar(tail));
    516             return;
    517         }
    518         ffi_type *t = p->acodecs[i]->libffi_type;
    519         p->argtypes[i] = t;
    520         p->buffer_size = align(p->buffer_size, t->alignment) + t->size;
    521         tail = kcdr(tail);
    522     }
    523     ffi_abi abi = tv2ffi_abi(K, abi_tv);
    524 
    525     ffi_status status = ffi_prep_cif(&p->cif, abi, nargs, p->rcodec->libffi_type, p->argtypes);
    526     switch (status) {
    527     case FFI_OK:
    528         break;
    529     case FFI_BAD_ABI:
    530         klispE_throw_simple(K, "FFI_BAD_ABI");
    531         return;
    532     case FFI_BAD_TYPEDEF:
    533         klispE_throw_simple(K, "FFI_BAD_TYPEDEF");
    534         return;
    535     default:
    536         klispE_throw_simple(K, "unknown error in ffi_prep_cif");
    537         return;
    538     }
    539 
    540     TValue key = xparams[0];
    541     TValue enc = kmake_encapsulation(K, key, bytevector);
    542     krooted_tvs_pop(K);
    543     kapply_cc(K, enc);
    544 }
    545 
    546 void do_ffi_call(klisp_State *K)
    547 {
    548     TValue *xparams = K->next_xparams;
    549     TValue ptree = K->next_value;
    550     TValue denv = K->next_env;
    551     klisp_assert(ttisenvironment(K->next_env));
    552     UNUSED(denv);
    553     /*
    554     ** xparams[0]: function pointer
    555     ** xparams[1]: call interface (encapsulated bytevector)
    556     */
    557 
    558     void *funptr = pvalue(xparams[0]);
    559     ffi_call_interface_t *p = (ffi_call_interface_t *) tv2bytevector(kget_enc_val(xparams[1]))->b;
    560 
    561 
    562     int64_t buffer[(p->buffer_size + sizeof(int64_t) - 1) / sizeof(int64_t)];
    563     void *aptrs[p->nargs];
    564 
    565     size_t offset = 0;
    566     void *rptr = (unsigned char *) buffer + offset;
    567     offset += p->rcodec->libffi_type->size;
    568 
    569     TValue tail = ptree;
    570     for (int i = 0; i < p->nargs; i++) {
    571         if (!ttispair(tail)) {
    572             klispE_throw_simple(K, "too few arguments");
    573             return;
    574         }
    575         ffi_type *t = p->acodecs[i]->libffi_type;
    576         offset = align(offset, t->alignment);
    577         aptrs[i] = (unsigned char *) buffer + offset;
    578         p->acodecs[i]->encode(p->acodecs[i], K, kcar(tail), aptrs[i]);
    579         offset += t->size;
    580         tail = kcdr(tail);
    581     }
    582     assert(offset == p->buffer_size);
    583     if (!ttisnil(tail)) {
    584         klispE_throw_simple(K, "too many arguments");
    585         return;
    586     }
    587 
    588     ffi_call(&p->cif, funptr, rptr, aptrs);
    589 
    590     TValue result = p->rcodec->decode(p->rcodec, K, rptr);
    591     kapply_cc(K, result);
    592 }
    593 
    594 void ffi_make_applicative(klisp_State *K)
    595 {
    596     TValue *xparams = K->next_xparams;
    597     TValue ptree = K->next_value;
    598     TValue denv = K->next_env;
    599     klisp_assert(ttisenvironment(K->next_env));
    600     UNUSED(denv);
    601     /*
    602     ** xparams[0]: encapsulation key denoting dynamically loaded library
    603     ** xparams[1]: encapsulation key denoting call interface
    604     */
    605 
    606     bind_3tp(K, ptree,
    607              "dynamic library", ttisencapsulation, lib_tv,
    608              "function name string", ttisstring, name_tv,
    609              "call interface", ttisencapsulation, cif_tv);
    610     if (!kis_encapsulation_type(lib_tv, xparams[0])) {
    611         klispE_throw_simple(K, "first argument shall be dynamic library");
    612         return;
    613     }
    614     if (!kis_encapsulation_type(cif_tv, xparams[1])) {
    615         klispE_throw_simple(K, "third argument shall be call interface");
    616         return;
    617     }
    618 
    619     TValue lib_name = kcdr(kget_enc_val(lib_tv));
    620     assert(ttisstring(lib_name));
    621 
    622 #if KGFFI_DLFCN
    623     void *handle = pvalue(kcar(kget_enc_val(lib_tv)));
    624     (void) dlerror();
    625     void *funptr = dlsym(handle, kstring_buf(name_tv));
    626     const char *err_c = dlerror();
    627     if (err_c) {
    628         krooted_tvs_push(K, name_tv);
    629         krooted_tvs_push(K, lib_name);
    630         TValue err = kstring_new_b_imm(K, err_c);
    631         klispE_throw_simple_with_irritants(K, "couldn't find symbol",
    632                                            3, lib_name, name_tv, err);
    633         return;
    634     }
    635     if (!funptr) {
    636         klispE_throw_simple_with_irritants(K, "symbol is NULL", 2,
    637                                            lib_name, name_tv);
    638     }
    639 #elif KGFFI_WIN32
    640     HMODULE handle = pvalue(kcar(kget_enc_val(lib_tv)));
    641     void *funptr = GetProcAddress(handle, kstring_buf(name_tv));
    642     if (NULL == funptr) {
    643         TValue err = ffi_win32_error_message(K, GetLastError());
    644         klispE_throw_simple_with_irritants(K, "couldn't find symbol",
    645                                            3, lib_name, name_tv, err);
    646         return;
    647     }
    648 #else
    649 #   error
    650 #endif
    651 
    652     TValue app = kmake_applicative(K, do_ffi_call, 2, p2tv(funptr), cif_tv);
    653 
    654 #if KTRACK_SI
    655     krooted_tvs_push(K, app);
    656     krooted_tvs_push(K, lib_name);
    657     TValue tail = kcons(K, i2tv((int) funptr), i2tv(0));
    658     krooted_tvs_push(K, tail);
    659     TValue si = kcons(K, lib_name, tail);
    660     krooted_tvs_push(K, si);
    661     kset_source_info(K, kunwrap(app), si);
    662     krooted_tvs_pop(K);
    663     krooted_tvs_pop(K);
    664     krooted_tvs_pop(K);
    665     krooted_tvs_pop(K);
    666 #endif
    667 
    668     kapply_cc(K, app);
    669 }
    670 
    671 static void ffi_callback_push(ffi_callback_t *cb, TValue v)
    672 {
    673     /* assume v is rooted */
    674     TValue *s = klispH_setfixint(cb->K, cb->table, CB_INDEX_STACK);
    675     *s = kimm_cons(cb->K, v, *s);
    676 }
    677 
    678 static TValue ffi_callback_pop(ffi_callback_t *cb)
    679 {
    680     TValue *s = klispH_setfixint(cb->K, cb->table, CB_INDEX_STACK);
    681     TValue v = kcar(*s);
    682     krooted_tvs_push(cb->K, v);
    683     *s = kcdr(*s);
    684     krooted_tvs_pop(cb->K);
    685     return v;
    686 }
    687 
    688 static TValue ffi_callback_guard(ffi_callback_t *cb, klisp_CFunction fn)
    689 {
    690     TValue app = kmake_applicative(cb->K, fn, 1, p2tv(cb));
    691     krooted_tvs_push(cb->K, app);
    692     TValue ls1 = kimm_list(cb->K, 2, G(cb->K)->root_cont, app);
    693     krooted_tvs_push(cb->K, ls1);
    694     TValue ls2 = kimm_list(cb->K, 1, ls1);
    695     krooted_tvs_pop(cb->K);
    696     krooted_tvs_pop(cb->K);
    697     return ls2;
    698 }
    699 
    700 void do_ffi_callback_encode_result(klisp_State *K)
    701 {
    702     TValue *xparams = K->next_xparams;
    703     TValue obj = K->next_value;
    704     klisp_assert(ttisnil(K->next_env));
    705     /*
    706     ** xparams[0]: cif
    707     ** xparams[1]: p2tv(libffi return buffer)
    708     */
    709     ffi_call_interface_t *p = (ffi_call_interface_t *) kbytevector_buf(kget_enc_val(xparams[0]));
    710     void *ret = pvalue(xparams[1]);
    711     p->rcodec->encode(p->rcodec, K, obj, ret);
    712     kapply_cc(K, KINERT);
    713 }
    714 
    715 void do_ffi_callback_decode_arguments(klisp_State *K)
    716 {
    717     TValue *xparams = K->next_xparams;
    718     TValue ptree = K->next_value;
    719     TValue denv = K->next_env;
    720     klisp_assert(ttisenvironment(K->next_env));
    721     /*
    722     ** xparams[0]: p2tv(ffi_callback_t)
    723     ** xparams[1]: p2tv(libffi return buffer)
    724     ** xparams[2]: p2tv(libffi argument array)
    725     */
    726 
    727     ffi_callback_t *cb = pvalue(xparams[0]);
    728     void *ret = pvalue(xparams[1]);
    729     void **args = pvalue(xparams[2]);
    730 
    731     /* get the lisp applicative and the call interface
    732      * from the auxilliary table. */
    733 
    734     const TValue *slot = klispH_setfixint(K, cb->table, cb->index);
    735     TValue app_tv = kcar(*slot);
    736     TValue cif_tv = kcdr(*slot);
    737     assert(ttisapplicative(app_tv));
    738     assert(ttisencapsulation(cif_tv));
    739     krooted_tvs_push(K, app_tv);
    740     krooted_tvs_push(K, cif_tv);
    741     ffi_call_interface_t *p = (ffi_call_interface_t *) kbytevector_buf(kget_enc_val(cif_tv));
    742 
    743     /* Decode arguments. */
    744 
    745     TValue tail = KNIL;
    746     for (int i = p->nargs - 1; i >= 0; i--) {
    747         krooted_tvs_push(K, ptree);
    748         TValue arg = p->acodecs[i]->decode(p->acodecs[i], K, args[i]);
    749         krooted_tvs_pop(K);
    750         tail = kimm_cons(K, arg, tail);
    751     }
    752     krooted_tvs_push(K, tail);
    753 
    754     /* Setup continuation for encoding return value. */
    755 
    756     TValue encoding_cont = kmake_continuation(K, kget_cc(K), do_ffi_callback_encode_result, 2, cif_tv, p2tv(ret));
    757     kset_cc(K, encoding_cont);
    758 
    759     /* apply the callback applicative */
    760 
    761     krooted_tvs_pop(K);
    762     krooted_tvs_pop(K);
    763     krooted_tvs_pop(K);
    764 
    765     while(ttisapplicative(app_tv))
    766         app_tv = tv2app(app_tv)->underlying;
    767     ktail_call(K, app_tv, tail, denv);
    768 }
    769 
    770 void do_ffi_callback_return(klisp_State *K)
    771 {
    772     TValue *xparams = K->next_xparams;
    773     TValue obj = K->next_value;
    774     klisp_assert(ttisnil(K->next_env));
    775     UNUSED(obj);
    776     /*
    777     ** xparams[0]: p2tv(ffi_callback_t)
    778     **
    779     ** Signal normal return and force the "inner" trampoline
    780     ** loop to exit.
    781     */
    782     ffi_callback_t *cb = pvalue(xparams[0]);
    783     ffi_callback_push(cb, i2tv(1));
    784     K->next_func = NULL;
    785 }
    786 
    787 void do_ffi_callback_entry_guard(klisp_State *K)
    788 {
    789     TValue *xparams = K->next_xparams;
    790     TValue ptree = K->next_value;
    791     TValue denv = K->next_env;
    792     klisp_assert(ttisenvironment(K->next_env));
    793     UNUSED(xparams);
    794     UNUSED(ptree);
    795     UNUSED(denv);
    796     /* The entry guard is invoked only if the user captured
    797      * the continuation under foreign callback and applied
    798      * it later after the foreign callback terminated.
    799      *
    800      * The auxilliary stack (stored in the callback hash table)
    801      * now does not correspond to the actual state of callback
    802      * nesting.
    803      */
    804     klispE_throw_simple(K, "tried to re-enter continuation under FFI callback");
    805 }
    806 
    807 void do_ffi_callback_exit_guard(klisp_State *K)
    808 {
    809     TValue *xparams = K->next_xparams;
    810     TValue ptree = K->next_value;
    811     TValue denv = K->next_env;
    812     klisp_assert(ttisenvironment(K->next_env));
    813     UNUSED(ptree);
    814     UNUSED(denv);
    815     /*
    816     ** xparams[0]: p2tv(ffi_callback_t)
    817     **
    818     ** Signal abnormal return and force the "inner" trampoline
    819     ** loop to exit to ffi_callback_entry(). The parameter tree
    820     ** will be processed there.
    821     */
    822     ffi_callback_t *cb = pvalue(xparams[0]);
    823     ffi_callback_push(cb, i2tv(0));
    824     K->next_func = NULL;
    825 }
    826 
    827 static void ffi_callback_entry(ffi_cif *cif, void *ret, void **args, void *user_data)
    828 {
    829     ffi_callback_t *cb = (ffi_callback_t *) user_data;
    830     klisp_State *K = cb->K;
    831 
    832     /* save state of the interpreter */
    833 
    834     volatile jmp_buf saved_error_jb;
    835     memcpy(&saved_error_jb, &K->error_jb, sizeof(K->error_jb));
    836     ffi_callback_push(cb, K->curr_cont);
    837 
    838     /* Set up continuation for normal return path. */
    839 
    840     TValue return_cont = kmake_continuation(K, K->curr_cont, do_ffi_callback_return, 1, p2tv(cb));
    841     krooted_tvs_push(K, return_cont);
    842     kset_cc(K, return_cont);
    843 
    844     /* Do not decode arguments yet. The decoding may fail
    845      * and raise errors. Let klisp core handle all errors
    846      * inside guarded continuation. */
    847 
    848     TValue app = kmake_applicative(K, do_ffi_callback_decode_arguments, 3, p2tv(cb), p2tv(ret), p2tv(args));
    849     krooted_tvs_push(K, app);
    850 
    851     TValue entry_guard = ffi_callback_guard(cb, do_ffi_callback_entry_guard);
    852     krooted_tvs_push(K, entry_guard);
    853     TValue exit_guard = ffi_callback_guard(cb, do_ffi_callback_exit_guard);
    854     krooted_tvs_push(K, exit_guard);
    855 
    856     /* Construct fresh dynamic environment for the callback applicative. */
    857     TValue denv = kmake_empty_environment(K);
    858     krooted_tvs_push(K, denv);
    859 
    860     TValue ptree = kimm_list(K, 3, entry_guard, app, exit_guard);
    861     krooted_tvs_pop(K);
    862     krooted_tvs_pop(K);
    863     krooted_tvs_pop(K);
    864     krooted_tvs_pop(K);
    865     krooted_tvs_pop(K);
    866 
    867     K->next_xparams = NULL;
    868     K->next_value = ptree;
    869     K->next_env = denv;
    870 
    871     guard_dynamic_extent(K);
    872 
    873     /* Enter new "inner" trampoline loop. */
    874 
    875     klispT_run(K);
    876 
    877     /* restore longjump buffer of the outer trampoline loop */
    878 
    879     memcpy(&K->error_jb, &saved_error_jb, sizeof(K->error_jb));
    880 
    881     /* Now, the "inner" trampoline loop exited. The exit
    882        was forced by return_cont or exit_guard. */
    883 
    884     if (ivalue(ffi_callback_pop(cb))) {
    885         /* Normal return - reinstall old continuation. It will be
    886          * used after the foreign call which originally called
    887          * this callback eventually returns. */
    888         kset_cc(K, ffi_callback_pop(cb));
    889     } else {
    890         /* Abnormal return - throw away the old continuation
    891         ** and longjump back in the "outer" trampoline loop.
    892         ** Longjump unwinds the stack space used by the foreign
    893         ** call which originally called this callback. After
    894         ** that the interpreter state will look like normal
    895         ** normal return from the exit guard.
    896         */
    897         (void) ffi_callback_pop(cb);
    898         klispT_apply_cc(K, kcar(K->next_value));
    899         longjmp(K->error_jb, 1);
    900     }
    901 }
    902 
    903 
    904 void ffi_make_callback(klisp_State *K)
    905 {
    906     TValue *xparams = K->next_xparams;
    907     TValue ptree = K->next_value;
    908     TValue denv = K->next_env;
    909     klisp_assert(ttisenvironment(K->next_env));
    910     UNUSED(denv);
    911     /*
    912     ** xparams[0]: encapsulation key denoting call interface
    913     ** xparams[1]: callback data table
    914     */
    915 
    916     bind_2tp(K, ptree,
    917              "applicative", ttisapplicative, app_tv,
    918              "call interface", ttisencapsulation, cif_tv);
    919     if (!kis_encapsulation_type(cif_tv, xparams[0])) {
    920         klispE_throw_simple(K, "second argument shall be call interface");
    921         return;
    922     }
    923     ffi_call_interface_t *p = (ffi_call_interface_t *) kbytevector_buf(kget_enc_val(cif_tv));
    924     TValue cb_tab = xparams[1];
    925 
    926     /* Allocate memory for libffi closure. */
    927 
    928     void *code;
    929     ffi_callback_t *cb = ffi_closure_alloc(sizeof(ffi_callback_t), &code);
    930 
    931     /* Get the index of this callback in the callback table. */
    932 
    933     TValue *n_tv = klispH_setfixint(K, tv2table(cb_tab), 0);
    934     assert(n_tv != &kfree);
    935     int32_t new_index = ivalue(*n_tv);
    936     *n_tv = i2tv(new_index + 1);
    937 
    938     /* Prepare the C part of callback data */
    939 
    940     cb->K = K;
    941     cb->table = tv2table(xparams[1]);
    942     cb->index = new_index;
    943 
    944     /* TODO: The closure leaks. Should be finalized. */
    945 
    946     /* Prepare the lisp part of callback data */
    947 
    948     krooted_tvs_push(K, cb_tab);
    949     krooted_tvs_push(K, app_tv);
    950     krooted_tvs_push(K, cif_tv);
    951 
    952     TValue item_tv = kimm_cons(K, app_tv, cif_tv);
    953     krooted_tvs_push(K, item_tv);
    954 
    955     TValue *slot = klispH_setfixint(K, tv2table(cb_tab), new_index);
    956     *slot = item_tv;
    957 
    958     krooted_tvs_pop(K);
    959     krooted_tvs_pop(K);
    960     krooted_tvs_pop(K);
    961     krooted_tvs_pop(K);
    962 
    963     /* Initialize callback. */
    964 
    965     ffi_status status = ffi_prep_closure_loc(&cb->libffi_closure, &p->cif, ffi_callback_entry, cb, code);
    966     if (status != FFI_OK) {
    967         ffi_closure_free(cb);
    968         klispE_throw_simple(K, "unknown error in ffi_prep_closure_loc");
    969         return;
    970     }
    971 
    972     /* return the libffi closure entry point */
    973 
    974     TValue funptr_tv = p2tv(code);
    975     kapply_cc(K, funptr_tv);
    976 }
    977 
    978 static uint8_t * ffi_memory_location(klisp_State *K, bool allow_nesting,
    979                                      TValue v, bool mutable, size_t size)
    980 {
    981     if (ttisbytevector(v)) {
    982         if (mutable && kbytevector_immutablep(v)) {
    983             klispE_throw_simple_with_irritants(K, "bytevector not mutable", 1, v);
    984             return NULL;
    985         } else if (size > kbytevector_size(v)) {
    986             klispE_throw_simple_with_irritants(K, "bytevector too small", 1, v);
    987             return NULL;
    988         } else {
    989             return kbytevector_buf(v);
    990         }
    991     } else if (ttisstring(v)) {
    992         if (mutable && kstring_immutablep(v)) {
    993             klispE_throw_simple_with_irritants(K, "string not mutable", 1, v);
    994             return NULL;
    995         } else if (size > kstring_size(v)) {
    996             klispE_throw_simple_with_irritants(K, "string too small", 1, v);
    997             return NULL;
    998         } else {
    999             return (uint8_t *) kstring_buf(v);
   1000         }
   1001     } else if (tbasetype_(v) == K_TAG_USER) {
   1002         /* TODO: do not use internal macro tbasetype_ */
   1003         return (pvalue(v));
   1004     } else if (ttispair(v) && ttispair(kcdr(v)) && ttisnil(kcddr(v))) {
   1005         if (!allow_nesting) {
   1006             klispE_throw_simple_with_irritants(K, "offset specifications cannot be nested", 1, v);
   1007             return NULL;
   1008         }
   1009         TValue base_tv = kcar(v);
   1010         TValue offset_tv = kcadr(v);
   1011         if (!ttisfixint(offset_tv) || ivalue(offset_tv) < 0) {
   1012             klispE_throw_simple_with_irritants(K, "offset should be nonnegative fixint", 1, v);
   1013             return NULL;
   1014         } else {
   1015             size_t offset = ivalue(offset_tv);
   1016             uint8_t * p = ffi_memory_location(K, false, base_tv, mutable, size + offset);
   1017             return (p + offset);
   1018         }
   1019     } else {
   1020         klispE_throw_simple_with_irritants(K, "not a memory location", 1, v);
   1021         return NULL;
   1022     }
   1023 }
   1024 
   1025 void ffi_memmove(klisp_State *K)
   1026 {
   1027     TValue *xparams = K->next_xparams;
   1028     TValue ptree = K->next_value;
   1029     TValue denv = K->next_env;
   1030     klisp_assert(ttisenvironment(K->next_env));
   1031     UNUSED(xparams);
   1032     UNUSED(denv);
   1033 
   1034     bind_3tp(K, ptree,
   1035              "any", anytype, dst_tv,
   1036              "any", anytype, src_tv,
   1037              "integer", ttisfixint, sz_tv);
   1038 
   1039     if (ivalue(sz_tv) < 0)
   1040         klispE_throw_simple(K, "size should be nonnegative fixint");
   1041 
   1042     size_t sz = (size_t) ivalue(sz_tv);
   1043     uint8_t * dst = ffi_memory_location(K, true, dst_tv, true, sz);
   1044     const uint8_t * src = ffi_memory_location(K, true, src_tv, false, sz);
   1045     memmove(dst, src, sz);
   1046 
   1047     kapply_cc(K, KINERT);
   1048 }
   1049 
   1050 static void ffi_type_ref(klisp_State *K)
   1051 {
   1052     TValue *xparams = K->next_xparams;
   1053     TValue ptree = K->next_value;
   1054     TValue denv = K->next_env;
   1055     klisp_assert(ttisenvironment(K->next_env));
   1056     UNUSED(denv);
   1057 
   1058     /*
   1059     ** xparams[0]: pointer to ffi_codec_t
   1060     */
   1061 
   1062     bind_1tp(K, ptree, "any", anytype, location_tv);
   1063     ffi_codec_t *codec = pvalue(xparams[0]);
   1064     const uint8_t *ptr = ffi_memory_location(K, true, location_tv, false, codec->libffi_type->size);
   1065 #if KGFFI_CHECK_ALIGNMENT
   1066     if ((size_t) ptr % codec->libffi_type->alignment != 0)
   1067         klispE_throw_simple(K, "unaligned memory read through FFI");
   1068 #endif
   1069 
   1070     TValue result = codec->decode(codec, K, ptr);
   1071     kapply_cc(K, result);
   1072 }
   1073 
   1074 static void ffi_type_set(klisp_State *K)
   1075 {
   1076     TValue *xparams = K->next_xparams;
   1077     TValue ptree = K->next_value;
   1078     TValue denv = K->next_env;
   1079     klisp_assert(ttisenvironment(K->next_env));
   1080     UNUSED(denv);
   1081 
   1082     /*
   1083     ** xparams[0]: pointer to ffi_codec_t
   1084     */
   1085 
   1086     bind_2tp(K, ptree,
   1087              "any", anytype, location_tv,
   1088              "any", anytype, value_tv);
   1089     ffi_codec_t *codec = pvalue(xparams[0]);
   1090     uint8_t *ptr = ffi_memory_location(K, true, location_tv, false, codec->libffi_type->size);
   1091 #if KGFFI_CHECK_ALIGNMENT
   1092     if ((size_t) ptr % codec->libffi_type->alignment != 0)
   1093         klispE_throw_simple(K, "unaligned memory write through FFI");
   1094 #endif
   1095 
   1096     codec->encode(codec, K, value_tv, ptr);
   1097     kapply_cc(K, KINERT);
   1098 }
   1099 
   1100 void ffi_type_suite(klisp_State *K)
   1101 {
   1102     TValue *xparams = K->next_xparams;
   1103     TValue ptree = K->next_value;
   1104     TValue denv = K->next_env;
   1105     klisp_assert(ttisenvironment(K->next_env));
   1106 
   1107     UNUSED(xparams);
   1108     UNUSED(denv);
   1109 
   1110     bind_1tp(K, ptree, "string", ttisstring, type_tv);
   1111     ffi_codec_t *codec = tv2ffi_codec(K, type_tv);
   1112 
   1113     TValue size_tv = i2tv(codec->libffi_type->size);
   1114     krooted_tvs_push(K, size_tv);
   1115 
   1116     TValue alignment_tv = i2tv(codec->libffi_type->alignment);
   1117     krooted_tvs_push(K, alignment_tv);
   1118 
   1119     TValue getter_tv =
   1120         (codec->decode)
   1121         ? kmake_applicative(K, ffi_type_ref, 1, p2tv(codec))
   1122         : KINERT;
   1123     krooted_tvs_push(K, getter_tv);
   1124 
   1125     TValue setter_tv =
   1126         (codec->encode)
   1127         ? kmake_applicative(K, ffi_type_set, 1, p2tv(codec))
   1128         : KINERT;
   1129     krooted_tvs_push(K, setter_tv);
   1130 
   1131     TValue suite_tv = kimm_list(K, 4, size_tv, alignment_tv, getter_tv, setter_tv);
   1132 
   1133     krooted_tvs_pop(K);
   1134     krooted_tvs_pop(K);
   1135     krooted_tvs_pop(K);
   1136     krooted_tvs_pop(K);
   1137 
   1138     kapply_cc(K, suite_tv);
   1139 }
   1140 
   1141 void ffi_klisp_state(klisp_State *K)
   1142 {
   1143     TValue *xparams = K->next_xparams;
   1144     TValue ptree = K->next_value;
   1145     TValue denv = K->next_env;
   1146     klisp_assert(ttisenvironment(K->next_env));
   1147     UNUSED(xparams);
   1148     UNUSED(denv);
   1149     check_0p(K, ptree);
   1150     kapply_cc(K, p2tv(K));
   1151 }
   1152 
   1153 /* init ground */
   1154 void kinit_ffi_ground_env(klisp_State *K)
   1155 {
   1156     TValue ground_env = G(K)->ground_env;
   1157     TValue symbol, value;
   1158 
   1159     /* create encapsulation keys */
   1160 
   1161     TValue dll_key = kmake_encapsulation_key(K);
   1162     TValue cif_key = kmake_encapsulation_key(K);
   1163 
   1164     /* TODO: should be rooted */
   1165 
   1166     /* create table for callback data */
   1167     TValue cb_tab = klispH_new(K, 0, 64, K_FLAG_WEAK_NOTHING);
   1168 
   1169     TValue *v;
   1170     v = klispH_setfixint(K, tv2table(cb_tab), CB_INDEX_N);
   1171     *v = i2tv(CB_INDEX_FIRST_CALLBACK);
   1172     v = klispH_setfixint(K, tv2table(cb_tab), CB_INDEX_STACK);
   1173     *v = KNIL;
   1174 
   1175     add_applicative(K, ground_env, "ffi-load-library", ffi_load_library, 1, dll_key);
   1176     add_applicative(K, ground_env, "ffi-make-call-interface", ffi_make_call_interface, 1, cif_key);
   1177     add_applicative(K, ground_env, "ffi-make-applicative", ffi_make_applicative, 2, dll_key, cif_key);
   1178     add_applicative(K, ground_env, "ffi-make-callback", ffi_make_callback, 2, cif_key, cb_tab);
   1179     add_applicative(K, ground_env, "ffi-memmove", ffi_memmove, 0);
   1180     add_applicative(K, ground_env, "ffi-type-suite", ffi_type_suite, 0);
   1181     add_applicative(K, ground_env, "ffi-klisp-state", ffi_klisp_state, 0);
   1182     add_applicative(K, ground_env, "ffi-library?", enc_typep, 1, dll_key);
   1183     add_applicative(K, ground_env, "ffi-call-interface?", enc_typep, 1, cif_key);
   1184 }
   1185 
   1186 /* XXX lock? */
   1187 /* init continuation names */
   1188 void kinit_ffi_cont_names(klisp_State *K)
   1189 {
   1190     Table *t = tv2table(G(K)->cont_name_table);
   1191 
   1192     add_cont_name(K, t, do_ffi_callback_encode_result, 
   1193                   "ffi-callback-encode-result");
   1194     add_cont_name(K, t, do_ffi_callback_return, 
   1195                   "ffi-callback-ret");
   1196 }