diff --git a/asmrun/backtrace.c b/asmrun/backtrace.c index 292549be7..8e5fa444f 100644 --- a/asmrun/backtrace.c +++ b/asmrun/backtrace.c @@ -14,6 +14,7 @@ /* Stack backtrace for uncaught exceptions */ #include +#include #include "alloc.h" #include "backtrace.h" #include "memory.h" @@ -191,18 +192,17 @@ void caml_print_exception_backtrace(void) } } -/* Convert the backtrace to a data structure usable from OCaml */ +/* Convert the raw backtrace to a data structure usable from OCaml */ -CAMLprim value caml_get_exception_backtrace(value unit) -{ - CAMLparam0(); +CAMLprim value caml_convert_raw_backtrace(value backtrace) { + CAMLparam1(backtrace); CAMLlocal4(res, arr, p, fname); int i; struct loc_info li; - arr = caml_alloc(caml_backtrace_pos, 0); - for (i = 0; i < caml_backtrace_pos; i++) { - extract_location_info((frame_descr *) (caml_backtrace_buffer[i]), &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); @@ -220,3 +220,34 @@ CAMLprim value caml_get_exception_backtrace(value unit) res = caml_alloc_small(1, 0); Field(res, 0) = arr; /* Some */ CAMLreturn(res); } + +/* Get a copy of the latest backtrace */ + +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. + + 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); + CAMLreturn(res); +} diff --git a/boot/ocamlc b/boot/ocamlc index bbf2d1f90..00b9b5801 100755 Binary files a/boot/ocamlc and b/boot/ocamlc differ diff --git a/boot/ocamldep b/boot/ocamldep index 89aaaca2a..2ac84d3f7 100755 Binary files a/boot/ocamldep and b/boot/ocamldep differ diff --git a/boot/ocamllex b/boot/ocamllex index 084339c62..57aca3046 100755 Binary files a/boot/ocamllex and b/boot/ocamllex differ diff --git a/byterun/backtrace.c b/byterun/backtrace.c index ef7ca6221..70d0a71c7 100644 --- a/byterun/backtrace.c +++ b/byterun/backtrace.c @@ -274,9 +274,9 @@ CAMLexport void caml_print_exception_backtrace(void) /* Convert the backtrace to a data structure usable from OCaml */ -CAMLprim value caml_get_exception_backtrace(value unit) +CAMLprim value caml_convert_raw_backtrace(value backtrace) { - CAMLparam0(); + CAMLparam1(backtrace); CAMLlocal5(events, res, arr, p, fname); int i; struct loc_info li; @@ -285,9 +285,9 @@ CAMLprim value caml_get_exception_backtrace(value unit) if (events == Val_false) { res = Val_int(0); /* None */ } else { - arr = caml_alloc(caml_backtrace_pos, 0); - for (i = 0; i < caml_backtrace_pos; i++) { - extract_location_info(events, caml_backtrace_buffer[i], &li); + 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); @@ -306,3 +306,26 @@ CAMLprim value caml_get_exception_backtrace(value unit) } CAMLreturn(res); } + +/* Get a copy of the latest backtrace */ + +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 */ + +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); + CAMLreturn(res); +} diff --git a/stdlib/printexc.ml b/stdlib/printexc.ml index be1d8f0f8..a36e2d4e3 100644 --- a/stdlib/printexc.ml +++ b/stdlib/printexc.ml @@ -79,6 +79,11 @@ let catch fct arg = eprintf "Uncaught exception: %s\n" (to_string x); exit 2 +type raw_backtrace + +external get_raw_backtrace: + unit -> raw_backtrace = "caml_get_exception_raw_backtrace" + type loc_info = | Known_location of bool (* is_raise *) * string (* filename *) @@ -90,8 +95,10 @@ type loc_info = (* to avoid warning *) let _ = [Known_location (false, "", 0, 0, 0); Unknown_location false] -external get_exception_backtrace: - unit -> loc_info array option = "caml_get_exception_backtrace" +type backtrace = loc_info array + +external convert_raw_backtrace: + raw_backtrace -> backtrace option = "caml_convert_raw_backtrace" let format_loc_info pos li = let is_raise = @@ -112,8 +119,8 @@ let format_loc_info pos li = sprintf "%s unknown location" info -let print_backtrace outchan = - match get_exception_backtrace() with +let print_exception_backtrace outchan backtrace = + match backtrace with | None -> fprintf outchan "(Program not linked with -g, cannot print stack backtrace)\n" @@ -123,8 +130,15 @@ let print_backtrace outchan = fprintf outchan "%s\n" (format_loc_info i a.(i)) done -let get_backtrace () = - match get_exception_backtrace() with +let print_raw_backtrace outchan raw_backtrace = + print_exception_backtrace outchan (convert_raw_backtrace raw_backtrace) + +(* confusingly named: prints the global current backtrace *) +let print_backtrace outchan = + print_raw_backtrace outchan (get_raw_backtrace ()) + +let backtrace_to_string backtrace = + match backtrace with | None -> "(Program not linked with -g, cannot print stack backtrace)\n" | Some a -> @@ -135,6 +149,17 @@ let get_backtrace () = done; Buffer.contents b +let raw_backtrace_to_string raw_backtrace = + backtrace_to_string (convert_raw_backtrace 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" external backtrace_status: unit -> bool = "caml_backtrace_status" diff --git a/stdlib/printexc.mli b/stdlib/printexc.mli index 829530fac..b65326552 100644 --- a/stdlib/printexc.mli +++ b/stdlib/printexc.mli @@ -82,3 +82,20 @@ val register_printer: (exn -> string option) -> unit the backtrace if it has itself raised an exception before. @since 3.11.2 *) + +(** {6 Raw backtraces} *) + +type raw_backtrace + +(** The abstract type [backtrace] stores exception backtraces in + a low-level format, instead of directly exposing them as string as + the [get_backtrace()] function does. + + This allows to pay the performance overhead of representation + conversion and formatting only at printing time, which is useful + if you want to record more backtrace than you actually print. +*) + +val get_raw_backtrace: unit -> raw_backtrace +val print_raw_backtrace: out_channel -> raw_backtrace -> unit +val raw_backtrace_to_string: raw_backtrace -> string