user-exposed abstract type for raw backtraces in Printexc.ml (original patch from Jacques-Henri Jourdan)

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@13394 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

asmrun/backtrace.c

@@ -14,6 +14,7 @@
 /* Stack backtrace for uncaught exceptions */
 
 #include <stdio.h>
+#include <stdlib.h>
 #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)
+CAMLprim value caml_convert_raw_backtrace(value backtrace) {
-{
+  CAMLparam1(backtrace);
-  CAMLparam0();
   CAMLlocal4(res, arr, p, fname);
   int i;
   struct loc_info li;
 
-  arr = caml_alloc(caml_backtrace_pos, 0);
+  arr = caml_alloc(Wosize_val(backtrace), 0);
-  for (i = 0; i < caml_backtrace_pos; i++) {
+  for (i = 0; i < Wosize_val(backtrace); i++) {
-    extract_location_info((frame_descr *) (caml_backtrace_buffer[i]), &li);
+    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);
+}

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);
+    arr = caml_alloc(Wosize_val(backtrace), 0);
-    for (i = 0; i < caml_backtrace_pos; i++) {
+    for (i = 0; i < Wosize_val(backtrace); i++) {
-      extract_location_info(events, caml_backtrace_buffer[i], &li);
+      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);
+}

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:
+type backtrace = loc_info array
-  unit -> loc_info array option = "caml_get_exception_backtrace"
+
+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 =
+let print_exception_backtrace outchan backtrace =
-  match get_exception_backtrace() with
+  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 () =
+let print_raw_backtrace outchan raw_backtrace =
-  match get_exception_backtrace() with
+  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"
 

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