/* Processes a (Instruct.debug_event list array) into a form suitable
for quick lookup and registers it for the (code_start,code_size) pc range. */
CAMLprim value caml_add_debug_info(code_t code_start, value code_size,
value events_heap)
{
CAMLparam1(events_heap);
struct debug_info *debug_info;
/* build the OCaml-side debug_info value */
debug_info = caml_stat_alloc(sizeof(struct debug_info));
debug_info->start = code_start;
debug_info->end = (code_t)((char*) code_start + Long_val(code_size));
if (events_heap == Val_unit) {
debug_info->events = NULL;
debug_info->num_events = 0;
debug_info->already_read = 0;
} else {
debug_info->events =
process_debug_events(code_start, events_heap, &debug_info->num_events);
debug_info->already_read = 1;
}
caml_ext_table_add(&caml_debug_info, debug_info);
CAMLreturn(Val_unit);
}
/* Processes a (Instruct.debug_event list array) into a form suitable
for quick lookup and registers it for the (code_start,code_size) pc range. */
CAMLprim value caml_add_debug_info(code_t code_start, value code_size, value events_heap)
{
CAMLparam1(events_heap);
CAMLlocal1(debug_info);
/* build the OCaml-side debug_info value */
debug_info = caml_alloc_debug_info();
Debug_info_val(debug_info)->start = code_start;
Debug_info_val(debug_info)->end = (code_t)((char*) code_start + Long_val(code_size));
if (events_heap == Val_unit) {
Debug_info_val(debug_info)->events = NULL;
Debug_info_val(debug_info)->num_events = 0;
Debug_info_val(debug_info)->already_read = 0;
} else {
Debug_info_val(debug_info)->events =
process_debug_events(code_start, events_heap, &Debug_info_val(debug_info)->num_events);
Debug_info_val(debug_info)->already_read = 1;
}
/* prepend it to the global caml_debug_info root (an OCaml list) */
{
value cons = caml_alloc(2, 0);
Store_field(cons, 0, debug_info);
Store_field(cons, 1, caml_debug_info);
caml_debug_info = cons;
}
CAMLreturn(Val_unit);
}
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;
}
