CAMLexport struct channel * caml_open_descriptor_out(int fd)
{
struct channel * channel;
channel = caml_open_descriptor_in(fd);
channel->max = NULL;
return channel;
}
CAMLprim value win_inchannel_of_filedescr(value handle)
{
CAMLparam1(handle);
CAMLlocal1(vchan);
struct channel * chan;
chan = caml_open_descriptor_in(win_CRT_fd_of_filedescr(handle));
if (Descr_kind_val(handle) == KIND_SOCKET)
chan->flags |= CHANNEL_FLAG_FROM_SOCKET;
vchan = caml_alloc_channel(chan);
CAMLreturn(vchan);
}
static void read_main_debug_info(struct debug_info *di)
{
CAMLparam0();
CAMLlocal3(events, evl, l);
char_os *exec_name;
int fd, num_events, orig, i;
struct channel *chan;
struct exec_trailer trail;
CAMLassert(di->already_read == 0);
di->already_read = 1;
if (caml_params->cds_file != NULL) {
exec_name = (char_os*) caml_params->cds_file;
} else {
exec_name = (char_os*) caml_params->exe_name;
}
fd = caml_attempt_open(&exec_name, &trail, 1);
if (fd < 0){
caml_fatal_error ("executable program file not found");
CAMLreturn0;
}
caml_read_section_descriptors(fd, &trail);
if (caml_seek_optional_section(fd, &trail, "DBUG") != -1) {
chan = caml_open_descriptor_in(fd);
num_events = caml_getword(chan);
events = caml_alloc(num_events, 0);
for (i = 0; i < num_events; i++) Op_val(events)[i] = Val_unit;
for (i = 0; i < num_events; i++) {
orig = caml_getword(chan);
evl = caml_input_val(chan);
caml_input_val(chan); /* Skip the list of absolute directory names */
/* Relocate events in event list */
for (l = evl; l != Val_int(0); l = Field_imm(l, 1)) {
value ev = Field_imm(l, 0);
Store_field (ev, EV_POS, Val_long(Long_val(Field(ev, EV_POS)) + orig));
}
/* Record event list */
Store_field(events, i, evl);
}
caml_close_channel(chan);
di->events = process_debug_events(caml_start_code, events, &di->num_events);
}
CAMLreturn0;
}
static void open_connection(void)
{
#ifdef _WIN32
/* Set socket to synchronous mode so that file descriptor-oriented
functions (read()/write() etc.) can be used */
int oldvalue, oldvaluelen, newvalue, retcode;
oldvaluelen = sizeof(oldvalue);
retcode = getsockopt(INVALID_SOCKET, SOL_SOCKET, SO_OPENTYPE,
(char *) &oldvalue, &oldvaluelen);
if (retcode == 0) {
newvalue = SO_SYNCHRONOUS_NONALERT;
setsockopt(INVALID_SOCKET, SOL_SOCKET, SO_OPENTYPE,
(char *) &newvalue, sizeof(newvalue));
}
#endif
dbg_socket = socket(sock_domain, SOCK_STREAM, 0);
#ifdef _WIN32
if (retcode == 0) {
/* Restore initial mode */
setsockopt(INVALID_SOCKET, SOL_SOCKET, SO_OPENTYPE,
(char *) &oldvalue, oldvaluelen);
}
#endif
if (dbg_socket == -1 ||
connect(dbg_socket, &sock_addr.s_gen, sock_addr_len) == -1){
caml_fatal_error_arg2 ("cannot connect to debugger at %s\n", dbg_addr,
"error: %s\n", strerror (errno));
}
#ifdef _WIN32
dbg_socket = _open_osfhandle(dbg_socket, 0);
if (dbg_socket == -1)
caml_fatal_error("_open_osfhandle failed");
#endif
dbg_in = caml_open_descriptor_in(dbg_socket);
dbg_out = caml_open_descriptor_out(dbg_socket);
if (!caml_debugger_in_use) caml_putword(dbg_out, -1); /* first connection */
#ifdef _WIN32
caml_putword(dbg_out, _getpid());
#else
caml_putword(dbg_out, getpid());
#endif
caml_flush(dbg_out);
}
static value read_debug_info(void)
{
CAMLparam0();
CAMLlocal1(events);
char * exec_name;
int fd;
struct exec_trailer trail;
struct channel * chan;
uint32 num_events, orig, i;
value evl, l;
if (caml_cds_file != NULL) {
exec_name = caml_cds_file;
} else {
exec_name = caml_exe_name;
}
fd = caml_attempt_open(&exec_name, &trail, 1);
if (fd < 0) CAMLreturn(Val_false);
caml_read_section_descriptors(fd, &trail);
if (caml_seek_optional_section(fd, &trail, "DBUG") == -1) {
close(fd);
CAMLreturn(Val_false);
}
chan = caml_open_descriptor_in(fd);
num_events = caml_getword(chan);
events = caml_alloc(num_events, 0);
for (i = 0; i < num_events; i++) {
orig = caml_getword(chan);
evl = caml_input_val(chan);
/* Relocate events in event list */
for (l = evl; l != Val_int(0); l = Field(l, 1)) {
value ev = Field(l, 0);
Field(ev, EV_POS) = Val_long(Long_val(Field(ev, EV_POS)) + orig);
}
/* Record event list */
Store_field(events, i, evl);
}
caml_close_channel(chan);
CAMLreturn(events);
}
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);
}
}
CAMLprim value caml_ml_open_descriptor_in(value fd)
{
return caml_alloc_channel(caml_open_descriptor_in(Int_val(fd)));
}