void caml_startup(char_os **argv)
{
value res = caml_startup_exn(argv);
caml_maybe_print_stats(Val_unit);
if (Is_exception_result(res))
caml_fatal_uncaught_exception(Extract_exception(res));
}
herr_t hdf5_h5l_operator(hid_t group, const char *name, const H5L_info_t *info,
void *op_data)
{
CAMLparam0();
CAMLlocal5(ret, info_v, address_v, args0, args1);
CAMLlocal2(args2, args3);
value args[4];
struct operator_data *operator_data = op_data;
args0 = alloc_h5l(group);
args1 = caml_copy_string(name);
args2 = Val_h5l_info(info);
args3 = *operator_data->operator_data;
args[0] = args0;
args[1] = args1;
args[2] = args2;
args[3] = args3;
ret = caml_callbackN_exn(*operator_data->callback, 4, args);
if (Is_exception_result(ret))
{
*(operator_data->exception) = Extract_exception(ret);
return -1;
}
CAMLreturnT(herr_t, H5_iter_val(ret));
}
CAMLexport value caml_callback3 (value closure, value arg1, value arg2,
value arg3)
{
value res = caml_callback3_exn(closure, arg1, arg2, arg3);
if (Is_exception_result(res)) caml_raise(Extract_exception(res));
return res;
}
void caml_execute_signal(int signal_number, int in_signal_handler)
{
value res;
#ifdef POSIX_SIGNALS
sigset_t sigs;
/* Block the signal before executing the handler, and record in sigs
the original signal mask */
sigemptyset(&sigs);
sigaddset(&sigs, signal_number);
sigprocmask(SIG_BLOCK, &sigs, &sigs);
#endif
res = caml_callback_exn(
Field(caml_signal_handlers, signal_number),
Val_int(caml_rev_convert_signal_number(signal_number)));
#ifdef POSIX_SIGNALS
if (! in_signal_handler) {
/* Restore the original signal mask */
sigprocmask(SIG_SETMASK, &sigs, NULL);
} else if (Is_exception_result(res)) {
/* Restore the original signal mask and unblock the signal itself */
sigdelset(&sigs, signal_number);
sigprocmask(SIG_SETMASK, &sigs, NULL);
}
#endif
if (Is_exception_result(res)) caml_raise(Extract_exception(res));
}
static inline int exec_not_null_callback(
void *cbx_, int num_columns, char **row, char **header)
{
callback_with_exn *cbx = cbx_;
value v_row, v_header, v_ret;
caml_leave_blocking_section();
v_row = copy_not_null_string_array((const char **) row, num_columns);
if (v_row == (value) NULL) return 1;
Begin_roots1(v_row);
v_header = safe_copy_string_array((const char **) header, num_columns);
End_roots();
v_ret = caml_callback2_exn(*cbx->cbp, v_row, v_header);
if (Is_exception_result(v_ret)) {
*cbx->exn = Extract_exception(v_ret);
caml_enter_blocking_section();
return 1;
}
caml_enter_blocking_section();
return 0;
}
/* Return 0 on success and non-zero on failure. */
static int caml_run_function_this_thread_r(CAML_R, value function, int index)
{
CAMLparam1(function);
CAMLlocal1(result_or_exception);
int did_we_fail;
/* fprintf(stderr, "======Forcing a GC\n"); fflush(stderr); */
//caml_gc_compaction_r(ctx, Val_unit); //!!!!!
/* fprintf(stderr, "======It's ok to have warnings about the lack of globals up to this point\n"); fflush(stderr); */
//fprintf(stderr, "W0[context %p] [thread %p] (index %i) BBBBBBBBBBBBBBBBBBBBBBBBBB\n", ctx, (void*)(pthread_self()), index); fflush(stderr); caml_acquire_global_lock(); // FIXME: a test. this is obviously unusable in production
//fprintf(stderr, "W1 [context %p] ctx->caml_local_roots is %p\n", ctx, caml_local_roots); fflush(stderr);
//DUMP();
/* Make a new context, and deserialize the blob into it: */
/* fprintf(stderr, "W3 [context %p] [thread %p] (index %i) (function %p)\n", ctx, (void*)(pthread_self()), index, (void*)function); fflush(stderr); */
/* // Allocate some trash: */
/* caml_pair_r(ctx, */
/* caml_pair_r(ctx, Val_int(1), Val_int(2)), */
/* caml_pair_r(ctx, Val_int(3), Val_int(4))); */
//fprintf(stderr, "W4 [context %p] [thread %p] (index %i) (function %p)\n", ctx, (void*)(pthread_self()), index, (void*)function); fflush(stderr);
//caml_gc_compaction_r(ctx, Val_unit); //!!!!!
//DUMP();
/* caml_empty_minor_heap_r(ctx); */
/* caml_finish_major_cycle_r (ctx); */
/* caml_compact_heap_r (ctx); */
/* caml_final_do_calls_r (ctx); */
/* Run the Caml function: */
//fprintf(stderr, "W5 [context %p] [thread %p] (index %i) (function %p)\n", ctx, (void*)(pthread_self()), index, (void*)function); fflush(stderr);
//caml_gc_compaction_r(ctx, Val_unit); //!!!!!
//DUMP();
//fprintf(stderr, "W7 [context %p] [thread %p] (index %i) (%i globals) ctx->caml_local_roots is %p\n", ctx, (void*)(pthread_self()), index, (int)(ctx->caml_globals.used_size / sizeof(value)), caml_local_roots); fflush(stderr);
//caml_dump_global_mutex();
/* It's important that Extract_exception be used before the next
collection, because result_or_exception is an invalid value in
case of exception: */
DUMP("running caml code in the new context");
result_or_exception = caml_callback_exn_r(ctx, function, Val_int(index));
did_we_fail = Is_exception_result(result_or_exception);
result_or_exception = Extract_exception(result_or_exception);
//caml_enter_blocking_section_r(ctx); // !!!!!!!!!!!!!!!
caml_enter_blocking_section_r(ctx); // Allow threads created by function to obtain the CPU
DUMP("back from the caml code in the new context");
/* If we decide to actually do something with result_or_exception,
then it becomes important that we call Extract_exception on it
(when it's an exception) before the next Caml allocation: in case
of exception result_or_exception is an invalid value, messing up
the GC. */
did_we_fail = Is_exception_result(result_or_exception);
if(did_we_fail){
char *printed_exception = caml_format_exception_r(ctx, result_or_exception);
fprintf(stderr, "FAILED with the exception %s\n", printed_exception); fflush(stderr);
free(printed_exception);
}
CAMLreturnT(int, did_we_fail);
}
void IDAOCaml_invoke_hotkey_callback(int i)
{
CAMLlocal1(ret);
ret = caml_callback_exn(*caml_named_value("HotkeyCallback"), Val_int(i));
if(Is_exception_result(ret))
{
char buf[1024];
char *exn = caml_format_exception(Extract_exception(ret));
sprintf(buf, "[E] Function bound to hotkey (internal %d) threw exception (value %08lx): %s\n",
i,
Extract_exception(ret),
exn);
wrap_msg(buf);
free(exn);
}
}
int range_set_exception(value caml_result) {
if (Is_exception_result(caml_result)) {
if (ocaml_exception) free(ocaml_exception);
ocaml_exception = strdup(String_val(Field(Extract_exception(caml_result), 1)));
return 1;
} else {
range_clear_exception();
return 0;
}
}
static N_Vector callml_custom_resid(SUNLinearSolver ls)
{
CAMLparam0();
CAMLlocal1(r);
r = caml_callback_exn(GET_OP(ls, GET_RES_ID), Val_unit);
if (Is_exception_result (r)) {
sunml_warn_discarded_exn (Extract_exception (r),
"user-defined res id handler");
CAMLreturnT(N_Vector, NULL);
}
CAMLreturnT(N_Vector, NVEC_VAL(r));
}
static int callml_custom_numiters(SUNLinearSolver ls)
{
CAMLparam0();
CAMLlocal1(r);
r = caml_callback_exn(GET_OP(ls, GET_NUM_ITERS), Val_unit);
if (Is_exception_result (r)) {
sunml_warn_discarded_exn (Extract_exception (r),
"user-defined num iters handler");
CAMLreturnT(int, 0);
}
CAMLreturnT(int, Int_val(r));
}
static realtype callml_custom_resnorm(SUNLinearSolver ls)
{
CAMLparam0();
CAMLlocal1(r);
r = caml_callback_exn(GET_OP(ls, GET_RES_NORM), Val_unit);
if (Is_exception_result (r)) {
sunml_warn_discarded_exn (Extract_exception (r),
"user-defined res norm handler");
CAMLreturnT(realtype, 0.0);
}
CAMLreturnT(realtype, Double_val(r));
}
/* Callout handler */
static int pcre_callout_handler(pcre_callout_block* cb)
{
struct cod *cod = (struct cod *) cb->callout_data;
if (cod != NULL) {
/* Callout is available */
value v_res;
/* Set up parameter array */
value v_callout_data = caml_alloc_small(6, 0);
const value v_substrings = *cod->v_substrings_p;
const int capture_top = cb->capture_top;
int subgroups2 = capture_top << 1;
const int subgroups2_1 = subgroups2 - 1;
const int *ovec_src = cb->offset_vector + subgroups2_1;
long int *ovec_dst = &Field(Field(v_substrings, 1), 0) + subgroups2_1;
/* Copy preliminary substring information */
while (subgroups2--) {
*ovec_dst = Val_int(*ovec_src);
--ovec_src; --ovec_dst;
}
Field(v_callout_data, 0) = Val_int(cb->callout_number);
Field(v_callout_data, 1) = v_substrings;
Field(v_callout_data, 2) = Val_int(cb->start_match);
Field(v_callout_data, 3) = Val_int(cb->current_position);
Field(v_callout_data, 4) = Val_int(capture_top);
Field(v_callout_data, 5) = Val_int(cb->capture_last);
Field(v_callout_data, 6) = Val_int(cb->pattern_position);
Field(v_callout_data, 7) = Val_int(cb->next_item_length);
/* Perform callout */
v_res = caml_callback_exn(*cod->v_cof_p, v_callout_data);
if (Is_exception_result(v_res)) {
/* Callout raised an exception */
const value v_exn = Extract_exception(v_res);
if (Field(v_exn, 0) == *pcre_exc_Backtrack) return 1;
cod->v_exn = v_exn;
return PCRE_ERROR_CALLOUT;
}
}
return 0;
}
void caml_main(char **argv)
{
char * exe_name;
#ifdef __linux__
static char proc_self_exe[256];
#endif
value res;
char tos;
caml_init_ieee_floats();
#ifdef _MSC_VER
caml_install_invalid_parameter_handler();
#endif
caml_init_custom_operations();
#ifdef DEBUG
caml_verb_gc = 63;
#endif
caml_top_of_stack = &tos;
parse_camlrunparam();
caml_init_gc (minor_heap_init, heap_size_init, heap_chunk_init,
percent_free_init, max_percent_free_init);
init_atoms();
caml_init_signals();
#if !defined(__FreeBSD__) && !defined(_KERNEL)
caml_debugger_init (); /* force debugger.o stub to be linked */
#endif
exe_name = argv[0];
if (exe_name == NULL) exe_name = "";
#ifdef __linux__
if (caml_executable_name(proc_self_exe, sizeof(proc_self_exe)) == 0)
exe_name = proc_self_exe;
else
exe_name = caml_search_exe_in_path(exe_name);
#elif defined(__FreeBSD__) && defined(_KERNEL)
exe_name = "mirage.ko";
#else
exe_name = caml_search_exe_in_path(exe_name);
#endif
caml_sys_init(exe_name, argv);
if (sigsetjmp(caml_termination_jmpbuf.buf, 0)) {
if (caml_termination_hook != NULL) caml_termination_hook(NULL);
return;
}
res = caml_start_program();
if (Is_exception_result(res))
caml_fatal_uncaught_exception(Extract_exception(res));
}
static void
event_callback_wrapper_locked (guestfs_h *g,
void *data,
uint64_t event,
int event_handle,
int flags,
const char *buf, size_t buf_len,
const uint64_t *array, size_t array_len)
{
CAMLparam0 ();
CAMLlocal5 (gv, evv, ehv, bufv, arrayv);
CAMLlocal2 (rv, v);
value *root;
size_t i;
root = guestfs_get_private (g, "_ocaml_g");
gv = *root;
/* Only one bit should be set in 'event'. Which one? */
evv = Val_int (event_bitmask_to_event (event));
ehv = Val_int (event_handle);
bufv = caml_alloc_string (buf_len);
memcpy (String_val (bufv), buf, buf_len);
arrayv = caml_alloc (array_len, 0);
for (i = 0; i < array_len; ++i) {
v = caml_copy_int64 (array[i]);
Store_field (arrayv, i, v);
}
value args[5] = { gv, evv, ehv, bufv, arrayv };
rv = caml_callbackN_exn (*(value*)data, 5, args);
/* Callbacks shouldn't throw exceptions. There's not much we can do
* except to print it.
*/
if (Is_exception_result (rv))
fprintf (stderr,
"libguestfs: uncaught OCaml exception in event callback: %s",
caml_format_exception (Extract_exception (rv)));
CAMLreturn0;
}
CAMLexport void caml_startup_code(
code_t code, asize_t code_size,
char *data, asize_t data_size,
char *section_table, asize_t section_table_size,
char **argv)
{
value res;
caml_init_ieee_floats();
caml_init_custom_operations();
#ifdef DEBUG
caml_verb_gc = 63;
#endif
parse_camlrunparam();
caml_external_raise = NULL;
/* 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);
/* Load the code */
caml_start_code = code;
#ifdef THREADED_CODE
caml_thread_code(caml_start_code, code_size);
#endif
/* Use the builtin table of primitives */
caml_build_primitive_table_builtin();
/* Load the globals */
caml_global_data = caml_input_value_from_block(data, data_size);
/* Ensure that the globals are in the major heap. */
caml_oldify_one (caml_global_data, &caml_global_data);
caml_oldify_mopup ();
/* Record the sections (for caml_get_section_table in meta.c) */
caml_section_table = section_table;
caml_section_table_size = section_table_size;
/* Run the code */
caml_init_exceptions();
caml_sys_init("", argv);
res = caml_interprete(caml_start_code, code_size);
if (Is_exception_result(res))
caml_fatal_uncaught_exception(Extract_exception(res));
}
static int callml_custom_space(SUNLinearSolver ls,
long int *lenrwLS, long int *leniwLS)
{
CAMLparam0();
CAMLlocal1(r);
r = caml_callback_exn(GET_OP(ls, GET_WORK_SPACE), Val_unit);
if (Is_exception_result (r)) {
r = Extract_exception (r);
lenrwLS = 0;
leniwLS = 0;
CAMLreturnT(int, lsolver_translate_exception(r));
}
*lenrwLS = Long_val(Field(r, 0));
*leniwLS = Long_val(Field(r, 1));
CAMLreturnT(int, SUNLS_SUCCESS);
}
static int
visitor_function_wrapper (const char *dir,
const char *filename,
const struct guestfs_statns *stat,
const struct guestfs_xattr_list *xattrs,
void *opaque)
{
CAMLparam0 ();
CAMLlocal5 (dirv, filenamev, statv, xattrsv, v);
struct visitor_function_wrapper_args *args = opaque;
assert (dir != NULL);
assert (stat != NULL);
assert (xattrs != NULL);
assert (args != NULL);
dirv = caml_copy_string (dir);
if (filename == NULL)
filenamev = Val_int (0); /* None */
else {
filenamev = caml_alloc (1, 0);
v = caml_copy_string (filename);
Store_field (filenamev, 0, v);
}
statv = copy_statns (stat);
xattrsv = copy_xattr_list (xattrs);
/* Call the visitor_function. */
value argsv[4] = { dirv, filenamev, statv, xattrsv };
v = caml_callbackN_exn (*args->fvp, 4, argsv);
if (Is_exception_result (v)) {
/* The visitor_function raised an exception. Store the exception
* in the 'exn' field on the stack of guestfs_int_mllib_visit, and
* return an error.
*/
*args->exnp = Extract_exception (v);
return -1;
}
/* No error, return normally. */
CAMLreturnT (int, 0);
}
static inline int exec_callback_no_headers(
void *cbx_, int num_columns, char **row, char __unused **header)
{
callback_with_exn *cbx = cbx_;
value v_row, v_ret;
caml_leave_blocking_section();
v_row = copy_string_option_array((const char **) row, num_columns);
v_ret = caml_callback_exn(*cbx->cbp, v_row);
if (Is_exception_result(v_ret)) {
*cbx->exn = Extract_exception(v_ret);
caml_enter_blocking_section();
return 1;
}
caml_enter_blocking_section();
return 0;
}
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();
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_global_data =
caml_input_value_from_block((char *) ocamlcc_global_data,
OCAMLCC_GLOBAL_DATA_LENGTH);
/* 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); */
caml_sys_init(exe_name, argv);
#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); */
res = ocamlcc_main();
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);
/*
fprintf(stderr, "Fatal error!\n");
exit(2);
*/
}
}
CAMLexport value caml_callbackN (value closure, int narg, value args[])
{
value res = caml_callbackN_exn(closure, narg, args);
if (Is_exception_result(res)) caml_raise(Extract_exception(res));
return res;
}
CAMLexport caml_global_context* caml_main_rr(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
caml_context_initialize_global_stuff();
CAML_R = caml_make_first_global_context();
the_main_context = ctx;
/* Machine-dependent initialization of the floating-point hardware
so that it behaves as much as possible as specified in IEEE */
caml_init_ieee_floats();
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_r(ctx);
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_r(ctx, 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_r(ctx, fd, &trail);
/* Initialize the abstract machine */
caml_init_gc_r (ctx,minor_heap_init, heap_size_init, heap_chunk_init,
percent_free_init, max_percent_free_init);
caml_init_stack_r (ctx, max_stack_init);
init_atoms_r(ctx);
/* Initialize the interpreter */
caml_interprete_r(ctx, NULL, 0);
/* Initialize the debugger, if needed */
caml_debugger_init_r(ctx);
/* Load the code */
caml_code_size = caml_seek_section(fd, &trail, "CODE");
caml_load_code_r(ctx, fd, caml_code_size);
/* Build the table of primitives */
shared_lib_path = read_section_r(ctx, fd, &trail, "DLPT");
shared_libs = read_section_r(ctx, fd, &trail, "DLLS");
req_prims = read_section_r(ctx, fd, &trail, "PRIM");
if (req_prims == NULL) caml_fatal_error("Fatal error: no PRIM section\n");
caml_build_primitive_table_r(ctx, 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_r(ctx, fd);
caml_global_data = caml_input_val_r(ctx, chan);
caml_close_channel(chan); /* this also closes fd */
//////////////
//fprintf(stderr, "[bytecode] startup: A\n"); fflush(stderr);
//fprintf(stderr, "caml_global_data is %i words long\n", (int)Wosize_val(caml_global_data)); fflush(stderr);
//////////////
caml_stat_free(trail.section);
/* Ensure that the globals are in the major heap. */
caml_oldify_one_r (ctx, caml_global_data, &caml_global_data);
caml_oldify_mopup_r (ctx);
/* Initialize system libraries */
caml_init_exceptions_r(ctx);
caml_sys_init_r(ctx, 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_r(ctx, PROGRAM_START);
res = caml_interprete_r(ctx, 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_r(ctx, UNCAUGHT_EXC);
}
caml_fatal_uncaught_exception_r(ctx, caml_exn_bucket);
}
return ctx;
}
void caml_startup_pooled(char_os **argv)
{
value res = caml_startup_pooled_exn(argv);
if (Is_exception_result(res))
caml_fatal_uncaught_exception(Extract_exception(res));
}
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;
static char proc_self_exe[256];
/* 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 = 0x3F;
#endif
caml_parse_ocamlrunparam();
#ifdef DEBUG
caml_gc_message (-1, "### OCaml runtime: debug mode ###\n", 0);
#endif
pos = 0;
/* First, try argv[0] (when ocamlrun is called by a bytecode program) */
exe_name = argv[0];
fd = caml_attempt_open(&exe_name, &trail, 0);
/* Should we really do that at all? The current executable is ocamlrun
itself, it's never a bytecode program. */
if (fd < 0
&& caml_executable_name(proc_self_exe, sizeof(proc_self_exe)) == 0) {
exe_name = proc_self_exe;
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 (caml_init_minor_heap_wsz, caml_init_heap_wsz,
caml_init_heap_chunk_sz, caml_init_percent_free,
caml_init_max_percent_free, caml_init_major_window);
caml_init_stack (caml_init_max_stack_wsz);
caml_init_atom_table();
caml_init_backtrace();
/* 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);
caml_init_debug_info();
/* 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_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_startup_code(
code_t code, asize_t code_size,
char *data, asize_t data_size,
char *section_table, asize_t section_table_size,
char **argv)
{
value res;
char* cds_file;
char * exe_name;
#ifdef __linux__
static char proc_self_exe[256];
#endif
caml_init_ieee_floats();
#ifdef _MSC_VER
caml_install_invalid_parameter_handler();
#endif
caml_init_custom_operations();
#ifdef DEBUG
caml_verb_gc = 63;
#endif
cds_file = getenv("CAML_DEBUG_FILE");
if (cds_file != NULL) {
caml_cds_file = caml_stat_alloc(strlen(cds_file) + 1);
strcpy(caml_cds_file, cds_file);
}
parse_camlrunparam();
exe_name = argv[0];
#ifdef __linux__
if (caml_executable_name(proc_self_exe, sizeof(proc_self_exe)) == 0)
exe_name = proc_self_exe;
#endif
caml_external_raise = NULL;
/* 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_start_code = code;
caml_code_size = code_size;
caml_init_code_fragments();
if (caml_debugger_in_use) {
int len, i;
len = code_size / sizeof(opcode_t);
caml_saved_code = (unsigned char *) caml_stat_alloc(len);
for (i = 0; i < len; i++) caml_saved_code[i] = caml_start_code[i];
}
#ifdef THREADED_CODE
caml_thread_code(caml_start_code, code_size);
#endif
/* Use the builtin table of primitives */
caml_build_primitive_table_builtin();
/* Load the globals */
caml_global_data = caml_input_value_from_block(data, data_size);
/* Ensure that the globals are in the major heap. */
caml_oldify_one (caml_global_data, &caml_global_data);
caml_oldify_mopup ();
/* Record the sections (for caml_get_section_table in meta.c) */
caml_section_table = section_table;
caml_section_table_size = section_table_size;
/* Initialize system libraries */
caml_init_exceptions();
caml_sys_init(exe_name, argv);
/* 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);
}
}
