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);
}
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[])
{
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;
}
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_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);
}
}
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();
#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 = 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_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);
#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);
}
}
