forked from ocaml/ocaml
-
Notifications
You must be signed in to change notification settings - Fork 0
/
dynlink.c
300 lines (264 loc) · 8.99 KB
/
dynlink.c
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
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
/**************************************************************************/
/* */
/* OCaml */
/* */
/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
/* */
/* Copyright 2000 Institut National de Recherche en Informatique et */
/* en Automatique. */
/* */
/* All rights reserved. This file is distributed under the terms of */
/* the GNU Lesser General Public License version 2.1, with the */
/* special exception on linking described in the file LICENSE. */
/* */
/**************************************************************************/
#define CAML_INTERNALS
/* Dynamic loading of C primitives. */
#include <stddef.h>
#include <stdlib.h>
#include <string.h>
#include <fcntl.h>
#include <sys/stat.h>
#include "caml/config.h"
#ifdef HAS_UNISTD
#include <unistd.h>
#endif
#include "caml/alloc.h"
#include "caml/dynlink.h"
#include "caml/fail.h"
#include "caml/mlvalues.h"
#include "caml/memory.h"
#include "caml/misc.h"
#include "caml/osdeps.h"
#include "caml/prims.h"
#include "caml/signals.h"
#ifndef NATIVE_CODE
/* The table of primitives */
struct ext_table caml_prim_table;
#ifdef DEBUG
/* The names of primitives (for instrtrace.c) */
struct ext_table caml_prim_name_table;
#endif
/* The table of shared libraries currently opened */
static struct ext_table shared_libs;
/* The search path for shared libraries */
struct ext_table caml_shared_libs_path;
/* 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;
}
/* Parse the OCAML_STDLIB_DIR/ld.conf file and add the directories
listed there to the search path */
#define LD_CONF_NAME _T("ld.conf")
static char_os * parse_ld_conf(void)
{
char_os * stdlib, * ldconfname, * wconfig, * p, * q;
char * config;
#ifdef _WIN32
struct _stati64 st;
#else
struct stat st;
#endif
int ldconf, nread;
stdlib = caml_secure_getenv(_T("OCAMLLIB"));
if (stdlib == NULL) stdlib = caml_secure_getenv(_T("CAMLLIB"));
if (stdlib == NULL) stdlib = OCAML_STDLIB_DIR;
ldconfname = caml_stat_strconcat_os(3, stdlib, _T("/"), LD_CONF_NAME);
if (stat_os(ldconfname, &st) == -1) {
caml_stat_free(ldconfname);
return NULL;
}
ldconf = open_os(ldconfname, O_RDONLY, 0);
if (ldconf == -1)
caml_fatal_error_arg("Fatal error: cannot read loader config file %s\n",
caml_stat_strdup_of_os(ldconfname));
config = caml_stat_alloc(st.st_size + 1);
nread = read(ldconf, config, st.st_size);
if (nread == -1)
caml_fatal_error_arg
("Fatal error: error while reading loader config file %s\n",
caml_stat_strdup_of_os(ldconfname));
config[nread] = 0;
wconfig = caml_stat_strdup_to_os(config);
caml_stat_free(config);
q = wconfig;
for (p = wconfig; *p != 0; p++) {
if (*p == _T('\n')) {
*p = 0;
caml_ext_table_add(&caml_shared_libs_path, q);
q = p + 1;
}
}
if (q < p) caml_ext_table_add(&caml_shared_libs_path, q);
close(ldconf);
caml_stat_free(ldconfname);
return wconfig;
}
/* Open the given shared library and add it to shared_libs.
Abort on error. */
static void open_shared_lib(char_os * name)
{
char_os * realname;
char * u8;
void * handle;
realname = caml_search_dll_in_path(&caml_shared_libs_path, name);
u8 = caml_stat_strdup_of_os(realname);
caml_gc_message(0x100, "Loading shared library %s\n", u8);
caml_stat_free(u8);
caml_enter_blocking_section();
handle = caml_dlopen(realname, 1, 1);
caml_leave_blocking_section();
if (handle == NULL)
caml_fatal_error_arg2("Fatal error: cannot load shared library %s\n",
caml_stat_strdup_of_os(name),
"Reason: %s\n", caml_dlerror());
caml_ext_table_add(&shared_libs, handle);
caml_stat_free(realname);
}
/* Build the table of primitives, given a search path and a list
of shared libraries (both 0-separated in a char array).
Abort the runtime system on error. */
void caml_build_primitive_table(char_os * lib_path,
char_os * libs,
char * req_prims)
{
char_os * tofree1, * tofree2;
char_os * p;
char * q;
/* Initialize the search path for dynamic libraries:
- directories specified on the command line with the -I option
- directories specified in the CAML_LD_LIBRARY_PATH
- directories specified in the executable
- directories specified in the file <stdlib>/ld.conf */
tofree1 = caml_decompose_path(&caml_shared_libs_path,
caml_secure_getenv(_T("CAML_LD_LIBRARY_PATH")));
if (lib_path != NULL)
for (p = lib_path; *p != 0; p += strlen_os(p) + 1)
caml_ext_table_add(&caml_shared_libs_path, p);
tofree2 = parse_ld_conf();
/* Open the shared libraries */
caml_ext_table_init(&shared_libs, 8);
if (libs != NULL)
for (p = libs; *p != 0; p += strlen_os(p) + 1)
open_shared_lib(p);
/* Build the primitive table */
caml_ext_table_init(&caml_prim_table, 0x180);
#ifdef DEBUG
caml_ext_table_init(&caml_prim_name_table, 0x180);
#endif
for (q = req_prims; *q != 0; q += strlen(q) + 1) {
c_primitive prim = lookup_primitive(q);
if (prim == NULL)
caml_fatal_error_arg("Fatal error: unknown C primitive `%s'\n", q);
caml_ext_table_add(&caml_prim_table, (void *) prim);
#ifdef DEBUG
caml_ext_table_add(&caml_prim_name_table, caml_stat_strdup(q));
#endif
}
/* Clean up */
caml_stat_free(tofree1);
caml_stat_free(tofree2);
caml_ext_table_free(&caml_shared_libs_path, 0);
}
/* Build the table of primitives as a copy of the builtin primitive table.
Used for executables generated by ocamlc -output-obj. */
void caml_build_primitive_table_builtin(void)
{
int i;
caml_ext_table_init(&caml_prim_table, 0x180);
#ifdef DEBUG
caml_ext_table_init(&caml_prim_name_table, 0x180);
#endif
for (i = 0; caml_builtin_cprim[i] != 0; i++) {
caml_ext_table_add(&caml_prim_table, (void *) caml_builtin_cprim[i]);
#ifdef DEBUG
caml_ext_table_add(&caml_prim_name_table,
caml_stat_strdup(caml_names_of_builtin_cprim[i]));
#endif
}
}
void caml_free_shared_libs(void)
{
while (shared_libs.size > 0)
caml_dlclose(shared_libs.contents[--shared_libs.size]);
}
#endif /* NATIVE_CODE */
/** dlopen interface for the bytecode linker **/
#define Handle_val(v) (*((void **) (v)))
CAMLprim value caml_dynlink_open_lib(value mode, value filename)
{
void * handle;
value result;
char_os * p;
caml_gc_message(0x100, "Opening shared library %s\n",
String_val(filename));
p = caml_stat_strdup_to_os(String_val(filename));
caml_enter_blocking_section();
handle = caml_dlopen(p, Int_val(mode), 1);
caml_leave_blocking_section();
caml_stat_free(p);
if (handle == NULL) caml_failwith(caml_dlerror());
result = caml_alloc_small(1, Abstract_tag);
Handle_val(result) = handle;
return result;
}
CAMLprim value caml_dynlink_close_lib(value handle)
{
caml_dlclose(Handle_val(handle));
return Val_unit;
}
/*#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;
}
#ifndef NATIVE_CODE
CAMLprim value caml_dynlink_add_primitive(value handle)
{
return Val_int(caml_ext_table_add(&caml_prim_table, Handle_val(handle)));
}
CAMLprim value caml_dynlink_get_current_libs(value unit)
{
CAMLparam0();
CAMLlocal1(res);
int i;
res = caml_alloc_tuple(shared_libs.size);
for (i = 0; i < shared_libs.size; i++) {
value v = caml_alloc_small(1, Abstract_tag);
Handle_val(v) = shared_libs.contents[i];
Store_field(res, i, v);
}
CAMLreturn(res);
}
#else
value caml_dynlink_add_primitive(value handle)
{
caml_invalid_argument("dynlink_add_primitive");
return Val_unit; /* not reached */
}
value caml_dynlink_get_current_libs(value unit)
{
caml_invalid_argument("dynlink_get_current_libs");
return Val_unit; /* not reached */
}
#endif /* NATIVE_CODE */