[llvm] r194669 - [OCaml] Expose LLVM's fatal error and stacktrace APIs
Peter Zotov
whitequark at whitequark.org
Wed Nov 13 22:34:13 PST 2013
Author: whitequark
Date: Thu Nov 14 00:34:13 2013
New Revision: 194669
URL: http://llvm.org/viewvc/llvm-project?rev=194669&view=rev
Log:
[OCaml] Expose LLVM's fatal error and stacktrace APIs
Modified:
llvm/trunk/bindings/ocaml/llvm/llvm.ml
llvm/trunk/bindings/ocaml/llvm/llvm.mli
llvm/trunk/bindings/ocaml/llvm/llvm_ocaml.c
Modified: llvm/trunk/bindings/ocaml/llvm/llvm.ml
URL: http://llvm.org/viewvc/llvm-project/llvm/trunk/bindings/ocaml/llvm/llvm.ml?rev=194669&r1=194668&r2=194669&view=diff
==============================================================================
--- llvm/trunk/bindings/ocaml/llvm/llvm.ml (original)
+++ llvm/trunk/bindings/ocaml/llvm/llvm.ml Thu Nov 14 00:34:13 2013
@@ -280,6 +280,13 @@ exception IoError of string
external register_exns : exn -> unit = "llvm_register_core_exns"
let _ = register_exns (IoError "")
+external install_fatal_error_handler : (string -> unit) -> unit
+ = "llvm_install_fatal_error_handler"
+external reset_fatal_error_handler : unit -> unit
+ = "llvm_reset_fatal_error_handler"
+external enable_pretty_stacktrace : unit -> unit
+ = "llvm_enable_pretty_stacktrace"
+
type ('a, 'b) llpos =
| At_end of 'a
| Before of 'b
Modified: llvm/trunk/bindings/ocaml/llvm/llvm.mli
URL: http://llvm.org/viewvc/llvm-project/llvm/trunk/bindings/ocaml/llvm/llvm.mli?rev=194669&r1=194668&r2=194669&view=diff
==============================================================================
--- llvm/trunk/bindings/ocaml/llvm/llvm.mli (original)
+++ llvm/trunk/bindings/ocaml/llvm/llvm.mli Thu Nov 14 00:34:13 2013
@@ -361,6 +361,21 @@ type ('a, 'b) llrev_pos =
exception IoError of string
+(** {6 Global configuration} *)
+
+(** [enable_pretty_stacktraces ()] enables LLVM's built-in stack trace code.
+ This intercepts the OS's crash signals and prints which component of LLVM
+ you were in at the time of the crash. *)
+val enable_pretty_stacktrace : unit -> unit
+
+(** [install_fatal_error_handler f] installs [f] as LLVM's fatal error handler.
+ The handler will receive the reason for termination as a string. After
+ the handler has been executed, LLVM calls [exit(1)]. *)
+val install_fatal_error_handler : (string -> unit) -> unit
+
+(** [reset_fatal_error_handler ()] resets LLVM's fatal error handler. *)
+val reset_fatal_error_handler : unit -> unit
+
(** {6 Contexts} *)
(** [create_context ()] creates a context for storing the "global" state in
Modified: llvm/trunk/bindings/ocaml/llvm/llvm_ocaml.c
URL: http://llvm.org/viewvc/llvm-project/llvm/trunk/bindings/ocaml/llvm/llvm_ocaml.c?rev=194669&r1=194668&r2=194669&view=diff
==============================================================================
--- llvm/trunk/bindings/ocaml/llvm/llvm_ocaml.c (original)
+++ llvm/trunk/bindings/ocaml/llvm/llvm_ocaml.c Thu Nov 14 00:34:13 2013
@@ -33,6 +33,7 @@ static value llvm_ioerror_exn;
CAMLprim value llvm_register_core_exns(value IoError) {
llvm_ioerror_exn = Field(IoError, 0);
register_global_root(&llvm_ioerror_exn);
+
return Val_unit;
}
@@ -50,6 +51,30 @@ static void llvm_raise(value Prototype,
#endif
}
+static value llvm_fatal_error_handler;
+
+static void llvm_fatal_error_trampoline(const char *Reason) {
+ callback(llvm_fatal_error_handler, copy_string(Reason));
+}
+
+CAMLprim value llvm_install_fatal_error_handler(value Handler) {
+ LLVMInstallFatalErrorHandler(llvm_fatal_error_trampoline);
+ llvm_fatal_error_handler = Handler;
+ caml_register_global_root(&llvm_fatal_error_handler);
+ return Val_unit;
+}
+
+CAMLprim value llvm_reset_fatal_error_handler(value Unit) {
+ caml_remove_global_root(&llvm_fatal_error_handler);
+ LLVMResetFatalErrorHandler();
+ return Val_unit;
+}
+
+CAMLprim value llvm_enable_pretty_stacktrace(value Unit) {
+ LLVMEnablePrettyStackTrace();
+ return Val_unit;
+}
+
static value alloc_variant(int tag, void *Value) {
value Iter = alloc_small(1, tag);
Field(Iter, 0) = Val_op(Value);
More information about the llvm-commits
mailing list