/* 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]);
}
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);
}
/* 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);
}
char * caml_search_exe_in_path(char * name)
{
struct ext_table path;
char * tofree;
char * res;
caml_ext_table_init(&path, 8);
tofree = caml_decompose_path(&path, getenv("PATH"));
#ifndef __CYGWIN__
res = caml_search_in_path(&path, name);
#else
res = cygwin_search_exe_in_path(&path, name);
#endif
caml_stat_free(tofree);
caml_ext_table_free(&path, 0);
return res;
}
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);
}
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);
}
CAMLexport void caml_main(char **argv)
{
int fd, pos;
struct exec_trailer trail;
struct channel * chan;
value res;
char * shared_lib_path, * shared_libs, * req_prims;
char * exe_name;
#ifdef __linux__
static char proc_self_exe[256];
#endif
/* Machine-dependent initialization of the floating-point hardware
so that it behaves as much as possible as specified in IEEE */
caml_init_ieee_floats();
#ifdef _MSC_VER
caml_install_invalid_parameter_handler();
#endif
caml_init_custom_operations();
caml_ext_table_init(&caml_shared_libs_path, 8);
caml_external_raise = NULL;
/* Determine options and position of bytecode file */
#ifdef DEBUG
caml_verb_gc = 0xBF;
#endif
parse_camlrunparam();
pos = 0;
exe_name = argv[0];
#ifdef __linux__
if (caml_executable_name(proc_self_exe, sizeof(proc_self_exe)) == 0)
exe_name = proc_self_exe;
#endif
fd = caml_attempt_open(&exe_name, &trail, 0);
if (fd < 0) {
pos = parse_command_line(argv);
if (argv[pos] == 0)
caml_fatal_error("No bytecode file specified.\n");
exe_name = argv[pos];
fd = caml_attempt_open(&exe_name, &trail, 1);
switch(fd) {
case FILE_NOT_FOUND:
caml_fatal_error_arg("Fatal error: cannot find file '%s'\n", argv[pos]);
break;
case BAD_BYTECODE:
caml_fatal_error_arg(
"Fatal error: the file '%s' is not a bytecode executable file\n",
exe_name);
break;
}
}
/* Read the table of contents (section descriptors) */
caml_read_section_descriptors(fd, &trail);
/* Initialize the abstract machine */
caml_init_gc (minor_heap_init, heap_size_init, heap_chunk_init,
percent_free_init, max_percent_free_init);
caml_init_stack (max_stack_init);
init_atoms();
/* Initialize the interpreter */
caml_interprete(NULL, 0);
/* Initialize the debugger, if needed */
caml_debugger_init();
/* Load the code */
caml_code_size = caml_seek_section(fd, &trail, "CODE");
caml_load_code(fd, caml_code_size);
/* Build the table of primitives */
shared_lib_path = read_section(fd, &trail, "DLPT");
shared_libs = read_section(fd, &trail, "DLLS");
req_prims = read_section(fd, &trail, "PRIM");
if (req_prims == NULL) caml_fatal_error("Fatal error: no PRIM section\n");
caml_build_primitive_table(shared_lib_path, shared_libs, req_prims);
caml_stat_free(shared_lib_path);
caml_stat_free(shared_libs);
caml_stat_free(req_prims);
/* Load the globals */
caml_seek_section(fd, &trail, "DATA");
chan = caml_open_descriptor_in(fd);
caml_global_data = caml_input_val(chan);
caml_close_channel(chan); /* this also closes fd */
caml_stat_free(trail.section);
/* Ensure that the globals are in the major heap. */
caml_oldify_one (caml_global_data, &caml_global_data);
caml_oldify_mopup ();
/* Initialize system libraries */
caml_init_exceptions();
caml_sys_init(exe_name, argv + pos);
#ifdef _WIN32
/* Start a thread to handle signals */
if (getenv("CAMLSIGPIPE"))
_beginthread(caml_signal_thread, 4096, NULL);
#endif
/* Execute the program */
caml_debugger(PROGRAM_START);
res = caml_interprete(caml_start_code, caml_code_size);
if (Is_exception_result(res)) {
caml_exn_bucket = Extract_exception(res);
if (caml_debugger_in_use) {
caml_extern_sp = &caml_exn_bucket; /* The debugger needs the
exception value.*/
caml_debugger(UNCAUGHT_EXC);
}
caml_fatal_uncaught_exception(caml_exn_bucket);
}
}
CAMLexport void caml_init_debug_info(void)
{
caml_ext_table_init(&caml_debug_info, 1);
caml_add_debug_info(caml_start_code, Val_long(caml_code_size), Val_unit);
}
