c/interop.c

   1 #include <string.h>
   2 #include <dlfcn.h>
   3 #if OSX
   4   #include <ffi/ffi.h>
   5 #else
   6   #include <ffi.h>
   7 #endif
   8
   9 #include "types.h"
  10
  11
  12 GHashTable *loaded_dls = NULL;
  13
  14 int get_byte_size(char *type) {
  15     return 0;
  16 }
  17
  18 typedef struct Raw64 {
  19     union {
  20         gdouble floatnum;
  21         gint64  integernum;
  22         char   *string;
  23     } v;
  24 } Raw64;
  25
  26
  27 // obj must be a pointer to the object to store
  28 ffi_type *_get_ffi_type(char *type) {
  29     if ((strcmp("void", type) == 0)) {
  30         return &ffi_type_void;
  31     } else if ((strcmp("string", type) == 0) ||
  32                (strcmp("char*", type) == 0) ||
  33                (strcmp("char *", type) == 0)) {
  34         return &ffi_type_pointer;
  35     } else if ((strcmp("integer", type) == 0) ||
  36                (strcmp("int64", type) == 0)) {
  37         return &ffi_type_sint64;
  38     } else if ((strcmp("int32", type) == 0)) {
  39         return &ffi_type_sint32;
  40     } else if (strcmp("double", type) == 0) {
  41         return &ffi_type_double;
  42     } else if (strcmp("float", type) == 0) {
  43         return &ffi_type_float;
  44     } else {
  45         abort("_get_ffi_type of unknown type '%s'", type);
  46     }
  47 }
  48
  49 MalVal *_malval_new_by_type(char *type) {
  50     if ((strcmp("void", type) == 0)) {
  51         return NULL;
  52     } else if ((strcmp("string", type) == 0) ||
  53                (strcmp("char*", type) == 0) ||
  54                (strcmp("char *", type) == 0)) {
  55         return malval_new(MAL_STRING, NULL);
  56     } else if ((strcmp("integer", type) == 0) ||
  57                (strcmp("int64", type) == 0)) {
  58         return malval_new(MAL_INTEGER, NULL);
  59     } else if ((strcmp("int32", type) == 0)) {
  60         return malval_new(MAL_INTEGER, NULL);
  61     } else if (strcmp("double", type) == 0) {
  62         return malval_new(MAL_FLOAT, NULL);
  63     } else if (strcmp("float", type) == 0) {
  64         return malval_new(MAL_FLOAT, NULL);
  65     } else {
  66         abort("_malval_new_by_type of unknown type '%s'", type);
  67     }
  68 }
  69
  70
  71
  72 // Mal syntax:
  73 //   (.  {DYN_LIB_FILE|nil}  RETURN_TYPE  FUNC_NAME  [ARG_TYPE ARG]...)
  74 MalVal *invoke_native(MalVal *call_data) {
  75     //g_print("invoke_native %s\n", pr_str(call_data));
  76     int cd_len = call_data->val.array->len;
  77     int arg_len = (cd_len - 3)/2;
  78     char *error;
  79     void *dl_handle;
  80
  81     assert_type(call_data, MAL_LIST,
  82                 "invoke_native called with non-list call_data: %s",
  83                 _pr_str(call_data,1));
  84     assert(cd_len >= 3,
  85            "invoke_native called with %d args, needs at least 3",
  86            cd_len);
  87     assert((cd_len % 2) == 1,
  88            "invoke_native called with an even number of args (%d)",
  89            cd_len);
  90     assert(arg_len <= 3,
  91            "invoke_native called with more than 3 native args (%d)",
  92            arg_len);
  93     MalVal *dl_file = _nth(call_data, 0),
  94            *ftype   = _nth(call_data, 1),
  95            *fname   = _nth(call_data, 2);
  96     assert_type(dl_file, MAL_STRING|MAL_NIL,
  97                 "invoke_native arg 1 (DYN_LIB_NAME) must be a string or nil");
  98     assert_type(ftype, MAL_STRING,
  99                 "invoke_native arg 2 (RETURN_TYPE) must be a string");
 100     assert_type(fname, MAL_STRING,
 101                 "invoke_native arg 3 (FUNC_NAME) must be a string");
 102
 103     // Cached load of the dynamic library handle
 104     if (dl_file->type == MAL_NIL) {
 105         dl_handle = dlopen(NULL, RTLD_LAZY);
 106     } else {
 107         // Load the library
 108         if (loaded_dls == NULL) {
 109             loaded_dls = g_hash_table_new(g_str_hash, g_str_equal);
 110         }
 111         dl_handle = g_hash_table_lookup(loaded_dls, dl_file->val.string);
 112         dlerror(); // clear any existing error
 113         if (!dl_handle) {
 114             dl_handle = dlopen(dl_file->val.string, RTLD_LAZY);
 115         }
 116         if ((error = dlerror()) != NULL) {
 117             abort("Could not dlopen '%s': %s", dl_file->val.string, error);
 118         }
 119         g_hash_table_insert(loaded_dls, dl_file->val.string, dl_handle);
 120     }
 121
 122     void * func = dlsym(dl_handle, fname->val.string);
 123     if ((error = dlerror()) != NULL) {
 124         abort("Could not dlsym '%s': %s", fname->val.string, error);
 125     }
 126
 127
 128     //
 129     // Use FFI library to make a dynamic call
 130     //
 131
 132     // Based on:
 133     // http://eli.thegreenplace.net/2013/03/04/flexible-runtime-interface-to-shared-libraries-with-libffi/
 134     ffi_cif cif;
 135     ffi_type *ret_type;
 136     ffi_type *arg_types[20];
 137     void     *arg_vals[20];
 138     ffi_status status;
 139     MalVal *ret_mv;
 140
 141     // Set return type
 142     ret_type = _get_ffi_type(ftype->val.string);
 143     ret_mv = _malval_new_by_type(ftype->val.string);
 144     if (mal_error) { return NULL; }
 145
 146     // Set the argument types and values
 147     int i;
 148     for (i=0; i < arg_len; i++) {
 149         arg_types[i] = _get_ffi_type(_nth(call_data, 3+i*2)->val.string);
 150         if (arg_types[i] == NULL) {
 151             return NULL;
 152         }
 153         arg_vals[i] = &_nth(call_data, 4+i*2)->val;
 154     }
 155
 156     status = ffi_prep_cif(&cif, FFI_DEFAULT_ABI, arg_len,
 157                           ret_type, arg_types);
 158     if (status != FFI_OK) {
 159         abort("ffi_prep_cif failed: %d\n", status);
 160     }
 161
 162     // Perform the call
 163     //g_print("Calling %s[%p](%d)\n", fname->val.string, func, arg_len);
 164     ffi_call(&cif, FFI_FN(func), &ret_mv->val, arg_vals);
 165
 166     if (ret_type == &ffi_type_void) {
 167         return &mal_nil;
 168     } else {
 169         return ret_mv;
 170     }
 171 }
 172