/* 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 * lib_path,
char * libs,
char * req_prims)
{
char * tofree1, * tofree2;
#ifdef OCAML_LIB
char * tofree3 ;
#endif
char * p;
/* 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,
getenv("CAML_LD_LIBRARY_PATH"));
if (lib_path != NULL)
for (p = lib_path; *p != 0; p += strlen(p) + 1)
caml_ext_table_add(&caml_shared_libs_path, p);
tofree2 = parse_ld_conf();
#ifdef OCAML_LIB
tofree3 = do_parse_ld_conf(OCAML_LIB) ;
#endif
/* Open the shared libraries */
caml_ext_table_init(&shared_libs, 8);
if (libs != NULL)
for (p = libs; *p != 0; p += strlen(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 (p = req_prims; *p != 0; p += strlen(p) + 1) {
c_primitive prim = lookup_primitive(p);
if (prim == NULL)
caml_fatal_error_arg("Fatal error: unknown C primitive `%s'\n", p);
caml_ext_table_add(&caml_prim_table, (void *) prim);
#ifdef DEBUG
caml_ext_table_add(&caml_prim_name_table, strdup(p));
#endif
}
/* Clean up */
caml_stat_free(tofree1);
caml_stat_free(tofree2);
#ifdef OCAML_LIB
caml_stat_free(tofree3);
#endif
caml_ext_table_free(&caml_shared_libs_path, 0);
}
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, strdup(caml_names_of_builtin_cprim[i]));
#endif
}
}
void caml_build_primitive_table_builtin(void)
{
int i;
caml_ext_table_init(&caml_prim_table, 0x180);
for (i = 0; caml_builtin_cprim[i] != 0; i++)
caml_ext_table_add(&caml_prim_table, (void *) caml_builtin_cprim[i]);
}
/* Processes a (Instruct.debug_event list array) into a form suitable
for quick lookup and registers it for the (code_start,code_size) pc range. */
CAMLprim value caml_add_debug_info(code_t code_start, value code_size,
value events_heap)
{
CAMLparam1(events_heap);
struct debug_info *debug_info;
/* build the OCaml-side debug_info value */
debug_info = caml_stat_alloc(sizeof(struct debug_info));
debug_info->start = code_start;
debug_info->end = (code_t)((char*) code_start + Long_val(code_size));
if (events_heap == Val_unit) {
debug_info->events = NULL;
debug_info->num_events = 0;
debug_info->already_read = 0;
} else {
debug_info->events =
process_debug_events(code_start, events_heap, &debug_info->num_events);
debug_info->already_read = 1;
}
caml_ext_table_add(&caml_debug_info, debug_info);
CAMLreturn(Val_unit);
}
CAMLprim value caml_register_code_fragment(value prog, value len, value digest)
{
struct code_fragment * cf = caml_stat_alloc(sizeof(struct code_fragment));
cf->code_start = (char *) prog;
cf->code_end = (char *) prog + Long_val(len);
memcpy(cf->digest, String_val(digest), 16);
cf->digest_computed = 1;
caml_ext_table_add(&caml_code_fragments_table, cf);
return Val_unit;
}
static char * parse_ld_conf(void)
{
const char * stdlib;
char * ldconfname, * config, * p, * q;
struct stat st;
int ldconf, nread;
stdlib = getenv("OCAMLLIB");
if (stdlib == NULL) stdlib = getenv("CAMLLIB");
if (stdlib == NULL) stdlib = OCAML_STDLIB_DIR;
ldconfname = (char *)
caml_stat_alloc(strlen(stdlib) + 2 + sizeof(LD_CONF_NAME));
strcpy(ldconfname, stdlib);
strcat(ldconfname, "/" LD_CONF_NAME);
if (stat(ldconfname, &st) == -1) {
caml_stat_free(ldconfname);
return NULL;
}
ldconf = open(ldconfname, O_RDONLY, 0);
if (ldconf == -1)
caml_fatal_error_arg("Fatal error: cannot read loader config file %s\n",
ldconfname);
config = (char *) 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",
ldconfname);
config[nread] = 0;
q = config;
for (p = config; *p != 0; p++) {
if (*p == '\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 config;
}
void caml_init_code_fragments() {
struct code_fragment * cf;
/* Register the code in the table of code fragments */
cf = caml_stat_alloc(sizeof(struct code_fragment));
cf->code_start = (char *) caml_start_code;
cf->code_end = (char *) caml_start_code + caml_code_size;
caml_md5_block(cf->digest, caml_start_code, caml_code_size);
cf->digest_computed = 1;
caml_ext_table_init(&caml_code_fragments_table, 8);
caml_ext_table_add(&caml_code_fragments_table, cf);
}
/* Open the given shared library and add it to shared_libs.
Abort on error. */
static void open_shared_lib(char * name)
{
char * realname;
void * handle;
realname = caml_search_dll_in_path(&caml_shared_libs_path, name);
caml_gc_message(0x100, "Loading shared library %s\n",
(uintnat) realname);
handle = caml_dlopen(realname, 1, 1);
if (handle == NULL)
caml_fatal_error_arg2("Fatal error: cannot load shared library %s\n", 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 * lib_path,
char * libs,
char * req_prims)
{
char * p;
caml_ext_table_init(&caml_prim_table, 0xA0);
for (p = req_prims; *p != 0; p += strlen(p) + 1) {
c_primitive prim = lookup_primitive(p);
if (prim == NULL)
caml_fatal_error_arg("Fatal error: unknown C primitive `%s'\n", p);
caml_ext_table_add(&caml_prim_table, (void *) prim);
}
/* Clean up */
}
CAMLprim value caml_sys_read_directory(value path)
{
CAMLparam1(path);
CAMLlocal1(result);
struct ext_table tbl;
caml_ext_table_init(&tbl, 50);
if (caml_read_directory(String_val(path), &tbl) == -1){
caml_ext_table_free(&tbl, 1);
caml_sys_error(path);
}
caml_ext_table_add(&tbl, NULL);
result = caml_copy_string_array((char const **) tbl.contents);
caml_ext_table_free(&tbl, 1);
CAMLreturn(result);
}
/* Open the given shared library and add it to shared_libs.
Abort on error. */
static void open_shared_lib(char * name)
{
char * realname;
void * handle;
realname = caml_search_dll_in_path(&caml_shared_libs_path, name);
caml_gc_log("Loading shared library %s", realname);
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", name,
"Reason: %s\n", caml_dlerror());
caml_ext_table_add(&shared_libs, handle);
caml_stat_free(realname);
}
char * caml_decompose_path(struct ext_table * tbl, char * path)
{
char * p, * q;
int n;
if (path == NULL) return NULL;
p = caml_strdup(path);
q = p;
while (1) {
for (n = 0; q[n] != 0 && q[n] != ';'; n++) /*nothing*/;
caml_ext_table_add(tbl, q);
q = q + n;
if (*q == 0) break;
*q = 0;
q += 1;
}
return p;
}
char * caml_decompose_path(struct ext_table * tbl, char * path)
{
char * p, * q;
int n;
if (path == NULL) return NULL;
p = (char *) caml_stat_alloc(strlen(path) + 1);
strcpy(p, path);
q = p;
while (1) {
for (n = 0; q[n] != 0 && q[n] != ':'; n++) /*nothing*/;
caml_ext_table_add(tbl, q);
q = q + n;
if (*q == 0) break;
*q = 0;
q += 1;
}
return p;
}
static int parse_command_line(char **argv)
{
int i, j;
for(i = 1; argv[i] != NULL && argv[i][0] == '-'; i++) {
switch(argv[i][1]) {
#ifdef DEBUG
case 't':
caml_trace_flag++;
break;
#endif
case 'v':
if (!strcmp (argv[i], "-version")){
printf ("The OCaml runtime, version " OCAML_VERSION "\n");
exit (0);
}else if (!strcmp (argv[i], "-vnum")){
printf (OCAML_VERSION "\n");
exit (0);
}else{
caml_verb_gc = 0x001+0x004+0x008+0x010+0x020;
}
break;
case 'p':
for (j = 0; caml_names_of_builtin_cprim[j] != NULL; j++)
printf("%s\n", caml_names_of_builtin_cprim[j]);
exit(0);
break;
case 'b':
caml_record_backtrace(Val_true);
break;
case 'I':
if (argv[i + 1] != NULL) {
caml_ext_table_add(&caml_shared_libs_path, argv[i + 1]);
i++;
}
break;
default:
caml_fatal_error_arg("Unknown option %s.\n", argv[i]);
}
}
return i;
}
CAMLprim value caml_natdynlink_run(void *handle, value symbol) {
CAMLparam1 (symbol);
CAMLlocal1 (result);
void *sym,*sym2;
struct code_fragment * cf;
#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);
cf = caml_stat_alloc(sizeof(struct code_fragment));
cf->code_start = (char *) sym;
cf->code_end = (char *) sym2;
cf->digest_computed = 0;
caml_ext_table_add(&caml_code_fragments_table, cf);
}
entrypoint = optsym("__entry");
if (NULL != entrypoint) result = caml_callback((value)(&entrypoint), 0);
else result = Val_unit;
#undef optsym
CAMLreturn (result);
}
int caml_read_directory(char * dirname, struct ext_table * contents)
{
DIR * d;
#ifdef HAS_DIRENT
struct dirent * e;
#else
struct direct * e;
#endif
d = opendir(dirname);
if (d == NULL) return -1;
while (1) {
e = readdir(d);
if (e == NULL) break;
if (strcmp(e->d_name, ".") == 0 || strcmp(e->d_name, "..") == 0) continue;
caml_ext_table_add(contents, caml_strdup(e->d_name));
}
closedir(d);
return 0;
}
int caml_parse_command_line(char_os **argv)
{
int i, j;
for(i = 1; argv[i] != NULL && argv[i][0] == _T('-'); i++) {
switch(argv[i][1]) {
case _T('t'):
params.trace_level++; /* ignored unless DEBUG mode */
break;
case _T('v'):
if (!strcmp_os (argv[i], _T("-version"))){
printf ("The OCaml runtime, version " OCAML_VERSION_STRING "\n");
exit (0);
}else if (!strcmp_os (argv[i], _T("-vnum"))){
printf (OCAML_VERSION_STRING "\n");
exit (0);
}else{
params.verb_gc = 0x001+0x004+0x008+0x010+0x020;
}
break;
case _T('p'):
for (j = 0; caml_names_of_builtin_cprim[j] != NULL; j++)
printf("%s\n", caml_names_of_builtin_cprim[j]);
exit(0);
break;
case _T('b'):
params.backtrace_enabled_init = 1;
break;
case _T('I'):
if (argv[i + 1] != NULL) {
caml_ext_table_add(&caml_shared_libs_path, argv[i + 1]);
i++;
}
break;
default:
caml_fatal_error_arg("Unknown option %s.\n", caml_stat_strdup_of_os(argv[i]));
}
}
return i;
}
static void init_segments(void)
{
extern struct segment caml_data_segments[], caml_code_segments[];
int i;
struct code_fragment * cf;
caml_code_area_start = caml_code_segments[0].begin;
caml_code_area_end = caml_code_segments[0].end;
for (i = 1; caml_code_segments[i].begin != 0; i++) {
if (caml_code_segments[i].begin < caml_code_area_start)
caml_code_area_start = caml_code_segments[i].begin;
if (caml_code_segments[i].end > caml_code_area_end)
caml_code_area_end = caml_code_segments[i].end;
}
/* Register the code in the table of code fragments */
cf = caml_stat_alloc(sizeof(struct code_fragment));
cf->code_start = caml_code_area_start;
cf->code_end = caml_code_area_end;
cf->digest_computed = 0;
caml_ext_table_init(&caml_code_fragments_table, 8);
caml_ext_table_add(&caml_code_fragments_table, cf);
}
static void init_atoms(void)
{
extern struct segment caml_data_segments[], caml_code_segments[];
int i;
struct code_fragment * cf;
for (i = 0; i < 256; i++) {
caml_atom_table[i] = Make_header(0, i, Caml_white);
}
if (caml_page_table_add(In_static_data,
caml_atom_table, caml_atom_table + 256) != 0)
caml_fatal_error("Fatal error: not enough memory for initial page table");
for (i = 0; caml_data_segments[i].begin != 0; i++) {
/* PR#5509: we must include the zero word at end of data segment,
because pointers equal to caml_data_segments[i].end are static data. */
if (caml_page_table_add(In_static_data,
caml_data_segments[i].begin,
caml_data_segments[i].end + sizeof(value)) != 0)
caml_fatal_error("Fatal error: not enough memory for initial page table");
}
caml_code_area_start = caml_code_segments[0].begin;
caml_code_area_end = caml_code_segments[0].end;
for (i = 1; caml_code_segments[i].begin != 0; i++) {
if (caml_code_segments[i].begin < caml_code_area_start)
caml_code_area_start = caml_code_segments[i].begin;
if (caml_code_segments[i].end > caml_code_area_end)
caml_code_area_end = caml_code_segments[i].end;
}
/* Register the code in the table of code fragments */
cf = caml_stat_alloc(sizeof(struct code_fragment));
cf->code_start = caml_code_area_start;
cf->code_end = caml_code_area_end;
cf->digest_computed = 0;
caml_ext_table_init(&caml_code_fragments_table, 8);
caml_ext_table_add(&caml_code_fragments_table, cf);
}
int caml_read_directory(char * dirname, struct ext_table * contents)
{
DIR * d;
#ifdef HAS_DIRENT
struct dirent * e;
#else
struct direct * e;
#endif
char * p;
d = opendir(dirname);
if (d == NULL) return -1;
while (1) {
e = readdir(d);
if (e == NULL) break;
if (strcmp(e->d_name, ".") == 0 || strcmp(e->d_name, "..") == 0) continue;
p = (char *) caml_stat_alloc(strlen(e->d_name) + 1);
strcpy(p, e->d_name);
caml_ext_table_add(contents, p);
}
closedir(d);
return 0;
}
CAMLprim value caml_sys_read_directory(value path)
{
CAMLparam1(path);
CAMLlocal1(result);
struct ext_table tbl;
char * p;
int ret;
caml_ext_table_init(&tbl, 50);
p = caml_strdup(String_val(path));
caml_enter_blocking_section();
ret = caml_read_directory(p, &tbl);
caml_leave_blocking_section();
caml_stat_free(p);
if (ret == -1){
caml_ext_table_free(&tbl, 1);
caml_sys_error(path);
}
caml_ext_table_add(&tbl, NULL);
result = caml_copy_string_array((char const **) tbl.contents);
caml_ext_table_free(&tbl, 1);
CAMLreturn(result);
}
CAMLprim value caml_dynlink_add_primitive(value handle)
{
return Val_int(caml_ext_table_add(&caml_prim_table, Handle_val(handle)));
}