CAMLprim value caml_natdynlink_open(value filename, value global)
{
CAMLparam2 (filename, global);
CAMLlocal3 (res, handle, header);
void *sym;
void *dlhandle;
char *p;
/* TODO: dlclose in case of error... */
p = caml_strdup(String_val(filename));
caml_enter_blocking_section();
dlhandle = caml_dlopen(String_val(filename), 1, Int_val(global));
caml_leave_blocking_section();
caml_stat_free(p);
if (NULL == dlhandle)
caml_failwith(caml_dlerror());
sym = caml_dlsym(dlhandle, "caml_plugin_header");
if (NULL == sym)
caml_failwith("not an OCaml plugin");
handle = Val_handle(dlhandle);
header = caml_input_value_from_malloc(sym, 0);
res = caml_alloc_tuple(2);
Init_field(res, 0, handle);
Init_field(res, 1, header);
CAMLreturn(res);
}
CAMLprim value caml_natdynlink_open(value filename, value global)
{
CAMLparam1 (filename);
CAMLlocal1 (res);
void *sym;
void *handle;
char *p;
/* TODO: dlclose in case of error... */
p = caml_strdup(String_val(filename));
caml_enter_blocking_section();
handle = caml_dlopen(p, 1, Int_val(global));
caml_leave_blocking_section();
caml_stat_free(p);
if (NULL == handle)
CAMLreturn(caml_copy_string(caml_dlerror()));
sym = caml_dlsym(handle, "caml_plugin_header");
if (NULL == sym)
CAMLreturn(caml_copy_string("not an OCaml plugin"));
res = caml_alloc_tuple(2);
Field(res, 0) = (value) handle;
Field(res, 1) = (value) (sym);
CAMLreturn(res);
}
void * caml_globalsym(char * name)
{
#ifdef RTLD_DEFAULT
return caml_dlsym(RTLD_DEFAULT, name);
#else
return NULL;
#endif
}
static void *getsym(void *handle, char *module, char *name){
char *fullname = caml_strconcat(3, "caml", module, name);
void *sym;
sym = caml_dlsym (handle, fullname);
/* printf("%s => %lx\n", fullname, (uintnat) sym); */
caml_stat_free(fullname);
return sym;
}
static void *getsym(void *handle, char *module, char *name){
char *fullname = malloc(strlen(module) + strlen(name) + 5);
void *sym;
sprintf(fullname, "caml%s%s", module, name);
sym = caml_dlsym (handle, fullname);
/* printf("%s => %lx\n", fullname, (uintnat) sym); */
free(fullname);
return sym;
}
/*#include <stdio.h>*/
CAMLprim value caml_dynlink_lookup_symbol(value handle, value symbolname)
{
void * symb;
value result;
symb = caml_dlsym(Handle_val(handle), String_val(symbolname));
/* printf("%s = 0x%lx\n", String_val(symbolname), symb);
fflush(stdout); */
if (symb == NULL) return Val_unit /*caml_failwith(caml_dlerror())*/;
result = caml_alloc_small(1, Abstract_tag);
Handle_val(result) = symb;
return result;
}
static void *getsym(void *handle, char *module, char *name, int opt){
char *fullname = malloc(strlen(module) + strlen(name) + 5);
void *sym;
sprintf(fullname, "caml%s%s", module, name);
sym = caml_dlsym (handle, fullname);
/* printf("%s => %lx\n", fullname, (uintnat) sym); */
free(fullname);
if (NULL == sym && !opt) {
printf("natdynlink: cannot find symbol %s\n", fullname);
exit(2);
}
return sym;
}
/* Look up the given primitive name in the built-in primitive table,
then in the opened shared libraries (shared_libs) */
static c_primitive lookup_primitive(char * name)
{
int i;
void * res;
for (i = 0; caml_names_of_builtin_cprim[i] != NULL; i++) {
if (strcmp(name, caml_names_of_builtin_cprim[i]) == 0)
return caml_builtin_cprim[i];
}
for (i = 0; i < shared_libs.size; i++) {
res = caml_dlsym(shared_libs.contents[i], name);
if (res != NULL) return (c_primitive) res;
}
return NULL;
}
CAMLprim value caml_natdynlink_open(value filename)
{
CAMLparam1 (filename);
CAMLlocal1 (res);
void *sym;
void *handle;
/* TODO: dlclose in case of error... */
handle = caml_dlopen(String_val(filename), 1);
if (NULL == handle)
CAMLreturn(caml_copy_string(caml_dlerror()));
sym = caml_dlsym(handle, "caml_plugin_header");
if (NULL == sym)
CAMLreturn(caml_copy_string("not an OCaml plugin"));
res = caml_alloc_tuple(2);
Field(res, 0) = (value) handle;
Field(res, 1) = (value) (sym);
CAMLreturn(res);
}
