/* 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)
{
char * msg;
value * at_exit;
int saved_backtrace_active, saved_backtrace_pos;
/* 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 = caml_backtrace_active;
saved_backtrace_pos = caml_backtrace_pos;
caml_backtrace_active = 0;
at_exit = caml_named_value("Pervasives.do_at_exit");
if (at_exit != NULL) caml_callback_exn(*at_exit, Val_unit);
caml_backtrace_active = saved_backtrace_active;
caml_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_backtrace_active
#ifndef NATIVE_CODE
&& !caml_debugger_in_use
#endif
) {
caml_print_exception_backtrace();
}
/* Terminate the process */
exit(2);
}
void caml_fatal_uncaught_exception(value exn)
{
char * msg;
value * at_exit;
/* 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 */
at_exit = caml_named_value("Pervasives.do_at_exit");
if (at_exit != NULL) caml_callback_exn(*at_exit, Val_unit);
/* Display the uncaught exception */
/*fprintf(stderr, "Fatal error: exception %s\n", msg);*/
free(msg);
/* Terminate the process */
exit(2);
}
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;
}
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);
}
}
