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