/* 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 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));
}
CAMLexport value caml_callbackN_exn(value closure, int narg, value args[])
{
CAMLparam1 (closure);
CAMLxparamN (args, narg);
CAMLlocal1 (res);
int i;
res = closure;
for (i = 0; i < narg; /*nothing*/) {
/* Pass as many arguments as possible */
switch (narg - i) {
case 1:
res = caml_callback_exn(res, args[i]);
if (Is_exception_result(res)) CAMLreturn (res);
i += 1;
break;
case 2:
res = caml_callback2_exn(res, args[i], args[i + 1]);
if (Is_exception_result(res)) CAMLreturn (res);
i += 2;
break;
default:
res = caml_callback3_exn(res, args[i], args[i + 1], args[i + 2]);
if (Is_exception_result(res)) CAMLreturn (res);
i += 3;
break;
}
}
CAMLreturn (res);
}
CAMLexport value caml_callbackN_exn(value closure, int narg, value args[])
{
CAMLparam0();
struct stack_info* parent_stack;
int i;
value res;
caml_domain_state* domain_state = Caml_state;
parent_stack = Stack_parent(domain_state->current_stack);
Stack_parent(domain_state->current_stack) = NULL;
CAMLassert(narg + 4 <= 256);
domain_state->current_stack->sp -= narg + 4;
for (i = 0; i < narg; i++) domain_state->current_stack->sp[i] = args[i]; /* arguments */
opcode_t code[7] = {
callback_code[0], narg + 3,
callback_code[2], narg,
callback_code[4], callback_code[5], callback_code[6]
};
domain_state->current_stack->sp[narg] = Val_pc (code + 4); /* return address */
domain_state->current_stack->sp[narg + 1] = Val_unit; /* environment */
domain_state->current_stack->sp[narg + 2] = Val_long(0); /* extra args */
domain_state->current_stack->sp[narg + 3] = closure;
res = caml_interprete(code, sizeof(code));
if (Is_exception_result(res)) domain_state->current_stack->sp += narg + 4; /* PR#1228 */
Assert(Stack_parent(domain_state->current_stack) == NULL);
Stack_parent(domain_state->current_stack) = parent_stack;
CAMLreturn (res);
}
CAMLexport value caml_callbackN_exn(value closure, int narg, value args[])
{
CAMLparam0();
CAMLlocal1(parent_stack);
int i;
value res;
parent_stack = Stack_parent(caml_current_stack);
Stack_parent(caml_current_stack) = Val_unit;
Assert(narg + 4 <= 256);
caml_extern_sp -= narg + 4;
for (i = 0; i < narg; i++) caml_extern_sp[i] = args[i]; /* arguments */
opcode_t code[7] = {
callback_code[0], narg + 3,
callback_code[2], narg,
callback_code[4], callback_code[5], callback_code[6]
};
caml_extern_sp[narg] = Val_pc (code + 4); /* return address */
caml_extern_sp[narg + 1] = Val_unit; /* environment */
caml_extern_sp[narg + 2] = Val_long(0); /* extra args */
caml_extern_sp[narg + 3] = closure;
res = caml_interprete(code, sizeof(code));
if (Is_exception_result(res)) caml_extern_sp += narg + 4; /* PR#1228 */
Assert(Stack_parent(caml_current_stack) == Val_unit);
Stack_parent(caml_current_stack) = parent_stack;
CAMLreturn (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;
}
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));
}
// Called by the host app to configure miTLS ahead of creating a connection
int FFI_mitls_configure(mitls_state **state, const char *tls_version, const char *host_name, char **outmsg, char **errmsg)
{
CAMLparam0();
CAMLlocal3(config, version, host);
int ret = 0;
*state = NULL;
*outmsg = NULL;
*errmsg = NULL;
version = caml_copy_string(tls_version);
host = caml_copy_string(host_name);
caml_acquire_runtime_system();
config = caml_callback2_exn(*g_mitls_FFI_Config, version, host);
if (Is_exception_result(config)) {
// call caml_format_exception(Extract_exception(config)) to extract the exception information
} else {
mitls_state * s;
// Allocate space on the heap, to store an OCaml value
s = (mitls_state*)malloc(sizeof(mitls_state));
if (s) {
// Tell the OCaml GC about the heap address, so it is treated
// as a GC root, keeping the config object live.
s->fstar_state = config;
caml_register_generational_global_root(&s->fstar_state);
*state = s;
ret = 1;
}
}
caml_release_runtime_system();
CAMLreturnT(int,ret);
}
// Called by the host app to create a TLS connection.
int FFI_mitls_connect(struct _FFI_mitls_callbacks *callbacks, /* in */ mitls_state *state, /* out */ char **outmsg, /* out */ char **errmsg)
{
CAMLparam0();
CAMLlocal1(result);
int ret;
*outmsg = NULL;
*errmsg = NULL;
caml_acquire_runtime_system();
result = caml_callback2_exn(*g_mitls_FFI_Connect, state->fstar_state, PtrToValue(callbacks));
if (Is_exception_result(result)) {
// Call caml_format_exception(Extract_exception(result)) to extract the exception text
ret = 0;
} else {
// Connect returns back (Connection.connection * int)
value connection = Field(result,0);
ret = Int_val(Field(result,1));
if (ret == 0) {
caml_modify_generational_global_root(&state->fstar_state, connection);
ret = 1;
} else {
ret = 0;
}
// The result is an integer. How to deduce the value of 'c' needed for
// subsequent FFI.read and FFI.write is TBD.
}
caml_release_runtime_system();
CAMLreturnT(int,ret);
}
int cstr_post(value* in)
{
value v;
CLOSURE ("Cstr.post");
v = caml_callback_exn(*closure, *in);
return Is_exception_result(v);
}
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;
}
/* Do a minor collection and a slice of major collection, call finalisation
functions, etc.
Leave the minor heap empty.
*/
CAMLexport void caml_minor_collection (void)
{
value *note_gc;
uint64_t start_time;
note_gc = caml_named_value("MProf.Trace.note_gc");
if (note_gc)
start_time = NOW();
intnat prev_alloc_words = caml_allocated_words;
caml_empty_minor_heap ();
caml_stat_promoted_words += caml_allocated_words - prev_alloc_words;
++ caml_stat_minor_collections;
caml_major_collection_slice (0);
caml_force_major_slice = 0;
caml_final_do_calls ();
if (note_gc){
double duration_ns = (double) (NOW () - start_time);
value result = caml_callback_exn(*note_gc, caml_copy_double(duration_ns / 1000000000));
if (Is_exception_result(result))
printk("warning: note_gc threw an exception!\n");
}
caml_empty_minor_heap ();
}
static int putc_callback(int c)
{
CAMLparam0();
CAMLlocal1(ret);
AWB(ret);
ret=callback_exn(putc_function,Val_int(c&255));
CAMLreturn(Is_exception_result(ret)?-1:0);
}
static gboolean ml_gtk_text_char_predicate(gunichar ch, gpointer user_data)
{
value res, *clos = user_data;
res = callback_exn (*clos, Val_int(ch));
if (Is_exception_result (res)) {
CAML_EXN_LOG ("ml_gtk_text_char_predicate");
return FALSE;
}
return Bool_val(res);
}
static
void ml_rsvg_size_callback(gint *w, gint *h, gpointer user_data)
{
value *cb = user_data;
value r;
r = callback2_exn(*cb, Val_int(*w), Val_int(*h));
if(Is_exception_result(r)) return;
*w = Int_val(Field(r, 0));
*h = Int_val(Field(r, 1));
}
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 void timer_proc(ClientData cdata) {
timerhandler *h;
value r;
h = (timerhandler *) cdata;
r = callback_exn(h->callback_fn, Val_int(0));
if (Is_exception_result(r)) {
fprintf(stderr, "In timer_proc: Uncaught Ocaml exception\n");
};
}
static void file_proc(ClientData cdata, int mask) {
filehandler *h;
value r;
h = (filehandler *) cdata;
r = callback_exn(h->callback_fn, Val_int(0));
if (Is_exception_result(r)) {
fprintf(stderr, "In file_proc: Uncaught Ocaml exception\n");
};
}
Hunpos hunpos_tagger_new(const char* model_file, const char* morph_table_file, int max_guessed_tags, int theta, int* error)
{
*error = 0;
if(model_file == NULL) {
*error = 3;
return NULL;
}
if(morph_table_file == NULL) {
morph_table_file = "";
}
/* Startup OCaml */
if (is_initialized == 0)
{
is_initialized = 1;
char* dummyargv[2];
dummyargv[0]="";
dummyargv[1]=NULL;
caml_startup(dummyargv);
}
CAMLparam0();
/* get hunpos init function from ocaml */
static value* init_fun;
if (init_fun == NULL)
{
init_fun = caml_named_value("init_from_files");
}
Hunpos tagger_fun = (Hunpos) malloc(sizeof(value));
*((value*)tagger_fun) = 0;
// we pass some argument to the function
CAMLlocalN ( args, 4 );
args[0] = caml_copy_string(model_file);
args[1] = caml_copy_string(morph_table_file);
args[2] = Val_int(max_guessed_tags);
args[3] = Val_int(theta);
/* due to the garbage collector we have to register the */
/* returned value not to be deallocated */
caml_register_global_root(tagger_fun);
value* t = tagger_fun;
*t = caml_callbackN_exn( *init_fun, 4, args );
if (Is_exception_result(*t))
{
*error = 1;
CAMLreturnT(Hunpos, NULL);
}
// CAMLreturn1(tagger_fun)
CAMLreturnT(Hunpos,tagger_fun);
}
cairo_status_t
ml_cairo_unsafe_read_func (void *closure, unsigned char *data, unsigned int length)
{
value res, *c = closure;
res = caml_callback2_exn (Field (*c, 0), Val_bp (data), Val_int (length));
if (Is_exception_result (res))
{
Store_field (*c, 1, res);
return CAIRO_STATUS_READ_ERROR;
}
return CAIRO_STATUS_SUCCESS;
}
static int ml_gsl_odeiv_func(double t, const double y[],
double dydt[], void *params)
{
struct mlgsl_odeiv_params *p = params;
value vt, res;
vt = copy_double(t);
memcpy(Double_array_val(p->arr1), y, p->dim * sizeof(double));
res = callback3_exn(p->closure, vt, p->arr1, p->arr2);
if(Is_exception_result(res))
return GSL_FAILURE;
memcpy(dydt, Double_array_val(p->arr2), p->dim * sizeof(double));
return GSL_SUCCESS;
}
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 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));
}
cairo_status_t
ml_cairo_read_func (void *closure, unsigned char *data, unsigned int length)
{
value s, res, *c = closure;
s = caml_alloc_string (length);
res = caml_callback_exn (Field (*c, 0), s);
if (Is_exception_result (res))
{
Store_field (*c, 1, res);
return CAIRO_STATUS_READ_ERROR;
}
memcpy (data, String_val (s), length);
return CAIRO_STATUS_SUCCESS;
}
/* 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));
}
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);
}
}
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 value caml_callbackN_exn(value closure, int narg, value args[])
{
int i;
value res;
/* some alternate bytecode implementations (e.g. a JIT translator)
might require that the bytecode is kept in a local variable on
the C stack */
#ifdef LOCAL_CALLBACK_BYTECODE
opcode_t local_callback_code[7];
#endif
Assert(narg + 4 <= 256);
caml_extern_sp -= narg + 4;
for (i = 0; i < narg; i++) caml_extern_sp[i] = args[i]; /* arguments */
#ifndef LOCAL_CALLBACK_BYTECODE
caml_extern_sp[narg] = (value) (callback_code + 4); /* return address */
caml_extern_sp[narg + 1] = Val_unit; /* environment */
caml_extern_sp[narg + 2] = Val_long(0); /* extra args */
caml_extern_sp[narg + 3] = closure;
Init_callback();
callback_code[1] = narg + 3;
callback_code[3] = narg;
res = caml_interprete(callback_code, sizeof(callback_code));
#else /*have LOCAL_CALLBACK_BYTECODE*/
caml_extern_sp[narg] = (value) (local_callback_code + 4); /* return address */
caml_extern_sp[narg + 1] = Val_unit; /* environment */
caml_extern_sp[narg + 2] = Val_long(0); /* extra args */
caml_extern_sp[narg + 3] = closure;
local_callback_code[0] = ACC;
local_callback_code[1] = narg + 3;
local_callback_code[2] = APPLY;
local_callback_code[3] = narg;
local_callback_code[4] = POP;
local_callback_code[5] = 1;
local_callback_code[6] = STOP;
#ifdef THREADED_CODE
caml_thread_code(local_callback_code, sizeof(local_callback_code));
#endif /*THREADED_CODE*/
res = caml_interprete(local_callback_code, sizeof(local_callback_code));
caml_release_bytecode(local_callback_code, sizeof(local_callback_code));
#endif /*LOCAL_CALLBACK_BYTECODE*/
if (Is_exception_result(res)) caml_extern_sp += narg + 4; /* PR#1228 */
return res;
}