summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorGabriel Scherer <gabriel.scherer@gmail.com>2014-05-10 19:19:47 +0000
committerGabriel Scherer <gabriel.scherer@gmail.com>2014-05-10 19:19:47 +0000
commit1fdea57c4c03c47ec48ecccc99d59211b4ec2c7c (patch)
treea860ad50726fd1e9712b1d6ff918386af9801cc5
parenteb2b1f64b17aab853ca16c531bf9c6b99c69503e (diff)
Printexc: OCaml-friendly access to individual backtrace slots
(Patch by Jacques-Henri Jourdan) There are several changes: - `raw_backtrace` is no longer an abstract type, but rather an `raw_backtrace_slot array`, where `raw_backtrace_slot` is a new abstract type. `raw_backtrace_slot` elements are hashable and comparable. At runtime, values of this type contain either a bytecode pointer or a frame_descr pointer. In order to prevent the GC from walking through this pointer, the low-order bit is set to 1 when stored in the array. - The old `loc_info` type is know public, renamed into `backtrace_slot`: type backtrace_slot = | Known_location of bool (* is_raise *) * string (* filename *) * int (* line number *) * int (* start char *) * int (* end char *) | Unknown_location of bool (*is_raise*) - new primitive : val convert_raw_backtrace_slot: raw_backtrace_slot -> backtrace_slot Rather than returning an option, it raises Failure when it is not possible to get the debugging information. It seems more idiomatic, especially because the exceptional case cannot appear only for a part of the executable. - the caml_convert_raw_backtrace primitive is removed; it is more difficult to implement in the C side because of the new exception interface described above. - In the bytecode runtime, the events are no longer deserialized once for each conversion, but once and for all at the first conversion, and stored in a global array (*outside* the OCaml heap), sorted by program counter value. I believe this information should not take much memory in practice (it uses the same order of magnitude memory as the bytecode executable). It also makes location lookup much more efficient, as a dichomoty is used instead of linear search as previously. git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@14776 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
-rw-r--r--asmrun/backtrace.c90
-rw-r--r--byterun/backtrace.c241
-rw-r--r--stdlib/printexc.ml16
-rw-r--r--stdlib/printexc.mli27
4 files changed, 224 insertions, 150 deletions
diff --git a/asmrun/backtrace.c b/asmrun/backtrace.c
index 3854967cf..eada458a1 100644
--- a/asmrun/backtrace.c
+++ b/asmrun/backtrace.c
@@ -172,7 +172,7 @@ CAMLprim value caml_get_current_callstack(value max_frames_value) {
}
}
- trace = caml_alloc((mlsize_t) trace_size, Abstract_tag);
+ trace = caml_alloc((mlsize_t) trace_size, 0);
/* then collect the trace */
{
@@ -183,11 +183,15 @@ CAMLprim value caml_get_current_callstack(value max_frames_value) {
for (trace_pos = 0; trace_pos < trace_size; trace_pos++) {
frame_descr * descr = caml_next_frame_descriptor(&pc, &sp);
Assert(descr != NULL);
- /* The assignment below is safe without [caml_initialize], even
+ /* In order to prevent the GC to walk through the debug
+ information (which have no headers), we transform the descr
+ pointer to a 31/63 bits ocaml integer by shifting it by 1 to
+ the right. We do not lose information as descr is aligned.
+
+ The assignment below is safe without [caml_initialize], even
if the trace is large and allocated on the old heap, because
- we assign values that are outside the OCaml heap. */
- Assert(!(Is_block((value) descr) && Is_in_heap((value) descr)));
- Field(trace, trace_pos) = (value) descr;
+ we assign long values. */
+ Field(trace, trace_pos) = Val_long((uintnat)descr>>1);
}
}
@@ -295,31 +299,29 @@ void caml_print_exception_backtrace(void)
/* Convert the raw backtrace to a data structure usable from OCaml */
-CAMLprim value caml_convert_raw_backtrace(value backtrace) {
- CAMLparam1(backtrace);
- CAMLlocal4(res, arr, p, fname);
- int i;
+CAMLprim value caml_convert_raw_backtrace_slot(value backtrace_slot) {
+ CAMLparam1(backtrace_slot);
+ CAMLlocal2(p, fname);
struct loc_info li;
- arr = caml_alloc(Wosize_val(backtrace), 0);
- for (i = 0; i < Wosize_val(backtrace); i++) {
- extract_location_info((frame_descr *) Field(backtrace, i), &li);
- if (li.loc_valid) {
- fname = caml_copy_string(li.loc_filename);
- p = caml_alloc_small(5, 0);
- Field(p, 0) = Val_bool(li.loc_is_raise);
- Field(p, 1) = fname;
- Field(p, 2) = Val_int(li.loc_lnum);
- Field(p, 3) = Val_int(li.loc_startchr);
- Field(p, 4) = Val_int(li.loc_endchr);
- } else {
- p = caml_alloc_small(1, 1);
- Field(p, 0) = Val_bool(li.loc_is_raise);
- }
- caml_modify(&Field(arr, i), p);
+ /* We shift back the backtrace slot to a frame_descr pointer. It is
+ aligned, so we know the low-order bit is 0. */
+ extract_location_info((frame_descr *)(Long_val(backtrace_slot)<<1), &li);
+
+ if (li.loc_valid) {
+ fname = caml_copy_string(li.loc_filename);
+ p = caml_alloc_small(5, 0);
+ Field(p, 0) = Val_bool(li.loc_is_raise);
+ Field(p, 1) = fname;
+ Field(p, 2) = Val_int(li.loc_lnum);
+ Field(p, 3) = Val_int(li.loc_startchr);
+ Field(p, 4) = Val_int(li.loc_endchr);
+ } else {
+ p = caml_alloc_small(1, 1);
+ Field(p, 0) = Val_bool(li.loc_is_raise);
}
- res = caml_alloc_small(1, 0); Field(res, 0) = arr; /* Some */
- CAMLreturn(res);
+
+ CAMLreturn(p);
}
/* Get a copy of the latest backtrace */
@@ -328,28 +330,20 @@ CAMLprim value caml_get_exception_raw_backtrace(value unit)
{
CAMLparam0();
CAMLlocal1(res);
- res = caml_alloc(caml_backtrace_pos, Abstract_tag);
- if(caml_backtrace_buffer != NULL)
- memcpy(&Field(res, 0), caml_backtrace_buffer,
- caml_backtrace_pos * sizeof(code_t));
- CAMLreturn(res);
-}
-/* the function below is deprecated: we previously returned directly
- the OCaml-usable representation, instead of the raw backtrace as an
- abstract type, but this has a large performance overhead if you
- store a lot of backtraces and print only some of them.
+ res = caml_alloc(caml_backtrace_pos, 0);
+ if(caml_backtrace_buffer != NULL) {
+ intnat i;
+ for(i = 0; i < caml_backtrace_pos; i++)
+ /* In order to prevent the GC to walk through the debug
+ information (which have no headers), we transform the
+ pointer to a 31/63 bits ocaml integer by shifting it by 1 to
+ the right. We do not lose information the pointer is aligned.
- It is not used by the Printexc library anymore, or anywhere else in
- the compiler, but we have kept it in case some user still depends
- on it as an external.
-*/
-
-CAMLprim value caml_get_exception_backtrace(value unit)
-{
- CAMLparam0();
- CAMLlocal2(raw,res);
- raw = caml_get_exception_raw_backtrace(unit);
- res = caml_convert_raw_backtrace(raw);
+ The assignment below is safe without [caml_initialize], even
+ if the trace is large and allocated on the old heap, because
+ we assign long values. */
+ Field(res, i) = Val_long(((uintnat)caml_backtrace_buffer[i])>>1);
+ }
CAMLreturn(res);
}
diff --git a/byterun/backtrace.c b/byterun/backtrace.c
index d39e39529..c50425ca1 100644
--- a/byterun/backtrace.c
+++ b/byterun/backtrace.c
@@ -35,6 +35,7 @@
#include "stacks.h"
#include "sys.h"
#include "backtrace.h"
+#include "fail.h"
CAMLexport int caml_backtrace_active = 0;
CAMLexport int caml_backtrace_pos = 0;
@@ -165,7 +166,7 @@ CAMLprim value caml_get_current_callstack(value max_frames_value) {
}
}
- trace = caml_alloc(trace_size, Abstract_tag);
+ trace = caml_alloc(trace_size, 0);
/* then collect the trace */
{
@@ -176,36 +177,58 @@ CAMLprim value caml_get_current_callstack(value max_frames_value) {
for (trace_pos = 0; trace_pos < trace_size; trace_pos++) {
code_t p = caml_next_frame_pointer(&sp, &trapsp);
Assert(p != NULL);
- /* The assignment below is safe without [caml_initialize], even
+ /* In order to prevent the GC to walk through the debug
+ information (which have no headers), we transform the p code
+ pointer to a 31/63 bits ocaml integer by shifting it by 1 to
+ the right. We do not lose information because p is aligned.
+
+ The assignment below is safe without [caml_initialize], even
if the trace is large and allocated on the old heap, because
- we assign values that are outside the OCaml heap. */
- Assert(!(Is_block((value) p) && Is_in_heap((value) p)));
- Field(trace, trace_pos) = (value) p;
+ we assign long values. */
+ Field(trace, trace_pos) = Val_long((uintnat)p>>1);
}
}
CAMLreturn(trace);
}
-/* Read the debugging info contained in the current bytecode executable.
- Return an OCaml array of OCaml lists of debug_event records in "events",
- or Val_false on failure. */
+/* Read the debugging info contained in the current bytecode executable. */
#ifndef O_BINARY
#define O_BINARY 0
#endif
+struct ev_info {
+ code_t ev_pc;
+ char * ev_filename;
+ int ev_lnum;
+ int ev_startchr;
+ int ev_endchr;
+};
+
+static int cmp_ev_info(const void *a, const void *b) {
+ if(((const struct ev_info*)a)->ev_pc > ((const struct ev_info*)b)->ev_pc)
+ return 1;
+ return -1;
+}
+
static char *read_debug_info_error = "";
-static value read_debug_info(void)
+static uintnat n_events;
+static struct ev_info *events = NULL;
+static void read_debug_info(void)
{
CAMLparam0();
- CAMLlocal1(events);
+ CAMLlocal1(events_heap);
char * exec_name;
int fd;
struct exec_trailer trail;
struct channel * chan;
uint32 num_events, orig, i;
- value evl, l;
+ uintnat j;
+ value evl, l, ev_start;
+
+ if(events != NULL)
+ CAMLreturn0;
if (caml_cds_file != NULL) {
exec_name = caml_cds_file;
@@ -215,17 +238,18 @@ static value read_debug_info(void)
fd = caml_attempt_open(&exec_name, &trail, 1);
if (fd < 0){
read_debug_info_error = "executable program file not found";
- CAMLreturn(Val_false);
+ CAMLreturn0;
}
caml_read_section_descriptors(fd, &trail);
if (caml_seek_optional_section(fd, &trail, "DBUG") == -1) {
close(fd);
read_debug_info_error = "program not linked with -g";
- CAMLreturn(Val_false);
+ CAMLreturn0;
}
chan = caml_open_descriptor_in(fd);
num_events = caml_getword(chan);
- events = caml_alloc(num_events, 0);
+ n_events = 0;
+ events_heap = caml_alloc(num_events, 0);
for (i = 0; i < num_events; i++) {
orig = caml_getword(chan);
evl = caml_input_val(chan);
@@ -234,36 +258,82 @@ static value read_debug_info(void)
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);
+ n_events++;
}
/* Record event list */
- Store_field(events, i, evl);
+ Store_field(events_heap, i, evl);
}
caml_close_channel(chan);
- CAMLreturn(events);
+
+ events = (struct ev_info*)malloc(n_events * sizeof(struct ev_info));
+ if(events == NULL) {
+ read_debug_info_error = "out of memory";
+ CAMLreturn0;
+ }
+
+ j = 0;
+ for (i = 0; i < num_events; i++) {
+ for (l = Field(events_heap, i); l != Val_int(0); l = Field(l, 1)) {
+ uintnat fnsz;
+ value ev = Field(l, 0);
+
+ events[j].ev_pc =
+ (code_t)((char*)caml_start_code + Long_val(Field(ev, EV_POS)));
+
+ ev_start = Field (Field (ev, EV_LOC), LOC_START);
+
+ fnsz = caml_string_length(Field (ev_start, POS_FNAME))+1;
+ events[j].ev_filename = (char*)malloc(fnsz);
+ if(events[j].ev_filename == NULL) {
+ for(j--; j >= 0; j--)
+ free(events[j].ev_filename);
+ free(events);
+ events = NULL;
+ read_debug_info_error = "out of memory";
+ CAMLreturn0;
+ }
+ memcpy(events[j].ev_filename, String_val (Field (ev_start, POS_FNAME)), fnsz);
+
+ events[j].ev_lnum = Int_val (Field (ev_start, POS_LNUM));
+ events[j].ev_startchr =
+ Int_val (Field (ev_start, POS_CNUM))
+ - Int_val (Field (ev_start, POS_BOL));
+ events[j].ev_endchr =
+ Int_val (Field (Field (Field (ev, EV_LOC), LOC_END), POS_CNUM))
+ - Int_val (Field (ev_start, POS_BOL));
+
+ j++;
+ }
+ }
+
+ Assert(j == n_events);
+
+ qsort(events, n_events, sizeof(struct ev_info), cmp_ev_info);
+
+ CAMLreturn0;
}
-/* Search the event for the given PC. Return Val_false if not found. */
+/* Search the event index for the given PC. Return -1 if not found. */
-static value event_for_location(value events, code_t pc)
+static intnat event_for_location(code_t pc)
{
- mlsize_t i;
- value pos, l, ev, ev_pos, best_ev;
-
- best_ev = 0;
+ uintnat low = 0, high = n_events;
Assert(pc >= caml_start_code && pc < caml_start_code + caml_code_size);
- pos = Val_long((char *) pc - (char *) caml_start_code);
- for (i = 0; i < Wosize_val(events); i++) {
- for (l = Field(events, i); l != Val_int(0); l = Field(l, 1)) {
- ev = Field(l, 0);
- ev_pos = Field(ev, EV_POS);
- if (ev_pos == pos) return ev;
- /* ocamlc sometimes moves an event past a following PUSH instruction;
- allow mismatch by 1 instruction. */
- if (ev_pos == pos + 8) best_ev = ev;
- }
+ Assert(events != NULL);
+ while(low+1 < high) {
+ uintnat m = (low+high)/2;
+ if(pc < events[m].ev_pc) high = m;
+ else low = m;
}
- if (best_ev != 0) return best_ev;
- return Val_false;
+ if(events[low].ev_pc == pc)
+ return low;
+ /* ocamlc sometimes moves an event past a following PUSH instruction;
+ allow mismatch by 1 instruction. */
+ if(events[low].ev_pc == pc + 1)
+ return low;
+ if(low+1 < n_events && events[low+1].ev_pc == pc + 1)
+ return low+1;
+ return -1;
}
/* Extract location information for the given PC */
@@ -277,28 +347,21 @@ struct loc_info {
int loc_endchr;
};
-static void extract_location_info(value events, code_t pc,
+static void extract_location_info(code_t pc,
/*out*/ struct loc_info * li)
{
- value ev, ev_start;
-
- ev = event_for_location(events, pc);
+ intnat ev = event_for_location(pc);
li->loc_is_raise = caml_is_instruction(*pc, RAISE) ||
caml_is_instruction(*pc, RERAISE);
- if (ev == Val_false) {
+ if (ev == -1) {
li->loc_valid = 0;
return;
}
li->loc_valid = 1;
- ev_start = Field (Field (ev, EV_LOC), LOC_START);
- li->loc_filename = String_val (Field (ev_start, POS_FNAME));
- li->loc_lnum = Int_val (Field (ev_start, POS_LNUM));
- li->loc_startchr =
- Int_val (Field (ev_start, POS_CNUM))
- - Int_val (Field (ev_start, POS_BOL));
- li->loc_endchr =
- Int_val (Field (Field (Field (ev, EV_LOC), LOC_END), POS_CNUM))
- - Int_val (Field (ev_start, POS_BOL));
+ li->loc_filename = events[ev].ev_filename;
+ li->loc_lnum = events[ev].ev_lnum;
+ li->loc_startchr = events[ev].ev_startchr;
+ li->loc_endchr = events[ev].ev_endchr;
}
/* Print location information -- same behavior as in Printexc */
@@ -335,55 +398,49 @@ static void print_location(struct loc_info * li, int index)
CAMLexport void caml_print_exception_backtrace(void)
{
- value events;
int i;
struct loc_info li;
- events = read_debug_info();
- if (events == Val_false) {
+ read_debug_info();
+ if (events == NULL) {
fprintf(stderr, "(Cannot print stack backtrace: %s)\n",
read_debug_info_error);
return;
}
for (i = 0; i < caml_backtrace_pos; i++) {
- extract_location_info(events, caml_backtrace_buffer[i], &li);
+ extract_location_info(caml_backtrace_buffer[i], &li);
print_location(&li, i);
}
}
/* Convert the backtrace to a data structure usable from OCaml */
-CAMLprim value caml_convert_raw_backtrace(value backtrace)
-{
- CAMLparam1(backtrace);
- CAMLlocal5(events, res, arr, p, fname);
- int i;
+CAMLprim value caml_convert_raw_backtrace_slot(value backtrace_slot) {
+ CAMLparam1(backtrace_slot);
+ CAMLlocal2(p, fname);
struct loc_info li;
- events = read_debug_info();
- if (events == Val_false) {
- res = Val_int(0); /* None */
+ read_debug_info();
+ if (events == NULL)
+ caml_failwith(read_debug_info_error);
+
+ /* We shift back the backtrace slot to a code_t. It is aligned, so
+ we know the low-order bit is 0. */
+ extract_location_info((code_t)(Long_val(backtrace_slot)<<1), &li);
+
+ if (li.loc_valid) {
+ fname = caml_copy_string(li.loc_filename);
+ p = caml_alloc_small(5, 0);
+ Field(p, 0) = Val_bool(li.loc_is_raise);
+ Field(p, 1) = fname;
+ Field(p, 2) = Val_int(li.loc_lnum);
+ Field(p, 3) = Val_int(li.loc_startchr);
+ Field(p, 4) = Val_int(li.loc_endchr);
} else {
- arr = caml_alloc(Wosize_val(backtrace), 0);
- for (i = 0; i < Wosize_val(backtrace); i++) {
- extract_location_info(events, (code_t)Field(backtrace, i), &li);
- if (li.loc_valid) {
- fname = caml_copy_string(li.loc_filename);
- p = caml_alloc_small(5, 0);
- Field(p, 0) = Val_bool(li.loc_is_raise);
- Field(p, 1) = fname;
- Field(p, 2) = Val_int(li.loc_lnum);
- Field(p, 3) = Val_int(li.loc_startchr);
- Field(p, 4) = Val_int(li.loc_endchr);
- } else {
- p = caml_alloc_small(1, 1);
- Field(p, 0) = Val_bool(li.loc_is_raise);
- }
- caml_modify(&Field(arr, i), p);
- }
- res = caml_alloc_small(1, 0); Field(res, 0) = arr; /* Some */
+ p = caml_alloc_small(1, 1);
+ Field(p, 0) = Val_bool(li.loc_is_raise);
}
- CAMLreturn(res);
+ CAMLreturn(p);
}
/* Get a copy of the latest backtrace */
@@ -392,20 +449,20 @@ CAMLprim value caml_get_exception_raw_backtrace(value unit)
{
CAMLparam0();
CAMLlocal1(res);
- res = caml_alloc(caml_backtrace_pos, Abstract_tag);
- if(caml_backtrace_buffer != NULL)
- memcpy(&Field(res, 0), caml_backtrace_buffer,
- caml_backtrace_pos * sizeof(code_t));
- CAMLreturn(res);
-}
-/* the function below is deprecated: see asmrun/backtrace.c */
+ res = caml_alloc(caml_backtrace_pos, 0);
+ if(caml_backtrace_buffer != NULL) {
+ intnat i;
+ for(i = 0; i < caml_backtrace_pos; i++)
+ /* In order to prevent the GC to walk through the debug
+ information (which have no headers), we transform the
+ pointer to a 31/63 bits ocaml integer by shifting it by 1 to
+ the right. We do not lose information as descr is aligned.
-CAMLprim value caml_get_exception_backtrace(value unit)
-{
- CAMLparam0();
- CAMLlocal2(raw, res);
- raw = caml_get_exception_raw_backtrace(unit);
- res = caml_convert_raw_backtrace(raw);
+ The assignment below is safe without [caml_initialize], even
+ if the trace is large and allocated on the old heap, because
+ we assign long values. */
+ Field(res, i) = Val_long(((uintnat)caml_backtrace_buffer[i])>>1);
+ }
CAMLreturn(res);
}
diff --git a/stdlib/printexc.ml b/stdlib/printexc.ml
index 285308b79..b983e3693 100644
--- a/stdlib/printexc.ml
+++ b/stdlib/printexc.ml
@@ -82,12 +82,13 @@ let catch fct arg =
eprintf "Uncaught exception: %s\n" (to_string x);
exit 2
-type raw_backtrace
+type raw_backtrace_slot
+type raw_backtrace = raw_backtrace_slot array
external get_raw_backtrace:
unit -> raw_backtrace = "caml_get_exception_raw_backtrace"
-type loc_info =
+type backtrace_slot =
| Known_location of bool (* is_raise *)
* string (* filename *)
* int (* line number *)
@@ -98,10 +99,12 @@ type loc_info =
(* to avoid warning *)
let _ = [Known_location (false, "", 0, 0, 0); Unknown_location false]
-type backtrace = loc_info array
+external convert_raw_backtrace_slot:
+ raw_backtrace_slot -> backtrace_slot = "caml_convert_raw_backtrace_slot"
-external convert_raw_backtrace:
- raw_backtrace -> backtrace option = "caml_convert_raw_backtrace"
+let convert_raw_backtrace rbckt =
+ try Some (Array.map convert_raw_backtrace_slot rbckt)
+ with Failure _ -> None
let format_loc_info pos li =
let is_raise =
@@ -158,9 +161,6 @@ let raw_backtrace_to_string raw_backtrace =
(* confusingly named:
returns the *string* corresponding to the global current backtrace *)
let get_backtrace () =
- (* we could use the caml_get_exception_backtrace primitive here, but
- we hope to deprecate it so it's better to just compose the
- raw stuff *)
backtrace_to_string (convert_raw_backtrace (get_raw_backtrace ()))
external record_backtrace: bool -> unit = "caml_record_backtrace"
diff --git a/stdlib/printexc.mli b/stdlib/printexc.mli
index 2916bf143..53cf81566 100644
--- a/stdlib/printexc.mli
+++ b/stdlib/printexc.mli
@@ -85,15 +85,20 @@ val register_printer: (exn -> string option) -> unit
(** {6 Raw backtraces} *)
-type raw_backtrace
+type raw_backtrace_slot
+type raw_backtrace = raw_backtrace_slot array
-(** The abstract type [backtrace] stores exception backtraces in
+(** The abstract type [raw_backtrace_slot] stores a slot of a backtrace in
a low-level format, instead of directly exposing them as string as
the [get_backtrace()] function does.
This allows delaying the formatting of backtraces to when they are
actually printed, which might be useful if you record more
backtraces than you print.
+
+ Elements of type raw_backtrace_slot can be compared and hashed: when two
+ elements are equal, then they represent the same source location (the
+ converse is not necessarily true in presence of inlining, for example).
*)
val get_raw_backtrace: unit -> raw_backtrace
@@ -116,6 +121,24 @@ val set_uncaught_exception_handler: (exn -> raw_backtrace -> unit) -> unit
@since 4.02.0
*)
+(** {6 Backtrace slots processing} *)
+
+type backtrace_slot =
+ | Known_location of bool (* is_raise *)
+ * string (* filename *)
+ * int (* line number *)
+ * int (* start char *)
+ * int (* end char *)
+ | Unknown_location of bool (*is_raise*)
+
+(** [convert_raw_backtrace_slot] converts one slot of a raw backtrace
+ to an Ocaml algebraic datatype representing to location
+ information in the source file.
+
+ Raises [Failure] if not able to load debug information.
+*)
+val convert_raw_backtrace_slot: raw_backtrace_slot -> backtrace_slot
+
(** {6 Current call stack} *)
val get_callstack: int -> raw_backtrace