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