From 5c3b4c6cc6ce463019442dc3060efc93dae04d14 Mon Sep 17 00:00:00 2001 From: Gabriel Scherer Date: Sat, 9 Mar 2013 20:35:28 +0100 Subject: [PATCH 1/2] user-exposed abstract type for raw backtraces in Printexc.ml (original patch from Jacques-Henri Jourdan) --- asmrun/backtrace.c | 45 ++++++++++++++++++++++++++++++++++++++------- byterun/backtrace.c | 33 ++++++++++++++++++++++++++++----- stdlib/printexc.ml | 37 +++++++++++++++++++++++++++++++------ stdlib/printexc.mli | 17 +++++++++++++++++ 4 files changed, 114 insertions(+), 18 deletions(-) diff --git a/asmrun/backtrace.c b/asmrun/backtrace.c index 292549b..8e5fa44 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/byterun/backtrace.c b/byterun/backtrace.c index ef7ca62..70d0a71 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 4283962..2964d4d 100644 --- a/stdlib/printexc.ml +++ b/stdlib/printexc.ml @@ -78,6 +78,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 *) @@ -89,8 +94,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 = @@ -111,8 +118,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" @@ -122,8 +129,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 -> @@ -134,6 +148,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 829530f..b653265 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 -- 1.7.10.4