1 files changed, 126 insertions, 0 deletions
diff --git a/ocaml-binary-annot/asmrun/natdynlink.c b/ocaml-binary-annot/asmrun/natdynlink.c
new file mode 100644
index 0000000000..84cfb590c9
--- /dev/null
+++ b/ocaml-binary-annot/asmrun/natdynlink.c
@@ -0,0 +1,126 @@
+#include "misc.h"
+#include "mlvalues.h"
+#include "memory.h"
+#include "stack.h"
+#include "callback.h"
+#include "alloc.h"
+#include "natdynlink.h"
+#include "osdeps.h"
+#include "fail.h"
+
+#include <stdio.h>
+#include <string.h>
+
+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;
+}
+
+extern char caml_globals_map[];
+
+CAMLprim value caml_natdynlink_getmap(value unit)
+{
+  return (value)caml_globals_map;
+}
+
+CAMLprim value caml_natdynlink_globals_inited(value unit)
+{
+  return Val_int(caml_globals_inited);
+}
+
+CAMLprim value caml_natdynlink_open(value filename, value global)
+{
+  CAMLparam1 (filename);
+  CAMLlocal1 (res);
+  void *sym;
+  void *handle;
+
+  /* TODO: dlclose in case of error... */
+
+  handle = caml_dlopen(String_val(filename), 1, Int_val(global));
+
+  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);
+}
+
+CAMLprim value caml_natdynlink_run(void *handle, value symbol) {
+  CAMLparam1 (symbol);
+  CAMLlocal1 (result);
+  void *sym,*sym2;
+
+#define optsym(n) getsym(handle,unit,n)
+  char *unit;
+  void (*entrypoint)(void);
+
+  unit = String_val(symbol);
+
+  sym = optsym("__frametable");
+  if (NULL != sym) caml_register_frametable(sym);
+
+  sym = optsym("");
+  if (NULL != sym) caml_register_dyn_global(sym);
+
+  sym = optsym("__data_begin");
+  sym2 = optsym("__data_end");
+  if (NULL != sym && NULL != sym2)
+    caml_page_table_add(In_static_data, sym, sym2);
+
+  sym = optsym("__code_begin");
+  sym2 = optsym("__code_end");
+  if (NULL != sym && NULL != sym2)
+    caml_page_table_add(In_code_area, sym, sym2);
+
+  entrypoint = optsym("__entry");
+  if (NULL != entrypoint) result = caml_callback((value)(&entrypoint), 0);
+  else result = Val_unit;
+
+#undef optsym
+
+  CAMLreturn (result);
+}
+
+CAMLprim value caml_natdynlink_run_toplevel(value filename, value symbol)
+{
+  CAMLparam2 (filename, symbol);
+  CAMLlocal2 (res, v);
+  void *handle;
+
+  /* TODO: dlclose in case of error... */
+
+  handle = caml_dlopen(String_val(filename), 1, 1);
+
+  if (NULL == handle) {
+    res = caml_alloc(1,1);
+    v = caml_copy_string(caml_dlerror());
+    Store_field(res, 0, v);
+  } else {
+    res = caml_alloc(1,0);
+    v = caml_natdynlink_run(handle, symbol);
+    Store_field(res, 0, v);
+  }
+  CAMLreturn(res);
+}
+
+CAMLprim value caml_natdynlink_loadsym(value symbol)
+{
+  CAMLparam1 (symbol);
+  CAMLlocal1 (sym);
+
+  sym = (value) caml_globalsym(String_val(symbol));
+  if (!sym) caml_failwith(String_val(symbol));
+  CAMLreturn(sym);
+}