mirror of
https://github.com/c64scene-ar/llvm-6502.git
synced 2025-01-12 17:32:19 +00:00
[OCaml] Expose LLVM's fatal error and stacktrace APIs
git-svn-id: https://llvm.org/svn/llvm-project/llvm/trunk@194669 91177308-0d34-0410-b5e6-96231b3b80d8
This commit is contained in:
parent
732cf2d598
commit
a69773cead
@ -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
|
||||
|
@ -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
|
||||
|
@ -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, char *Message) {
|
||||
#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);
|
||||
|
Loading…
x
Reference in New Issue
Block a user