lmtforeign.c /size: 50 Kb    last modification: 2024-01-16 10:22
1/*
2    See license.txt in the root of this project.
3*/
4
5/*tex
6
7    In \LUATEX\ we provide an ffi library that is derived from luajit but it got orphaned a few years
8    after it showed up. A problem with such libraries is that they need to be maintained actively
9    because platforms and processors evolve. So, having a mechanism like that makes not much sense in
10    a \TEX\ engine. In \LUAMETATEX\ we therefore don't use that library but have a model for delayed
11    loading of optional libraries. A few interfaces are built in (like zint) but we don't ship any
12    library: you get what is installed on the system (which actually is the whole idea behind using
13    most libraries). Delayed loading is implemented by using function pointers and in practice that
14    is fast enough (after all we use them in \TEX\ as well as \METAPOST\ without much penalty).
15
16    But \unknown\ what if a user wants to use a library and doesn't want to write an interface? We
17    kind of end up again with something ffi. When looking around I ran into an \LUA\ module that
18    was made a few years ago (for 5.1 and 5.2) called 'alien' that also binds to libffi. But that
19    library looks a bit more complex than we need. For instance, mechanisms for callbacks use libffi
20    calls than need some compile time properties that normally come from the h files generated on
21    the system and I don't want to impose on users to also install and compile a whole chain of
22    dependencies. We could (and maybe some day will if users really need it) provide callbacks
23    too but then we also need to keep some system specific 'constants' in sync. We then probaly
24    also need to provide libraries at the contextgarden.
25
26    The basics of an interface as used in this module (running over specs) is given in the \LUA\
27    manual\ and we also use it for callbacks in \LUATEX\ and therefore \LUAMETATEX. There we use
28    varargs but here specification if converted into a recipe that libffi will bind to a function.
29    Some code below looks like the code in alien (after all I took a good look at it). The ffi
30    part is filtered from the ffi.h.in file. The interfaces are sort of what we do with other
31    libraries.
32
33    For the record: when testing, I just used a version of libffi that came with inkscape and I
34    saw several other instances on my system disk. A quick test with loading showed that it is no
35    problem in the ecosystem that we use in \TEX. The buildot on the contextgarden generates
36    binaries for several platforms and one can observe that some platforms (like bsd) are not
37    that downward compatible, so there we have multiple versions. This also means that finding
38    matching libraries can be an issue. In \CONTEXT\ we never depend on external or evolving
39    libraries so it's a user's choice in the end.
40
41    The \LUATEX\ build script and infrastructure are more complex than the \LUAMETATEX\ ones and
42    it's often the libraries that make for the - sometimes incompatible - changes which in turn
43    demands adaptation of the scripts etc in the build farm. We try to avoid that as much as
44    possible but if we ever decide to also provide libraries that match the binaries, but it
45    remains a depencenie that you want to avoid in long running projects.
46
47    Comment: I might look into a vararg variant some day, just for fun. Actually, this module is
48    mostly about the fun, so it will take some time to evolve.
49
50*/
51
52/*tex
53    Because it is an optional module, we use the optional interface.
54*/
55
56# include "luametatex.h"
57# include "lmtoptional.h"
58
59/*tex
60    We need to define a few ffi datatypes and function prototypes. We need to keep an eye on how
61    the library evolves but I assume the api is rather stable. We don't want to depend on a system
62    specific header file.
63*/
64
65typedef struct ffi_type {
66    size_t            size;
67    unsigned short    alignment;
68    unsigned short    type;
69    struct ffi_type **elements;
70} ffi_type;
71
72typedef enum ffi_types {
73    ffi_void_type,
74    ffi_int_type,
75    ffi_float_type,
76    ffi_double_type,
77    ffi_longdouble_type,
78    ffi_uint8_type,
79    ffi_int8_type,
80    ffi_uint16_type,
81    ffi_int16_type,
82    ffi_uint32_type,
83    ffi_int32_type,
84    ffi_uint64_type,
85    ffi_int64_type,
86    ffi_struct_type,
87    ffi_pointer_type,
88    ffi_complex_type, /* unsupported */
89    ffi_last_type,
90} ffi_types;
91
92/*
93    The libffi api document says that the size and alignment should be zero but somehow we do crash
94    when we set the size to some value. Only size_t is now system dependent (e.g. on 32 bit windows
95    it's different).
96
97    We only need to support the architectures and operating systems that the ecosystem runs on so we
98    check a bit differently. We just don't want all these dependencies in the source tree. We have:
99
100    -- 32 64 bit intel linux | freebsd | openbsd
101    --    64 bit intel osx
102    -- 32 64 bit intel windows mingw
103    --    64 bit windows msvc
104    --    64 bit arm msvc
105    -- 32 64 bit arm (rpi etc)
106    --    64 bit arm darwin
107
108*/
109
110# if PTRDIFF_MAX == 65535
111#   define ffi_size_t_type ffi_uint16_type
112# elif PTRDIFF_MAX == 2147483647
113#   define ffi_size_t_type ffi_uint32_type
114# elif PTRDIFF_MAX == 9223372036854775807
115#   define ffi_size_t_type ffi_uint64_type
116# elif defined(_WIN64)
117#   define ffi_size_t_type ffi_uint64_type
118# else
119#   define ffi_size_t_type ffi_uint32_type
120# endif
121
122/*tex This comes from the libffi.h* file: */
123
124typedef enum ffi_abi {
125
126# if defined (X86_WIN64)
127
128    FFI_FIRST_ABI = 0,
129    FFI_WIN64,            /* sizeof(long double) == 8  - microsoft compilers */
130    FFI_GNUW64,           /* sizeof(long double) == 16 - GNU compilers */
131    FFI_LAST_ABI,
132# ifdef __GNUC__
133    FFI_DEFAULT_ABI = FFI_GNUW64
134# else
135    FFI_DEFAULT_ABI = FFI_WIN64
136# endif
137
138# elif defined (X86_64) || (defined (__x86_64__) && defined (X86_DARWIN))
139
140    FFI_FIRST_ABI = 1,
141    FFI_UNIX64,
142    FFI_WIN64,
143    FFI_EFI64 = FFI_WIN64,
144    FFI_GNUW64,
145    FFI_LAST_ABI,
146    FFI_DEFAULT_ABI = FFI_UNIX64
147
148# elif defined (X86_WIN32)
149
150    FFI_FIRST_ABI = 0,
151    FFI_SYSV      = 1,
152    FFI_STDCALL   = 2,
153    FFI_THISCALL  = 3,
154    FFI_FASTCALL  = 4,
155    FFI_MS_CDECL  = 5,
156    FFI_PASCAL    = 6,
157    FFI_REGISTER  = 7,
158    FFI_LAST_ABI,
159    FFI_DEFAULT_ABI = FFI_MS_CDECL
160
161# else
162
163    FFI_FIRST_ABI = 0,
164    FFI_SYSV      = 1,
165    FFI_THISCALL  = 3,
166    FFI_FASTCALL  = 4,
167    FFI_STDCALL   = 5,
168    FFI_PASCAL    = 6,
169    FFI_REGISTER  = 7,
170    FFI_MS_CDECL  = 8,
171    FFI_LAST_ABI,
172    FFI_DEFAULT_ABI = FFI_SYSV
173
174#endif
175
176} ffi_abi;
177
178typedef enum ffi_status {
179    FFI_OK,
180    FFI_BAD_TYPEDEF,
181    FFI_BAD_ABI
182} ffi_status;
183
184typedef struct {
185    ffi_abi    abi;
186    unsigned   nargs;
187    ffi_type **arg_types;
188    ffi_type  *rtype;
189    unsigned   bytes;
190    unsigned   flags;
191} ffi_cif;
192
193typedef struct foreign_state_info {
194
195    int initialized;
196    int padding;
197
198    ffi_status (*ffi_prep_cif) (
199        ffi_cif       *cif,
200        ffi_abi        abi,
201        unsigned int   nargs,
202        ffi_type      *rtype,
203        ffi_type     **atypes
204    );
205
206    void (*ffi_call) (
207        ffi_cif  *cif,
208        void    (*fn) (void),
209        void     *rvalue,
210        void    **avalue
211    );
212
213    ffi_type ffi_type_void;
214    ffi_type ffi_type_uint8;
215    ffi_type ffi_type_int8;
216    ffi_type ffi_type_uint16;
217    ffi_type ffi_type_int16;
218    ffi_type ffi_type_uint32;
219    ffi_type ffi_type_int32;
220    ffi_type ffi_type_uint64;
221    ffi_type ffi_type_int64;
222    ffi_type ffi_type_float;
223    ffi_type ffi_type_double;
224    ffi_type ffi_type_pointer;
225    ffi_type ffi_type_size_t;
226
227
228} foreign_state_info;
229
230static foreign_state_info foreign_state = {
231
232    .initialized  = 0,
233    .padding      = 0,
234
235    .ffi_prep_cif = NULL,
236    .ffi_call     = NULL,
237
238    .ffi_type_void    = { .size = 1,                .alignment = 0, .type = ffi_void_type,    .elements = NULL },
239    .ffi_type_uint8   = { .size = sizeof(uint8_t),  .alignment = 0, .type = ffi_uint8_type,   .elements = NULL },
240    .ffi_type_int8    = { .size = sizeof(int8_t),   .alignment = 0, .type = ffi_int8_type,    .elements = NULL },
241    .ffi_type_uint16  = { .size = sizeof(uint16_t), .alignment = 0, .type = ffi_uint16_type,  .elements = NULL },
242    .ffi_type_int16   = { .size = sizeof(int16_t),  .alignment = 0, .type = ffi_int16_type,   .elements = NULL },
243    .ffi_type_uint32  = { .size = sizeof(uint32_t), .alignment = 0, .type = ffi_uint32_type,  .elements = NULL },
244    .ffi_type_int32   = { .size = sizeof(int32_t),  .alignment = 0, .type = ffi_int32_type,   .elements = NULL },
245    .ffi_type_uint64  = { .size = sizeof(uint64_t), .alignment = 0, .type = ffi_uint64_type,  .elements = NULL },
246    .ffi_type_int64   = { .size = sizeof(int64_t),  .alignment = 0, .type = ffi_int64_type,   .elements = NULL },
247    .ffi_type_float   = { .size = sizeof(float),    .alignment = 0, .type = ffi_float_type,   .elements = NULL },
248    .ffi_type_double  = { .size = sizeof(double),   .alignment = 0, .type = ffi_double_type,  .elements = NULL },
249    .ffi_type_pointer = { .size = sizeof(void *),   .alignment = 0, .type = ffi_pointer_type, .elements = NULL },
250    .ffi_type_size_t  = { .size = sizeof(size_t),   .alignment = 0, .type = ffi_size_t_type,  .elements = NULL },
251
252};
253
254/*tex
255    We use similar names as in other modules:
256*/
257
258#define FOREIGN_METATABLE_LIBRARY  "foreign.library"
259#define FOREIGN_METATABLE_FUNCTION "foreign.function"
260#define FOREIGN_METATABLE_POINTER  "foreign.pointer"
261
262/*tex
263    First I had some info structure as we have elsewhere but in the end not much was needed so we
264    now have some simple arrays instead.
265*/
266
267typedef enum foreign_type {
268    foreign_type_void,
269    foreign_type_byte,       foreign_type_char,
270    foreign_type_short,      foreign_type_ushort,
271    foreign_type_int,        foreign_type_uint,
272    foreign_type_long,       foreign_type_ulong,
273    foreign_type_longlong,   foreign_type_ulonglong,
274    foreign_type_float,      foreign_type_double,
275    foreign_type_size_t,
276    foreign_type_string,
277    foreign_type_pointer,
278    foreign_type_reference_to_char,
279    foreign_type_reference_to_int,
280    foreign_type_reference_to_uint,
281    foreign_type_reference_to_double,
282    foreign_type_max,
283} foreign_type;
284
285# define foreign_first_value_return_type foreign_type_void
286# define foreign_last_value_return_type  foreign_type_pointer
287
288static const char *foreign_typenames[] = {
289    "void",
290    /* basic types */
291    "byte",       "char",
292    "short",      "ushort",
293    "int",        "uint",
294    "long",       "ulong",
295    "longlong",   "ulonglong",
296    "float",      "double",
297    "size_t",
298    "string",
299    "pointer",
300    "reference to char",
301    "reference to int",
302    "reference to uint",
303    "reference to double",
304    NULL,
305};
306
307static ffi_type *foreign_typecodes[] = {
308    &foreign_state.ffi_type_void,
309    &foreign_state.ffi_type_int8,    &foreign_state.ffi_type_uint8,
310    &foreign_state.ffi_type_int16,   &foreign_state.ffi_type_uint16,
311    &foreign_state.ffi_type_int32,   &foreign_state.ffi_type_uint32,
312    &foreign_state.ffi_type_int64,   &foreign_state.ffi_type_uint64,
313    &foreign_state.ffi_type_int64,   &foreign_state.ffi_type_uint64,
314    &foreign_state.ffi_type_float,   &foreign_state.ffi_type_double,
315    &foreign_state.ffi_type_size_t,
316    &foreign_state.ffi_type_pointer, /* string */
317    &foreign_state.ffi_type_pointer, /* pointer */
318    &foreign_state.ffi_type_pointer,
319    &foreign_state.ffi_type_pointer,
320    &foreign_state.ffi_type_pointer,
321    &foreign_state.ffi_type_pointer,
322    NULL,
323};
324
325typedef struct foreign_library {
326    void    *library;
327    char    *name;
328    ffi_abi  abi;
329    int      padding;
330} foreign_library;
331
332typedef enum foreign_states {
333    foreign_state_initialized,
334    foreign_state_registered,
335} foreign_states;
336
337typedef struct foreign_function {
338    foreign_library *library;
339    char            *name;
340    void            *function;
341    foreign_type     result_type;
342    int              nofarguments;
343    foreign_type    *arguments;
344    ffi_type        *ffi_result_type;
345    ffi_type       **ffi_arguments;
346    ffi_cif          cif;
347    ffi_abi          abi;
348} foreign_function;
349
350typedef enum foreign_pointer_types {
351    foreign_pointer_state_regular,
352    foreign_pointer_state_buffer,
353} foreign_pointer_types;
354
355typedef struct foreign_pointer {
356    void *ptr;
357    int   state;
358    int   padding;
359} foreign_pointer;
360
361/*tex
362    We use the already defined helpers instead of setting up loading here. That way we're also
363    consistent in lookups. You need to pass the resolved name (so at the \LUA\ end we wrap the
364    loader to use the library resolver. So no check for loaders here etc.
365*/
366
367
368#ifdef WIN32
369# ifndef WINDOWS
370#  define WINDOWS
371# endif
372#endif
373
374#if !defined(WINDOWS) || defined(_WIN64)
375#define FFI_STDCALL FFI_DEFAULT_ABI
376#endif
377
378#ifdef __APPLE__
379#define FFI_SYSV FFI_DEFAULT_ABI
380#endif
381
382typedef struct foreign_abi_entry {
383    const char *name;
384    ffi_abi     abi;
385} foreign_abi_entry;
386
387# define foreign_abi_max 3
388
389static foreign_abi_entry foreign_abi_map[] = {
390    { .name = "default", .abi = FFI_DEFAULT_ABI },
391    { .name = "cdecl",   .abi = FFI_SYSV        },
392    { .name = "stdcall", .abi = FFI_STDCALL     },
393};
394
395typedef enum foreign_library_uv_slots {
396    library_name_uv      = 1,
397    library_registry_uv  = 2,
398
399} foreign_library_uv_slots;
400
401typedef enum foreign_function_uv_slots {
402    function_name_uv      = 1,
403    function_finalizer_uv = 2,
404} foreign_function_uv_slots;
405
406static int foreignlib_not_yet_initialized(lua_State *L)
407{
408    return luaL_error(L, "foreign: not yet initialized");
409}
410
411static int foreignlib_allocation_error(lua_State *L)
412{
413    return luaL_error(L, "foreign: allocation error");
414}
415
416static foreign_library *foreignlib_library_check(lua_State *L, int index)
417{
418    return (foreign_library *) luaL_checkudata(L, index, FOREIGN_METATABLE_LIBRARY);
419}
420
421static foreign_function *foreignlib_function_check(lua_State *L, int index)
422{
423    return (foreign_function *) luaL_checkudata(L, index, FOREIGN_METATABLE_FUNCTION);
424}
425
426static foreign_pointer *foreignlib_pointer_check(lua_State *L, int index)
427{
428    return (foreign_pointer *) luaL_checkudata(L, index, FOREIGN_METATABLE_POINTER);
429}
430
431static int foreignlib_library_tostring(lua_State *L)
432{
433    foreign_library *library = foreignlib_library_check(L, 1);
434    if (library) {
435        lua_pushfstring(L, "<foreign.library %s>", library->name ? library->name : "unknown");
436        return 1;
437    } else {
438        return 0;
439    }
440}
441
442static int foreignlib_function_tostring(lua_State *L)
443{
444    foreign_function *function = foreignlib_function_check(L, 1);
445    if (function) {
446        foreign_library *library = function->library;
447        if (library) {
448            lua_pushfstring(L, "<foreign.function %s in library %s>", function->name ? function->name : "unknown", ((library && library->name) ? library->name : "unknown"));
449            return 1;
450        }
451    }
452    return 0;
453}
454
455static int foreignlib_pointer_tostring(lua_State *L)
456{
457    foreign_pointer *pointer = foreignlib_pointer_check(L, 1);
458    if (! pointer) {
459        return 0;
460    } else {
461        lua_pushfstring(L, pointer->state == foreign_pointer_state_buffer ? "<foreign.buffer %p>" : "<foreign.pointer %p>", pointer->ptr);
462        return 1;
463    }
464}
465
466static int foreignlib_pointer_gc(lua_State *L)
467{
468    foreign_pointer *pointer = foreignlib_pointer_check(L, 1);
469    if (pointer->state == foreign_pointer_state_buffer) {
470        lmt_memory_free(pointer->ptr);
471        /* not needed: */
472        pointer->state = foreign_pointer_state_regular;
473        pointer->ptr = NULL;
474    }
475    return 0;
476}
477
478/*tex
479    We accept numbers as well as names (just in case go symboloc as we do with other modules).
480*/
481
482static int foreignlib_type_found(lua_State *L, int slot, int dflt)
483{
484    switch (lua_type(L, slot)) {
485        case LUA_TNUMBER:
486            {
487                int i = (int) lua_tointeger(L, slot);
488                if (i >= 0 && i < foreign_type_max) {
489                    return i;
490                }
491                break;
492            }
493        case LUA_TSTRING:
494            {
495                const char *s = lua_tostring(L, slot);
496                for (int i = 0; i < foreign_type_max; i++) {
497                    if (strcmp(s, foreign_typenames[i]) == 0) {
498                        return i;
499                    }
500                }
501                break;
502            }
503    }
504    return dflt;
505}
506
507static int foreignlib_abi_found(lua_State *L, int slot, int dflt)
508{
509    switch (lua_type(L, slot)) {
510        case LUA_TNUMBER:
511            {
512                int i = (int) lua_tointeger(L, slot);
513                if (i >= 0 && i < foreign_abi_max) {
514                    return foreign_abi_map[i].abi;
515                }
516                break;
517            }
518        case LUA_TSTRING:
519            {
520                const char *s = lua_tostring(L, slot);
521                for (int i = 0; i < foreign_abi_max; i++) {
522                    if (strcmp(s, foreign_abi_map[i].name) == 0) {
523                        return foreign_abi_map[i].abi;
524                    }
525                }
526                break;
527            }
528    }
529    return dflt;
530}
531
532static int foreignlib_types(lua_State* L)
533{
534    lua_createtable(L, foreign_type_max, 0);
535    for (lua_Integer i = 0; i < foreign_type_max; i++) {
536        lua_pushstring(L, foreign_typenames[i]);
537        lua_rawseti(L, -2, i + 1);
538    }
539    return 1;
540}
541
542static int foreignlib_abivalues(lua_State* L)
543{
544    lua_createtable(L, 0, foreign_abi_max);
545    for (lua_Integer i = 0; i < foreign_abi_max; i++) {
546        lua_pushstring(L, foreign_abi_map[i].name);
547        lua_pushinteger(L, foreign_abi_map[i].abi);
548        lua_rawset(L, -3);
549    }
550    return 1;
551}
552
553static int foreignlib_load(lua_State *L)
554{
555    if (foreign_state.initialized) {
556        size_t len;
557        const char *libraryname = lua_tolstring(L, 1, &len);
558        if (libraryname && len > 0) {
559            foreign_library *library = (foreign_library *) lua_newuserdatauv(L, sizeof(foreign_library), 2);
560            if (library) {
561                void *libraryreference = lmt_library_open_indeed(libraryname);
562                if (libraryreference) {
563                    library->name = lmt_memory_malloc(sizeof(char) * (len + 1));
564                    if (library->name) {
565                        strcpy(library->name, libraryname);
566                        library->library = libraryreference;
567                        library->abi = foreignlib_abi_found(L, 2, FFI_DEFAULT_ABI);
568                        lua_pushvalue(L, 1);
569                        lua_setiuservalue(L, -2, library_name_uv);
570                        lua_newtable(L);
571                        lua_setiuservalue(L, -2, library_registry_uv);
572                        luaL_getmetatable(L, FOREIGN_METATABLE_LIBRARY);
573                        lua_setmetatable(L, -2);
574                        return 1;
575                    } else {
576                        goto ALLOCATION_ERROR;
577                    }
578                } else {
579                    return luaL_error(L, "foreign: invalid library");
580                }
581            } else {
582                goto ALLOCATION_ERROR;
583            }
584        } else {
585            return luaL_error(L, "foreign: invalid library name");
586        }
587    ALLOCATION_ERROR:
588        return foreignlib_allocation_error(L);
589    } else {
590        return foreignlib_not_yet_initialized(L);
591    }
592}
593
594static int foreignlib_library_register(lua_State *L)
595{
596    if (foreign_state.initialized) {
597        /* 1:library 2:specification */
598        foreign_library *library = foreignlib_library_check(L, 1);
599        if (lua_type(L, 2) == LUA_TTABLE) {
600            /* 1:library 2:specification -1:name */
601            if (lua_getfield(L, 2, "name") == LUA_TSTRING) {
602                /* 1:library 2:specification -2:name */
603                lua_getiuservalue(L, 1, library_registry_uv);
604                /* 1:library 2:specification -2:name -1:registry */
605                lua_pushvalue(L, -2);
606                /* 1:library 2:specification -3:name -2:registry -1:name */
607                lua_rawget(L, -2);
608                if (lua_type(L, -1) == LUA_TUSERDATA) {
609                    /* 1:library 2:specification -3:name -2:registry -1:function */
610                    return 1;
611                } else {
612                    /* 1:library 2:specification -3:name -2:registry -1:nil */
613                    size_t len;
614                    const char *functionname = lua_tolstring(L, -3, &len);
615                    void *functionreference = lmt_library_find_indeed(library->library, functionname);
616                    lua_pop(L, 1);
617                    if (functionreference) {
618                        /* 1:library 2:specification -2:name -1:registry */
619                        foreign_function *function = (foreign_function *) lua_newuserdatauv(L, sizeof(foreign_function), 2);
620                        if (function) {
621                            /* 1:library 2:specification -3:name -2:registry -1:function */
622                            lua_pushvalue(L, -3);
623                            /* 1:library 2:specification -4:name -3:registry -2:function -1:name */
624                            lua_pushvalue(L, -2);
625                            /* 1:library 2:specification -5:name -4:registry -3:function -2:name -1:function */
626                            lua_rawset(L, -4);
627                            /* 1:library 2:specification -3:name -2:registry -1:function */
628                            lua_pushvalue(L, -3);
629                            /* 1:library 2:specification -4:name -3:registry -2:function -1:name */
630                            lua_setiuservalue(L, -2, function_name_uv);
631                            lua_getfield(L, 2, "finalizer");
632                            /* 1:library 2:specification -4:name -3:registry -2:function -1:finalizer */
633                            lua_setiuservalue(L, -2, function_finalizer_uv);
634                            /* 1:library 2:specification -3:name -2:registry -1:function */
635                            luaL_getmetatable(L, FOREIGN_METATABLE_FUNCTION);
636                            /* 1:library 2:specification -4:name -3:registry -2:function -1:metatable */
637                            lua_setmetatable(L, -2);
638                            /* 1:library 2:specification -3:name -2:registry -1:function */
639                            function->name = (char *) lmt_memory_malloc((size_t) len + 1);
640                            if (function->name) {
641                                strcpy(function->name, functionname);
642                                function->function = functionreference;
643                                function->library = library;
644                                function->arguments = NULL;
645                                function->ffi_arguments = NULL;
646                                /* set the return type */
647                                lua_getfield(L, 2, "result");
648                                function->result_type = foreignlib_type_found(L, -1, foreign_type_void);
649                                if (function->result_type >= foreign_first_value_return_type && function->result_type <= foreign_last_value_return_type) {
650                                    function->ffi_result_type = foreign_typecodes[function->result_type];
651                                    lua_pop(L, 1);
652                                    /* set the abi (will move to library) */
653                                    lua_getfield(L, 2, "abi");
654                                    function->abi = foreignlib_abi_found(L, -1, library->abi);
655                                    lua_pop(L, 1);
656                                    /* set the argument types */
657                                    switch (lua_getfield(L, 2, "arguments")) {
658                                        case LUA_TTABLE:
659                                            {
660                                                function->nofarguments = (int) lua_rawlen(L, -1);
661                                                if (function->nofarguments > 0) {
662                                                    function->ffi_arguments = (ffi_type **) lmt_memory_malloc(function->nofarguments * sizeof(ffi_type *));
663                                                    function->arguments = (foreign_type *) lmt_memory_malloc(function->nofarguments * sizeof(foreign_type));
664                                                    if (function->ffi_arguments && function->arguments) {
665                                                        for (lua_Integer i = 0; i < function->nofarguments; i++) {
666                                                            lua_rawgeti(L, -1, i + 1);
667                                                            function->arguments[i] = foreignlib_type_found(L, -1, foreign_type_int); /* maybe issue an error */
668                                                            function->ffi_arguments[i] = foreign_typecodes[function->arguments[i]];
669                                                            lua_pop(L, 1);
670                                                        }
671                                                    } else {
672                                                        goto ALLOCATION_ERROR;
673                                                    }
674                                                }
675                                                break;
676                                            }
677                                        case LUA_TSTRING:
678                                            {
679                                                /* Just one argument, no varag here as it's too ugly otherwise. */
680                                                function->nofarguments = 1;
681                                                function->ffi_arguments = (ffi_type **) lmt_memory_malloc(sizeof(ffi_type *));
682                                                function->arguments = (foreign_type *) lmt_memory_malloc(sizeof(foreign_type));
683                                                if (function->ffi_arguments && function->arguments) {
684                                                    function->arguments[0] = foreignlib_type_found(L, -1, foreign_type_int); /* maybe issue an error */
685                                                    function->ffi_arguments[0] = foreign_typecodes[function->arguments[0]];
686                                                } else {
687                                                    goto ALLOCATION_ERROR;
688                                                }
689                                                break;
690                                            }
691                                    }
692                                    lua_pop(L, 1);
693                                    if (foreign_state.ffi_prep_cif(&(function->cif), function->abi, function->nofarguments, function->ffi_result_type, function->ffi_arguments) == FFI_OK) {
694                                        return 1;
695                                    } else {
696                                        return luaL_error(L, "foreign: error in libffi preparation");
697                                    }
698                                } else {
699                                    return luaL_error(L, "foreign: invalid return type for function %s", functionname);
700                                }
701                            } else {
702                                goto ALLOCATION_ERROR;
703                            }
704                        }
705                    } else {
706                        return luaL_error(L, "foreign: unknown function %s", functionname);
707                    }
708                }
709            } else {
710                return luaL_error(L, "foreign: function name expected");
711            }
712        } else {
713            return luaL_error(L, "foreign: specification table expected");
714        }
715    ALLOCATION_ERROR:
716        return foreignlib_allocation_error(L);
717    } else {
718        return foreignlib_not_yet_initialized(L);
719    }
720}
721
722static int foreignlib_library_registered(lua_State *L)
723{
724    if (foreign_state.initialized) {
725        foreign_library *library = foreignlib_library_check(L, 1);
726        if (library) {
727            lua_getiuservalue(L, 1, library_registry_uv);
728            if (lua_type(L, 2) == LUA_TSTRING) {
729                lua_pushvalue(L, 2);
730                lua_rawget(L, -2);
731                if (lua_type(L, -1) == LUA_TUSERDATA) {
732                /* 1:library 2:name -3:registry -2:name -1:function */
733                    return 1;
734                } else {
735                    size_t len;
736                    const char *functionname = lua_tolstring(L, 2, &len);
737                    return luaL_error(L, "foreign: unknown function %s", functionname);
738                }
739            } else {
740                lua_newtable(L);
741                lua_pushnil(L);
742                while (lua_next(L, -3)) {
743                    /* key -2 value -1 | key has to stay*/
744                    lua_pushvalue(L, -2);
745                    lua_rawset(L, -4);
746                }
747                lua_pop(L, 1);
748                return 1;
749            }
750        }
751    } else {
752        return foreignlib_not_yet_initialized(L);
753    }
754    return 0;
755}
756
757static int foreignlib_library_available(lua_State *L)
758{
759    if (foreign_state.initialized) {
760        foreign_library *library = foreignlib_library_check(L, 1);
761        if (library && lua_type(L, 2) == LUA_TSTRING) {
762            lua_getiuservalue(L, 1, library_registry_uv);
763            lua_pushvalue(L, 2);
764            lua_rawget(L, -2);
765            lua_pushboolean(L, lua_type(L, -1) == LUA_TUSERDATA);
766            return 1;
767        }
768    } else {
769        return foreignlib_not_yet_initialized(L);
770    }
771    return 0;
772}
773
774 /*tex This one is adapted from the alien version (watch the way pointer arguments are returned). */
775
776static int foreignlib_function_call(lua_State *L)
777{
778    int nofreturnvalues = 1; /* we always return at least nil */
779    foreign_function *function = foreignlib_function_check(L, 1);
780    ffi_cif *cif = &(function->cif);
781    int nofarguments = lua_gettop(L) - 1;
782    void **arguments = NULL;
783    int luacall = 0;
784    if (nofarguments != function->nofarguments) {
785        return luaL_error(L, "foreign: function '%s' expects %d arguments", function->name, function->nofarguments);
786    }
787    lua_getiuservalue(L, 1, function_finalizer_uv);
788    luacall = lua_type(L, -1) == LUA_TFUNCTION;
789    if (! luacall) {
790        lua_pop(L, 1);
791    }
792    if (nofarguments > 0) {
793        arguments = lmt_memory_malloc(sizeof(void*) * nofarguments);
794        if (arguments) {
795            for (int i = 0; i < nofarguments; i++) {
796                void *argument = NULL;
797                int slot = i + 2;
798                switch (function->arguments[i]) {
799                    case foreign_type_byte     : argument = lmt_memory_malloc(sizeof(char));               *((char               *) argument) = (signed char)        lua_tointeger(L, slot); break;
800                    case foreign_type_char     : argument = lmt_memory_malloc(sizeof(unsigned char));      *((unsigned char      *) argument) = (unsigned char)      lua_tointeger(L, slot); break;
801                    case foreign_type_short    : argument = lmt_memory_malloc(sizeof(short));              *((short              *) argument) = (short)              lua_tointeger(L, slot); break;
802                    case foreign_type_ushort   : argument = lmt_memory_malloc(sizeof(unsigned short));     *((unsigned short     *) argument) = (unsigned short)     lua_tointeger(L, slot); break;
803                    case foreign_type_int      : argument = lmt_memory_malloc(sizeof(int));                *((int                *) argument) = (int)                lua_tointeger(L, slot); break;
804                    case foreign_type_uint     : argument = lmt_memory_malloc(sizeof(unsigned int));       *((unsigned int       *) argument) = (unsigned int)       lua_tointeger(L, slot); break;
805                    case foreign_type_long     : argument = lmt_memory_malloc(sizeof(long));               *((long               *) argument) = (long)               lua_tointeger(L, slot); break;
806                    case foreign_type_ulong    : argument = lmt_memory_malloc(sizeof(unsigned long));      *((unsigned long      *) argument) = (unsigned long)      lua_tointeger(L, slot); break;
807                    case foreign_type_longlong : argument = lmt_memory_malloc(sizeof(long long));          *((long long          *) argument) = (long long)          lua_tointeger(L, slot); break;
808                    case foreign_type_ulonglong: argument = lmt_memory_malloc(sizeof(unsigned long long)); *((unsigned long long *) argument) = (unsigned long long) lua_tointeger(L, slot); break;
809                    case foreign_type_float    : argument = lmt_memory_malloc(sizeof(float));              *((float              *) argument) = (float)              lua_tonumber (L, slot); break;
810                    case foreign_type_double   : argument = lmt_memory_malloc(sizeof(double));             *((double             *) argument) = (double)             lua_tonumber (L, slot); break;
811                    case foreign_type_size_t   : argument = lmt_memory_malloc(sizeof(size_t));             *((size_t             *) argument) = (size_t)             lua_tointeger(L, slot); break;
812                    case foreign_type_string   :
813                        {
814                            argument = lmt_memory_malloc(sizeof(char*));
815                            if (argument) {
816                                *((const char**) argument) = lua_type(L, slot) == LUA_TSTRING ? lua_tostring(L, slot) : NULL;
817                                break;
818                            } else {
819                                return foreignlib_allocation_error(L);
820                            }
821                        }
822                    case foreign_type_pointer   :
823                        {
824                            /* why not just use the pointers */
825                            argument = lmt_memory_malloc(sizeof(char*));
826                            if (argument) {
827                                switch (lua_type(L, slot)) {
828                                    case LUA_TSTRING:
829                                        {
830                                            /*tex A packed 5.4 string. */
831                                            *((const char **) argument) = lua_tostring(L, slot);
832                                            break;
833                                        }
834                                    case LUA_TUSERDATA:
835                                        {
836                                            /*tex A constructed array or so. */
837                                            foreign_pointer *pointer = foreignlib_pointer_check(L, slot);
838                                            *((void **) argument) = pointer ? pointer->ptr : NULL;
839                                            break;
840                                        }
841                                    default:
842                                        {
843                                            *((void **) argument) = NULL;
844                                            break;
845                                        }
846                                }
847                                break;
848                            } else {
849                                return foreignlib_allocation_error(L);
850                            }
851                        }
852                    case foreign_type_reference_to_char:
853                        {
854                            argument = lmt_memory_malloc(sizeof(char *));
855                            if (argument) {
856                                *((char **) argument) = lmt_memory_malloc(sizeof(char));
857                                **((char **) argument) = (char) lua_tointeger(L, slot);
858                                nofreturnvalues++;
859                                break;
860                            } else {
861                                return foreignlib_allocation_error(L);
862                            }
863                        }
864                    case foreign_type_reference_to_int:
865                        {
866                            argument = lmt_memory_malloc(sizeof(int *));
867                            if (argument) {
868                                *((int **) argument) = lmt_memory_malloc(sizeof(int));
869                                **((int **) argument) = (int) lua_tointeger(L, slot);
870                                nofreturnvalues++;
871                                break;
872                            } else {
873                                return foreignlib_allocation_error(L);
874                            }
875                        }
876                    case foreign_type_reference_to_uint:
877                        {
878                            argument = lmt_memory_malloc(sizeof(unsigned int *));
879                            if (argument) {
880                                *((unsigned int **) argument) = lmt_memory_malloc(sizeof(unsigned int));
881                                **((unsigned int **) argument) = (unsigned int) lua_tointeger(L, slot);
882                                nofreturnvalues++;
883                                break;
884                            } else {
885                                return foreignlib_allocation_error(L);
886                            }
887                        }
888                    case foreign_type_reference_to_double:
889                        {
890                            argument = lmt_memory_malloc(sizeof(double *));
891                            if (argument) {
892                                *((double **) argument) = lmt_memory_malloc(sizeof(double));
893                                **((double **) argument) = (double) lua_tonumber(L, slot);
894                                nofreturnvalues++;
895                                break;
896                            } else {
897                                return foreignlib_allocation_error(L);
898                            }
899                        }
900                    default:
901                        return luaL_error(L, "foreign: invalid parameter %d for '%s')", function->arguments[i], function->name);
902                }
903                arguments[i] = argument;
904            }
905        } else {
906            return foreignlib_allocation_error(L);
907        }
908    }
909    switch (function->result_type) {
910        case foreign_type_void     : {                       foreign_state.ffi_call(cif, function->function, NULL, arguments); lua_pushnil    (L);                       break; }
911        case foreign_type_byte     : { int                r; foreign_state.ffi_call(cif, function->function, &r,   arguments); lua_pushinteger(L, (signed char)      r); break; }
912        case foreign_type_char     : { int                r; foreign_state.ffi_call(cif, function->function, &r,   arguments); lua_pushinteger(L, (unsigned char)    r); break; }
913        case foreign_type_short    : { int                r; foreign_state.ffi_call(cif, function->function, &r,   arguments); lua_pushinteger(L, (short)            r); break; }
914        case foreign_type_ushort   : { int                r; foreign_state.ffi_call(cif, function->function, &r,   arguments); lua_pushinteger(L, (unsigned short)   r); break; }
915        case foreign_type_int      : { int                r; foreign_state.ffi_call(cif, function->function, &r,   arguments); lua_pushinteger(L, (int)              r); break; }
916        case foreign_type_uint     : { int                r; foreign_state.ffi_call(cif, function->function, &r,   arguments); lua_pushinteger(L, (unsigned int)     r); break; }
917        case foreign_type_long     : { long               r; foreign_state.ffi_call(cif, function->function, &r,   arguments); lua_pushinteger(L, (long)             r); break; }
918        case foreign_type_ulong    : { unsigned long      r; foreign_state.ffi_call(cif, function->function, &r,   arguments); lua_pushinteger(L, (unsigned long)    r); break; }
919        case foreign_type_longlong : { long long          r; foreign_state.ffi_call(cif, function->function, &r,   arguments); lua_pushinteger(L, (lua_Integer)      r); break; }
920        case foreign_type_ulonglong: { unsigned long long r; foreign_state.ffi_call(cif, function->function, &r,   arguments); lua_pushinteger(L, (lua_Integer)      r); break; }
921        case foreign_type_float    : { float              r; foreign_state.ffi_call(cif, function->function, &r,   arguments); lua_pushnumber (L, (lua_Number)       r); break; }
922        case foreign_type_double   : { double             r; foreign_state.ffi_call(cif, function->function, &r,   arguments); lua_pushnumber (L,                    r); break; }
923        case foreign_type_size_t   : { size_t             r; foreign_state.ffi_call(cif, function->function, &r,   arguments); lua_pushinteger(L,                    r); break; }
924        case foreign_type_string   :
925            {
926                void *str = NULL;
927                foreign_state.ffi_call(cif, function->function, &str, arguments);
928                if (str) {
929                    lua_pushstring(L, (char *) str);
930                } else {
931                    lua_pushnil(L);
932                }
933                break;
934            }
935        case foreign_type_pointer  :
936            {
937                void *ptr = NULL;
938                foreign_state.ffi_call(cif, function->function, &ptr, arguments);
939                if (ptr) {
940                    foreign_pointer *pointer = (foreign_pointer *) lua_newuserdatauv(L, sizeof(foreign_pointer), 0);
941                    luaL_getmetatable(L, FOREIGN_METATABLE_POINTER);
942                    lua_setmetatable(L, -2);
943                    pointer->ptr = ptr;
944                    pointer->state = foreign_pointer_state_regular;
945                } else {
946                    lua_pushnil(L);
947                }
948                break;
949            }
950        default:
951            return luaL_error(L, "foreign: invalid return value %d for '%s')", function->result_type, function->name);
952    }
953    for (int i = 0; i < nofarguments; i++) {
954        switch (function->arguments[i]) {
955            case foreign_type_reference_to_char  : lua_pushinteger(L, **(char         **) arguments[i]); break;
956            case foreign_type_reference_to_int   : lua_pushinteger(L, **(int          **) arguments[i]); break;
957            case foreign_type_reference_to_uint  : lua_pushinteger(L, **(unsigned int **) arguments[i]); break;
958            case foreign_type_reference_to_double: lua_pushnumber (L, **(double       **) arguments[i]); break;
959            default: break;
960        }
961        lmt_memory_free(arguments[i]); /* not needed for pointers when we just use pointer */
962    }
963    lmt_memory_free(arguments);
964    if (luacall) {
965        lua_call(L, nofreturnvalues, 1);
966        return 1;
967    } else {
968        return nofreturnvalues;
969    }
970}
971
972static int foreignlib_library_gc(lua_State *L)
973{
974    foreign_library *library = foreignlib_library_check(L, 1);
975    if (library->library) {
976        lmt_library_open_indeed(library->library);
977        lmt_memory_free(library->name);
978    }
979    return 0;
980}
981
982static int foreignlib_function_gc(lua_State *L)
983{
984    foreign_function *function = foreignlib_function_check(L, 1);
985    lmt_memory_free(function->name);
986    lmt_memory_free(function->arguments);
987    lmt_memory_free(function->ffi_arguments);
988    return 0;
989}
990
991/* */
992
993static int foreignlib_newbuffer(lua_State *L)
994{
995    size_t size = lua_tointeger(L, 1);
996    foreign_pointer *pointer = (foreign_pointer *) lua_newuserdatauv(L, sizeof(foreign_pointer), 0);
997    luaL_getmetatable(L, FOREIGN_METATABLE_POINTER);
998    lua_setmetatable(L, -2);
999    pointer->ptr = lmt_memory_malloc(size);
1000    pointer->state = foreign_pointer_state_buffer;
1001    return 1;
1002}
1003
1004static int foreignlib_getbuffer(lua_State *L)
1005{
1006    foreign_pointer *pointer = foreignlib_pointer_check(L, 1);
1007    if (pointer && pointer->state == foreign_pointer_state_buffer && pointer->ptr) {
1008        size_t size = lua_tointeger(L, 2);
1009        if (size > 0) {
1010            lua_pushlstring(L, pointer->ptr, size);
1011        } else {
1012            lua_pushnil(L);
1013        }
1014        lmt_memory_free(pointer->ptr);
1015        pointer->ptr = NULL;
1016        pointer->state = foreign_pointer_state_regular;
1017    } else {
1018        lua_pushnil(L);
1019    }
1020    return 1;
1021}
1022
1023/* pointer to array of pointers */
1024
1025static int foreignlib_totable(lua_State *L)
1026{
1027    foreign_pointer *pointer = foreignlib_pointer_check(L, 1);
1028    if (pointer) {
1029        void *ptr = pointer->ptr;
1030        if (ptr) {
1031            int resulttype = foreignlib_type_found(L, 2, foreign_type_void);
1032            int size = (int) luaL_optinteger(L, 3, -1);
1033            lua_createtable(L, size > 0 ? size : 0, 0);
1034            switch (resulttype) {
1035                case foreign_type_void:
1036                    return 0;
1037                case foreign_type_string:
1038                    {
1039                        void **ptr = pointer->ptr;
1040                        if (ptr) {
1041                            lua_Integer r = 0;
1042                            lua_newtable(L);
1043                            if (size < 0) {
1044                                while (ptr[r]) {
1045                                    lua_pushstring(L, ptr[r]);
1046                                    lua_rawseti(L, -2, ++r);
1047                                }
1048                            } else {
1049                                for (lua_Integer i = 0; i < size; i++) {
1050                                    lua_pushstring(L, ptr[i]);
1051                                    lua_rawseti(L, -2, ++r);
1052                                }
1053                            }
1054                        }
1055                        break;
1056                    }
1057                case foreign_type_byte     : { signed char        *p = ptr; for (lua_Integer i = 0; i < size; i++) { lua_pushinteger(L, (lua_Integer) p[i]); lua_rawseti(L, -2, i + 1); } break; }
1058                case foreign_type_char     : { unsigned char      *p = ptr; for (lua_Integer i = 0; i < size; i++) { lua_pushinteger(L, (lua_Integer) p[i]); lua_rawseti(L, -2, i + 1); } break; }
1059                case foreign_type_short    : { short              *p = ptr; for (lua_Integer i = 0; i < size; i++) { lua_pushinteger(L, (lua_Integer) p[i]); lua_rawseti(L, -2, i + 1); } break; }
1060                case foreign_type_ushort   : { unsigned short     *p = ptr; for (lua_Integer i = 0; i < size; i++) { lua_pushinteger(L, (lua_Integer) p[i]); lua_rawseti(L, -2, i + 1); } break; }
1061                case foreign_type_int      : { int                *p = ptr; for (lua_Integer i = 0; i < size; i++) { lua_pushinteger(L, (lua_Integer) p[i]); lua_rawseti(L, -2, i + 1); } break; }
1062                case foreign_type_uint     : { unsigned int       *p = ptr; for (lua_Integer i = 0; i < size; i++) { lua_pushinteger(L, (lua_Integer) p[i]); lua_rawseti(L, -2, i + 1); } break; }
1063                case foreign_type_long     : { long               *p = ptr; for (lua_Integer i = 0; i < size; i++) { lua_pushinteger(L, (lua_Integer) p[i]); lua_rawseti(L, -2, i + 1); } break; }
1064                case foreign_type_ulong    : { unsigned long      *p = ptr; for (lua_Integer i = 0; i < size; i++) { lua_pushinteger(L, (lua_Integer) p[i]); lua_rawseti(L, -2, i + 1); } break; }
1065                case foreign_type_longlong : { long long          *p = ptr; for (lua_Integer i = 0; i < size; i++) { lua_pushinteger(L, (lua_Integer) p[i]); lua_rawseti(L, -2, i + 1); } break; }
1066                case foreign_type_ulonglong: { unsigned long long *p = ptr; for (lua_Integer i = 0; i < size; i++) { lua_pushinteger(L, (lua_Integer) p[i]); lua_rawseti(L, -2, i + 1); } break; }
1067                case foreign_type_float    : { float              *p = ptr; for (lua_Integer i = 0; i < size; i++) { lua_pushnumber (L, (lua_Number)  p[i]); lua_rawseti(L, -2, i + 1); } break; }
1068                case foreign_type_double   : { double             *p = ptr; for (lua_Integer i = 0; i < size; i++) { lua_pushnumber (L, (lua_Number)  p[i]); lua_rawseti(L, -2, i + 1); } break; }
1069                case foreign_type_size_t   : { size_t             *p = ptr; for (lua_Integer i = 0; i < size; i++) { lua_pushinteger(L, (lua_Integer) p[i]); lua_rawseti(L, -2, i + 1); } break; }
1070            }
1071            return 1;
1072        }
1073    }
1074    lua_pushnil(L);
1075    return 1;
1076}
1077
1078/*tex
1079
1080    Here we prepare some metatables. Todo: newindex. When we don't use a metatable for the
1081    library we can have more keys, like list and so.
1082
1083    local library = foreign.load("whatever","abi")
1084
1085    library:register   { name = ..., result = ..., arguments = { ... }, abi = ...  )
1086    library:registered ("name")
1087    library:registered ()
1088    library:available  ("name")
1089
1090    foreign.load()
1091    foreign.abivalues()
1092    foreign.types()
1093
1094    todo: ckeck what this abi does: probably better at lib loading time than per function
1095
1096*/
1097
1098static struct luaL_Reg foreignlib_function_methods[] = {
1099    { "register",   foreignlib_library_register   },
1100    { "registered", foreignlib_library_registered },
1101    { "available",  foreignlib_library_available  },
1102    { NULL,         NULL                          },
1103};
1104
1105static void foreignlib_populate(lua_State *L)
1106{
1107    luaL_newmetatable(L, FOREIGN_METATABLE_LIBRARY);
1108    lua_pushliteral(L, "__gc");
1109    lua_pushcfunction(L, foreignlib_library_gc);
1110    lua_settable(L, -3);
1111    lua_pushliteral(L, "__tostring");
1112    lua_pushcfunction(L, foreignlib_library_tostring);
1113    lua_settable(L, -3);
1114    lua_pushliteral(L, "__index");
1115    lua_newtable(L);
1116    for (int i = 0; foreignlib_function_methods[i].name; i++) {
1117        lua_pushstring(L, foreignlib_function_methods[i].name);
1118        lua_pushcfunction(L, foreignlib_function_methods[i].func);
1119        lua_settable(L, -3);
1120    }
1121    lua_settable(L, -3);
1122    lua_pop(L, 1);
1123
1124    luaL_newmetatable(L, FOREIGN_METATABLE_FUNCTION);
1125    lua_pushliteral(L, "__gc");
1126    lua_pushcfunction(L, foreignlib_function_gc);
1127    lua_settable(L, -3);
1128    lua_pushliteral(L, "__tostring");
1129    lua_pushcfunction(L, foreignlib_function_tostring);
1130    lua_settable(L, -3);
1131    lua_pushliteral(L, "__call");
1132    lua_pushcfunction(L, foreignlib_function_call);
1133    lua_settable(L, -3);
1134    lua_pop(L, 1);
1135
1136    luaL_newmetatable(L, FOREIGN_METATABLE_POINTER);
1137    lua_pushliteral(L, "__gc");
1138    lua_pushcfunction(L, foreignlib_pointer_gc);
1139    lua_settable(L, -3);
1140    lua_pushliteral(L, "__tostring");
1141    lua_pushcfunction(L, foreignlib_pointer_tostring);
1142    lua_settable(L, -3);
1143}
1144
1145/*tex
1146    Finally it all somes together in the initializer. We expect the caller to handle the lookup
1147    of |libffi| which can have different names per operating system.
1148*/
1149
1150static int foreignlib_initialize(lua_State * L)
1151{
1152    if (! foreign_state.initialized) {
1153        if (lmt_engine_state.permit_loadlib) {
1154            /*tex Just an experiment. */
1155            const char *filename = lua_tostring(L, 1); /* libffi */
1156            if (filename) {
1157
1158                lmt_library lib = lmt_library_load(filename);
1159
1160                foreign_state.ffi_prep_cif = lmt_library_find(lib, "ffi_prep_cif");
1161                foreign_state.ffi_call     = lmt_library_find(lib, "ffi_call"    );
1162
1163                foreign_state.initialized = lmt_library_okay(lib);
1164            }
1165            if (foreign_state.initialized) {
1166                foreignlib_populate(L);
1167            }
1168        } else {
1169            return luaL_error(L, "foreign: use --permitloadlib to enable this");
1170        }
1171    }
1172    lua_pushboolean(L, foreign_state.initialized);
1173    return 1;
1174}
1175
1176static struct luaL_Reg foreignlib_function_list[] = {
1177    { "initialize", foreignlib_initialize },
1178    { "load",       foreignlib_load       },
1179    { "types",      foreignlib_types      },
1180    { "newbuffer",  foreignlib_newbuffer  },
1181    { "getbuffer",  foreignlib_getbuffer  },
1182    { "abivalues",  foreignlib_abivalues  }, /* mostly for diagnostics */
1183    { "totable",    foreignlib_totable    },
1184    { NULL,         NULL                  },
1185};
1186
1187int luaopen_foreign(lua_State * L)
1188{
1189    lmt_library_register(L, "foreign", foreignlib_function_list);
1190    return 0;
1191}
1192