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