/* Finish the work that was put off by [caml_oldify_one]. Note that [caml_oldify_one] itself is called by oldify_mopup, so we have to be careful to remove the first entry from the list before oldifying its fields. */ void caml_oldify_mopup (void) { value v, new_v, f; mlsize_t i; while (oldify_todo_list != 0){ v = oldify_todo_list; /* Get the head. */ Assert (Hd_val (v) == 0); /* It must be forwarded. */ new_v = Field (v, 0); /* Follow forward pointer. */ oldify_todo_list = Field (new_v, 1); /* Remove from list. */ f = Field (new_v, 0); if (Is_block (f) && Is_young (f)){ caml_oldify_one (f, &Field (new_v, 0)); } for (i = 1; i < Wosize_val (new_v); i++){ f = Field (v, i); if (Is_block (f) && Is_young (f)){ caml_oldify_one (f, &Field (new_v, i)); }else{ Field (new_v, i) = f; } } } }
/* Finish the work that was put off by [caml_oldify_one]. Note that [caml_oldify_one] itself is called by oldify_mopup, so we have to be careful to remove the first entry from the list before oldifying its fields. */ static void caml_oldify_mopup (void) { value v, new_v, f; mlsize_t i; while (oldify_todo_list != 0){ v = oldify_todo_list; /* Get the head. */ Assert (Hd_val (v) == 0); /* It must be forwarded. */ new_v = Op_val (v)[0]; /* Follow forward pointer. */ if (Tag_val(new_v) == Stack_tag) { oldify_todo_list = Op_val (v)[1]; /* Remove from list (stack) */ caml_scan_stack(caml_oldify_one, new_v); } else { oldify_todo_list = Op_val (new_v)[1]; /* Remove from list (non-stack) */ f = Op_val (new_v)[0]; if (Is_block (f) && Is_young (f)){ caml_oldify_one (f, Op_val (new_v)); } for (i = 1; i < Wosize_val (new_v); i++){ f = Op_val (v)[i]; if (Is_block (f) && Is_young (f)){ caml_oldify_one (f, Op_val (new_v) + i); }else{ Op_val (new_v)[i] = f; } } } } }
/* Call [caml_oldify_one] on (at least) all the roots that point to the minor heap. */ void caml_oldify_local_roots (void) { register value * sp; struct caml__roots_block *lr; intnat i, j; /* The stack */ for (sp = caml_extern_sp; sp < caml_stack_high; sp++) { caml_oldify_one (*sp, sp); } /* Local C roots */ /* FIXME do the old-frame trick ? */ for (lr = caml_local_roots; lr != NULL; lr = lr->next) { for (i = 0; i < lr->ntables; i++){ for (j = 0; j < lr->nitems; j++){ sp = &(lr->tables[i][j]); caml_oldify_one (*sp, sp); } } } /* Global C roots */ caml_scan_global_young_roots(&caml_oldify_one); /* Finalised values */ caml_final_do_young_roots (&caml_oldify_one); /* Hook */ if (caml_scan_roots_hook != NULL) (*caml_scan_roots_hook)(&caml_oldify_one); }
/* Make sure the minor heap is empty by performing a minor collection if needed. */ void caml_empty_minor_heap (void) { value **r; uintnat prev_alloc_words; if (caml_young_ptr != caml_young_end) { if (caml_minor_gc_begin_hook != NULL) (*caml_minor_gc_begin_hook) (); prev_alloc_words = caml_allocated_words; caml_in_minor_collection = 1; caml_gc_message (0x02, "<", 0); caml_oldify_local_roots(); for (r = caml_ref_table.base; r < caml_ref_table.ptr; r++) { caml_oldify_one (**r, *r); } caml_oldify_mopup (); for (r = caml_weak_ref_table.base; r < caml_weak_ref_table.ptr; r++) { if (Is_block (**r) && Is_young (**r)) { if (Hd_val (**r) == 0) { **r = Field (**r, 0); } else { **r = caml_weak_none; } } } if (caml_young_ptr < caml_young_start) caml_young_ptr = caml_young_start; caml_stat_minor_words += Wsize_bsize (caml_young_end - caml_young_ptr); caml_young_ptr = caml_young_end; caml_young_limit = caml_young_start; clear_table (&caml_ref_table); clear_table (&caml_weak_ref_table); caml_gc_message (0x02, ">", 0); caml_in_minor_collection = 0; caml_stat_promoted_words += caml_allocated_words - prev_alloc_words; ++ caml_stat_minor_collections; caml_final_empty_young (); if (caml_minor_gc_end_hook != NULL) (*caml_minor_gc_end_hook) (); } else { caml_final_empty_young (); } #ifdef DEBUG { value *p; for (p = (value *) caml_young_start; p < (value *) caml_young_end; ++p) { *p = Debug_free_minor; } ++ minor_gc_counter; } #endif }
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)); }
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); */ } }
void caml_oldify_one (value v, value *p) { value result; header_t hd; mlsize_t sz, i; tag_t tag; tail_call: if (Is_block (v) && Is_young (v)){ if (Hp_val(v) < caml_young_ptr) printf("%lx, %lx\n", Hp_val(v), caml_young_ptr); Assert (Hp_val (v) >= caml_young_ptr); hd = Hd_val (v); if (hd == 0){ /* If already forwarded */ *p = Field (v, 0); /* then forward pointer is first field. */ }else{ tag = Tag_hd (hd); if (tag < Infix_tag){ value field0; sz = Wosize_hd (hd); result = caml_alloc_shr (sz, tag); *p = result; field0 = Field (v, 0); Hd_val (v) = 0; /* Set forward flag */ Field (v, 0) = result; /* and forward pointer. */ if (sz > 1){ Field (result, 0) = field0; Field (result, 1) = oldify_todo_list; /* Add this block */ oldify_todo_list = v; /* to the "to do" list. */ }else{ Assert (sz == 1); p = &Field (result, 0); v = field0; goto tail_call; } }else if (tag >= No_scan_tag){ sz = Wosize_hd (hd); result = caml_alloc_shr (sz, tag); for (i = 0; i < sz; i++) Field (result, i) = Field (v, i); Hd_val (v) = 0; /* Set forward flag */ Field (v, 0) = result; /* and forward pointer. */ *p = result; }else if (tag == Infix_tag){ mlsize_t offset = Infix_offset_hd (hd); caml_oldify_one (v - offset, p); /* Cannot recurse deeper than 1. */ *p += offset; }else{ value f = Forward_val (v); tag_t ft = 0; int vv = 1; Assert (tag == Forward_tag); if (Is_block (f)){ vv = Is_in_value_area(f); if (vv) { ft = Tag_val (Hd_val (f) == 0 ? Field (f, 0) : f); } } if (!vv || ft == Forward_tag || ft == Lazy_tag || ft == Double_tag){ /* Do not short-circuit the pointer. Copy as a normal block. */ Assert (Wosize_hd (hd) == 1); result = caml_alloc_shr (1, Forward_tag); *p = result; Hd_val (v) = 0; /* Set (GC) forward flag */ Field (v, 0) = result; /* and forward pointer. */ p = &Field (result, 0); v = f; goto tail_call; }else{ v = f; /* Follow the forwarding */ goto tail_call; /* then oldify. */ } } } }else{ *p = v; } }
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); } }
/* Make sure the minor heap is empty by performing a minor collection if * needed. */ void caml_empty_minor_heap (void) { uintnat minor_allocated_bytes = caml_domain_state->young_end - caml_domain_state->young_ptr; unsigned rewritten = 0; struct caml_ref_entry *r; caml_save_stack_gc(); stat_live_bytes = 0; if (minor_allocated_bytes != 0){ caml_gc_log ("Minor collection starting"); caml_do_local_roots(&caml_oldify_one, caml_domain_self()); for (r = caml_domain_state->remembered_set->ref.base; r < caml_domain_state->remembered_set->ref.ptr; r++){ value x; caml_oldify_one (Op_val(r->obj)[r->field], &x); } for (r = caml_domain_state->remembered_set->fiber_ref.base; r < caml_domain_state->remembered_set->fiber_ref.ptr; r++) { caml_scan_dirty_stack(&caml_oldify_one, r->obj); } caml_oldify_mopup (); for (r = caml_domain_state->remembered_set->ref.base; r < caml_domain_state->remembered_set->ref.ptr; r++){ value v = Op_val(r->obj)[r->field]; if (Is_block(v) && Is_young(v)) { Assert (Hp_val (v) >= caml_domain_state->young_ptr); value vnew; header_t hd = Hd_val(v); // FIXME: call oldify_one here? if (Is_promoted_hd(hd)) { vnew = caml_addrmap_lookup(&caml_domain_state->remembered_set->promotion, v); } else { int offset = 0; if (Tag_hd(hd) == Infix_tag) { offset = Infix_offset_hd(hd); v -= offset; } Assert (Hd_val (v) == 0); vnew = Op_val(v)[0] + offset; } Assert(Is_block(vnew) && !Is_young(vnew)); Assert(Hd_val(vnew)); if (Tag_hd(hd) == Infix_tag) { Assert(Tag_val(vnew) == Infix_tag); } rewritten += caml_atomic_cas_field(r->obj, r->field, v, vnew); } } caml_addrmap_iter(&caml_domain_state->remembered_set->promotion, unpin_promoted_object); if (caml_domain_state->young_ptr < caml_domain_state->young_start) caml_domain_state->young_ptr = caml_domain_state->young_start; caml_stat_minor_words += Wsize_bsize (minor_allocated_bytes); caml_domain_state->young_ptr = caml_domain_state->young_end; clear_table (&caml_domain_state->remembered_set->ref); caml_addrmap_clear(&caml_domain_state->remembered_set->promotion); caml_addrmap_clear(&caml_domain_state->remembered_set->promotion_rev); caml_gc_log ("Minor collection completed: %u of %u kb live, %u pointers rewritten", (unsigned)stat_live_bytes/1024, (unsigned)minor_allocated_bytes/1024, rewritten); } for (r = caml_domain_state->remembered_set->fiber_ref.base; r < caml_domain_state->remembered_set->fiber_ref.ptr; r++) { caml_scan_dirty_stack(&caml_darken, r->obj); caml_clean_stack(r->obj); } clear_table (&caml_domain_state->remembered_set->fiber_ref); caml_restore_stack_gc(); #ifdef DEBUG { value *p; for (p = (value *) caml_domain_state->young_start; p < (value *) caml_domain_state->young_end; ++p){ *p = Debug_free_minor; } ++ minor_gc_counter; } #endif }
static void caml_oldify_one (value v, value *p) { value result; header_t hd; mlsize_t sz, i; tag_t tag; tail_call: if (Is_block (v) && Is_young (v)){ Assert (Hp_val (v) >= caml_domain_state->young_ptr); hd = Hd_val (v); stat_live_bytes += Bhsize_hd(hd); if (Is_promoted_hd (hd)) { *p = caml_addrmap_lookup(&caml_domain_state->remembered_set->promotion, v); } else if (hd == 0){ /* If already forwarded */ *p = Op_val(v)[0]; /* then forward pointer is first field. */ }else{ tag = Tag_hd (hd); if (tag < Infix_tag){ value field0; sz = Wosize_hd (hd); result = alloc_shared (sz, tag); *p = result; if (tag == Stack_tag) { memcpy((void*)result, (void*)v, sizeof(value) * sz); Hd_val (v) = 0; Op_val(v)[0] = result; Op_val(v)[1] = oldify_todo_list; oldify_todo_list = v; } else { field0 = Op_val(v)[0]; Hd_val (v) = 0; /* Set forward flag */ Op_val(v)[0] = result; /* and forward pointer. */ if (sz > 1){ Op_val (result)[0] = field0; Op_val (result)[1] = oldify_todo_list; /* Add this block */ oldify_todo_list = v; /* to the "to do" list. */ }else{ Assert (sz == 1); p = Op_val(result); v = field0; goto tail_call; } } }else if (tag >= No_scan_tag){ sz = Wosize_hd (hd); result = alloc_shared(sz, tag); for (i = 0; i < sz; i++) Op_val (result)[i] = Op_val(v)[i]; Hd_val (v) = 0; /* Set forward flag */ Op_val (v)[0] = result; /* and forward pointer. */ *p = result; }else if (tag == Infix_tag){ mlsize_t offset = Infix_offset_hd (hd); caml_oldify_one (v - offset, p); /* Cannot recurse deeper than 1. */ *p += offset; } else{ value f = Forward_val (v); tag_t ft = 0; int vv = 1; Assert (tag == Forward_tag); if (Is_block (f)){ if (Is_young (f)){ vv = 1; ft = Tag_val (Hd_val (f) == 0 ? Op_val (f)[0] : f); }else{ vv = 1; if (vv){ ft = Tag_val (f); } } } if (!vv || ft == Forward_tag || ft == Lazy_tag || ft == Double_tag){ /* Do not short-circuit the pointer. Copy as a normal block. */ Assert (Wosize_hd (hd) == 1); result = alloc_shared (1, Forward_tag); *p = result; Hd_val (v) = 0; /* Set (GC) forward flag */ Op_val (v)[0] = result; /* and forward pointer. */ p = Op_val (result); v = f; goto tail_call; }else{ v = f; /* Follow the forwarding */ goto tail_call; /* then oldify. */ } } } }else{ *p = v; } }
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); } }