/* 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); }