1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
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);
}
|
