/* Default C implementation in case the OCaml one is not registered. */
static void default_fatal_uncaught_exception(value exn)
{
char * msg;
caml_root at_exit;
int saved_backtrace_active;
intnat saved_backtrace_pos;
caml_domain_state* domain_state = Caml_state;
/* Build a string representation of the exception */
msg = caml_format_exception(exn);
/* Perform "at_exit" processing, ignoring all exceptions that may
be triggered by this */
saved_backtrace_active = domain_state->backtrace_active;
saved_backtrace_pos = domain_state->backtrace_pos;
domain_state->backtrace_active = 0;
at_exit = caml_named_root("Pervasives.do_at_exit");
if (at_exit) caml_callback_exn(caml_read_root(at_exit), Val_unit);
domain_state->backtrace_active = saved_backtrace_active;
domain_state->backtrace_pos = saved_backtrace_pos;
/* Display the uncaught exception */
fprintf(stderr, "Fatal error: exception %s\n", msg);
free(msg);
/* Display the backtrace if available */
if (Caml_state->backtrace_active && !DEBUGGER_IN_USE)
caml_print_exception_backtrace();
}
void caml_fatal_uncaught_exception(value exn)
{
caml_root handle_uncaught_exception =
caml_named_root("Printexc.handle_uncaught_exception");
if (handle_uncaught_exception)
/* [Printexc.handle_uncaught_exception] does not raise exception. */
caml_callback2(caml_read_root(handle_uncaught_exception), exn, Val_bool(DEBUGGER_IN_USE));
else
default_fatal_uncaught_exception(exn);
/* Terminate the process */
exit(2);
}
void caml_array_bound_error(void)
{
caml_root array_bound_error_exn;
array_bound_error_exn =
caml_named_root("Pervasives.array_bound_error");
if (!array_bound_error_exn) {
fprintf(stderr, "Fatal error: exception "
"Invalid_argument(\"index out of bounds\")\n");
exit(2);
}
caml_raise(caml_read_root(array_bound_error_exn));
}
char * format_result(int n)
{
value format_result_closure = caml_read_root(caml_named_root("format_result"));
return strdup(String_val(callback(format_result_closure, Val_int(n))));
}
int fib(int n)
{
value fib_closure = caml_read_root(caml_named_root("fib"));
return Int_val(callback(fib_closure, Val_int(n)));
}
